From 487ca4806cc046076293cf6cc5fbba0db282bac7 Mon Sep 17 00:00:00 2001 From: Karl Berry Date: Tue, 17 Jan 2006 21:41:51 +0000 Subject: texk 1 git-svn-id: svn://tug.org/texlive/trunk@1485 c570f23f-e606-0410-a88d-b1316a301751 --- Build/source/texk/web2c/alephdir/Makefile | 74 + Build/source/texk/web2c/alephdir/aleph.c | 480 ++ Build/source/texk/web2c/alephdir/aleph.defines | 74 + Build/source/texk/web2c/alephdir/aleph.mak | 197 + Build/source/texk/web2c/alephdir/aleph.mk | 184 + Build/source/texk/web2c/alephdir/aleph.version | 1 + Build/source/texk/web2c/alephdir/alephbis.c | 331 ++ Build/source/texk/web2c/alephdir/alephextra-rc1.h | 36 + Build/source/texk/web2c/alephdir/alephextra-rc2.h | 37 + Build/source/texk/web2c/alephdir/alephextra.h | 37 + Build/source/texk/web2c/alephdir/alephmem.h | 129 + Build/source/texk/web2c/alephdir/ceostuff.ch | 72 + Build/source/texk/web2c/alephdir/com-supp-w32.ch | 26 + Build/source/texk/web2c/alephdir/com16bit-rc1.ch | 2507 +++++++++ Build/source/texk/web2c/alephdir/com16bit-rc2.ch | 2755 +++++++++ Build/source/texk/web2c/alephdir/comchar.ch | 20 + Build/source/texk/web2c/alephdir/comdir.ch | 20 + Build/source/texk/web2c/alephdir/comfi.ch | 20 + Build/source/texk/web2c/alephdir/comfilter.ch | 123 + Build/source/texk/web2c/alephdir/comfont.ch | 20 + Build/source/texk/web2c/alephdir/comocp.ch | 141 + Build/source/texk/web2c/alephdir/compar.ch | 20 + Build/source/texk/web2c/alephdir/comsrcspec.ch | 346 ++ Build/source/texk/web2c/alephdir/comstr.ch | 20 + Build/source/texk/web2c/alephdir/comtrans.ch | 20 + Build/source/texk/web2c/alephdir/comw32.ch | 77 + Build/source/texk/web2c/alephdir/eo16bit-rc1.ch | 696 +++ Build/source/texk/web2c/alephdir/eo16bit-rc2.ch | 696 +++ Build/source/texk/web2c/alephdir/eo16bit-rc3.ch | 759 +++ Build/source/texk/web2c/alephdir/eobase.ch | 5548 ++++++++++++++++++ Build/source/texk/web2c/alephdir/eochar-rc1.ch | 0 Build/source/texk/web2c/alephdir/eochar-rc2.ch | 158 + Build/source/texk/web2c/alephdir/eocprt.ch | 11 + Build/source/texk/web2c/alephdir/eoeqtb.ch | 23 + Build/source/texk/web2c/alephdir/eoext.ch | 114 + Build/source/texk/web2c/alephdir/eofix.ch | 6 + Build/source/texk/web2c/alephdir/eofmt.ch | 6 + Build/source/texk/web2c/alephdir/eomega.ech | 53 + Build/source/texk/web2c/alephdir/eomem-rc1.ch | 321 ++ Build/source/texk/web2c/alephdir/eomem-rc2.ch | 330 ++ Build/source/texk/web2c/alephdir/eomem-rc3.ch | 498 ++ Build/source/texk/web2c/alephdir/eonewdir-rc1.ch | 0 Build/source/texk/web2c/alephdir/eonewdir-rc2.ch | 52 + Build/source/texk/web2c/alephdir/eopage-rc1.ch | 0 Build/source/texk/web2c/alephdir/eopage-rc2.ch | 180 + Build/source/texk/web2c/alephdir/eover-rc1.ch | 21 + Build/source/texk/web2c/alephdir/eover-rc2.ch | 230 + Build/source/texk/web2c/alephdir/etex.ch | 6176 +++++++++++++++++++++ Build/source/texk/web2c/alephdir/om16bit.ch | 2635 +++++++++ Build/source/texk/web2c/alephdir/omchar.ch | 84 + Build/source/texk/web2c/alephdir/omdir.ch | 3048 ++++++++++ Build/source/texk/web2c/alephdir/omega.ch0 | 45 + Build/source/texk/web2c/alephdir/omega.ch1 | 155 + Build/source/texk/web2c/alephdir/omega.ch2 | 83 + Build/source/texk/web2c/alephdir/omfi.ch | 246 + Build/source/texk/web2c/alephdir/omfilter.ch | 942 ++++ Build/source/texk/web2c/alephdir/omfont.ch | 2373 ++++++++ Build/source/texk/web2c/alephdir/omocp.ch | 1068 ++++ Build/source/texk/web2c/alephdir/ompar.ch | 798 +++ Build/source/texk/web2c/alephdir/omstr.ch | 875 +++ Build/source/texk/web2c/alephdir/omtrans.ch | 782 +++ Build/source/texk/web2c/alephdir/omxml.ch | 1975 +++++++ 62 files changed, 38754 insertions(+) create mode 100644 Build/source/texk/web2c/alephdir/Makefile create mode 100644 Build/source/texk/web2c/alephdir/aleph.c create mode 100644 Build/source/texk/web2c/alephdir/aleph.defines create mode 100644 Build/source/texk/web2c/alephdir/aleph.mak create mode 100644 Build/source/texk/web2c/alephdir/aleph.mk create mode 100644 Build/source/texk/web2c/alephdir/aleph.version create mode 100644 Build/source/texk/web2c/alephdir/alephbis.c create mode 100644 Build/source/texk/web2c/alephdir/alephextra-rc1.h create mode 100644 Build/source/texk/web2c/alephdir/alephextra-rc2.h create mode 100644 Build/source/texk/web2c/alephdir/alephextra.h create mode 100644 Build/source/texk/web2c/alephdir/alephmem.h create mode 100644 Build/source/texk/web2c/alephdir/ceostuff.ch create mode 100644 Build/source/texk/web2c/alephdir/com-supp-w32.ch create mode 100644 Build/source/texk/web2c/alephdir/com16bit-rc1.ch create mode 100644 Build/source/texk/web2c/alephdir/com16bit-rc2.ch create mode 100644 Build/source/texk/web2c/alephdir/comchar.ch create mode 100644 Build/source/texk/web2c/alephdir/comdir.ch create mode 100644 Build/source/texk/web2c/alephdir/comfi.ch create mode 100644 Build/source/texk/web2c/alephdir/comfilter.ch create mode 100644 Build/source/texk/web2c/alephdir/comfont.ch create mode 100644 Build/source/texk/web2c/alephdir/comocp.ch create mode 100644 Build/source/texk/web2c/alephdir/compar.ch create mode 100644 Build/source/texk/web2c/alephdir/comsrcspec.ch create mode 100644 Build/source/texk/web2c/alephdir/comstr.ch create mode 100644 Build/source/texk/web2c/alephdir/comtrans.ch create mode 100644 Build/source/texk/web2c/alephdir/comw32.ch create mode 100644 Build/source/texk/web2c/alephdir/eo16bit-rc1.ch create mode 100644 Build/source/texk/web2c/alephdir/eo16bit-rc2.ch create mode 100644 Build/source/texk/web2c/alephdir/eo16bit-rc3.ch create mode 100644 Build/source/texk/web2c/alephdir/eobase.ch create mode 100644 Build/source/texk/web2c/alephdir/eochar-rc1.ch create mode 100644 Build/source/texk/web2c/alephdir/eochar-rc2.ch create mode 100644 Build/source/texk/web2c/alephdir/eocprt.ch create mode 100644 Build/source/texk/web2c/alephdir/eoeqtb.ch create mode 100644 Build/source/texk/web2c/alephdir/eoext.ch create mode 100644 Build/source/texk/web2c/alephdir/eofix.ch create mode 100644 Build/source/texk/web2c/alephdir/eofmt.ch create mode 100644 Build/source/texk/web2c/alephdir/eomega.ech create mode 100644 Build/source/texk/web2c/alephdir/eomem-rc1.ch create mode 100644 Build/source/texk/web2c/alephdir/eomem-rc2.ch create mode 100644 Build/source/texk/web2c/alephdir/eomem-rc3.ch create mode 100644 Build/source/texk/web2c/alephdir/eonewdir-rc1.ch create mode 100644 Build/source/texk/web2c/alephdir/eonewdir-rc2.ch create mode 100644 Build/source/texk/web2c/alephdir/eopage-rc1.ch create mode 100644 Build/source/texk/web2c/alephdir/eopage-rc2.ch create mode 100644 Build/source/texk/web2c/alephdir/eover-rc1.ch create mode 100644 Build/source/texk/web2c/alephdir/eover-rc2.ch create mode 100644 Build/source/texk/web2c/alephdir/etex.ch create mode 100644 Build/source/texk/web2c/alephdir/om16bit.ch create mode 100644 Build/source/texk/web2c/alephdir/omchar.ch create mode 100644 Build/source/texk/web2c/alephdir/omdir.ch create mode 100644 Build/source/texk/web2c/alephdir/omega.ch0 create mode 100644 Build/source/texk/web2c/alephdir/omega.ch1 create mode 100644 Build/source/texk/web2c/alephdir/omega.ch2 create mode 100644 Build/source/texk/web2c/alephdir/omfi.ch create mode 100644 Build/source/texk/web2c/alephdir/omfilter.ch create mode 100644 Build/source/texk/web2c/alephdir/omfont.ch create mode 100644 Build/source/texk/web2c/alephdir/omocp.ch create mode 100644 Build/source/texk/web2c/alephdir/ompar.ch create mode 100644 Build/source/texk/web2c/alephdir/omstr.ch create mode 100644 Build/source/texk/web2c/alephdir/omtrans.ch create mode 100644 Build/source/texk/web2c/alephdir/omxml.ch (limited to 'Build/source/texk/web2c/alephdir') 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; ip==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; ip != -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=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 +# 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 +#include +#include +#include +#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@> +% +% @= +% function effective_char(@!err_p:boolean; +% @y +% replacement, but always existing character |font_bc[f]|. +% @^inner loop@> +% +% @= +% 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 @@/ +@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} + +@= +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 @@;@+tini +@y 318 +@!init +if ini_version then + begin @@; + end; +@+tini +@z + +@x [1.11] l.375 - Compile-time constants: most removed for dynamic allocation. +@= +@!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|!} + +@= +@!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 + @; + 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. +@= +@!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} + +@= +@!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. +@= +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. + +@= + 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@>@@/ + +@!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. +@ @=interaction:=error_stop_mode; +@y +@ @=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. +@= +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 + +@= +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. + +@= +@y +|remainder|, holds the remainder after a division. + +@d remainder==tex_remainder + +@= +@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 @; +@y 2738 +if r>intcast(p+1) then @; +@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_max) then + print_char("*") +@.*\relax@> + else @; +@y + begin @; +@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_max) then print_char("*") +@.*\relax@> + else @; +@y +begin if p>mem_end then print_esc("CLOBBERED.") +else begin @; +@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. +@; +@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; + +@ @= +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 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 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 @; + 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 +@ @= +k:=hyph_word[h]; if k=0 then goto not_found; +if length(k)hc[j] then goto done; + incr(j); incr(u); + until j>hn; + @; + decr(hn); goto found; + end; +done: +@y 18184 +@ @= +{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; + @; + 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 +@ @= +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 h>0 then decr(h)@+else h:=hyph_size; + end; +hyph_word[h]:=s; hyph_list[h]:=p +@y 18290 +@ @= + 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 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 +@ @= +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); +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 +@ @= +{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_int(x); +if x<>mem_bot then goto bad_fmt; +undump_int(x); +if x<>mem_top then goto bad_fmt; +@y +@+init +if ini_version then + begin libc_free(str_pool); libc_free(str_start_ar); libc_free(yzmem); + end; +@+tini +undump_int(x); +format_debug('string pool checksum')(x); +if x<>@$ then goto bad_fmt; {check that strings are the same} +undump_int(x); +if x<>max_halfword then goto bad_fmt; {check |max_halfword|} +@/@@/ + +undump_int(x); format_debug ('mem_bot')(x); +if x<>mem_bot then goto bad_fmt; +undump_int(mem_top); format_debug ('mem_top')(mem_top); +if mem_bot+1100>mem_top then goto bad_fmt; + + +head:=contrib_head; tail:=contrib_head; + page_tail:=page_head; {page initialization} + +mem_min := mem_bot - extra_mem_bot; +mem_max := mem_top + extra_mem_top; + +yzmem:=xmalloc_array (memory_word, mem_max - mem_min); +zmem := yzmem - mem_min; {this pointer arithmetic fails with some compilers} +mem := zmem; +@z + +%%%%%%%% dynamic hyph_size +@x 23804 m.1308 +if x<>hyph_size then goto bad_fmt +@y 23804 +if x<>hyph_prime then goto bad_fmt +@z + +% [1309] Make dumping/undumping more efficient by doing whole arrays at +% a time, via fread/fwrite in texmfmp.c. +@x [50.1309] l.23814 - Make dumping/undumping more efficient. +for k:=too_big_char to str_ptr do dump_int(str_start(k)); +k:=0; +while k+40 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 +@= +@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); + +@= +@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_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 @ 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 + +@= +@!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. + +@= +edit_name_start:=0; + +@ These are used when we regenerate the representation of the first 256 +strings. + +@ = +@!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.) + +@ = +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? + +@ = +@!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. + +@= +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! + +@= +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 @@/ +@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} + +@= +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 @@;@+tini +@y 318 +@!init +if ini_version then + begin @@; + end; +@+tini +@z + +@x [1.11] l.375 - Compile-time constants: most removed for dynamic allocation. +@= +@!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|!} + +@= +@!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 + @; + 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. +@= +@!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} + +@= +@!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. +@= +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. + +@= + 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@>@@/ + +@!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. +@ @=interaction:=error_stop_mode; +@y +@ @=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. +@= +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 + +@= +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. + +@= +@y +|remainder|, holds the remainder after a division. + +@d remainder==tex_remainder + +@= +@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 @; +@y 2738 +if r>intcast(p+1) then @; +@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_max) then + print_char("*") +@.*\relax@> + else @; +@y + begin @; +@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_max) then print_char("*") +@.*\relax@> + else @; +@y +begin if p>mem_end then print_esc("CLOBBERED.") +else begin @; +@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. +@; +@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; + +@ @= +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(": "); @; +if cur_ext="" then cur_ext:=e; +@y +saved_cur_name:=cur_name; +clear_terminal; prompt_input(": "); @; +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 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 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 @; + 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 +@ @= +k:=hyph_word[h]; if k=0 then goto not_found; +if length(k)hc[j] then goto done; + incr(j); incr(u); + until j>hn; + @; + decr(hn); goto found; + end; +done: +@y 18184 +@ @= +{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; + @; + 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 +@ @= +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 h>0 then decr(h)@+else h:=hyph_size; + end; +hyph_word[h]:=s; hyph_list[h]:=p +@y 18290 +@ @= + 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 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 +@ @= +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); +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 +@ @= +{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_int(x); +if x<>mem_bot then goto bad_fmt; +undump_int(x); +if x<>mem_top then goto bad_fmt; +@y +@+init +if ini_version then + begin libc_free(str_pool); libc_free(str_start_ar); libc_free(yzmem); + end; +@+tini +undump_int(x); +format_debug('format magic number')(x); +if x<>@"57325458 then goto bad_fmt; {not a format file} +undump_int(x); +format_debug('engine name size')(x); +if (x<0) or (x>256) then goto bad_fmt; {corrupted format file} +format_engine:=xmalloc_array(char, x); +undump_things(format_engine[0], x); +format_engine[x-1]:=0; {force string termination, just in case} +if strcmp(engine_name, format_engine) then + begin wake_up_terminal; + wterm_ln('---! ', stringcast(name_of_file+1), ' was written by ', format_engine); + libc_free(format_engine); + goto bad_fmt; +end; +libc_free(format_engine); +undump_int(x); +format_debug('string pool checksum')(x); +if x<>@$ then begin {check that strings are the same} + wake_up_terminal; + wterm_ln('---! ', stringcast(name_of_file+1), ' doesn''t match ', pool_name); + goto bad_fmt; +end; +undump_int(x); +if x<>max_halfword then goto bad_fmt; {check |max_halfword|} +@/@@/ + +undump_int(x); format_debug ('mem_bot')(x); +if x<>mem_bot then goto bad_fmt; +undump_int(mem_top); format_debug ('mem_top')(mem_top); +if mem_bot+1100>mem_top then goto bad_fmt; + + +head:=contrib_head; tail:=contrib_head; + page_tail:=page_head; {page initialization} + +mem_min := mem_bot - extra_mem_bot; +mem_max := mem_top + extra_mem_top; + +yzmem:=xmalloc_array (memory_word, mem_max - mem_min + 1); +zmem := yzmem - mem_min; {this pointer arithmetic fails with some compilers} +mem := zmem; +@z + +%%%%%%%% dynamic hyph_size +@x 23804 m.1308 +if x<>hyph_size then goto bad_fmt +@y 23804 +if x<>hyph_prime then goto bad_fmt +@z + +% [1309] Make dumping/undumping more efficient by doing whole arrays at +% a time, via fread/fwrite in texmfmp.c. +@x [50.1309] l.23814 - Make dumping/undumping more efficient. +for k:=too_big_char to str_ptr do dump_int(str_start(k)); +k:=0; +while k+40 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 +@= +@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); + +@= +@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_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 @ 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 + +@= +@!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. + +@= +edit_name_start:=0; +stop_at_space:=true; + +@ These are used when we regenerate the representation of the first 256 +strings. + +@ = +@!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.) + +@ = +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? + +@ = +@!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. + +@= +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. + +@= +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. + +@= +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! + +@= +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_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_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_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_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_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_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 +@= +adjust_space_factor;@/ +@y +@= +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 + +@ @= + +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 +@ @= +max_reg_num:=32767; +max_reg_help_line:="A register number must be between 0 and 32767."; +@y +@ @= +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= +@!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} + +@ @= +sa_mark:=null; sa_null.hh.lh:=null; sa_null.hh.rh:=null; + +@ @= +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|. + +@= +@!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} + +@ @= +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|} + +@= +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: @; +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 + +@= +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 + +@= +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)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. + +@= +procedure print_sa_num(@!q:pointer); {print register number} +var @!n:halfword; {the register number} +begin if sa_index(q)= +@!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 tnull 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|} + +@= +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: @; +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= +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 + +@= +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)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. + +@= +procedure print_sa_num(@!q:pointer); {print register number} +var @!n:halfword; {the register number} +begin if false {was |sa_index(q)= +@!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 tnull 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= +procedure sa_destroy(@!p:pointer); {destroy value of |p|} +begin if sa_index(p)null then + if sa_index(p)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= +procedure sa_destroy(@!p:pointer); {destroy value of |p|} +begin if false {was |sa_index(p)null then + if false {was |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)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|} sa_destroy(sa_chain); + @!stat if tracing_restores>0 then show_sa(p,"retaining");@+tats@;@/ + end +else begin if false {was |sa_index(p)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)= +max_reg_num:=32767; +max_reg_help_line:="A register number must be between 0 and 32767."; +@y +@ @= +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= +@!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} + +@ @= +sa_mark:=null; sa_null.hh.lh:=null; sa_null.hh.rh:=null; + +@ @= +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|. + +@= +@!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} + +@ @= +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|} + +@= +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: @; +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 + +@= +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 + +@= +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)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. + +@= +procedure print_sa_num(@!q:pointer); {print register number} +var @!n:halfword; {the register number} +begin if sa_index(q)= +@!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 tnull 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|} + +@= +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: @; +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= +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 + +@= +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)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. + +@= +procedure print_sa_num(@!q:pointer); {print register number} +var @!n:halfword; {the register number} +begin if false {was |sa_index(q)= +@!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 tnull 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= +procedure sa_destroy(@!p:pointer); {destroy value of |p|} +begin if sa_index(p)null then + if sa_index(p)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= +procedure sa_destroy(@!p:pointer); {destroy value of |p|} +begin if false {was |sa_index(p)null then + if false {was |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)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|} sa_destroy(sa_chain); + @!stat if tracing_restores>0 then show_sa(p,"retaining");@+tats@;@/ + end +else begin if false {was |sa_index(p)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)= +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. + +@= +procedure@?scan_register_num; forward;@t\2@> + +@ @= +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; + +@ @= +max_reg_num:=255; +max_reg_help_line:="A register number must be between 0 and 255."; + +@ @= +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. + +@= +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. + +@= +procedure@?scan_register_num; forward;@t\2@> + +@ @= +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; + +@ @= +max_reg_num:=255; +max_reg_help_line:="A register number must be between 0 and 255."; + +@ @= +max_reg_num:=32767; +max_reg_help_line:="A register number must be between 0 and 32727."; +@z +%---------------------------------------- +@x l.4607 +@ @= +@!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 +@ @= +@!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= +@!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} + +@ @= +sa_mark:=null; sa_null.hh.lh:=null; sa_null.hh.rh:=null; + +@ @= +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|. + +@= +@!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} + +@ @= +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|} + +@= +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: @; +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 + +@= +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 + +@= +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)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. + +@= +procedure print_sa_num(@!q:pointer); {print register number} +var @!n:halfword; {the register number} +begin if sa_index(q)= +@!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 tnull 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|} + +@= +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: @; +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} +@# + +@= +{|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. + +@= +begin if (chr_codelo_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}'. + +@= +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. + +@= +toks_register,register: + if (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. + +@= +@!sa_chain: pointer; {chain of saved sparse array entries} +@!sa_level: quarterword; {group level for |sa_chain|} + +@ @= +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} + +@= +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= +procedure sa_destroy(@!p:pointer); {destroy value of |p|} +begin if sa_index(p)null then + if sa_index(p)= +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|. + +@= +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| + +@= +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)0 then show_sa(p,"restoring");@+tats@;@/ + end; +delete_sa_ref(p); +p:=sa_chain; sa_chain:=link(p); +if sa_index(p)= +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 + +@ @= +print_esc("toks") + +@ @= +{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 @; +% @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 + @/@@/ + 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 npar_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 +@/@@/ +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") + @; +@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") + @; +@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"); + @@;@/ + 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") + @; +@z +%--------------------------------------- +@x [18] m.266 l.5764 - e-TeX sparse arrays +toks_register: print_esc("toks"); +@y +toks_register: @; +@z +%--------------------------------------- +% @x [18] m.266 l.5766 - e-TeX TeXXeT +% valign: print_esc("valign"); +% @y +% valign: if chr_code=0 then print_esc("valign")@/ +% @; +% @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@>@ +@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 +@/@@/ +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@>@@;@/ +@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 +@ @= +@y +@ @= +@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_chr0 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(" "); +@y +every_cr_text: print_nl(" "); +every_eof_text: print_nl(" "); +@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_tok17 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@>@@;@/ +@y +@t\4@>@@;@/ +@t\4@>@@;@/ +@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 +@y +reswitch: +if cur_cmd +@z +%--------------------------------------- +@x [25] m.367 l.7659 - e-TeX cond +expand_after:@; +@y +expand_after:if cur_chr=0 then @ + else @; +@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") + @/@@/ + 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 +@/@@/ +@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 @; +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@>@ +@y +@t\4\4@>@@; +@t\4\4@>@ +@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: @; +@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 +@/@@/ +@+else print_esc("insertpenalties"); +@z +%--------------------------------------- +@x [26] m.417 l.8434 - e-TeX basic + othercases print_esc("badness") +@y + @/@@/ + 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 +@/@@/ +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 @ +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 @@; + else if m>=eTeX_dim then + begin case m of + @/@@/ + 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; + @/@@/ + 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 (mlo_mem_stat_max) then + begin cur_val_level:=sa_type(m); + if cur_val_level255 then + begin find_sa_element(cur_val_level,cur_val,false); + if cur_ptr=null then + if cur_val_level@; +@z +%--------------------------------------- +@x [27] m.464 l.9129 - e-TeX basic +@p function str_toks(@!b:pool_pointer):pointer; +@y +@p @t\4@>@@;@/ +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 @;@/ +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 + @/@@/ + 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 +@/@@/ +end {there are no other cases} +@z +%--------------------------------------- +@x [27] m.472 l.9265 - e-TeX basic +end {there are no other cases} +@y +@/@@/ +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 +@;@/ +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 + @/@@/ + 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 @;@+save_cond_ptr:=cond_ptr;this_if:=cur_chr;@/ +@; +@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; +@;@+save_cond_ptr:=cond_ptr; +is_unless:=(cur_chr>=unless_code); this_if:=cur_chr mod unless_code;@/ +@; +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; +@/@@/ +@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 @; +% 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 +% @; +% 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 @; +% 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 +% @; +% cur_h:=cur_h+width(p); +% end; +% @z +%--------------------------------------- +% @x [32] m.622 l.12364 - e-TeX TeXXeT +% othercases do_nothing +% @y +% @/@@; +% 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 +% @; +% @y +% @; +% if eTeX_ex then @; +% @z +%--------------------------------------- +% @x [33] m.649 l.12876 hpack - e-TeX TeXXeT +% h:=0; @; +% @y +% h:=0; @; +% if TeXXeT_en then @; +% @z +%--------------------------------------- +% @x [33] m.649 l.12886 hpack - e-TeX TeXXeT +% exit: hpack:=r; +% @y +% exit: if TeXXeT_en then @; +% 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 @; +% 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)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; @; + 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; +@z +%--------------------------------------- +@x [37] m.785 l.15461 align_peek - e-TeX protected +begin restart: align_state:=1000000; @; +@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; @; +@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@>@ +@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); +@; +@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 + @; +@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 @; +@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 @; +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} + @; + 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 + @; +@z +%--------------------------------------- +@x [39] m.863 l.16969 - e-TeX last_line_fit + end;@+tats@/ +@y + end;@+tats@/ +if do_last_line_fit then @; +@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 + @; +@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); +% @z +%--------------------------------------- +% @x [39] m.880 l.17276 - e-TeX TeXXeT +% @; +% @y +% if TeXXeT_en then +% @; +% @; +% if TeXXeT_en then @; +% @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 @; +% 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 + @; +@z +%--------------------------------------- +@x [43] m.966 l.18791 init_trie - e-TeX hyph_codes +@; +@y +if hyph_root<>0 then @; +@; +@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@>@@; +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 @ + 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 @0 then @ + else @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; +% @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 +% @; +% 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") + @@/ +@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 @; +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:@@; 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@>@@; +% 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 `\.{\$\${ }\$\$}'} +% @ +% 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 +% @; +% @z +%--------------------------------------- +% @x [48] m.1146 l.21723 - e-TeX TeXXeT +% done: +% @y +% done: +% @ +% @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@>@@; +% @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 +@/@@/ +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); + @; {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); + @; {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@>@@; +% procedure after_math; +% @z +%--------------------------------------- +% @x [48] m.1194 l.22338 after_math - e-TeX TeXXeT +% begin danger:=false; +% @y +% begin danger:=false; +% @; +% @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; +% @; +% @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 +% @; +% 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 + @/@@/ + else print_esc("global"); +@z +%--------------------------------------- +@x [49] m.1211 l.22665 prefixed_command - e-TeX tracing + @; +@y + @; + 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 plo_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@/ +@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"); + @@;@/ +@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 @@;@/ +othercases @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(@$);@/ +@@/ +@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} +@/@@/ +@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 +@@;@/ +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. + +@= +@!init if (buffer[loc]="*")and(format_ident=" (INITEX)") then + begin no_new_control_sequence:=false; + @@; + incr(loc); eTeX_mode:=1; {enter 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}} + +@= +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@> + +@ @= +last_node_type_code: print_esc("lastnodetype"); +eTeX_version_code: print_esc("eTeXversion"); + +@ @= +eTeX_version_code: cur_val:=eTeX_version; + +@ @= +eTeX_revision_code: print_esc("eTeXrevision"); + +@ @= +eTeX_revision_code: do_nothing; + +@ @= +eTeX_revision_code: print(eTeX_revision); + +@ @d eTeX_ex==(eTeX_mode=1) {is this extended mode?} + +@= +@!eTeX_mode: 0..1; {identifies compatibility and extended mode} + +@ @= +eTeX_mode:=0; {initially we are in compatibility mode} +@@; + +@ @= +dump_int(eTeX_mode); +for j:=0 to eTeX_states-1 do eTeX_state(j):=0; {disable all enhancements} + +@ @= +undump(0)(1)(eTeX_mode); +if eTeX_ex then + begin @@; + end +else begin @@; + 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. + +@= +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. + +@= +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) + +@= +every_eof_loc: print_esc("everyeof"); + +@ @= +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. + +@= +@!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|. + +@= +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. + +@= +@!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}} + +@= +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@> + +@ @= +current_group_level_code: print_esc("currentgrouplevel"); +current_group_type_code: print_esc("currentgrouptype"); + +@ @= +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}} + +@= +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@> + +@ @= +current_if_level_code: print_esc("currentiflevel"); +current_if_type_code: print_esc("currentiftype"); +current_if_branch_code: print_esc("currentifbranch"); + +@ @= +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= +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@> + +@ @= +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"); + +@ @= +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}} + +@= +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@> + +@ @= +par_shape_length_code: print_esc("parshapelength"); +par_shape_indent_code: print_esc("parshapeindent"); +par_shape_dimen_code: print_esc("parshapedimen"); + +@ @= +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} } + +@= +primitive("showgroups",xray,show_groups); +@!@:show_groups_}{\.{\\showgroups} primitive@> + +@ @= +show_groups:print_esc("showgroups"); + +@ @= +show_groups: begin begin_diagnostic; show_save_groups; + end; + +@ @= +@!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. + +@= +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} + @; + found1: print_esc(s); @; + 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; + +@ @= +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 + +@ @= +i:=saved(-4); +if i<>0 then + if i0 then print_cmd_chr(j,0) else print_cmd_chr(j,1); + print_scaled(abs(i)); print("pt"); + end + else 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@> + +@= +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.) + +@= +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= +primitive("showtokens",xray,show_tokens); +@!@:show_tokens_}{\.{\\showtokens} primitive@> + +@ @= +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. + +@= +primitive("unexpanded",the,1);@/ +@!@:unexpanded_}{\.{\\unexpanded} primitive@> +primitive("detokenize",the,show_tokens);@/ +@!@:detokenize_}{\.{\\detokenize} primitive@> + +@ @= +else if chr_code=1 then print_esc("unexpanded") +else print_esc("detokenize") + +@ @= +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} } + +@= +primitive("showifs",xray,show_ifs); +@!@:show_ifs_}{\.{\\showifs} primitive@> + +@ @= +show_ifs:print_esc("showifs"); + +@ +@d print_if_line(#)==if #<>0 then + begin print(" entered on line "); print_int(#); + end + +@= +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. + +@= +primitive("interactionmode",set_page_int,2); +@!@:interaction_mode_}{\.{\\interactionmode} primitive@> + +@ @= +else if chr_code=2 then print_esc("interactionmode") + +@ @= +else if m=2 then cur_val:=interaction + +@ @= +procedure@?new_interaction; forward;@t\2@> + +@ @= +else if c=2 then + begin if (cur_valerror_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}. + +@= +primitive("middle",left_right,middle_noad); +@!@:middle_}{\.{\\middle} primitive@> + +@ @= +else if chr_code=middle_noad then print_esc("middle") + +@ The |scan_tokens| feature of \eTeX\ defines the \.{\\scantokens} +primitive. + +@= +primitive("scantokens",input,2); +@!@:scan_tokens_}{\.{\\scantokens} primitive@> + +@ @= +else if chr_code=2 then print_esc("scantokens") + +@ @= +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. + +@= +@!pseudo_files:pointer; {stack of pseudo files} + +@ @= +pseudo_files:=null; + +@ The |pseudo_start| procedure initiates reading from a pseudo file. + +@= +procedure@?pseudo_start; forward;@t\2@> + +@ @= +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; +@; +flush_string; +@; +end; + +@ @= +str_pool[pool_ptr]:=si(" "); l:=str_start(s); +nl:=si(new_line_char); +p:=get_avail; q:=p; +while lnl) 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 + +@ @= +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|. + +@= +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 + @; + 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. + +@= +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; + +@ @= +while pseudo_files<>null do pseudo_close; {flush pseudo files} + +@ @= +primitive("readline",read_to_cs,1);@/ +@!@:read_line_}{\.{\\readline} primitive@> + +@ @= +else print_esc("readline") + +@ @= +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}' } + +@= +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@> + +@ @= +else print_esc("unless") + +@ @= +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}. + +@= +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. + +@= +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). + +@= +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 @; + @; + flush_list(n); + b:=(eq_type(cur_cs)<>undefined_cs); + end; + +@ @= +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. + +@= +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}. + +@= +primitive("protected",prefix,8); +@!@:protected_}{\.{\\protected} primitive@> + +@ @= +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. + +@= +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= +@!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|. + +@= +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 @; + 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. + +@= +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). + +@= +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 @; + 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. + +@= +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. + +@= +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@> + +@ @= +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. + +@= +begin if m@/ + end; {there are no other cases} + cur_val_level:=glue_val; + end +else if m@/ + 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); + @; + end + else negate(cur_val); +return; +end + +@ @= +procedure@?scan_expr; forward;@t\2@> + +@ The |scan_expr| procedure scans and evaluates an expression. + +@= +@t\4@>@ +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; +@; +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} + +@= +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; +@; +found: @; +arith_error:=b; +@; +case s of @@; +end; {there are no other cases} +if o>expr_sub then s:=o@+else @; +b:=arith_error; +if o<>expr_none then goto continue; +if p<>null then @ + +@ @= +@; +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 + +@ @= +@; +if cur_tok=other_token+"(" then + @; +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 + +@ @= +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. + +@= +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} + +@= +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 + +@ @= +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 + +@= +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 + +@= +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) + +@= +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 @; +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|. + +@= +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|. + +@= +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)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)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) + +@= +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) + +@= +expr_div: if l= +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) + +@= +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} + +@= +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@; +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= +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= +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@> + +@ @= +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"); + +@ @= +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; + +@ @= +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}} + +@= +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@> + +@ @= +mu_to_glue_code: print_esc("mutoglue"); +glue_to_mu_code: print_esc("gluetomu"); + +@ @= +mu_to_glue_code: scan_mu_glue; + +@ @= +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. + +@= +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. + +@= +procedure@?scan_register_num; forward;@t\2@> + +@ @= +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; + +@ @= +max_reg_num:=255; +max_reg_help_line:="A register number must be between 0 and 255."; + +@ @= +max_reg_num:=32767; +max_reg_help_line:="A register number must be between 0 and 32767."; + +@ @= +@!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= +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} + +@= +@!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} + +@ @= +sa_mark:=null; sa_null.hh.lh:=null; sa_null.hh.rh:=null; + +@ @= +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|} + +@= +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: @; +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 + +@= +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 + +@= +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)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. + +@= +procedure print_sa_num(@!q:pointer); {print register number} +var @!n:halfword; {the register number} +begin if sa_index(q)= +@!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 tnull 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|. + +@= +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|} + +@= +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 + @@; + 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. + +@= +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|. + +@= +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|. + +@= +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; + +@ @= +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; + +@ @= +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@> + +@= +@!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. + +@= +begin if (chr_codelo_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}'. + +@= +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. + +@= +toks_register,register: + if (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. + +@= +@!sa_chain: pointer; {chain of saved sparse array entries} +@!sa_level: quarterword; {group level for |sa_chain|} + +@ @= +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} + +@= +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= +procedure sa_destroy(@!p:pointer); {destroy value of |p|} +begin if sa_index(p)null then + if sa_index(p)= +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|. + +@= +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| + +@= +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)0 then show_sa(p,"restoring");@+tats@;@/ + end; +delete_sa_ref(p); +p:=sa_chain; sa_chain:=link(p); +if sa_index(p)= +@!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. + +@= +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 + +@ @= +@!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. + +@= +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|. + +@= +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 + @ +else if g<0 then + @; +not_found:end + +@ These badness computations are rather similar to those of the standard +algorithm, with the adjustment amount |g| replacing the |shortfall|. + +@= +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 + +@ @= +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. + +@= +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). + +@= +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. + +@= +begin active_short(q):=best_pl_short[fit_class]; +active_glue(q):=best_pl_glue[fit_class]; +end + +@ @= +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. + +@= +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|} + +@= +hyph_root:=0; hyph_start:=0; + +@ @= +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; +q:=p; {now node |q| represents |cur_lang|} +@; +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. + +@= +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 + @ + 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. + +@= +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+#)) + +@= +@!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}} + +@= +@!disc_ptr:array[copy_code..vsplit_code] of pointer; {list pointers} + +@ @= +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|. + +@= +primitive("pagediscards",un_vbox,last_box_code);@/ +@!@:page_discards_}{\.{\\pagediscards} primitive@> +primitive("splitdiscards",un_vbox,vsplit_code);@/ +@!@:split_discards_}{\.{\\splitdiscards} primitive@> + +@ @= +else if chr_code=last_box_code then print_esc("pagediscards") +else if chr_code=vsplit_code then print_esc("splitdiscards") + +@ @= +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) + +@= +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@> + +@ @= +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"); + +@ @= +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 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 +@ @= +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 +@ @= +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 +@ @= +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 +@ @= +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 +@ + +@ @= +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 @ +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@> + +@ @= +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 @ +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@> +% +% @= +% function effective_char(@!err_p:boolean; +% @y +% replacement, but always existing character |font_bc[f]|. +% @^inner loop@> +% +% @= +% 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 (mlo_mem_stat_max) then + begin cur_val_level:=sa_type(m); + if cur_val_level255 then + begin find_sa_element(cur_val_level,cur_val,false); + if cur_ptr=null then + if cur_val_level1) 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_contextcopy_code then @; +c:=cur_chr; scan_register_num; fetch_box(p); +@y +begin if cur_chr>copy_code then @; +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 plo_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 pnull 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 (mlo_mem_stat_max) then + begin cur_val_level:=sa_type(m); + if cur_val_level255 then + begin find_sa_element(cur_val_level,cur_val,false); + if cur_ptr=null then + if cur_val_level1) 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_contextcopy_code then @; +c:=cur_chr; scan_register_num; fetch_box(p); +@y +begin if cur_chr>copy_code then @; +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 plo_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 pnull 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: @; +@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@>@ +@y +@d level_boundary=3 {|save_type| corresponding to beginning of group} + +@p@t\4@>@ +@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 +@/@@/ +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: @; +@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 (mlo_mem_stat_max) then + begin cur_val_level:=sa_type(m); + if cur_val_level255 then + begin find_sa_element(cur_val_level,cur_val,false); + if cur_ptr=null then + if cur_val_level1) 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_contextcopy_code then @; +c:=cur_chr; scan_register_num; fetch_box(p); +@y +begin if cur_chr>copy_code then @; +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 plo_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 pnull 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 +@ @= +i:=saved(-4); +if i<>0 then + if i0 then print_cmd_chr(j,0) else print_cmd_chr(j,1); + print_scaled(abs(i)); print("pt"); + end + else 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 +@ @= +i:=saved(-4); +if i<>0 then + if i0 then print_cmd_chr(j,0) else print_cmd_chr(j,1); + print_scaled(abs(i)); print("pt"); + end + else 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 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 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 +@ @= +@; +@; +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 +@ @= +@; +@; +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"); + @/@@/ + 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"); + @/@@/ + 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}} + +@= +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@> + +@ @= +last_node_type_code: print_esc("lastnodetype"); +eTeX_version_code: print_esc("eTeXversion"); + +@ @= +eTeX_version_code: cur_val:=eTeX_version; + +@ @= +eTeX_revision_code: print_esc("eTeXrevision"); + +@ @= +eTeX_revision_code: do_nothing; + +@ @= +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}} + +@= +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@> + +@ @= +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"); + +@ @= +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; + +@ @= +Aleph_revision_code: print_esc("Alephrevision"); +Omega_revision_code: print_esc("Omegarevision"); +eTeX_revision_code: print_esc("eTeXrevision"); + +@ @= +Aleph_revision_code: do_nothing; +Omega_revision_code: do_nothing; +eTeX_revision_code: do_nothing; + +@ @= +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 @; +@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 + @/@@/ + 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 npar_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 +@/@@/ +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") + @; +@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") + @; +@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"); + @@;@/ + 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") + @; +@z +%--------------------------------------- +@x [18] m.266 l.5764 - e-TeX sparse arrays +toks_register: print_esc("toks"); +@y +toks_register: @; +@z +%--------------------------------------- +@x [18] m.266 l.5766 - e-TeX TeXXeT +valign: print_esc("valign"); +@y +valign: if chr_code=0 then print_esc("valign")@/ + @; +@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@>@ +@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 +@/@@/ +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@>@@;@/ +@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 +@ @= +@y +@ @= +@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_chr0 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(" "); +@y +every_cr_text: print_nl(" "); +every_eof_text: print_nl(" "); +@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_tok17 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@>@@;@/ +@y +@t\4@>@@;@/ +@t\4@>@@;@/ +@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 +@y +reswitch: +if cur_cmd +@z +%--------------------------------------- +@x [25] m.367 l.7659 - e-TeX cond +expand_after:@; +@y +expand_after:if cur_chr=0 then @ + else @; +@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") + @/@@/ + 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 +@/@@/ +@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 @; +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@>@ +@y +@t\4\4@>@@; +@t\4\4@>@ +@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: @; +@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 +@/@@/ +@+else print_esc("insertpenalties"); +@z +%--------------------------------------- +@x [26] m.417 l.8434 - e-TeX basic + othercases print_esc("badness") +@y + @/@@/ + 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 +@/@@/ +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 @ +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 @@; + else if m>=eTeX_dim then + begin case m of + @/@@/ + 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; + @/@@/ + 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 (mlo_mem_stat_max) then + begin cur_val_level:=sa_type(m); + if cur_val_level255 then + begin find_sa_element(cur_val_level,cur_val,false); + if cur_ptr=null then + if cur_val_level@; +@z +%--------------------------------------- +@x [27] m.464 l.9129 - e-TeX basic +@p function str_toks(@!b:pool_pointer):pointer; +@y +@p @t\4@>@@;@/ +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 @;@/ +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 + @/@@/ + 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 +@/@@/ +end {there are no other cases} +@z +%--------------------------------------- +@x [27] m.472 l.9265 - e-TeX basic +end {there are no other cases} +@y +@/@@/ +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 +@;@/ +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 + @/@@/ + 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 @;@+save_cond_ptr:=cond_ptr;this_if:=cur_chr;@/ +@; +@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; +@;@+save_cond_ptr:=cond_ptr; +is_unless:=(cur_chr>=unless_code); this_if:=cur_chr mod unless_code;@/ +@; +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; +@/@@/ +@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 @; + 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 + @; + 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 @; + 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 + @; + cur_h:=cur_h+width(p); + end; +@z +%--------------------------------------- +@x [32] m.622 l.12364 - e-TeX TeXXeT +othercases do_nothing +@y +@/@@; +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 +@; +@y +@; +if eTeX_ex then @; +@z +%--------------------------------------- +@x [33] m.649 l.12876 hpack - e-TeX TeXXeT +h:=0; @; +@y +h:=0; @; +if TeXXeT_en then @; +@z +%--------------------------------------- +@x [33] m.649 l.12886 hpack - e-TeX TeXXeT +exit: hpack:=r; +@y +exit: if TeXXeT_en then @; +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 @; + 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)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; @; + 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; +@z +%--------------------------------------- +@x [37] m.785 l.15461 align_peek - e-TeX protected +begin restart: align_state:=1000000; @; +@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; @; +@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@>@ +@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); +@; +@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 + @; +@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 @; +@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 @; +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} + @; + 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 + @; +@z +%--------------------------------------- +@x [39] m.863 l.16969 - e-TeX last_line_fit + end;@+tats@/ +@y + end;@+tats@/ +if do_last_line_fit then @; +@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 + @; +@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); +@z +%--------------------------------------- +@x [39] m.880 l.17276 - e-TeX TeXXeT +@; +@y +if TeXXeT_en then + @; +@; +if TeXXeT_en then @; +@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 @; + 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 + @; +@z +%--------------------------------------- +@x [43] m.966 l.18791 init_trie - e-TeX hyph_codes +@; +@y +if hyph_root<>0 then @; +@; +@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@>@@; +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 @ + 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 @0 then @ + else @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; +@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 + @; + 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") + @@/ +@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 @; +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:@@; 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@>@@; +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 `\.{\$\${ }\$\$}'} + @ +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 +@; +@z +%--------------------------------------- +@x [48] m.1146 l.21723 - e-TeX TeXXeT +done: +@y +done: +@ +@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@>@@; +@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 +@/@@/ +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@>@@; +procedure after_math; +@z +%--------------------------------------- +@x [48] m.1194 l.22338 after_math - e-TeX TeXXeT +begin danger:=false; +@y +begin danger:=false; +@; +@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; + @; +@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 +@; +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 + @/@@/ + else print_esc("global"); +@z +%--------------------------------------- +@x [49] m.1211 l.22665 prefixed_command - e-TeX tracing + @; +@y + @; + 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 plo_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@/ +@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"); + @@;@/ +@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 @@;@/ +othercases @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(@$);@/ +@@/ +@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} +@/@@/ +@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 +@@;@/ +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. + +@= +@!init if (buffer[loc]="*")and(format_ident=" (INITEX)") then + begin no_new_control_sequence:=false; + @@; + incr(loc); eTeX_mode:=1; {enter 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}} + +@= +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@> + +@ @= +last_node_type_code: print_esc("lastnodetype"); +eTeX_version_code: print_esc("eTeXversion"); + +@ @= +eTeX_version_code: cur_val:=eTeX_version; + +@ @= +eTeX_revision_code: print_esc("eTeXrevision"); + +@ @= +eTeX_revision_code: do_nothing; + +@ @= +eTeX_revision_code: print(eTeX_revision); + +@ @d eTeX_ex==(eTeX_mode=1) {is this extended mode?} + +@= +@!eTeX_mode: 0..1; {identifies compatibility and extended mode} + +@ @= +eTeX_mode:=0; {initially we are in compatibility mode} +@@; + +@ @= +dump_int(eTeX_mode); +for j:=0 to eTeX_states-1 do eTeX_state(j):=0; {disable all enhancements} + +@ @= +undump(0)(1)(eTeX_mode); +if eTeX_ex then + begin @@; + end +else begin @@; + 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. + +@= +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. + +@= +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) + +@= +every_eof_loc: print_esc("everyeof"); + +@ @= +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. + +@= +@!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|. + +@= +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. + +@= +@!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}} + +@= +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@> + +@ @= +current_group_level_code: print_esc("currentgrouplevel"); +current_group_type_code: print_esc("currentgrouptype"); + +@ @= +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}} + +@= +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@> + +@ @= +current_if_level_code: print_esc("currentiflevel"); +current_if_type_code: print_esc("currentiftype"); +current_if_branch_code: print_esc("currentifbranch"); + +@ @= +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= +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@> + +@ @= +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"); + +@ @= +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}} + +@= +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@> + +@ @= +par_shape_length_code: print_esc("parshapelength"); +par_shape_indent_code: print_esc("parshapeindent"); +par_shape_dimen_code: print_esc("parshapedimen"); + +@ @= +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} } + +@= +primitive("showgroups",xray,show_groups); +@!@:show_groups_}{\.{\\showgroups} primitive@> + +@ @= +show_groups:print_esc("showgroups"); + +@ @= +show_groups: begin begin_diagnostic; show_save_groups; + end; + +@ @= +@!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. + +@= +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} + @; + found1: print_esc(s); @; + 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; + +@ @= +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 + +@ @= +i:=saved(-4); +if i<>0 then + if i0 then print_cmd_chr(j,0) else print_cmd_chr(j,1); + print_scaled(abs(i)); print("pt"); + end + else 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@> + +@= +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.) + +@= +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= +primitive("showtokens",xray,show_tokens); +@!@:show_tokens_}{\.{\\showtokens} primitive@> + +@ @= +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. + +@= +primitive("unexpanded",the,1);@/ +@!@:unexpanded_}{\.{\\unexpanded} primitive@> +primitive("detokenize",the,show_tokens);@/ +@!@:detokenize_}{\.{\\detokenize} primitive@> + +@ @= +else if chr_code=1 then print_esc("unexpanded") +else print_esc("detokenize") + +@ @= +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} } + +@= +primitive("showifs",xray,show_ifs); +@!@:show_ifs_}{\.{\\showifs} primitive@> + +@ @= +show_ifs:print_esc("showifs"); + +@ +@d print_if_line(#)==if #<>0 then + begin print(" entered on line "); print_int(#); + end + +@= +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. + +@= +primitive("interactionmode",set_page_int,2); +@!@:interaction_mode_}{\.{\\interactionmode} primitive@> + +@ @= +else if chr_code=2 then print_esc("interactionmode") + +@ @= +else if m=2 then cur_val:=interaction + +@ @= +procedure@?new_interaction; forward;@t\2@> + +@ @= +else if c=2 then + begin if (cur_valerror_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}. + +@= +primitive("middle",left_right,middle_noad); +@!@:middle_}{\.{\\middle} primitive@> + +@ @= +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 + +@= +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)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?} + +@= +eTeX_state_code+TeXXeT_code:print_esc("TeXXeTstate"); + +@ @= +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@> + +@ @= +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 + +@ @= +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. + +@= +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 + +@= +@!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} + +@ @= +LR_temp:=null; LR_ptr:=null; LR_problems:=0; cur_dir:=left_to_right; + +@ @= +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 @; + q:=link(q); + end; +end + +@ @= +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. + +@= +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. + +@= +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; + +@ @= +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; + +@ @= +put_LR(before) {this will never match} + +@ @= +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) + +@ @= +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 @; goto common_ending; + end; +pop_LR; +if LR_ptr<>null then confusion("LR1"); +@:this can't happen LR1}{\quad LR1@> +end + +@ @= +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'} + +@= +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 + @; + end; +type(p):=kern_node; +end + +@ @= +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)} + +@= +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; + +@ @= +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. + +@= +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. + +@= +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. + +@= +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 + @; + 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; + +@ @= +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 @ + +@ @= +begin q:=link(p); +case type(p) of +hlist_node,vlist_node,rule_node,kern_node: rule_wd:=width(p); +@t\4@>@@; +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. + +@= +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. + +@= +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. + +@= +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 @; + 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. + +@= +begin free_node(p,small_node_size); +link(t):=q; width(t):=rule_wd; edge_dist(t):=-cur_h-rule_wd; goto done; +end + +@ @= +begin if LR_problems>0 then + begin @; 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. + +@= +if LR_save=null then x:=0 +else if info(LR_save)>=R_code then x:=-1@+else x:=1 + +@ @= +begin pop_nest; @; +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@> + +@= +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:@; + 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. + +@= +if eTeX_ex then @; +v:=shift_amount(just_box); +@; +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 @ + +@ @= +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|. + +@= +math_node: begin d:=width(p); + if TeXXeT_en then @ + 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; + +@ @= +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 + +@ @= +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 + @; + 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; + +@ @= +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}. + +@= +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. + +@= +@!j:pointer; {prototype box} + +@ @= +if mode=mmode then j:=LR_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. + +@= +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; + @; + @; + 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). + +@= +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) + +@= +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. + +@= +primitive("scantokens",input,2); +@!@:scan_tokens_}{\.{\\scantokens} primitive@> + +@ @= +else if chr_code=2 then print_esc("scantokens") + +@ @= +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. + +@= +@!pseudo_files:pointer; {stack of pseudo files} + +@ @= +pseudo_files:=null; + +@ The |pseudo_start| procedure initiates reading from a pseudo file. + +@= +procedure@?pseudo_start; forward;@t\2@> + +@ @= +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; +@; +flush_string; +@; +end; + +@ @= +str_pool[pool_ptr]:=si(" "); l:=str_start[s]; +nl:=si(new_line_char); +p:=get_avail; q:=p; +while lnl) 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 + +@ @= +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|. + +@= +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 + @; + 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. + +@= +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; + +@ @= +while pseudo_files<>null do pseudo_close; {flush pseudo files} + +@ @= +primitive("readline",read_to_cs,1);@/ +@!@:read_line_}{\.{\\readline} primitive@> + +@ @= +else print_esc("readline") + +@ @= +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}' } + +@= +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@> + +@ @= +else print_esc("unless") + +@ @= +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}. + +@= +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. + +@= +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). + +@= +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 @; + @; + flush_list(n); + b:=(eq_type(cur_cs)<>undefined_cs); + end; + +@ @= +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. + +@= +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}. + +@= +primitive("protected",prefix,8); +@!@:protected_}{\.{\\protected} primitive@> + +@ @= +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. + +@= +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= +@!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|. + +@= +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 @; + 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. + +@= +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). + +@= +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 @; + 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. + +@= +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. + +@= +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@> + +@ @= +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. + +@= +begin if m@/ + end; {there are no other cases} + cur_val_level:=glue_val; + end +else if m@/ + 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); + @; + end + else negate(cur_val); +return; +end + +@ @= +procedure@?scan_expr; forward;@t\2@> + +@ The |scan_expr| procedure scans and evaluates an expression. + +@= +@t\4@>@ +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; +@; +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} + +@= +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; +@; +found: @; +arith_error:=b; +@; +case s of @@; +end; {there are no other cases} +if o>expr_sub then s:=o@+else @; +b:=arith_error; +if o<>expr_none then goto continue; +if p<>null then @ + +@ @= +@; +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 + +@ @= +@; +if cur_tok=other_token+"(" then + @; +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 + +@ @= +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. + +@= +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} + +@= +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 + +@ @= +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 + +@= +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 + +@= +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) + +@= +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 @; +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|. + +@= +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|. + +@= +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)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)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) + +@= +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) + +@= +expr_div: if l= +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) + +@= +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} + +@= +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@; +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= +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= +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@> + +@ @= +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"); + +@ @= +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; + +@ @= +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}} + +@= +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@> + +@ @= +mu_to_glue_code: print_esc("mutoglue"); +glue_to_mu_code: print_esc("gluetomu"); + +@ @= +mu_to_glue_code: scan_mu_glue; + +@ @= +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. + +@= +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. + +@= +procedure@?scan_register_num; forward;@t\2@> + +@ @= +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; + +@ @= +max_reg_num:=255; +max_reg_help_line:="A register number must be between 0 and 255."; + +@ @= +max_reg_num:=32767; +max_reg_help_line:="A register number must be between 0 and 32767."; + +@ @= +@!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= +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} + +@= +@!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} + +@ @= +sa_mark:=null; sa_null.hh.lh:=null; sa_null.hh.rh:=null; + +@ @= +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|} + +@= +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: @; +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 + +@= +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 + +@= +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)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. + +@= +procedure print_sa_num(@!q:pointer); {print register number} +var @!n:halfword; {the register number} +begin if sa_index(q)= +@!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 tnull 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|. + +@= +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|} + +@= +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 + @@; + 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. + +@= +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|. + +@= +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|. + +@= +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; + +@ @= +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; + +@ @= +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@> + +@= +@!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. + +@= +begin if (chr_codelo_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}'. + +@= +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. + +@= +toks_register,register: + if (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. + +@= +@!sa_chain: pointer; {chain of saved sparse array entries} +@!sa_level: quarterword; {group level for |sa_chain|} + +@ @= +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} + +@= +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= +procedure sa_destroy(@!p:pointer); {destroy value of |p|} +begin if sa_index(p)null then + if sa_index(p)= +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|. + +@= +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| + +@= +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)0 then show_sa(p,"restoring");@+tats@;@/ + end; +delete_sa_ref(p); +p:=sa_chain; sa_chain:=link(p); +if sa_index(p)= +@!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. + +@= +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 + +@ @= +@!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. + +@= +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|. + +@= +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 + @ +else if g<0 then + @; +not_found:end + +@ These badness computations are rather similar to those of the standard +algorithm, with the adjustment amount |g| replacing the |shortfall|. + +@= +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 + +@ @= +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. + +@= +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). + +@= +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. + +@= +begin active_short(q):=best_pl_short[fit_class]; +active_glue(q):=best_pl_glue[fit_class]; +end + +@ @= +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. + +@= +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|} + +@= +hyph_root:=0; hyph_start:=0; + +@ @= +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; +q:=p; {now node |q| represents |cur_lang|} +@; +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. + +@= +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 + @ + 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. + +@= +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+#)) + +@= +@!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}} + +@= +@!disc_ptr:array[copy_code..vsplit_code] of pointer; {list pointers} + +@ @= +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|. + +@= +primitive("pagediscards",un_vbox,last_box_code);@/ +@!@:page_discards_}{\.{\\pagediscards} primitive@> +primitive("splitdiscards",un_vbox,vsplit_code);@/ +@!@:split_discards_}{\.{\\splitdiscards} primitive@> + +@ @= +else if chr_code=last_box_code then print_esc("pagediscards") +else if chr_code=vsplit_code then print_esc("splitdiscards") + +@ @= +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) + +@= +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@> + +@ @= +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"); + +@ @= +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''} + +@= +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''} + +@= +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 +@ @= +begin if n=cur_font_loc then print("current font") +else if n= +set_new_eqtb_int(int_base+new_line_char_code,-1) + +@ @= +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|. + +@= +@!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} + +@= +@!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+#) + +@= +@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 @; +p:=h+hash_base; {we start searching here; note that |0<=h0 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 @; + goto found; + end; + p:=next(p); + end; +found: id_lookup:=p; +@y +@!k:pointer; {index in |buffer| array} +@!newstring:integer; +begin @; +p:=h+hash_base; {we start searching here; note that |0<=h0 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 @; + 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)=end_match_token)or(info(r); +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 @; +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 @; +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 +@ @= +begin scan_char_num; +if m=math_code_base then scanned_result(ho(math_code(cur_val)))(int_val) +else if m= +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 m255) 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; + +@ @= +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 + @=h+256|@>; +@y + @=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)|. + +@=h+256|@>= +if trie_maxz|, 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)|. + +@=h+max_hyph_char|@>= +if trie_max= +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 +@ @= +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 @; +@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); +@; +@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_context255 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)) + +@= +procedure scan_math(@!p:pointer); +label restart,reswitch,exit; +var c:integer; {math character code} +begin restart:@; +reswitch:case cur_cmd of +letter,other_char,char_given: begin c:=ho(math_code(cur_chr)); + if c=@'100000 then + begin @; + 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 @ +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)) + +@= +@t\4@>@@t@>@;@/ + +procedure scan_math(@!p:pointer); +label restart,reswitch,exit; +var c:integer; {math character code} +begin restart:@; +reswitch: +case cur_cmd of +letter,other_char,char_given: begin + c:=ho(math_code(cur_chr)); + if c=@"8000000 then + begin @; + 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 @ +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 + @ +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 + @ +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 @; + 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 @; +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 @; + 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 @; + 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 + @; +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 + @; +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@>@@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}} + +@= +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}} + +@= +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 @; + p:=cur_chr; scan_char_num; p:=p+cur_val; scan_optional_equals; + scan_int; + if ((cur_val<0)and(pn) then + begin print_err("Invalid code ("); print_int(cur_val); +@.Invalid code@> + if p@"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 + @; + p:=cur_chr; scan_char_num; p:=p+cur_val; scan_optional_equals; + scan_int; + if ((cur_val<0)and(pn) then + begin print_err("Invalid code ("); print_int(cur_val); +@.Invalid code@> + if p; +@; +@y +dump_eqtb_table; +@z +%--------------------------------------- +@x [50] m.1314 l.23904 - Omega +@; +@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)$. + +@= +k:=active_base; +repeat j:=k; +while jequiv(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= +repeat j:=k; +while jeqtb[j+1].int then goto done2; + incr(j); + end; +done2:dump_int(l-k); +while keqtb_size + +@ @= +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_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_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 +@ @= +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 + @ +else begin @; + 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 +@ @= +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 + @ +else begin @; + 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 @; +@y +@ @p @; + +@ @p @; +@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} + +@= +@!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} + +@= +@!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 +@ @= +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 + +@= +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; + +@ @= +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; +@; +@; +found: @; +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; +@; +end; +@; +found: @; +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 @; +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); +@; +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 @; +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; +@; +@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 +@= +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 +@= +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 @; +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 @; +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 +@= +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 +@= +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 +@= +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 +@= +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|} + +@= +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; + @; + 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); +@; +@z +%------------------------- +@x [33] m.649 +exit: hpack:=r; +@y +exit: +@; +hpack:=r; +@z +%------------------------- +@x [33] m.653 +@= +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 +@= +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 +@= +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 +@= +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 +@ @= +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 +@ @= +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 +@ @= +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 +@ @= +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= +@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; + +@ @= +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; +@; +@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 +@= +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 +@= +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 +@ @= +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 +@ @= +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 +@ @= +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 +@ @= +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 +@ @= +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 +@ @= +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} + +@= +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 @; +cur_line:=prev_graf+1; +repeat @; +incr(cur_line); cur_p:=next_break(cur_p); +if cur_p<>null then if not post_disc_break then + @; +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} + +@= +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; +@; +cur_line:=prev_graf+1; +repeat @; +incr(cur_line); cur_p:=next_break(cur_p); +if cur_p<>null then if not post_disc_break then + @; +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 +@= +@; +@; +@y +@= +@; +@; +@; +@; +@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 + @ + 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); + @; + 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); + @; + 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 + @ + 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; +@; +@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; +@; +q:=vert_break(list_ptr(v),h,split_max_depth); +@; +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; +@; +q:=vert_break(list_ptr(v),h,split_max_depth); +@; +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 @; + 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 + @; + unsave; + if abs(mode)=hmode then begin + if temp_no_dirs<>0 then begin + @; + dir_dir(tail):=temporary_dir-64; + end; + if temp_no_whatsits<>0 then + @; + 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 @; + 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 + @; + unsave; + if abs(mode)=hmode then begin + if temp_no_dirs<>0 then begin + @; + dir_dir(tail):=temporary_dir-64; + end; + if temp_no_whatsits<>0 then + @; + end + end; +@z +%------------------------- +@x [47] m.1083 +begin k:=cur_chr-vtop_code; saved(0):=box_context; +if k=hmode then + if (box_context; + 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 @; + end; +if saved(4)<>null then + @; +pop_nest; box_end(saved(0)); +end; +@z +%------------------------- +@x [47] m.1091 +procedure new_graf(@!indented:boolean); +begin prev_graf:=0; +if (mode=vmode)or(head<>tail) then + tail_append(new_param_glue(par_skip_code)); +push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang; +prev_graf:=(norm_min(left_hyphen_min)*@'100+norm_min(right_hyphen_min)) + *@'200000+cur_lang; +@; +if indented then begin + tail:=new_null_box; link(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; +@; +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; +@; +end; +@z +%------------------------- +@x [48] m.1174 +begin unsave; p:=fin_mlist(null); +@y +begin @; p:=fin_mlist(null); +@z +%------------------------- +@x [48] m.1186 +math_group: begin unsave; decr(save_ptr);@/ +@y +math_group: begin @; 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); + @; {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} +@@; +begin danger:=false; +@; +m:=mode; l:=false; p:=fin_mlist(null); {this pops the nest} +if mode=-m then {end of equation number} + begin @; + 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} +@@; +begin danger:=false; +@; +m:=mode; l:=false; p:=fin_mlist(null); {this pops the nest} +if mode=-m then {end of equation number} + begin @; + cur_mlist:=p; cur_style:=text_style; mlist_penalties:=false; + mlist_to_hlist; a:=hpack(link(temp_head),natural); + @; + decr(save_ptr); {now |cur_group=math_shift_group|} + if saved(0)=1 then l:=true; +@z +%------------------------- +@x [48] m.1196 +@= +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 +@ = +begin tail_append(new_math(math_surround,before)); +if dir_math_save then + @; +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 + @; +dir_math_save:=false; +tail_append(new_math(math_surround,after)); +space_factor:=1000; +@; +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@> +@; +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 + @ + 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; +@; +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; +@; +f:=read_font_info(u,cur_name,cur_area,s,offset,natural_dir); +@z +%------------------------- +@x [51] m.1337 +if (locescape) then start_input; + {\.{\\input} assumed} +@y +if (locescape) then start_input; + {\.{\\input} assumed} +@; +@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:@; +@y +set_language_code:@; +@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 +@ @=do_nothing +@y +@ @= +begin +if subtype(p)=dir_node then + begin + @; + end; +end +@z +%------------------------- +@x [53] m.1362 +@=@+ +adv_past(cur_p) else @ +@y +@=@+ +adv_past(cur_p) else @ +else @ +@z +%------------------------- +@x [53] m.1366 +@ @= +out_what(p) +@y +@ @= +if subtype(p)<>dir_node then out_what(p) +else @ +@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 +@ @= +((type(q)=whatsit_node) and (subtype(q)=local_par_node)) + +@y +@ @= +((type(q)=whatsit_node) and (subtype(q)=local_par_node)) + +@ @= +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_dir(tail):=dir_dir(tail)-64; + end; + if dir_level(text_dir_ptr)=cur_level then + @; + eq_word_define(dir_base+text_direction_code,cur_val); + @; + if abs(mode)=hmode then + begin + @; + 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 + +@ @= +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 + +@ @= +tail_append(new_dir(math_direction)) + +@ @= +tail_append(new_dir(math_direction-64)) + +@ @= +tail_append(new_dir(text_direction)) + +@ @= +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 + +@ @= +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 + +@ @= +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 + +@ @= +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 + +@ @= +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 + +@ @= +begin + while dir_ptr<>null do + pop_dir_node +end + +@ @= +begin +unsave; +decr(save_ptr); +flush_node_list(text_dir_ptr); +text_dir_ptr:=saved(0); +end + +@ @= +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 + +@ @= +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 + +@ @= +begin +flush_node_list(text_dir_ptr); +text_dir_ptr:=saved(4); +end + +@ @= +begin +text_dir_tmp:=new_dir(text_direction); +link(text_dir_tmp):=text_dir_ptr; +text_dir_ptr:=text_dir_tmp; +end + +@ @= +begin +text_dir_tmp:=link(text_dir_ptr); +free_node(text_dir_ptr,dir_node_size); +text_dir_ptr:=text_dir_tmp; +end + +@ @= +begin +text_dir_ptr:=new_dir(0); +end + +@ @= +begin dir_ptr:=null; push_dir(dvi_direction); +dir_dvi_ptr(dir_ptr):=dvi_ptr; +end + +@ @= +begin dir_ptr:=null; push_dir(hpack_dir) end + +@ @= +begin dir_ptr:=null; push_dir(paragraph_dir); end + +@ @= +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} +@/@@/ +@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. + +@= + 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 +% @; +% @y +% @; +% if src_specials_p then begin +% @z + +% @x +% while p<>null do @null do @= +if ((head=tail) and (mode>0)) then begin + if (insert_src_special_auto) then append_src_special; +end; +@y +@= +@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|} +@/@@/ +@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) + +@= +@!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) + +@= +@!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]|. + +@= +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]|. + +@= +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 @; + @; +@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(":"); + @; + end + else if state<>token_list then + begin @; + @; +@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;@/ + @0 then + begin + pop_input; goto restart; + end; + state:=new_line; + @= +@!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 + +@= +@!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; + +@ +@= +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-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; +@y +main_loop: +if is_last_ocp(current_ocp_lstack,current_ocp_no) then + begin + @; + end +else begin + @; + end; +@z +%--------------------------------------- +@x [50] m.1302 l.23862 - Omega Filtering +@; +@y +@; +@; +@z +%--------------------------------------- +@x [50] m.1303 l.23711 - Omega Filtering +@; +@y +@; +@; +@z +%--------------------------------------- +@x [50] m.1323 l.24907 - Omega Filtering +begin undump_font_table(k);@/ +end +@y +begin undump_font_table(k);@/ +end + +@ @= +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_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. + +@ +@= + +@ 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 + +@ +@= +@!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; + +@ +@= + +@ +@= +begin +if (cur_cmd=char_given) or (cur_cmd=char_num) then + @ +else begin +@; +@; +@; +end; +goto big_switch; +end; + +@ +@= +begin + back_input; + current_ocp_lstack:=active_lstack_no(active_real); + current_ocp_no:=active_counter(active_real); +end + +@ +@= +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 + +@ +@= +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 + @; + 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 + +@ +@= +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 + +@= +begin +otp_set_instruction; +case otp_instr of + @; + @; + @; + @; + @; + @; + @; + 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 + +@= + 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 + +@ +@= + 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 + +@ +@= + 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 + +@ +@= + 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 + +@ +@= + 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 + +@ +@= + 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 + +@ +@= + 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.) + +@= +@!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 + +@= +@!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 + @; +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 + @; +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: @; + 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=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: @; + 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 + +@= +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 + +@= +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} + +@= +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=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} + +@= +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=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 + else cur_val:=n+param_base[f]; + end; +@; +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 + else cur_val:=n+param_base(f); + end; +@; +end; +@z +%--------------------------------------- +@x [30] m.579 l.11240 - Omega +@ @= +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 +@ @= +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 +@ @= +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 +@ @= +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 +@= +begin if cur_style= +begin if cur_style= +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 + @; + until z<16; + end +@y +@= +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 + @; + until z=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;@/ +@; +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;@/ +@; +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 wmin_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 wmin_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 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 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_stylelig_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_chrfont_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_chrfont_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 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 + @; +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 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 + @; + 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 + @; + 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. + +@= +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=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 + 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)] + 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)) +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 +@; +@; +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 +@; +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; +@; +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_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 + @; +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_int(font_ptr); +for k:=null_font to font_ptr do + @; +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_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 + @ +@y +@ @= +undump_size(font_base)(font_max)('font max')(font_ptr); +for k:=null_font to font_ptr do + @ +@z +%--------------------------------------- +@x [50] m.1322 l.24000 - Omega +@ @= +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 +@ @= +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 +@ @= +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 +@ @= +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@>@ +@y +@t\4\4@>@ +@t\4\4@>@ +@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 +@ @= +@y +@ @= +@z +%--------------------------------------- +@x [30] m.??? l.11010 - Omega OCP +@ @= +@y +@ @= +@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. + +@= +@!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. + +@= +@!internal_ocp_number=ocp_base..ocp_biggest; +@!ocp_index=integer; + +@ Here now is the array of ocp arrays. + +@= +@!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. + +@= +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|} + + +@ @= +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;@/ +@; +bad_ocp: @; +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,""); + +@= +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 + +@ @= +if external_ocp then + @ +else begin + @; + @; + end; + +@ @= +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 + +@ @= +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 + +@ @= +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. + +@= +procedure scan_ocp_ident; +var f:internal_ocp_number; +begin @; +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. + + +@= +@!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 + +@= +@!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; + +@ +@= +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. + +@ @= +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; +@; +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 @; +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 @; +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 +@; +@y +@; +@; +@; +@z +%--------------------------------------- +@x [50] m.1303 l.23711 - Omega OCP +@; +@y +@; +@; +@; +@z +%--------------------------------------- +@x [50] m.1323 l.24907 - Omega OCP +begin undump_font_table(k);@/ +end +@y +begin undump_font_table(k);@/ +end + +@ @= +dump_int(ocp_ptr); +for k:=null_ocp to ocp_ptr do + @; +print_ln; print_int(ocp_ptr-ocp_base); print(" preloaded ocp"); +if ocp_ptr<>ocp_base+1 then print_char("s") + +@ @= +undump_size(ocp_base)(ocp_biggest)('ocp max')(ocp_ptr); +for k:=null_ocp to ocp_ptr do + @ + +@ @= +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 + +@ @= +begin undump_ocp_table(k); +end + +@ @= +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_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. + +@ @= +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); + +@ @= +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"); + +@ @= +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; + +@ @= +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; +@; +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. + +@= +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 + +@ @= +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; + +@ @= +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; + +@ @= +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; + +@ @= +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 @; + +@ 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} + +@ @= +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 +@= +begin l:=line_number(r); +if l>old_l then + begin {now we are no longer in the inner loop} +@y +@= +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 +@= +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 +@= +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 +@= +begin artificial_demerits:=false;@/ +@^inner loop@> +shortfall:=line_width-cur_active_width[1]; {we're this much too short} +@y +@= +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 @; + @; + 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 @; + @; + cur_p:=link(temp_head); auto_breaking:=true;@/ + prev_p:=cur_p; {glue at beginning is not a legal breakpoint} + @; +@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 @ 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 + @ + 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 +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 + @ + 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; +@; +@z +%------------------------- +@x [39] m.887 l.17352 +@= +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 +@= +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 +@= +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 +@= +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 @; + 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 @; + 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; +@; +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@> + +@ @= +discretionary: if chr_code=1 then + print_esc("-")@+else print_esc("discretionary"); + +@ @= +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@> + +@ @= +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"); + +@ @= +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 + @; +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; +@; +@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 + @; + 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; +@; +@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 +@=@+ +adv_past(cur_p) +@y +@=@+ +adv_past(cur_p) else @ +@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:@; +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:@; +special_node:special_out(p); +language_node:do_nothing; +local_par_node:do_nothing; +othercases confusion("ext4") +@z +%------------------------- +@x [53] m.1378 l.24900 +@ @= +for k:=0 to 15 do if write_open[k] then a_close(write_file[k]) +@y +@ @= +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 + +@= +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 + +@ @= +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 + +@ @= +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_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 + +@ @= +begin tail_append(make_local_par_node) end + +@ @= +((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|} + +@= +@!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} + +@ @= +@!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] + +@= +@!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} + +@ @= +@!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 jlength(t) then goto not_found; +j:=str_start[s]; k:=str_start[t]; +while jstr_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 jstr_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; +@; +@; +@= +for k:=0 to 255 do + begin if (@) 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 +@= +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 +@= + (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@> + +@= +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 (@) then + if selector + +@d print_lc_hex(#)==l:=#; + if l<10 then print_char(l+"0") else print_char(l-10+"a"); + +@= +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 spseudo then + begin print_char(s); return; {internal strings are not expanded} + end; + if (@) then + if selector; + 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; + @; + return; + end; +j:=str_start(s); +while j=str_ptr) or (s<256) then print(s) +else begin j:=str_start[s]; + while j=str_ptr) or (s<=biggest_char) then print(s) +else begin j:=str_start(s); + while j; +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 @; +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 k2 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 k2 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 + 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 + 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 + 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 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 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 +@= +procedure print_char(@!s:ASCII_code); {prints a single character} +label exit; +begin if @ then + if selector= +procedure print_char(@!s:ASCII_code); {prints a single character} +label exit; +begin if @ then + if selector=str_ptr then s:="???" {this can't happen} +@.???@> +else if spseudo then + begin print_char(s); return; {internal strings are not expanded} + end; + if (@) then + if selector; + 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; + @; + return; + end; +j:=str_start(s); +while j= +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_ptr then s:="???" {this can't happen} +@.???@> +else if spseudo then + begin print_char(s); return; {internal strings are not expanded} + end; + if (@) then + if selector; + 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; + @; + return; + end; +j:=str_start(s); +while j0)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; + end; + for otp_counter:=1 to (otp_output_end-1) do begin + new_s:=otp_output_buf[otp_counter]; + if (om_mode255) 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: + +@= +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 +@= +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 +@= +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. + +@ @= +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); + +@ @= +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; + +@ @= +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 + @; + 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_max) then + print_char("*") +@.*\relax@> + else @; + 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_max) then + print_char("*") +@.*\relax@> + else @; + 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_max) then print_char("*") +@.*\relax@> + else @; + 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_max) then print_char("*") +@.*\relax@> + else @; + 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 + +@= +@!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 + +@= +@!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 +@ @=output_file_name:=0; +@y +@ @=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 +@; +@y +if not MML_mode then begin @; 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; +@; +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; +@; +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|. + +@= +procedure push_math(@!c:group_code); +begin +if math_direction<>text_direction then dir_math_save:=true; +push_nest; mode:=-mmode; incompleat_noad:=null; +@; +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|. + +@= +@!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; + +@ @= +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(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(" "); + 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(" "); + 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(" Unrecognized math stuff "); + print(new_line_char); + end + endcases; + +@= +procedure push_math(@!c:group_code); +begin +if math_direction<>text_direction then dir_math_save:=true; +push_nest; mode:=-mmode; incompleat_noad:=null; +@; +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(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(" Arguments "); 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("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("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; +@; +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. + +@= +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); + +@ @= +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; + +@ @= + +@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. + +@= +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. + +@= +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;} + @; + decr(save_ptr); + q:=saved(0); + r:=fin_mlist(null); + push_math(math_group); + tail_append(q); tail_append(r); tail_append(p); + {unsave;} + @; + p:=fin_mlist(null); + tail_append(p); + end + else tail_append(p); +@z +%--------------------------------------- +@x [48] m.1176--1177 l.22109 - Omega +procedure sub_sup; +var t:small_number; {type of previous sub/superscript} +@!p:pointer; {field to be filled by |scan_math|} +begin t:=empty; p:=null; +if tail<>head then if scripts_allowed(tail) then + begin p:=supscr(tail)+cur_cmd-sup_mark; {|supscr| or |subscr|} + t:=math_type(p); + end; +if (p=null)or(t<>empty) then @; +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 @; +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 + @ +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; + @; + 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 + @ +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; + @; + 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 @ +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 @ +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 +@ @= +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 +@ @= +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","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 @; 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 @; + 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_ln; + print_nl("The MathML translator cannot continue"); + succumb; + end; +math_mml_group: begin + @; + 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 @; 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 @; + 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 + @ +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); + @; {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 + @ +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;} + @; + decr(save_ptr); + q:=saved(0); r:=fin_mlist(null); + push_math(math_group); + tail_append(q); tail_append(r); + tail_append(p); + {unsave;} + @; + p:=fin_mlist(null); + tail_append(p); + end + end + else begin + type(p):=t; + scan_delimiter(delimiter(p),false); + if t=left_noad then + begin push_math(math_left_group); link(head):=p; tail:=p; + end + else begin p:=fin_mlist(p); + @; {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} +@@; +begin danger:=false; +@; +m:=mode; l:=false; p:=fin_mlist(null); {this pops the nest} +if mode=-m then {end of equation number} + begin @; + cur_mlist:=p; cur_style:=text_style; mlist_penalties:=false; + mlist_to_hlist; a:=hpack(link(temp_head),natural); + @; + decr(save_ptr); {now |cur_group=math_shift_group|} + if saved(0)=1 then l:=true; + danger:=false; + @; + m:=mode; p:=fin_mlist(null); + end +else a:=null; +if m<0 then @ +else begin if a=null then @; + @; + end; +end; +@y +procedure after_mml; +var p:pointer; +begin +@; +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} +@@; +begin danger:=false; +@; +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 @; + 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; + @; + decr(save_ptr); {now |cur_group=math_shift_group|} + if saved(0)=1 then l:=true; + danger:=false; + @; + m:=mode; p:=fin_mlist(null); + end +else a:=null; +if m<0 then @ +else begin if a=null then @; + @; + end; +end; +@z +%--------------------------------------- +@x [49] m.1196 l.22388 - Omega +@ = +begin tail_append(new_math(math_surround,before)); +if dir_math_save then + @; +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 + @; +dir_math_save:=false; +tail_append(new_math(math_surround,after)); +space_factor:=1000; +@; +end +@y +@= +begin +if not MML_mode then begin + tail_append(new_math(math_surround,before)); + if dir_math_save then + @; + 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 + @; + dir_math_save:=false; + tail_append(new_math(math_surround,after)); + end; +space_factor:=1000; +@; +end +@z +%--------------------------------------- +@x [49] m.1197 l.22430 - Omega +@= +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 + @; +@; +@; +@; +@; +resume_after_display +@y +@= +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 + @; + @; + @; + @; + @; + 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); + @; + end + else end_file_reading; + end; + end; + end; +@z +%--------------------------------------- +@x [50] m.1320 l.23983 - Omega +@ @= +@y +@ @= +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 +@ @= +@y +@ @= +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 @; +@!stat if tracing_stats>0 then @;@;@+tats@/ +wake_up_terminal; @; +@y +procedure close_files_and_terminate; +var k:integer; {all-purpose index} +begin @; +@!stat if tracing_stats>0 then @;@;@+tats@/ +wake_up_terminal; +if not MML_mode then begin @; end; +@z +%--------------------------------------- -- cgit v1.2.3