summaryrefslogtreecommitdiff
path: root/Build/source/texk/web2c/alephdir
diff options
context:
space:
mode:
authorKarl Berry <karl@freefriends.org>2006-01-17 21:41:51 +0000
committerKarl Berry <karl@freefriends.org>2006-01-17 21:41:51 +0000
commit487ca4806cc046076293cf6cc5fbba0db282bac7 (patch)
tree847b412ab5158dd7bdd7ed7e5a4cc3fbca94be32 /Build/source/texk/web2c/alephdir
parenta3d3111bfe26b8e5f5bc6049dfb2a4ca2edc7881 (diff)
texk 1
git-svn-id: svn://tug.org/texlive/trunk@1485 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build/source/texk/web2c/alephdir')
-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
62 files changed, 38754 insertions, 0 deletions
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
+%---------------------------------------