diff options
Diffstat (limited to 'Build/source/texk/web2c/ptexdir')
30 files changed, 22675 insertions, 0 deletions
diff --git a/Build/source/texk/web2c/ptexdir/COPYRIGHT b/Build/source/texk/web2c/ptexdir/COPYRIGHT new file mode 100644 index 00000000000..9f2495ecb04 --- /dev/null +++ b/Build/source/texk/web2c/ptexdir/COPYRIGHT @@ -0,0 +1,25 @@ +Copyright (C) 2009 ASCII MEDIA WORKS. +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. Neither the name of the author may be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT +NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Build/source/texk/web2c/ptexdir/COPYRIGHT.jis b/Build/source/texk/web2c/ptexdir/COPYRIGHT.jis new file mode 100644 index 00000000000..fb491511cc7 --- /dev/null +++ b/Build/source/texk/web2c/ptexdir/COPYRIGHT.jis @@ -0,0 +1,32 @@ +($BCm(B) $B0J2<$O!"1QJ8$N7@Ls>r9`$rF|K\8l$KK]Lu$7$?$b$N$G$"$k!#F|K\8lLu$H1Q(B +$B8lI=5-$N4V$Ksrsw$,$"$C$?>l9g$K$O!"7@Ls>r7o$O1Q8lI=5-$K$h$k7@Ls>r9`$K=>(B +$B$&!#(B + +$B!ZCx:n8"I=<(![(B +Copyright (C) 2009 ASCII MEDIA WORKS. +All rights reserved. + +$B!Z7@Ls>r7o![(B +$B2~JQ$NM-L5$K$+$+$o$i$:!"K\%=%U%H%&%'%"$N%=!<%9%3!<%I5Z$S%P%$%J%j!<%3!<(B +$B%I7A<0$K$h$k:FHRI[5Z$S;HMQ$O!"<!$N7@Ls>r7o$N2<$K5vBz$5$l$k!#(B +1. $B%=!<%9%3!<%I$N:FHRI[$K:]$7$F$O!">e5-$N!ZCx:n8"I=<(![!"$3$N!Z7@Ls>r(B + $B7o![5Z$S<!$N!ZLH@U>r9`![$NI=5-$r!"0z$-B3$-0];}$7$FL@5-$7$J$1$l$P$J(B + $B$i$J$$!#(B +2. $B%P%$%J%j!<7A<0$K$h$k:FHRI[$K:]$7$F$O!">e5-$N!ZCx:n8"I=<(![!"$3$N(B + $B!Z7@Ls>r7o![5Z$S<!$N!ZLH@U>r9`![$r!":FHRI[$K:]$7Ds6!$9$k@bL@=q5Z$S(B + $B$=$NB>$N4XO";qNA$K2~$a$FL@5-$7$J$1$l$P$J$i$J$$!#(B +3. $BFCJL$J;vA0$N=qLL$K$h$k5vBz$,$J$$8B$j!"K\%=%U%H%&%'%"$+$iGI@8$7$?@=(B + $BIJ$r?d>)Kt$O@kEA$9$k$?$a$K!"Cx:n8"<TL>$O;HMQ$7$F$O$J$i$J$$!#(B + +$B!ZLH@U>r9`![(B +$BK\%=%U%H%&%'%"$O!"Cx:n8"<T$K$h$j!"!V8=>uM-;Q$N$^$^!J$=$N$^$^$N7A$G!K!W(B +$BDs6!$5$l$k$b$N$G$"$j!">&IJ@-Kt$OFCDjL\E*$X$NE,9g@-$K4X$9$kL[<(E*J]>Z$J(B +$B$I!"L@<(Kt$OL[<($NJ]>Z$rLd$o$:!"$$$+$J$kJ]>Z$r$b9T$&$b$N$G$O$J$$!#(B +$B$$$+$J$kM}M3$K$h$C$F$b!"$^$?!"7@Ls@UG$!"873J@UG$Kt$O!J2a<:$K$h$k$b$N$r(B +$B4^$`!KITK!9T0Y@UG$$rLd$o$:$I$N$h$&$J@UG$$NM}O@$K$h$C$F$b!"Cx:n8"<T$O!"(B +$B$$$+$J$k>l9g$b!"K\%=%U%H%&%'%"$r;HMQ$9$k$3$H$K$h$jH/@8$9$k!"$"$i$f$kD>(B +$B@\B;32!"4V@\B;32!"6vH/B;32!"FCJLB;32!"D(H3E*B;32$"$k$$$OGI@8E*B;32!JBe(B +$BBX@=IJ!&BeBX%5!<%S%9$ND4C#!";HMQMx1W!"%G!<%?Kt$O<}1W$K4X$9$kB;<:!"1D6H(B +$BCfCG$K$h$kB;<:$J$I!K$K$D$$$F2?$i$N@UG$$bIi$o$J$$!#$3$l$O!"K\%=%U%H%&%'(B +$B%"$r;HMQ$9$k$3$H$K$h$j!"$3$l$i$NB;32$,H/@8$9$k2DG=@-$K$D$$$F!"$"$i$+$8(B +$B$a<(:6$5$l$F$$$?>l9g$G$"$C$F$bF1MM$G$"$k!#(B diff --git a/Build/source/texk/web2c/ptexdir/Changes.txt b/Build/source/texk/web2c/ptexdir/Changes.txt new file mode 100644 index 00000000000..9695f05eb68 --- /dev/null +++ b/Build/source/texk/web2c/ptexdir/Changes.txt @@ -0,0 +1,317 @@ +2009/08/17: (p3.1.11) + ptex: 2バイト文字間のグルーがおかしくなるバグを修正 + \{y|t}baselineshift が数式にも反映されるように修正 + (ありがとうございます 角藤さん、土村さん) + +2006/07/18: (p3.1.10) + ptex, tftopl, pltotf, jbibtex: -kanji オプションが -version オプションの + 漢字コード情報に反映されるよう修正。 + Makefile.in: texmf.cnf 中のパス記述が teTeX-3.0 の記法に近くなるように修正 + (ありがとうございます 土村さん) + ptex: 変数の初期化忘れのため、環境によって組版結果が異なる症状を修正 + (ありがとうございます 土村さん、角藤さん) + pltotf, tftopl: 16区の漢字の扱いに失敗する不具合を修正 + (ありがとうございます TANAKA Takujiさん) + +2005/10/17: (p3.1.9) + mkconf: platex の検索パスに tex/platex を入れないように修正 + ptex: 単語の先頭で LIG/ を行うようなTFMを使用するとベースラインシフトが + 0でない場合に異常終了するバグを修正 + +2005/03/07: (p3.1.8) + Makefile.in: make install の最後に mktexlsr の実行を追加 + Makefile.in, INSTALL.txt: teTeX-3.0のTEXMFディレクトリの変更に伴い修正 + (ありがとうございます、角藤さん)。 + +2004/12/14: (p3.1.8) + ptex: コントロールシーケンス名の処理誤りを修正。 + (例：\Te^^5e^58 ⇒ \Te^^58 となり、\TeX として評価されない) + ptex: コントロールシーケンス直後の ^^形式が漢字として認識されて + しまう場合があるのを修正 (例：\TeX^^83A ⇒ \TeXア) + (以上、ありがとうございます、井上さん)。 + ptex: 端末やログファイルでの改行位置のタイミングの修正 + (ありがとうございます、角藤さん)。 + +2004/12/09: (p3.1.7) + ptex: ^^形式を含むコントロールシーケンス名の処理誤りを修正。 + ptex: 表示不可能文字の範囲を3.1.4と同じにした。 + (Missing character では ^^ 形式で出力)。 + mkconf: sjis,jis,eucの各エンコード名のTEXINPUTSを作成するようにした。 + また、TEXINPUTS.xetex の次に作成するようにした。 + +2004/12/02: (p3.1.6) + ptex: tetex-2.99.4.20041128-beta に対応(ありがとうございます、角藤さん)。 + INSTALL.txt: ファイル名とTDSに関するコメントを追加 + (ありがとうございます、角藤さん)。 + +2004/11/29: (p3.1.5) + ptex: コントロールシーケンス名の、^^形式の文字と次の文字を漢字と + してみなす場合があるのを修正(ありがとうございます、井上さん)。 + ptex: Missing character などのメッセージでの表示不可能文字を + ^^ 形式で出力するように修正。 + +2004/11/08: (p3.1.5) + ptex: JISエンコーディングファイルを読み込んだ後、`漢字イン' の状態が + ファイルの終わりを越えて有効になってしまう場合があるのを修正 + (ありがとうございます、井上さん)。 + +2004/10/12: + pltotf: SJISコードのPLファイルから、TFMファイルを正しく作れない + のを修正(ありがとうございます、角藤さん、青木さん)。 + +2004/09/02: (p3.1.4) + ptex: 行末記号を漢字の第1バイトに当たる文字にした場合、行の次の文字 + と共に漢字にしようとしてしまうのを修正。 + ptex: 1バイト文字のうち、漢字の第1バイトに当たる文字のカテゴリー + コードが無効な文字となってしまうのを修正。 + ptex: ^^形式で入力された文字コードが漢字の第1バイトに当たる場合、 + 次の文字と共に漢字にしようとしてしまうのを修正。 + ptex: \string で扱う文字の漢字判定を厳密化。 + jbibtex: 改行コードCRに対応。 + (以上、ありがとうございます、井上さん) + ptex: 数式内で \char を使用した場合に1バイト文字が漢字と誤認識される + バグを修正。 + (ありがとうございます、角藤さん) + 契約条文和訳を修正。 + +2003/10/07: (p3.1.3) + ptex: -kanji=sjis のとき、\kansujichar で、期待した文字が設定され + ないのを修正(ありがとう、角藤さん)。 + +2003/09/30: + ptex: 端末/ログへのメッセージで、印字できない文字が出力されることが + あるのに対処。 + +2003/08/05: + pconvert: usage メッセージの変更。pltotf, tftopl, pdvitype のとき、 + fixwrites にオプション($target)を指定するようにした。 + +2003/06/23: (p3.1.2) + configure: mktempを使わないように修正 + +2003/06/17: (p3.1.2) + Makefile.in: BSD版 make で texmf.cnf の作成に失敗しているのを修正 + +2003/02/18: (p3.1.2) + ptex: \kansuji プリミティブを復活させた。 + ptex: \kansujichar プリミティブにより、\kansuji で出力される文字を設定 + 可能にした。 + +2003/02/14: (p3.1.1) + ptex: 漢字が ^^ 形式でコンソールに表示されるのを修正。 + ptex: \uppercase, \lowercase で core を出す場合があるのを修正。 + +2003/02/13: (p3.1) + ptex: main_memory、hash_extra を大きくし、膨大なマクロ定義をすると、 + 「!Missing control sequence inserted.」のエラーになるのを修正。 + +2003/02/03: (p3.0.6) + ptex: tetex-2.0 への対応 + ptex: sjis 動作以外のとき、\char\sjis が正しく動かないのを修正 + ptex: 実験的に入れてあったプリミティブ（\kansuji、\tozen）を取り除いた + ptexextra.h: BANNER 文字列の更新 + ptexextra.c: tetex-2.0 への対応 + +2002/11/22: + Makefile.in: euc(jis), sjis 用フォーマットを作成するよう修正 + platex 用のリンクを作成するようにした + mkconf: iniptex の記述を削除 + +2002/11/15: (p3.0.5) + ptexextra.c: web2c-7.3.11 (teTeX-beta-20021114) への対応 + +2002/10/29: (p3.0.4) + --version の１行目のフォーマットを変更 + jbibtex: 認識できないオプションで core を出すのを修正 + +2002/10/28: (p3.0.3) + ptex: バナーのフォーマットを変更 + tftopl.ch: pTeX用のHELPを使っていないのを修正 + pltotf.ch: pTeX用のHELPを使っていないのを修正 + +2002/10/24: (p3.0.2) + web2c-7.3.9 に対応。 + +2002/01/18: (p3.0.1) + 以下のソースを用いたたときでもコンパイルできるようにした。 + * tetex-supp.tar.gz + * web2c-7.3.3.tar.gz + * teTeX-src-beta-20011202.tar.gz + +2002/01/15: (p3.0) + ptex-base.ch: fix hyphenation. + +2001/10/03: + README.txt: rewrite + INSTALL.txt: rewrite + ptex-base.ch: version 3.0 + ptexextra-plain.c: removed local_maintainer and this_bug_address + ptexextra-src-special.c: removed local_maintainer and this_bug_address + jbibextra.c: removed local_maintainer and this_bug_address + maintain.h: removed local_maintainer and this_bug_address + version.c: modified message + +2001/07/26: + Change Licence to modified BSD license + COPYRIGHT: new file + COPYRIGHT.jis: new file + INSTALL.txt: new file + README.txt: cut short and move to INSTALL.txt + version.c: change licence filename (l.87,91, COPYING -> COPYRIGHT) + +2001/02/13: + version.c: typo (l.89, build -> build) + ptexhelp.h: typo (l.56, versobe -> verbose) + Changes.txt: typo (20001/02/09 -> 2001/02/09) + +2001/02/09: + REAMDE.txt: rewrite for 2.1.10 + version.c: rewrite the copyright message. enable usage() function. + ptexhelp.h: newfile + help.h: removed + kanji.h.in: include "ptexhelp.h" + ptexextra-plain.c: rename TEXHELP to PTEXHELP. + ptexextra-src-special.c rename TEXHELP to PTEXHELP. + Makefile.in: depend on ptexhelp.h + +2000/11/13: (p2.1.10) +2000/11/10: + ptex.ch: can't load JFM which the number of char_type less than + the glue types. + pltotf.ch: can't convert property list which has fullwidth space + '0x2121(JIS)' in charsintype. + +2000/08/17 + mkconf: modify path separator to semicolon(;) + +2000/03/18 + README.txt: fixed web2c-7.2 -> teTeX-1.0 (l.77) + +2000/03/01 (p2.1.9) + ptexextra-plain.c, ptexextra-src-special.c: version number 2.1.8 -> 2.1.9 + +2000/02/29 (p2.1.9) + README.txt: rewrite. + +2000/02/28 (p2.1.9) + correspond to TeX 3.14159 with Web2c 7.3.1 and tex-src-special. + Makefile.in: distclean cleans tftopl.ch and pltotf.ch + ptexextra-plain.c, ptexextra-src-special.c: newfile + COPYING: newfile + +1998/04/09 (p2.1.8) +1998/03/26 (p2.1.8.beta1) + correspond to TeX 3.14159 with Web2c 7.2. + +1998/03/19 (p2.1.7) + fix bug: \leaders + +1998/02/26 (p2.1.6) + fix bug: \inhibitxspcode + +1997/08/27 (p2.1.5) + official release. + +1997/08/27 (TFtoPL v1.3) + fix bug: occers core dump when loading a JFM. + +1997/08/14 (p2.1.5, beta12) + fix bug: kinsoku process doesn't work for ligatured character. + +1997/08/07 (p2.1.5, beta11) + changed specification: How to insert \xkanjiskip at surrounding a \hbox + (back to the p2.1.4 specification). + +1997/08/01 (p2.1.5, beta10) + fix bug: caused line breaking after a kinsoku penalty by + the \jcharwidowpenalty. + +1997/07/29 (p2.1.5, beta9) + fix bug: A penalty of kinsoku doesn't work well. + fix bug: italic correction is not inserted. + +1997/07/11 (p2.1.5, beta8) + fix bug: A penalty of kinsoku doesn't work well. + fix bug: Inserted \kanjiskip before widow KANJI character when the line + holds only it (embeded 2.1.5.beta6). + fix bug: Inserted \kanjiskip between kern of head of the line and + the next widow KANJI character (since from jTeX 1.7 p1.0.9G). + changed specification: How to insert \xkanjiskip at surrounding text-math. + +1997/06/29 (p2.1.5, beta7) + fix bug: pTeX occers coredump, when \{y,t}baselineskip is not equal zero, + and where explicit kern after ligature like `diff\/'. + changed specification: How to insert \xkanjiskip at surrounding text-math. + +1997/06/16 (p2.1.5, beta6) + fix bug: The \{y,t}baselineskip isn't work except the first place in + a paragraph. + fix bug: Doesn't hyphenation when the value of \{y,t}baselineskip is + not equals zero. + fix buf: Printed `(EUC)' in banner instead of making as JIS-version. + fix bug: `make install' increase the TEXINPUTS.{ptex,platex,platex209} at + texmf.cnf. + +1997/05/13 (p2.1.5, beta5) + fix bug: Fail to read euex10.tfm. + +1997/05/01 (p2.1.5, beta4) + fix bug: \char{\jis,\euc,\sjis,\kuten} after a 1byte character that have + a possibility of ligature like the "`" causes coredump or worng result. + +1997/03/17 (p2.1.5, beta3) + change banner strings. + +1997/03/14 (p2.1.5, beta3) + fix bug: can't run as iniptex/virptex. + +1997/03/12 (p2.1.5, beta2) + fix bug: \calcpos return wrong number. + +1997/02/27 (p2.1.5, beta1) + correspond to TeX 3.14159 with Web2c 7.0. + +1995/11/21 (p2.1.4) + new feature: accept kanji filename. + +1995/11/17 (p2.1.3) + fix bug : try_break routine doesn't corect action when the list + has disp_node or dir_node (Error `disc4'). + +1995/11/07 (p2.1.2) + fix bug : \kanjiskip doesn't inserted after JFM glue/kern. + +1995/10/11 + include jbibtex (Shouichi Matsui<matsui@denken.or.jp>) and + pdvitype (Thanks, Kazunori Asayama) + +1995/09/20 (p2.1.1) + fix bug : \xkanjiskip doesn't inserted after italic correction. + fix bug : italic correction doesn't inserted when \{y,t}baselineshift + is used. + +1995/09/08 (p2.1) + fix bug : \xkanjiskip doesn't inserted after math mode which correct + italic kern spacing. + +1995/08/29 + rename `find_first' to `find_first_char' for djgpp 1.12. + (Thanks, Kazunori Asayama) + +1995/03/25 + fix bug : Three minuses sequence (---) doesn't become em-hyphen. + +1995/03/11 + imprement \kanji primitive. + +1995/01/17 + translate/modify pTeX 2.0 change file for TeX 3.1415. + +1994/12/17 + translate/modify pTeX 2.0 change file for TeX 3.141. + +1994/10/17 + translate/modify pTeX 1.0.9F change file which based on TeX 2.99 to + pTeX 2.0 which based on TeX 3.14. + +== EOF === diff --git a/Build/source/texk/web2c/ptexdir/Files b/Build/source/texk/web2c/ptexdir/Files new file mode 100644 index 00000000000..ac7a1dff916 --- /dev/null +++ b/Build/source/texk/web2c/ptexdir/Files @@ -0,0 +1,27 @@ +COPYRIGHT +COPYRIGHT.jis +Changes.txt +Files +INSTALL.txt +Makefile.in +README.txt +configure +jbibd.sed +jbibextra.c +jbibextra.h +jbibtex.ch +jbibtex.defines +kanji.c +kanji.defines +kanji.h.in +mkconf +pconvert +pdvitype.ch +pltotf.ch +ptex-base.ch +ptexextra.c +ptexextra.h +ptexhelp.h +tftopl.ch +usage.c +version.c diff --git a/Build/source/texk/web2c/ptexdir/INSTALL.txt b/Build/source/texk/web2c/ptexdir/INSTALL.txt new file mode 100644 index 00000000000..ac53b2f2944 --- /dev/null +++ b/Build/source/texk/web2c/ptexdir/INSTALL.txt @@ -0,0 +1,83 @@ +=========================================================================== +$BF|K\8l(B TeX $B%P!<%8%g%s(B 3.141592, p3.1.11 +(tetex-src-3.0 $B0J9_MQ(B) +=========================================================================== +$B"((B $BI,MW$J$i$P!"%$%s%9%H!<%k:n6H$r$9$kA0$K!"(B + $B5l%P!<%8%g%s$N(B TeX $B%7%9%F%`$N%P%C%/%"%C%W$r$7$F$/$@$5$$!#(B + +$B"((B space code $B$r4^$s$@%U%!%$%kL>$,%5%]!<%H$5$l$F$$$^$9!#(B + $B$?$@$7!"O"B3$9$kFs$D0J>e$N(B space codes $B$O;HMQ$7$J$$$G$/$@$5$$(B: + platex "a b c d e.tex" $B$O(B ok $B$G$9$,(B + platex "a b.tex" $B$O(B ng $B$G$9!#(B + +--------------------------------------------------------------------------- +$B!|(B $B%=!<%9%U%!%$%k(B +--------------------------------------------------------------------------- +pTeX $B$r%$%s%9%H!<%k$9$k$K$O!"$D$.$N%U%!%$%k$,I,MW$G$9!#(B + + $B!&(Bptex-src-3.1.11.tar.gz (pTeX $B%=!<%9%U%!%$%k(B) + $B!&(Bptex-texmf-2.5.tar.gz (pTeX $B%i%$%V%i%j%U%!%$%k(B) + $B!&(BteTeX-src-3.0.tar.gz (teTeX $B%=!<%9%U%!%$%k(B) + $B!&(BteTeX-texmf-3.0.tar.gz (teTeX $B%i%$%V%i%j%U%!%$%k(B) + +$B$3$l$i$O!"0J2<$N%5%$%H$J$I$+$iF~<j2DG=$G$9!#(B + +$B!&(BpTeX $B4XO"(B + ftp://ftp.ascii.co.jp/pub/TeX/ascii-ptex/ + ftp://ftp.ring.gr.jp/pub/text/TeX/ascii-ptex/ + ftp://ftp.media.kyoto-u.ac.jp/TeX/ASCII-pTeX/ + ftp://bash.cc.keio.ac.jp/pub/TeX/ascii-ptex/ + ftp://ftp.cs.titech.ac.jp/pub/text/TeX/ASCII-pTeX/ + ftp://ftp.tut.ac.jp/TeX/ASCII-pTeX/ + ftp://ftp.u-aizu.ac.jp/pub/tex/ASCII-pTeX/ + ftp://ftp.foretune.co.jp/pub/TeX/ascii-ptex/ + +$B!&(BteTeX $B4XO"(B + ftp://ftp.ring.gr.jp/pub/text/CTAN/systems/unix/teTeX/current/distrib/ (JPN) + ftp://cam.ctan.org/tex-archive/systems/unix/teTeX/current/distrib/ (UK) + ftp://dante.ctan.org/tex-archive/systems/unix/teTeX/current/distrib/ (GER) + ftp://tug.ctan.org/tex-archive/systems/unix/teTeX/current/distrib/ (US) + +--------------------------------------------------------------------------- +$B!|(B $B%$%s%9%H!<%k(B +--------------------------------------------------------------------------- +1. teTeX $B$N%i%$%V%i%j%U%!%$%k$rE83+$7$^$9!#(B + + mkdir -p /usr/local/teTeX3/share/texmf-dist + tar zxf tetex-texmf-3.0.tar.gz \ + -C /usr/local/teTeX3/share/texmf-dist + +2. ptex $B$N%i%$%V%i%j%U%!%$%k$rE83+$7$^$9!#(B + + mkdir -p /usr/local/teTeX3/share/texmf + tar zxf ptex-texmf-2.5.tar.gz -C /usr/local/teTeX3/share/texmf + +3. teTeX $B$N%=!<%9%U%!%$%k$rE83+$7$^$9!#(B + + tar zxf tetex-src-3.0.tar.gz -C /usr/local/src + +4. ptex $B$N%=!<%9%U%!%$%k$rE83+$7$^$9!#(B + + tar zxvf ptex-src-3.1.11.tar.gz \ + -C /usr/local/src/tetex-src-3.0/texk/web2c + +5. teTeX $B%=!<%9%U%!%$%k$rE83+$7$?%G%#%l%/%H%j$K0\F0$7!"(Bconfigure $B%3%^%s%I(B + $B$r<B9T$7$^$9!#(Bprefix $B%*%W%7%g%s$K$O!"(BteTeX $B%i%$%V%i%j$r%$%s%9%H!<%k(B + $B$7$?%G%#%l%/%H%j$r;XDj$7$^$9!#(B + + cd /usr/local/src/tetex-src-3.0 + ./configure --prefix=/usr/local/teTeX3 + make + make install + +6. ptex $B$N%=!<%9%G%#%l%/%H%j$K0\F0$7!"(Bconfigure $B%3%^%s%I$r<B9T$7$^$9!#(B + $B$3$N$H$-!"%G%U%)%k%H$N4A;z%3!<%I$r;XDj$7$F$/$@$5$$!#(B + + cd /usr/local/src/tetex-src-3.0/texk/web2c/ptex-src-3.1.11 + ./configure euc (EUC$B%3!<%I$N>l9g(B) + ./configure jis (JIS$B%3!<%I$N>l9g(B) + ./configure sjis ($B%7%U%H(BJIS$B%3!<%I$N>l9g(B) + make + make install + +=============================================================== EOT ===== diff --git a/Build/source/texk/web2c/ptexdir/README.txt b/Build/source/texk/web2c/ptexdir/README.txt new file mode 100644 index 00000000000..121468c213c --- /dev/null +++ b/Build/source/texk/web2c/ptexdir/README.txt @@ -0,0 +1,32 @@ +--------------------------------------------------------------------------- +● 日本語 TeX（pTeX: publishing TeX）について +--------------------------------------------------------------------------- + + * 日本語 TeX（pTeX）は、本格的な商業出版に耐える TeX を開発する + ことを目標にしています。 + + * pTeX は、横組み専用の「日本語 TeX」に縦組み機能を追加したもの + です。日本語化のバグフィックスはすべて pTeX に対してのみ行ない、 + 横組のみの日本語 TeX に対しては行ないませんので、ご了承ください。 + + * pTeX は、WEB のチェンジファイルを使って実現されています。 + + * インストールの手順については、付属の INSTALL.txt ファイルを参照 + してください。 + + * pTeX の使用および配付に関しては、付属の COPYRIGHT ファイルを + 参照してください。 + +--------------------------------------------------------------------------- +● 問い合わせ先など +--------------------------------------------------------------------------- +pTeX についてのお問い合わせは、電子メールで ptex-staff@ml.asciimw.jp 宛て +にお願いします。 + +pTeX の WEB ページ（http://ascii.asciimw.jp/pb/ptex/）では、バグ情報や +インストールのヒント、pTeX で追加されたプリミティブ一覧などを掲載して +います。こちらもご覧ください。 + +------------------------------------- +株式会社アスキー・メディアワークス +=============================================================== EOT ===== diff --git a/Build/source/texk/web2c/ptexdir/am/ptex.am b/Build/source/texk/web2c/ptexdir/am/ptex.am new file mode 100644 index 00000000000..35f492e740e --- /dev/null +++ b/Build/source/texk/web2c/ptexdir/am/ptex.am @@ -0,0 +1,200 @@ +## texk/web2c/ptexdir/am/ptex.am: Makefile fragment for pTeX. +## +## Copyright (C) 2009, 2010 Peter Breitenlohner <tex-live@tug.org> +## You may freely use, modify and/or distribute this file. + +## pTeX +## +if PTEX +bin_PROGRAMS += ptex pbibtex pdvitype ptftopl ppltotf +endif PTEX +EXTRA_PROGRAMS += ptex + +ptex_CPPFLAGS = $(PTEXENC_INCLUDES) +ptex_CFLAGS = $(WARNING_CFLAGS) + +# With --enable-ipc, pTeX may need to link with -lsocket. +ptex_LDADD = $(pproglib) $(PTEXENC_LIBS) $(LDADD) $(ipc_socketlibs) +pbibtex_LDADD = $(pproglib) $(PTEXENC_LIBS) $(LDADD) +ptftopl_LDADD = $(pproglib) $(PTEXENC_LIBS) $(LDADD) +ppltotf_LDADD = $(pproglib) $(PTEXENC_LIBS) $(LDADD) +pdvitype_LDADD = $(pproglib) $(PTEXENC_LIBS) $(LDADD) + +SUBDIRS += ptexdir/lib +pproglib = ptexdir/lib/lib.a +# Rebuild $(pproglib) +$(pproglib): $(KPATHSEA_DEPEND) ${srcdir}/ptexdir/lib/*.c + cd ptexdir/lib && $(MAKE) $(AM_MAKEFLAGS) + +# pTeX C sources +ptex_c_h = ptexini.c ptex0.c ptexcoerce.h ptexd.h +nodist_ptex_SOURCES = $(ptex_c_h) ptex-pool.c ptexextra.c ptexdir/ptexextra.h ptexdir/kanji.c ptexdir/kanji.h + +# We must create ptexd.h before building the ptex_OBJECTS. +ptex_prereq = ptexd.h +$(ptex_OBJECTS): $(ptex_prereq) + +$(ptex_c_h): ptex-web2c + @$(web2c) ptex +ptex-web2c: ptex.p $(web2c_texmf) + @$(web2c) ptex + +ptex-pool.c: ptex.pool ptexd.h $(makecpool_stamp) + $(makecpool) ptex >$@ || rm -f $@ + +ptexextra.c: ptexdir/ptexextra.h lib/texmfmp.c ptexd.h + sed s/TEX-OR-MF-OR-MP/ptex/ $(srcdir)/lib/texmfmp.c >$@ + +ptexdir/ptexextra.h: ptexdir/ptexextra.in ptexdir/ptex.version + sed s/PTEX-VERSION/`cat ptexdir/ptex.version`/ \ + $(srcdir)/ptexdir/ptexextra.in >$@ + +# Tangling pTeX +ptex.p ptex.pool: ptex-tangle + @$(texmf_tangle) ptex ptex +ptex-tangle: tangle$(EXEEXT) ptex.web ptex.ch tangle-sh + @$(texmf_tangle) ptex ptex + +# Extract ptex version +ptexdir/ptex.version: ptexdir/ptex-base.ch + $(MKDIR_P) ptexdir/lib + grep "^@d TeX_banner=='This is pTeX" $(srcdir)/ptexdir/ptex-base.ch \ + | sed "s/^.*-//;s/'.*$$//" >ptexdir/ptex.version + +# Generate ptex.web +ptex.web: tie$(EXEEXT) $(ptex_web_srcs) + $(tie) -m ptex.web $(ptex_web_srcs) +ptex_web_srcs = \ + tex.web \ + tex.ch + +# Generate ptex.ch +ptex.ch: tie$(EXEEXT) ptex.web $(ptex_ch_srcs) + $(tie) -c ptex.ch ptex.web $(ptex_ch_srcs) +ptex_ch_srcs = \ + $(ptex_ch_synctex) \ + ptexdir/ptex-base.ch \ + ptexdir/ptex-include.ch \ + tex-binpool.ch + +### pBibTeX +nodist_pbibtex_SOURCES = pbibtex.c pbibtex.h +pbibtex.c pbibtex.h: pbibtex-web2c +pbibtex.o: pbibtex.c $(srcdir)/ptexdir/kanji.h $(srcdir)/ptexdir/ptexhelp.h +pbibtex-web2c: $(web2c_depend) web2c/cvtbib.sed pbibtex.p + $(web2c) pbibtex + echo timestamp >$@ + touch pbibtex.c pbibtex.h +pbibtex.p: tangle$(EXEEXT) pbibtex.web $(srcdir)/ptexdir/pbibtex.ch + $(tangle) pbibtex.web $(srcdir)/ptexdir/pbibtex.ch +pbibtex.web: $(srcdir)/bibtex.web + #cat $(srcdir)/bibtex.web > $@ + cat $(srcdir)/pbibtex.web > $@ + +### pDVItype +nodist_pdvitype_SOURCES = pdvitype.c pdvitype.h +pdvitype_CPPFLAGS = -DDHEX_CHAR_CODE +pdvitype.c pdvitype.h: pdvitype-web2c +pdvitype.o: pdvitype.c $(srcdir)/ptexdir/kanji.h $(srcdir)/ptexdir/ptexhelp.h +pdvitype-web2c: $(web2c_depend) pdvitype.p + $(web2c) pdvitype + echo timestamp >$@ + touch pdvitype.c pdvitype.h +pdvitype.p: tangle$(EXEEXT) pdvitype.web $(srcdir)/ptexdir/pdvitype.ch + $(tangle) pdvitype $(srcdir)/ptexdir/pdvitype +pdvitype.web: $(srcdir)/dvitype.web + cat $(srcdir)/dvitype.web > $@ + +### pTFtoPL +nodist_ptftopl_SOURCES = ptftopl.c ptftopl.h +ptftopl.c ptftopl.h: ptftopl-web2c +ptftopl.o: ptftopl.c $(srcdir)/ptexdir/kanji.h $(srcdir)/ptexdir/ptexhelp.h +ptftopl-web2c: $(web2c_depend) ptftopl.p + $(web2c) ptftopl + echo timestamp >$@ + touch ptftopl.c ptftopl.h +ptftopl.p: tangle$(EXEEXT) ptftopl.web $(srcdir)/ptexdir/ptftopl.ch + $(tangle) ptftopl.web $(srcdir)/ptexdir/ptftopl.ch +ptftopl.web: tie$(EXEEXT) $(srcdir)/tftopl.web $(srcdir)/tftopl.ch + $(tie) -m ptftopl.web $(srcdir)/tftopl.web $(srcdir)/tftopl.ch + +### pPLtoTF +nodist_ppltotf_SOURCES = ppltotf.c ppltotf.h +ppltotf_CPPFLAGS = -DPRESERVE_PUTC +ppltotf.c ppltotf.h: ppltotf-web2c +pppltotf.o: pppltotf.c $(srcdir)/ptexdir/kanji.h $(srcdir)/ptexdir/ptexhelp.h +ppltotf-web2c: $(web2c_depend) ppltotf.p + $(web2c) ppltotf + echo timestamp >$@ + touch ppltotf.c ppltotf.h +ppltotf.p: tangle$(EXEEXT) ppltotf.web $(srcdir)/ptexdir/ppltotf.ch + $(tangle) ppltotf.web $(srcdir)/ptexdir/ppltotf +ppltotf.web: tie$(EXEEXT) $(srcdir)/pltotf.web $(srcdir)/pltotf.ch + $(tie) -m ppltotf.web $(srcdir)/pltotf.web $(srcdir)/pltotf.ch + + +## +EXTRA_DIST += $(ptex_web_srcs) $(ptex_ch_srcs) ptexdir/ptexextra.in \ + lib/texmfmp.c tmf-pool.h + +DISTCLEANFILES += $(nodist_ptex_SOURCES) ptex.web ptex.ch ptex-web2c \ + ptex.p ptex.pool ptex-tangle ptexdir/ptex.version + +EXTRA_DIST += \ + ptexdir/ChangeLog \ + ptexdir/INSTALL \ + ptexdir/README \ + ptexdir/ptex_gen.tex + +# pTeX Tests +# +ptex_tests = ptexdir/ptrip.test + +EXTRA_DIST += $(ptex_tests) + +if PTEX +TESTS += $(ptex_tests) +check_PROGRAMS += pdvitype ppltotf ptftopl +TRIPTRAP += ptrip.diffs +endif PTEX +DISTCLEANFILES += ptrip.diffs + +.PHONY: ptrip-clean +clean-local:: ptrip-clean +# ptrip.test +ptrip-clean: + rm -f trip.tfm trip.pl trip.tex trip.fmt ctripin.fot ctripin.log + rm -f ctrip.fot ctrip.log trip.dvi ctrip.typ + rm -f xtripin.fot xtripin.log + rm -f xtrip.fot xtrip.log xtrip.typ + rm -f ptrip.tfm ptrip.pl ptrip.tex ptrip.fmt ptripin.fot ptripin.log + rm -f ptrip.fot ptrip.log ptrip.dvi ptrip.out ptrip.typ + rm -f tripos.tex 8terminal.tex + rm -rf tfm + +## Test data +## +EXTRA_DIST += \ + ptexdir/ptrip/ptrip.diffs \ + ptexdir/ptrip/ptrip.fot \ + ptexdir/ptrip/ptrip.log \ + ptexdir/ptrip/ptrip.out \ + ptexdir/ptrip/ptrip.pl \ + ptexdir/ptrip/ptrip.tex \ + ptexdir/ptrip/ptrip.typ \ + ptexdir/ptrip/ptrip1.in \ + ptexdir/ptrip/ptrip2.in \ + ptexdir/ptrip/ptrip3.in \ + ptexdir/ptrip/ptripin.log \ + ptexdir/ptrip/ptripman.tex \ + ptexdir/ptrip/texmf.cnf \ + ptexdir/ptrip/trip2.in + +## Not used +## +EXTRA_DIST += ptexdir/ptex.mak + +## Eventually delete these files +## +EXTRA_DIST += ptexdir/ptex.mk + diff --git a/Build/source/texk/web2c/ptexdir/kanji.c b/Build/source/texk/web2c/ptexdir/kanji.c new file mode 100644 index 00000000000..c4d1d3d7a5b --- /dev/null +++ b/Build/source/texk/web2c/ptexdir/kanji.c @@ -0,0 +1,79 @@ +/* + * KANJI Code conversion routines. + * (for ptex only) + */ + +#include "kanji.h" + +/* FIXME: why not boolean value */ +boolean check_kanji(integer c) +{ + /* FIXME: why not 255 (0xff) */ + if (0 <= c && c <= 256) return -1; /* ascii without catcode */ + if (iskanji1(Hi(c)) && iskanji2(Lo(c))) return 1; + return 0; /* ascii with catcode */ +} + +boolean is_kanji(integer c) +{ + return (iskanji1(Hi(c)) && iskanji2(Lo(c))); +} + +boolean is_char_ascii(integer c) +{ + return (0 <= c && c < 0x100); +} + +boolean is_wchar_ascii(integer c) +{ + return (!is_char_ascii(c) && !is_kanji(c)); +} + +boolean ismultiprn(integer c) +{ + if (iskanji1(c) || iskanji2(c)) return true; + return false; +} + +#ifdef OLDSTYLE +integer calc_pos(integer c) +{ + int c1, c2; + + if(c<256) return(c<<1); + c1 = c>>8; + c2 = c & 0xff; + if(c1) { + if (is_internalSJIS()) + return((c2+(c2<<(c1-0x81)) & 0xff)<<1); + else + return((c2+(c2<<(c1-0xa1)) & 0xff)<<1); + } else + return(((c2+c2+1) & 0xff)<<1); +} +#else /* OLDSTYLE */ +integer calc_pos(integer c) +{ + unsigned char c1, c2; + + if(c>=0 && c<=255) return(c); + c1 = (c >> 8) & 0xff; + c2 = c & 0xff; + if(iskanji1(c1)) { + if (is_internalSJIS()) { + c1 = ((c1 - 0x81) % 4) * 64; /* c1 = 0, 64, 128, 192 */ + c2 = c2 % 64; /* c2 = 0..63 */ + } else { + c1 = ((c1 - 0xa1) % 4) * 64; /* c1 = 0, 64, 128, 192 */ + c2 = c2 % 64; /* c2 = 0..63 */ + } + return(c1 + c2); /* ret = 0..255 */ + } else + return(c2); +} +#endif /* OLDSTYLE */ + +integer kcatcodekey(integer c) +{ + return Hi(toDVI(c)); +} diff --git a/Build/source/texk/web2c/ptexdir/kanji.h b/Build/source/texk/web2c/ptexdir/kanji.h new file mode 100644 index 00000000000..f6e9d2dd5f2 --- /dev/null +++ b/Build/source/texk/web2c/ptexdir/kanji.h @@ -0,0 +1,48 @@ +/* + kanji.h: Handling 2byte char, and so on. +*/ +#ifndef KANJI_H +#define KANJI_H +#include "cpascal.h" +#include "ptexhelp.h" +#include <ptexenc/ptexenc.h> + +#define KANJI + +/* functions */ +#define Hi(x) (((x) >> 8) & 0xff) +#define Lo(x) ((x) & 0xff) + +extern boolean check_kanji(integer c); +#define checkkanji check_kanji +extern boolean is_kanji(integer c); +#define iskanji is_kanji +extern boolean is_char_ascii(integer c); +#define ischarascii is_char_ascii +extern boolean is_wchar_ascii(integer c); +#define iswcharascii is_wchar_ascii +extern boolean ismultiprn(integer c); +extern integer calc_pos(integer c); +#define calcpos calc_pos +extern integer kcatcodekey(integer c); + +#ifndef PRESERVE_PUTC +#undef putc +#define putc(c,fp) putc2(c,fp) +#endif /* !PRESERVE_PUTC */ + +#ifdef TeX +#undef TEXMFPOOLNAME +#undef TEXMFENGINENAME +#define TEXMFPOOLNAME "ptex.pool" +#define TEXMFENGINENAME "ptex" +#endif /* TeX */ + +#ifdef MP +#undef TEXMFPOOLNAME +#undef TEXMFENGINENAME +#define TEXMFPOOLNAME "jmp.pool" +#define TEXMFENGINENAME "jmpost" +#endif /* MP */ + +#endif /* not KANJI_H */ diff --git a/Build/source/texk/web2c/ptexdir/lib/Makefile.am b/Build/source/texk/web2c/ptexdir/lib/Makefile.am new file mode 100644 index 00000000000..c47cc958b8d --- /dev/null +++ b/Build/source/texk/web2c/ptexdir/lib/Makefile.am @@ -0,0 +1,19 @@ +## Makefile.am for the TeX Live subdirectory texk/web2c/ptexdir/lib/ +## +## Copyright (C) 2009 Peter Breitenlohner <tex-live@tug.org> +## You may freely use, modify and/or distribute this file. +## +INCLUDES = -I$(top_builddir)/.. -I$(top_srcdir) $(KPATHSEA_INCLUDES) +AM_CFLAGS = $(WARNING_CFLAGS) + +## Rebuild libkpathsea +@KPATHSEA_RULE@ + +noinst_LIBRARIES = lib.a + +## We don't compile `texmfmp.c'; this file is converted into 'texextra.c' +## for TeX, 'mfextra.c' for Metafont, 'mfextra.c' for MetaPost, ... +lib_a_SOURCES = \ + openclose.c \ + printversion.c \ + usage.c diff --git a/Build/source/texk/web2c/ptexdir/lib/Makefile.in b/Build/source/texk/web2c/ptexdir/lib/Makefile.in new file mode 100644 index 00000000000..8e19fcc33fb --- /dev/null +++ b/Build/source/texk/web2c/ptexdir/lib/Makefile.in @@ -0,0 +1,585 @@ +# Makefile.in generated by automake 1.11.1 from Makefile.am. +# @configure_input@ + +# Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, +# 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, +# Inc. +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + +@SET_MAKE@ + +VPATH = @srcdir@ +pkgdatadir = $(datadir)/@PACKAGE@ +pkgincludedir = $(includedir)/@PACKAGE@ +pkglibdir = $(libdir)/@PACKAGE@ +pkglibexecdir = $(libexecdir)/@PACKAGE@ +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +install_sh_DATA = $(install_sh) -c -m 644 +install_sh_PROGRAM = $(install_sh) -c +install_sh_SCRIPT = $(install_sh) -c +INSTALL_HEADER = $(INSTALL_DATA) +transform = $(program_transform_name) +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_triplet = @build@ +host_triplet = @host@ +subdir = ptexdir/lib +DIST_COMMON = $(srcdir)/Makefile.am $(srcdir)/Makefile.in +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +am__aclocal_m4_deps = $(top_srcdir)/m4/web2c-disable.m4 \ + $(top_srcdir)/../../m4/kpse-asm.m4 \ + $(top_srcdir)/../../m4/kpse-common.m4 \ + $(top_srcdir)/../../m4/kpse-cross.m4 \ + $(top_srcdir)/../../m4/kpse-cxx-hack.m4 \ + $(top_srcdir)/../../m4/kpse-fontconfig-flags.m4 \ + $(top_srcdir)/../../m4/kpse-freetype2-flags.m4 \ + $(top_srcdir)/../../m4/kpse-graphite-flags.m4 \ + $(top_srcdir)/../../m4/kpse-icu-flags.m4 \ + $(top_srcdir)/../../m4/kpse-kpathsea-flags.m4 \ + $(top_srcdir)/../../m4/kpse-lex.m4 \ + $(top_srcdir)/../../m4/kpse-libpng-flags.m4 \ + $(top_srcdir)/../../m4/kpse-lt-hack.m4 \ + $(top_srcdir)/../../m4/kpse-macos-framework.m4 \ + $(top_srcdir)/../../m4/kpse-obsdcompat-flags.m4 \ + $(top_srcdir)/../../m4/kpse-ptexenc-flags.m4 \ + $(top_srcdir)/../../m4/kpse-socket-libs.m4 \ + $(top_srcdir)/../../m4/kpse-teckit-flags.m4 \ + $(top_srcdir)/../../m4/kpse-warnings.m4 \ + $(top_srcdir)/../../m4/kpse-web2c.m4 \ + $(top_srcdir)/../../m4/kpse-win32.m4 \ + $(top_srcdir)/../../m4/kpse-xpdf-flags.m4 \ + $(top_srcdir)/../../m4/kpse-zlib-flags.m4 \ + $(top_srcdir)/../../m4/kpse-zziplib-flags.m4 \ + $(top_srcdir)/../../m4/libtool.m4 \ + $(top_srcdir)/../../m4/ltoptions.m4 \ + $(top_srcdir)/../../m4/ltsugar.m4 \ + $(top_srcdir)/../../m4/ltversion.m4 \ + $(top_srcdir)/../../m4/lt~obsolete.m4 \ + $(top_srcdir)/ac/web2c.ac $(top_srcdir)/configure.ac +am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ + $(ACLOCAL_M4) +mkinstalldirs = $(install_sh) -d +CONFIG_HEADER = $(top_builddir)/c-auto.h $(top_builddir)/ff-config.h +CONFIG_CLEAN_FILES = +CONFIG_CLEAN_VPATH_FILES = +LIBRARIES = $(noinst_LIBRARIES) +ARFLAGS = cru +lib_a_AR = $(AR) $(ARFLAGS) +lib_a_LIBADD = +am_lib_a_OBJECTS = openclose.$(OBJEXT) printversion.$(OBJEXT) \ + usage.$(OBJEXT) +lib_a_OBJECTS = $(am_lib_a_OBJECTS) +DEFAULT_INCLUDES = -I.@am__isrc@ -I$(top_builddir) +depcomp = $(SHELL) $(top_srcdir)/../../build-aux/depcomp +am__depfiles_maybe = depfiles +am__mv = mv -f +COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \ + $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) +LTCOMPILE = $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \ + --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) \ + $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) +CCLD = $(CC) +LINK = $(LIBTOOL) --tag=CC $(AM_LIBTOOLFLAGS) $(LIBTOOLFLAGS) \ + --mode=link $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) \ + $(LDFLAGS) -o $@ +SOURCES = $(lib_a_SOURCES) +DIST_SOURCES = $(lib_a_SOURCES) +ETAGS = etags +CTAGS = ctags +DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) +ACLOCAL = @ACLOCAL@ +AMTAR = @AMTAR@ +AR = @AR@ +AS = @AS@ +AUTOCONF = @AUTOCONF@ +AUTOHEADER = @AUTOHEADER@ +AUTOMAKE = @AUTOMAKE@ +AWK = @AWK@ +CC = @CC@ +CCDEPMODE = @CCDEPMODE@ +CFLAGS = @CFLAGS@ +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CTANGLE = @CTANGLE@ +CTANGLEBOOT = @CTANGLEBOOT@ +CXX = @CXX@ +CXXCPP = @CXXCPP@ +CXXDEPMODE = @CXXDEPMODE@ +CXXFLAGS = @CXXFLAGS@ +CXXLD = @CXXLD@ +CYGPATH_W = @CYGPATH_W@ +DEFS = @DEFS@ +DEPDIR = @DEPDIR@ +DLLTOOL = @DLLTOOL@ +DSYMUTIL = @DSYMUTIL@ +DUMPBIN = @DUMPBIN@ +ECHO_C = @ECHO_C@ +ECHO_N = @ECHO_N@ +ECHO_T = @ECHO_T@ +EGREP = @EGREP@ +EXEEXT = @EXEEXT@ +FGREP = @FGREP@ +FONTCONFIG_INCLUDES = @FONTCONFIG_INCLUDES@ +FONTCONFIG_LIBS = @FONTCONFIG_LIBS@ +FREETYPE2_DEPEND = @FREETYPE2_DEPEND@ +FREETYPE2_INCLUDES = @FREETYPE2_INCLUDES@ +FREETYPE2_LIBS = @FREETYPE2_LIBS@ +FT2_CONFIG = @FT2_CONFIG@ +GRAPHITE_DEPEND = @GRAPHITE_DEPEND@ +GRAPHITE_INCLUDES = @GRAPHITE_INCLUDES@ +GRAPHITE_LIBS = @GRAPHITE_LIBS@ +GREP = @GREP@ +ICU_DEPEND = @ICU_DEPEND@ +ICU_INCLUDES = @ICU_INCLUDES@ +ICU_LIBS = @ICU_LIBS@ +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ +KPATHSEA_DEPEND = @KPATHSEA_DEPEND@ +KPATHSEA_INCLUDES = @KPATHSEA_INCLUDES@ +KPATHSEA_LIBS = @KPATHSEA_LIBS@ +KPATHSEA_PATHS_H = @KPATHSEA_PATHS_H@ +KPSEWHICH = @KPSEWHICH@ +LD = @LD@ +LDFLAGS = @LDFLAGS@ +LEX = @LEX@ +LEXLIB = @LEXLIB@ +LEX_OUTPUT_ROOT = @LEX_OUTPUT_ROOT@ +LIBADD_DL = @LIBADD_DL@ +LIBADD_DLD_LINK = @LIBADD_DLD_LINK@ +LIBADD_DLOPEN = @LIBADD_DLOPEN@ +LIBADD_SHL_LOAD = @LIBADD_SHL_LOAD@ +LIBOBJS = @LIBOBJS@ +LIBPNG_DEPEND = @LIBPNG_DEPEND@ +LIBPNG_INCLUDES = @LIBPNG_INCLUDES@ +LIBPNG_LIBS = @LIBPNG_LIBS@ +LIBS = @LIBS@ +LIBTOOL = @LIBTOOL@ +LIPO = @LIPO@ +LN_S = @LN_S@ +LTLIBOBJS = @LTLIBOBJS@ +LT_DLLOADERS = @LT_DLLOADERS@ +LT_DLPREOPEN = @LT_DLPREOPEN@ +LUATANGLE = @LUATANGLE@ +MAINT = @MAINT@ +MAKEINFO = @MAKEINFO@ +MKDIR_P = @MKDIR_P@ +NM = @NM@ +NMEDIT = @NMEDIT@ +OBJCXX = @OBJCXX@ +OBJCXXFLAGS = @OBJCXXFLAGS@ +OBJDUMP = @OBJDUMP@ +OBJEXT = @OBJEXT@ +OBSDCOMPAT_DEPEND = @OBSDCOMPAT_DEPEND@ +OBSDCOMPAT_INCLUDES = @OBSDCOMPAT_INCLUDES@ +OBSDCOMPAT_LIBS = @OBSDCOMPAT_LIBS@ +OTANGLE = @OTANGLE@ +OTOOL = @OTOOL@ +OTOOL64 = @OTOOL64@ +PACKAGE = @PACKAGE@ +PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ +PACKAGE_NAME = @PACKAGE_NAME@ +PACKAGE_STRING = @PACKAGE_STRING@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +PACKAGE_URL = @PACKAGE_URL@ +PACKAGE_VERSION = @PACKAGE_VERSION@ +PATH_SEPARATOR = @PATH_SEPARATOR@ +PKG_CONFIG = @PKG_CONFIG@ +PTEXENC_DEPEND = @PTEXENC_DEPEND@ +PTEXENC_INCLUDES = @PTEXENC_INCLUDES@ +PTEXENC_LIBS = @PTEXENC_LIBS@ +RANLIB = @RANLIB@ +SED = @SED@ +SET_MAKE = @SET_MAKE@ +SHELL = @SHELL@ +STRIP = @STRIP@ +TANGLE = @TANGLE@ +TANGLEBOOT = @TANGLEBOOT@ +TECKIT_DEPEND = @TECKIT_DEPEND@ +TECKIT_INCLUDES = @TECKIT_INCLUDES@ +TECKIT_LIBS = @TECKIT_LIBS@ +TIE = @TIE@ +VERSION = @VERSION@ +WARNING_CFLAGS = @WARNING_CFLAGS@ +WARNING_CXXFLAGS = @WARNING_CXXFLAGS@ +WARNING_OBJCXXFLAGS = @WARNING_OBJCXXFLAGS@ +WEB2CVERSION = @WEB2CVERSION@ +XMKMF = @XMKMF@ +XPDF_DEPEND = @XPDF_DEPEND@ +XPDF_INCLUDES = @XPDF_INCLUDES@ +XPDF_LIBS = @XPDF_LIBS@ +X_CFLAGS = @X_CFLAGS@ +X_EXTRA_LIBS = @X_EXTRA_LIBS@ +X_LIBS = @X_LIBS@ +X_PRE_LIBS = @X_PRE_LIBS@ +YACC = @YACC@ +YFLAGS = @YFLAGS@ +ZLIB_DEPEND = @ZLIB_DEPEND@ +ZLIB_INCLUDES = @ZLIB_INCLUDES@ +ZLIB_LIBS = @ZLIB_LIBS@ +ZZIPLIB_DEPEND = @ZZIPLIB_DEPEND@ +ZZIPLIB_INCLUDES = @ZZIPLIB_INCLUDES@ +ZZIPLIB_LIBS = @ZZIPLIB_LIBS@ +abs_builddir = @abs_builddir@ +abs_srcdir = @abs_srcdir@ +abs_top_builddir = @abs_top_builddir@ +abs_top_srcdir = @abs_top_srcdir@ +ac_ct_CC = @ac_ct_CC@ +ac_ct_CXX = @ac_ct_CXX@ +ac_ct_DUMPBIN = @ac_ct_DUMPBIN@ +ac_ct_OBJCXX = @ac_ct_OBJCXX@ +am__include = @am__include@ +am__leading_dot = @am__leading_dot@ +am__quote = @am__quote@ +am__tar = @am__tar@ +am__untar = @am__untar@ +bindir = @bindir@ +build = @build@ +build_alias = @build_alias@ +build_cpu = @build_cpu@ +build_os = @build_os@ +build_vendor = @build_vendor@ +builddir = @builddir@ +datadir = @datadir@ +datarootdir = @datarootdir@ +docdir = @docdir@ +dvidir = @dvidir@ +exec_prefix = @exec_prefix@ +host = @host@ +host_alias = @host_alias@ +host_cpu = @host_cpu@ +host_os = @host_os@ +host_vendor = @host_vendor@ +htmldir = @htmldir@ +includedir = @includedir@ +infodir = @infodir@ +install_sh = @install_sh@ +ipc_socketlibs = @ipc_socketlibs@ +libdir = @libdir@ +libexecdir = @libexecdir@ +localedir = @localedir@ +localstatedir = @localstatedir@ +lt_ECHO = @lt_ECHO@ +lua_socketlibs = @lua_socketlibs@ +mandir = @mandir@ +mkdir_p = @mkdir_p@ +oldincludedir = @oldincludedir@ +pdfdir = @pdfdir@ +prefix = @prefix@ +program_transform_name = @program_transform_name@ +psdir = @psdir@ +sbindir = @sbindir@ +sharedstatedir = @sharedstatedir@ +srcdir = @srcdir@ +subdirs = @subdirs@ +sysconfdir = @sysconfdir@ +target_alias = @target_alias@ +top_build_prefix = @top_build_prefix@ +top_builddir = @top_builddir@ +top_srcdir = @top_srcdir@ +wlibs = @wlibs@ +x_ext_lib = @x_ext_lib@ +x_tool_libs = @x_tool_libs@ +INCLUDES = -I$(top_builddir)/.. -I$(top_srcdir) $(KPATHSEA_INCLUDES) +AM_CFLAGS = $(WARNING_CFLAGS) +noinst_LIBRARIES = lib.a +lib_a_SOURCES = \ + openclose.c \ + printversion.c \ + usage.c + +all: all-am + +.SUFFIXES: +.SUFFIXES: .c .lo .o .obj +$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ $(srcdir)/Makefile.am $(am__configure_deps) + @for dep in $?; do \ + case '$(am__configure_deps)' in \ + *$$dep*) \ + ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ + && { if test -f $@; then exit 0; else break; fi; }; \ + exit 1;; \ + esac; \ + done; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --foreign ptexdir/lib/Makefile'; \ + $(am__cd) $(top_srcdir) && \ + $(AUTOMAKE) --foreign ptexdir/lib/Makefile +.PRECIOUS: Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ + esac; + +$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh + +$(top_srcdir)/configure: @MAINTAINER_MODE_TRUE@ $(am__configure_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ $(am__aclocal_m4_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(am__aclocal_m4_deps): + +clean-noinstLIBRARIES: + -test -z "$(noinst_LIBRARIES)" || rm -f $(noinst_LIBRARIES) +lib.a: $(lib_a_OBJECTS) $(lib_a_DEPENDENCIES) + -rm -f lib.a + $(lib_a_AR) lib.a $(lib_a_OBJECTS) $(lib_a_LIBADD) + $(RANLIB) lib.a + +mostlyclean-compile: + -rm -f *.$(OBJEXT) + +distclean-compile: + -rm -f *.tab.c + +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/openclose.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/printversion.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/usage.Po@am__quote@ + +.c.o: +@am__fastdepCC_TRUE@ $(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(COMPILE) -c $< + +.c.obj: +@am__fastdepCC_TRUE@ $(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'` +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(COMPILE) -c `$(CYGPATH_W) '$<'` + +.c.lo: +@am__fastdepCC_TRUE@ $(LTCOMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< +@am__fastdepCC_TRUE@ $(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Plo +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='$<' object='$@' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LTCOMPILE) -c -o $@ $< + +mostlyclean-libtool: + -rm -f *.lo + +clean-libtool: + -rm -rf .libs _libs + +ID: $(HEADERS) $(SOURCES) $(LISP) $(TAGS_FILES) + list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | \ + $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in files) print i; }; }'`; \ + mkid -fID $$unique +tags: TAGS + +TAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ + $(TAGS_FILES) $(LISP) + set x; \ + here=`pwd`; \ + list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | \ + $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in files) print i; }; }'`; \ + shift; \ + if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \ + test -n "$$unique" || unique=$$empty_fix; \ + if test $$# -gt 0; then \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + "$$@" $$unique; \ + else \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + $$unique; \ + fi; \ + fi +ctags: CTAGS +CTAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) \ + $(TAGS_FILES) $(LISP) + list='$(SOURCES) $(HEADERS) $(LISP) $(TAGS_FILES)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | \ + $(AWK) '{ files[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in files) print i; }; }'`; \ + test -z "$(CTAGS_ARGS)$$unique" \ + || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ + $$unique + +GTAGS: + here=`$(am__cd) $(top_builddir) && pwd` \ + && $(am__cd) $(top_srcdir) \ + && gtags -i $(GTAGS_ARGS) "$$here" + +distclean-tags: + -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags + +distdir: $(DISTFILES) + @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + list='$(DISTFILES)'; \ + dist_files=`for file in $$list; do echo $$file; done | \ + sed -e "s|^$$srcdirstrip/||;t" \ + -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ + case $$dist_files in \ + */*) $(MKDIR_P) `echo "$$dist_files" | \ + sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ + sort -u` ;; \ + esac; \ + for file in $$dist_files; do \ + if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ + if test -d $$d/$$file; then \ + dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ + if test -d "$(distdir)/$$file"; then \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ + cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ + else \ + test -f "$(distdir)/$$file" \ + || cp -p $$d/$$file "$(distdir)/$$file" \ + || exit 1; \ + fi; \ + done +check-am: all-am +check: check-am +all-am: Makefile $(LIBRARIES) +installdirs: +install: install-am +install-exec: install-exec-am +install-data: install-data-am +uninstall: uninstall-am + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am + +installcheck: installcheck-am +install-strip: + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + `test -z '$(STRIP)' || \ + echo "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'"` install +mostlyclean-generic: + +clean-generic: + +distclean-generic: + -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) + -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) + +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." +clean: clean-am + +clean-am: clean-generic clean-libtool clean-noinstLIBRARIES \ + mostlyclean-am + +distclean: distclean-am + -rm -rf ./$(DEPDIR) + -rm -f Makefile +distclean-am: clean-am distclean-compile distclean-generic \ + distclean-tags + +dvi: dvi-am + +dvi-am: + +html: html-am + +html-am: + +info: info-am + +info-am: + +install-data-am: + +install-dvi: install-dvi-am + +install-dvi-am: + +install-exec-am: + +install-html: install-html-am + +install-html-am: + +install-info: install-info-am + +install-info-am: + +install-man: + +install-pdf: install-pdf-am + +install-pdf-am: + +install-ps: install-ps-am + +install-ps-am: + +installcheck-am: + +maintainer-clean: maintainer-clean-am + -rm -rf ./$(DEPDIR) + -rm -f Makefile +maintainer-clean-am: distclean-am maintainer-clean-generic + +mostlyclean: mostlyclean-am + +mostlyclean-am: mostlyclean-compile mostlyclean-generic \ + mostlyclean-libtool + +pdf: pdf-am + +pdf-am: + +ps: ps-am + +ps-am: + +uninstall-am: + +.MAKE: install-am install-strip + +.PHONY: CTAGS GTAGS all all-am check check-am clean clean-generic \ + clean-libtool clean-noinstLIBRARIES ctags distclean \ + distclean-compile distclean-generic distclean-libtool \ + distclean-tags distdir dvi dvi-am html html-am info info-am \ + install install-am install-data install-data-am install-dvi \ + install-dvi-am install-exec install-exec-am install-html \ + install-html-am install-info install-info-am install-man \ + install-pdf install-pdf-am install-ps install-ps-am \ + install-strip installcheck installcheck-am installdirs \ + maintainer-clean maintainer-clean-generic mostlyclean \ + mostlyclean-compile mostlyclean-generic mostlyclean-libtool \ + pdf pdf-am ps ps-am tags uninstall uninstall-am + + +@KPATHSEA_RULE@ + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/Build/source/texk/web2c/ptexdir/lib/openclose.c b/Build/source/texk/web2c/ptexdir/lib/openclose.c new file mode 100644 index 00000000000..f865d53464b --- /dev/null +++ b/Build/source/texk/web2c/ptexdir/lib/openclose.c @@ -0,0 +1,286 @@ +/* openclose.c: open and close files for TeX, Metafont, and BibTeX. + Derived from ../../lib/openclose.c. + + Written 1995, 96 Karl Berry. Public domain. */ + +#include "config.h" +#include "../../lib/lib.h" +#include <kpathsea/c-pathch.h> +#include <kpathsea/tex-file.h> +#include <kpathsea/variable.h> +#include <kpathsea/absolute.h> +#include <ptexenc/ptexenc.h> + +/* The globals we use to communicate. */ +extern string nameoffile; +extern unsigned namelength; +/* For "file:line:error" style error messages. */ +extern string fullnameoffile; +/* For the filename recorder. */ +extern boolean recorder_enabled; +/* For the output-dir option. */ +extern string output_directory; + +/* Define some variables. */ +string fullnameoffile; /* Defaults to NULL. */ +static string recorder_name; /* Defaults to NULL. */ +static FILE *recorder_file; /* Defaults to NULL. */ +boolean recorder_enabled; /* Defaults to false. */ +string output_directory; /* Defaults to NULL. */ + +/* For TeX and MetaPost. See below. Always defined so we don't have to + #ifdef, and thus this file can be compiled once and go in lib.a. */ +int tfmtemp; +int ocptemp; +int texinputtype; + +/* Helpers for the filename recorder... */ +/* Start the recorder */ +static void +recorder_start(void) +{ + /* Alas, while we might want to use mkstemp it is not portable. + So we have to be content with using a default name... */ + string cwd; + + recorder_name = (string)xmalloc(strlen(kpse_program_name)+5); + strcpy(recorder_name, kpse_program_name); + strcat(recorder_name, ".fls"); + + /* If an output directory was specified, use it instead of cwd. */ + if (output_directory) { + string temp = concat3(output_directory, DIR_SEP_STRING, recorder_name); + free(recorder_name); + recorder_name = temp; + } + + recorder_file = xfopen(recorder_name, FOPEN_W_MODE); + + cwd = xgetcwd(); + fprintf(recorder_file, "PWD %s\n", cwd); + free(cwd); +} + +/* Change the name of the recorder file. */ +void +recorder_change_filename (string new_name) +{ + if (!recorder_file) + return; + rename(recorder_name, new_name); + free(recorder_name); + recorder_name = xstrdup(new_name); +} + +/* helper for recorder_record_* */ +static void +recorder_record_name (const_string prefix, const_string name) +{ + if (recorder_enabled) { + if (!recorder_file) + recorder_start(); + fprintf(recorder_file, "%s %s\n", prefix, name); + fflush(recorder_file); + } +} + +/* record an input file name */ +void +recorder_record_input (const_string name) +{ + recorder_record_name ("INPUT", name); +} + +/* record an output file name */ +void +recorder_record_output (const_string name) +{ + recorder_record_name ("OUTPUT", name); +} + +/* Open an input file F, using the kpathsea format FILEFMT and passing + FOPEN_MODE to fopen. The filename is in `nameoffile+1'. We return + whether or not the open succeeded. If it did, `nameoffile' is set to + the full filename opened, and `namelength' to its length. */ + +boolean +open_input (FILE **f_ptr, int filefmt, const_string fopen_mode) +{ + string fname = NULL; +#ifdef FUNNY_CORE_DUMP + /* This only applies if a preloaded TeX/Metafont is being made; + it allows automatic creation of the core dump (typing ^\ loses + since that requires manual intervention). */ + if ((filefmt == kpse_tex_format || filefmt == kpse_mf_format + || filefmt == kpse_mp_format) + && STREQ (nameoffile + 1, "HackyInputFileNameForCoreDump.tex")) + funny_core_dump (); +#endif + + /* We havent found anything yet. */ + *f_ptr = NULL; + if (fullnameoffile) + free(fullnameoffile); + fullnameoffile = NULL; + + /* Look in -output-directory first, if the filename is not + absolute. This is because .aux and other such files will get + written to the output directory, and we have to be able to read + them from there. We only look for the name as-is. */ + if (output_directory && kpse_absolute_p (nameoffile+1, false)) { + fname = concat3 (output_directory, DIR_SEP_STRING, nameoffile + 1); + *f_ptr = fopen (fname, fopen_mode); + if (*f_ptr) { + free (nameoffile); + namelength = strlen (fname); + nameoffile = (string) xmalloc (namelength + 2); + strcpy (nameoffile + 1, fname); + fullnameoffile = fname; + } else { + free (fname); + } + } + + /* No file means do the normal search. */ + if (*f_ptr == NULL) { + /* A negative FILEFMT means don't use a path. */ + if (filefmt < 0) { + /* no_file_path, for BibTeX .aux files and MetaPost things. */ + *f_ptr = fopen(nameoffile + 1, fopen_mode); + /* FIXME... fullnameoffile = xstrdup(nameoffile + 1); */ + } else { + /* The only exception to `must_exist' being true is \openin, for + which we set `tex_input_type' to 0 in the change file. */ + /* According to the pdfTeX people, pounding the disk for .vf files + is overkill as well. A more general solution would be nice. */ + boolean must_exist = (filefmt != kpse_tex_format || texinputtype) + && (filefmt != kpse_vf_format); + fname = kpse_find_file (nameoffile + 1, + (kpse_file_format_type)filefmt, + must_exist); + if (fname) { + fullnameoffile = xstrdup(fname); + /* If we found the file in the current directory, don't leave + the `./' at the beginning of `nameoffile', since it looks + dumb when `tex foo' says `(./foo.tex ... )'. On the other + hand, if the user said `tex ./foo', and that's what we + opened, then keep it -- the user specified it, so we + shouldn't remove it. */ + if (fname[0] == '.' && IS_DIR_SEP (fname[1]) + && (nameoffile[1] != '.' || !IS_DIR_SEP (nameoffile[2]))) + { + unsigned i = 0; + while (fname[i + 2] != 0) { + fname[i] = fname[i + 2]; + i++; + } + fname[i] = 0; + } + + /* kpse_find_file always returns a new string. */ + free (nameoffile); + namelength = strlen (fname); + nameoffile = (string)xmalloc (namelength + 2); + strcpy (nameoffile + 1, fname); + free (fname); + + /* This fopen is not allowed to fail. */ + if (filefmt == kpse_tex_format || + filefmt == kpse_bib_format) { + *f_ptr = nkf_open (nameoffile + 1, fopen_mode); + } else { + *f_ptr = xfopen (nameoffile + 1, fopen_mode); + } + } + } + } + + if (*f_ptr) { + recorder_record_input (nameoffile + 1); + + /* If we just opened a TFM file, we have to read the first + byte, to pretend we're Pascal. See tex.ch and mp.ch. + Ditto for the ocp/ofm Omega file formats. */ + if (filefmt == kpse_tfm_format) { + tfmtemp = getc (*f_ptr); + /* We intentionally do not check for EOF here, i.e., an + empty TFM file. TeX will see the 255 byte and complain + about a bad TFM file, which is what we want. */ + } else if (filefmt == kpse_ocp_format) { + ocptemp = getc (*f_ptr); + } else if (filefmt == kpse_ofm_format) { + tfmtemp = getc (*f_ptr); + } + } + + return *f_ptr != NULL; +} + +/* Open an output file F either in the current directory or in + $TEXMFOUTPUT/F, if the environment variable `TEXMFOUTPUT' exists. + (Actually, this also applies to the BibTeX and MetaPost output files, + but `TEXMFMPBIBOUTPUT' was just too long.) The filename is in the + global `nameoffile' + 1. We return whether or not the open + succeeded. If it did, `nameoffile' is reset to the name opened if + necessary, and `namelength' to its length. */ + +boolean +open_output (FILE **f_ptr, const_string fopen_mode) +{ + string fname; + boolean absolute = kpse_absolute_p(nameoffile+1, false); + + /* If we have an explicit output directory, use it. */ + if (output_directory && !absolute) { + fname = concat3(output_directory, DIR_SEP_STRING, nameoffile + 1); + } else { + fname = nameoffile + 1; + } + + /* Is the filename openable as given? */ + *f_ptr = fopen (fname, fopen_mode); + + if (!*f_ptr) { + /* Can't open as given. Try the envvar. */ + string texmfoutput = kpse_var_value("TEXMFOUTPUT"); + + if (texmfoutput && *texmfoutput && !absolute) { + if (fname != nameoffile + 1) + free(fname); + fname = concat3(texmfoutput, DIR_SEP_STRING, nameoffile+1); + *f_ptr = fopen(fname, fopen_mode); + } + } + /* If this succeeded, change nameoffile accordingly. */ + if (*f_ptr) { + if (fname != nameoffile + 1) { + free (nameoffile); + namelength = strlen (fname); + nameoffile = (string)xmalloc (namelength + 2); + strcpy (nameoffile + 1, fname); + } + recorder_record_output (fname); + } + if (fname != nameoffile +1) + free(fname); + return *f_ptr != NULL; +} + +/* Close F. */ + +void +close_file (FILE *f) +{ + /* If F is null, just return. bad_pool might close a file that has + never been opened. */ + if (!f) + return; + + if (nkf_close (f) == EOF) { + /* It's not always nameoffile, we might have opened something else + in the meantime. And it's not easy to extract the filenames out + of the pool array. So just punt on the filename. Sigh. This + probably doesn't need to be a fatal error. */ + perror ("fclose"); + } +} diff --git a/Build/source/texk/web2c/ptexdir/lib/openclose.c.orig b/Build/source/texk/web2c/ptexdir/lib/openclose.c.orig new file mode 100644 index 00000000000..33b2ef985bc --- /dev/null +++ b/Build/source/texk/web2c/ptexdir/lib/openclose.c.orig @@ -0,0 +1,279 @@ +/* openclose.c: open and close files for TeX, Metafont, and BibTeX. + + Written 1995, 96 Karl Berry. Public domain. */ + +#include "config.h" +#include "lib.h" +#include <kpathsea/c-pathch.h> +#include <kpathsea/tex-file.h> +#include <kpathsea/variable.h> +#include <kpathsea/absolute.h> + +/* The globals we use to communicate. */ +extern string nameoffile; +extern unsigned namelength; +/* For "file:line:error style error messages. */ +extern string fullnameoffile; +/* For the filename recorder. */ +extern boolean recorder_enabled; +/* For the output-dir option. */ +extern string output_directory; + +/* Define some variables. */ +string fullnameoffile; /* Defaults to NULL. */ +static string recorder_name; /* Defaults to NULL. */ +static FILE *recorder_file; /* Defaults to NULL. */ +boolean recorder_enabled; /* Defaults to false. */ +string output_directory; /* Defaults to NULL. */ + +/* For TeX and MetaPost. See below. Always defined so we don't have to + #ifdef, and thus this file can be compiled once and go in lib.a. */ +int tfmtemp; +int ocptemp; +int texinputtype; + +/* Helpers for the filename recorder... */ +/* Start the recorder */ +static void +recorder_start(void) +{ + /* Alas, while we might want to use mkstemp it is not portable. + So we have to be content with using a default name... */ + string cwd; + + recorder_name = (string)xmalloc(strlen(kpse_program_name)+5); + strcpy(recorder_name, kpse_program_name); + strcat(recorder_name, ".fls"); + + /* If an output directory was specified, use it instead of cwd. */ + if (output_directory) { + string temp = concat3(output_directory, DIR_SEP_STRING, recorder_name); + free(recorder_name); + recorder_name = temp; + } + + recorder_file = xfopen(recorder_name, FOPEN_W_MODE); + + cwd = xgetcwd(); + fprintf(recorder_file, "PWD %s\n", cwd); + free(cwd); +} + +/* Change the name of the recorder file. */ +void +recorder_change_filename (string new_name) +{ + if (!recorder_file) + return; + rename(recorder_name, new_name); + free(recorder_name); + recorder_name = xstrdup(new_name); +} + +/* helper for recorder_record_* */ +static void +recorder_record_name (const_string prefix, const_string name) +{ + if (recorder_enabled) { + if (!recorder_file) + recorder_start(); + fprintf(recorder_file, "%s %s\n", prefix, name); + fflush(recorder_file); + } +} + +/* record an input file name */ +void +recorder_record_input (const_string name) +{ + recorder_record_name ("INPUT", name); +} + +/* record an output file name */ +void +recorder_record_output (const_string name) +{ + recorder_record_name ("OUTPUT", name); +} + +/* Open an input file F, using the kpathsea format FILEFMT and passing + FOPEN_MODE to fopen. The filename is in `nameoffile+1'. We return + whether or not the open succeeded. If it did, `nameoffile' is set to + the full filename opened, and `namelength' to its length. */ + +boolean +open_input (FILE **f_ptr, int filefmt, const_string fopen_mode) +{ + string fname = NULL; +#ifdef FUNNY_CORE_DUMP + /* This only applies if a preloaded TeX/Metafont is being made; + it allows automatic creation of the core dump (typing ^\ loses + since that requires manual intervention). */ + if ((filefmt == kpse_tex_format || filefmt == kpse_mf_format + || filefmt == kpse_mp_format) + && STREQ (nameoffile + 1, "HackyInputFileNameForCoreDump.tex")) + funny_core_dump (); +#endif + + /* We havent found anything yet. */ + *f_ptr = NULL; + if (fullnameoffile) + free(fullnameoffile); + fullnameoffile = NULL; + + /* Look in -output-directory first, if the filename is not + absolute. This is because .aux and other such files will get + written to the output directory, and we have to be able to read + them from there. We only look for the name as-is. */ + if (output_directory && kpse_absolute_p (nameoffile+1, false)) { + fname = concat3 (output_directory, DIR_SEP_STRING, nameoffile + 1); + *f_ptr = fopen (fname, fopen_mode); + if (*f_ptr) { + free (nameoffile); + namelength = strlen (fname); + nameoffile = (string) xmalloc (namelength + 2); + strcpy (nameoffile + 1, fname); + fullnameoffile = fname; + } else { + free (fname); + } + } + + /* No file means do the normal search. */ + if (*f_ptr == NULL) { + /* A negative FILEFMT means don't use a path. */ + if (filefmt < 0) { + /* no_file_path, for BibTeX .aux files and MetaPost things. */ + *f_ptr = fopen(nameoffile + 1, fopen_mode); + /* FIXME... fullnameoffile = xstrdup(nameoffile + 1); */ + } else { + /* The only exception to `must_exist' being true is \openin, for + which we set `tex_input_type' to 0 in the change file. */ + /* According to the pdfTeX people, pounding the disk for .vf files + is overkill as well. A more general solution would be nice. */ + boolean must_exist = (filefmt != kpse_tex_format || texinputtype) + && (filefmt != kpse_vf_format); + fname = kpse_find_file (nameoffile + 1, + (kpse_file_format_type)filefmt, + must_exist); + if (fname) { + fullnameoffile = xstrdup(fname); + /* If we found the file in the current directory, don't leave + the `./' at the beginning of `nameoffile', since it looks + dumb when `tex foo' says `(./foo.tex ... )'. On the other + hand, if the user said `tex ./foo', and that's what we + opened, then keep it -- the user specified it, so we + shouldn't remove it. */ + if (fname[0] == '.' && IS_DIR_SEP (fname[1]) + && (nameoffile[1] != '.' || !IS_DIR_SEP (nameoffile[2]))) + { + unsigned i = 0; + while (fname[i + 2] != 0) { + fname[i] = fname[i + 2]; + i++; + } + fname[i] = 0; + } + + /* kpse_find_file always returns a new string. */ + free (nameoffile); + namelength = strlen (fname); + nameoffile = (string)xmalloc (namelength + 2); + strcpy (nameoffile + 1, fname); + free (fname); + + /* This fopen is not allowed to fail. */ + *f_ptr = xfopen (nameoffile + 1, fopen_mode); + } + } + } + + if (*f_ptr) { + recorder_record_input (nameoffile + 1); + + /* If we just opened a TFM file, we have to read the first + byte, to pretend we're Pascal. See tex.ch and mp.ch. + Ditto for the ocp/ofm Omega file formats. */ + if (filefmt == kpse_tfm_format) { + tfmtemp = getc (*f_ptr); + /* We intentionally do not check for EOF here, i.e., an + empty TFM file. TeX will see the 255 byte and complain + about a bad TFM file, which is what we want. */ + } else if (filefmt == kpse_ocp_format) { + ocptemp = getc (*f_ptr); + } else if (filefmt == kpse_ofm_format) { + tfmtemp = getc (*f_ptr); + } + } + + return *f_ptr != NULL; +} + +/* Open an output file F either in the current directory or in + $TEXMFOUTPUT/F, if the environment variable `TEXMFOUTPUT' exists. + (Actually, this also applies to the BibTeX and MetaPost output files, + but `TEXMFMPBIBOUTPUT' was just too long.) The filename is in the + global `nameoffile' + 1. We return whether or not the open + succeeded. If it did, `nameoffile' is reset to the name opened if + necessary, and `namelength' to its length. */ + +boolean +open_output (FILE **f_ptr, const_string fopen_mode) +{ + string fname; + boolean absolute = kpse_absolute_p(nameoffile+1, false); + + /* If we have an explicit output directory, use it. */ + if (output_directory && !absolute) { + fname = concat3(output_directory, DIR_SEP_STRING, nameoffile + 1); + } else { + fname = nameoffile + 1; + } + + /* Is the filename openable as given? */ + *f_ptr = fopen (fname, fopen_mode); + + if (!*f_ptr) { + /* Can't open as given. Try the envvar. */ + string texmfoutput = kpse_var_value("TEXMFOUTPUT"); + + if (texmfoutput && *texmfoutput && !absolute) { + if (fname != nameoffile + 1) + free(fname); + fname = concat3(texmfoutput, DIR_SEP_STRING, nameoffile+1); + *f_ptr = fopen(fname, fopen_mode); + } + } + /* If this succeeded, change nameoffile accordingly. */ + if (*f_ptr) { + if (fname != nameoffile + 1) { + free (nameoffile); + namelength = strlen (fname); + nameoffile = (string)xmalloc (namelength + 2); + strcpy (nameoffile + 1, fname); + } + recorder_record_output (fname); + } + if (fname != nameoffile +1) + free(fname); + return *f_ptr != NULL; +} + +/* Close F. */ + +void +close_file (FILE *f) +{ + /* If F is null, just return. bad_pool might close a file that has + never been opened. */ + if (!f) + return; + + if (fclose (f) == EOF) { + /* It's not always nameoffile, we might have opened something else + in the meantime. And it's not easy to extract the filenames out + of the pool array. So just punt on the filename. Sigh. This + probably doesn't need to be a fatal error. */ + perror ("fclose"); + } +} diff --git a/Build/source/texk/web2c/ptexdir/lib/printversion.c b/Build/source/texk/web2c/ptexdir/lib/printversion.c new file mode 100644 index 00000000000..5a6e2897df4 --- /dev/null +++ b/Build/source/texk/web2c/ptexdir/lib/printversion.c @@ -0,0 +1,66 @@ +/* printversion.c: Output for the standard GNU option --version. + + Written in 1996 by Karl Berry. Public domain. */ + +#include "config.h" +#include "../../lib/lib.h" +#include "../kanji.h" +#include <kpathsea/version.h> + +/* We're passed in the original WEB banner string, which has the form +This is PROGRAM, Version VERSION-NUMBER + We parse the PROGRAM and VERSION-NUMBER out of this. + + If COPYRIGHT_HOLDER is specified and AUTHOR isn't, then use the + former for the latter. If AUTHOR is specified and COPYRIGHT_HOLDER + isn't, it means the original program is public domain. + + Maybe I should have just done it all inline in each individual + program, but tangle doesn't allow multiline string constants ... */ + +void +printversionandexit (const_string banner, + const_string copyright_holder, + const_string author, + char *extra_info) +{ + string prog_name; + unsigned len; + const_string prog_name_end = strchr (banner, ','); + const_string prog_version = strrchr (banner, ' '); + assert (prog_name_end && prog_version); + prog_version++; + + /* attention: strlen(s)+1 = sizeof(s) */ + len = prog_name_end - banner - sizeof ("This is"); + prog_name = (string)xmalloc (len + 1); + strncpy (prog_name, banner + sizeof ("This is"), len); + prog_name[len] = 0; + + /* The Web2c version string starts with a space. */ + printf ("%s %s (%s)%s\n", prog_name, prog_version, get_enc_string(), + versionstring); + puts (kpathsea_version_string); + puts (ptexenc_version_string); + + if (copyright_holder) { + printf ("Copyright 2009 %s.\n", copyright_holder); + if (!author) + author = copyright_holder; + } + + puts ("There is NO warranty. Redistribution of this software is"); + fputs ("covered by the terms of ", stdout); + printf ("both the %s copyright and\n", prog_name); + puts ("the Lesser GNU General Public License."); + puts ("For more information about these matters, see the file"); + printf ("named COPYING and the %s source.\n", prog_name); + printf ("Primary author of %s: %s.\n", prog_name, author); + + if (extra_info) { + puts (extra_info); + } + + free (prog_name); /* lost in lib/printversion.c */ + uexit (0); +} diff --git a/Build/source/texk/web2c/ptexdir/lib/printversion.c.orig b/Build/source/texk/web2c/ptexdir/lib/printversion.c.orig new file mode 100644 index 00000000000..bb9874b5244 --- /dev/null +++ b/Build/source/texk/web2c/ptexdir/lib/printversion.c.orig @@ -0,0 +1,61 @@ +/* printversion.c: Output for the standard GNU option --version. + + Written in 1996 by Karl Berry. Public domain. */ + +#include "config.h" +#include "lib.h" +#include <kpathsea/version.h> + +/* We're passed in the original WEB banner string, which has the form +This is PROGRAM, Version VERSION-NUMBER + We parse the PROGRAM and VERSION-NUMBER out of this. + + If COPYRIGHT_HOLDER is specified and AUTHOR isn't, then use the + former for the latter. If AUTHOR is specified and COPYRIGHT_HOLDER + isn't, it means the original program is public domain. + + Maybe I should have just done it all inline in each individual + program, but tangle doesn't allow multiline string constants ... */ + +void +printversionandexit (const_string banner, + const_string copyright_holder, + const_string author, + char *extra_info) +{ + string prog_name; + unsigned len; + const_string prog_name_end = strchr (banner, ','); + const_string prog_version = strrchr (banner, ' '); + assert (prog_name_end && prog_version); + prog_version++; + + len = prog_name_end - banner - sizeof ("This is"); + prog_name = (string)xmalloc (len + 1); + strncpy (prog_name, banner + sizeof ("This is"), len); + prog_name[len] = 0; + + /* The Web2c version string starts with a space. */ + printf ("%s %s%s\n", prog_name, prog_version, versionstring); + puts (kpathsea_version_string); + + if (copyright_holder) { + printf ("Copyright 2009 %s.\n", copyright_holder); + if (!author) + author = copyright_holder; + } + + puts ("There is NO warranty. Redistribution of this software is"); + fputs ("covered by the terms of ", stdout); + printf ("both the %s copyright and\n", prog_name); + puts ("the Lesser GNU General Public License."); + puts ("For more information about these matters, see the file"); + printf ("named COPYING and the %s source.\n", prog_name); + printf ("Primary author of %s: %s.\n", prog_name, author); + + if (extra_info) { + puts (extra_info); + } + + uexit (0); +} diff --git a/Build/source/texk/web2c/ptexdir/lib/usage.c b/Build/source/texk/web2c/ptexdir/lib/usage.c new file mode 100644 index 00000000000..642a0314207 --- /dev/null +++ b/Build/source/texk/web2c/ptexdir/lib/usage.c @@ -0,0 +1,36 @@ +/* usage.c: Output a help message (from help.h). + Derived from ../../lib/usage.c. + + Modified in 2001 by O. Weber. + Written in 1995 by K. Berry. Public domain. */ + +#include "config.h" + +/* Call usage if the program exits with an "usage error". STR is supposed + to be the program name. */ + +void +usage (const_string str) +{ + fprintf (stderr, "Try `%s --help' for more information.\n", str); + uexit (1); +} + +/* Call usage if the program exits by printing the help message. + MESSAGE is a NULL-terminated array of strings which make up the + help message. Each string is printed on a separate line. + We use arrays instead of a single string to work around compiler + limitations (sigh). +*/ +void +usagehelp (const_string *message, const_string bug_email) +{ + if (!bug_email) + bug_email = "ptex-staff@ml.asciimw.jp"; + while (*message) { + printf("%s\n", *message); + ++message; + } + printf("\nEmail bug reports to %s.\n", bug_email); + uexit(0); +} diff --git a/Build/source/texk/web2c/ptexdir/lib/usage.c.orig b/Build/source/texk/web2c/ptexdir/lib/usage.c.orig new file mode 100644 index 00000000000..c09ee874fce --- /dev/null +++ b/Build/source/texk/web2c/ptexdir/lib/usage.c.orig @@ -0,0 +1,35 @@ +/* usage.c: Output a help message (from help.h). + + Modified in 2001 by O. Weber. + Written in 1995 by K. Berry. Public domain. */ + +#include "config.h" + +/* Call usage if the program exits with an "usage error". STR is supposed + to be the program name. */ + +void +usage (const_string str) +{ + fprintf (stderr, "Try `%s --help' for more information.\n", str); + uexit (1); +} + +/* Call usage if the program exits by printing the help message. + MESSAGE is a NULL-terminated array of strings which make up the + help message. Each string is printed on a separate line. + We use arrays instead of a single string to work around compiler + limitations (sigh). +*/ +void +usagehelp (const_string *message, const_string bug_email) +{ + if (!bug_email) + bug_email = "tex-k@tug.org"; + while (*message) { + printf("%s\n", *message); + ++message; + } + printf("\nEmail bug reports to %s.\n", bug_email); + uexit(0); +} diff --git a/Build/source/texk/web2c/ptexdir/pbibtex.ch b/Build/source/texk/web2c/ptexdir/pbibtex.ch new file mode 100644 index 00000000000..889bf8cc2e1 --- /dev/null +++ b/Build/source/texk/web2c/ptexdir/pbibtex.ch @@ -0,0 +1,2233 @@ +% Change file for BibTeX in C, originally by Howard Trickey. +% +% 05/28/84 Initial implementation, version 0.41 of BibTeX +% 07/01/84 Version 0.41a of BibTeX. +% 12/17/84 Version 0.97c of BibTeX. +% 02/12/85 Version 0.98c of BibTeX. +% 02/25/85 Newer version 0.98c of BibTeX. +% 03/25/85 Version 0.98f of BibTeX +% 05/23/85 Version 0.98i of BibTeX +% 02/11/88 Version 0.99b of BibTeX +% 04/04/88 Version 0.99c; converted for use with web2c (ETM). +% 11/30/89 Use FILENAMESIZE instead of 1024 (KB). +% 03/09/90 `int' is a bad variable name for C. +% (more recent changes in the ChangeLog) +% +% 5/ 2/89 Version 0.20 of JBiBTeX by Shouichi Matsui +% 12/25/90 Version 0.30 of JBibTeX by Shouichi Matsui +% 1/ 1/91 last update for JBibTeX 0.30 by Shouichi Matsui +% 10/30/92 last update for JBibTeX 0.31 for bug fix by Shouichi Matsui +% 11/02/94 Version 0.32 for use with web2c 6.1, by Takafumi Sakurai +% +% 2009 pTeXenc, pbibtex N. Tsuchimura + +% [0] Let bibtex.tex work with latest webmac (which defines \ET, hence +% making E active loses). +@x +\catcode`E=13 \uppercase{\def E{e}} +\def\\#1{\hbox{\let E=\drop\it#1\/\kern.05em}} % italic type for identifiers +@y +\let\maybe = \iffalse % process only changed sections +@z + +@x only print chnages +\def\title{\BibTeX\ } +@y +\let\maybe=\iffalse +\def\title{J\BibTeX\ 0.33 Changes for C Version \BibTeX\ } +@z + +@x + \def\titlepage{F} + \centerline{\:\titlefont The {\:\ttitlefont \BibTeX} preprocessor} + \vskip 15pt \centerline{(Version 0.99c---\today)} \vfill} +@y + \def\titlepage{F} + \centerline{\:\titlefont The {\:\ttitlefont J\BibTeX} preprocessor} + \vskip 15pt \centerline{(Version 0.32 base on C Version \BibTeX 0.99c---\today)} \vfill} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1] banner +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d banner=='This is BibTeX, Version 0.99d' {printed when the program starts} +@y +@d banner=='This is pBibTeX, Version 0.99d-j0.33' + {printed when the program starts} +@z + +% [2] `term_in' and `term_out' are standard input and output. But +% there is a complication: BibTeX passes `term_out' to some routines as +% a var parameter. web2c turns a var parameter f into &f at the calling +% side -- and stdout is sometimes implemented as `&_iob[1]' or some +% such. An address of an address is invalid. Therefore, we define +% variables `standardinput' and `standardoutput' in openinout.c. +@x +@d term_out == tty +@d term_in == tty +@y +@d term_out == standard_output +@d term_in == standard_input + +@<Globals in the outer block@>= +standard_input, standard_output: text; +@z + +@x [3] Add log_pr macros. +@d trace_pr_newline == begin write_ln(log_file); end +@y +@d trace_pr_newline == begin write_ln(log_file); end +@# +@d log_pr(#) == trace_pr(#) +@d log_pr_ln(#) == trace_pr_ln(#) +@d log_pr_newline == trace_pr_newline +@z + +@x [4] Turn debug..gubed et al. into #ifdef's. +@d debug == @{ { remove the `|@{|' when debugging } +@d gubed == @t@>@} { remove the `|@}|' when debugging } +@f debug == begin +@f gubed == end +@# +@d stat == @{ { remove the `|@{|' when keeping statistics } +@d tats == @t@>@} { remove the `|@}|' when keeping statistics } +@f stat == begin +@f tats == end +@# +@d trace == @{ { remove the `|@{|' when in |trace| mode } +@d ecart == @t@>@} { remove the `|@}|' when in |trace| mode } +@f trace == begin +@f ecart == end +@y +@d debug == ifdef('TEXMF_DEBUG') +@d gubed == endif('TEXMF_DEBUG') +@f debug == begin +@f gubed == end +@# +@d stat == ifndef('NO_BIBTEX_STAT') +@d tats == endifn('NO_BIBTEX_STAT') +@f stat==begin +@f tats==end +@# +@d trace == ifdef@&('TRACE') +@d ecart == endif@&('TRACE') +@f trace == begin +@f ecart == end +@z + +@x [10] Eliminate the |exit_program| label. +label close_up_shop,@!exit_program @<Labels in the outer block@>; +@y +label close_up_shop @<Labels in the outer block@>; +@z + +@x [10] Don't print the banner unless verbose, and initialize dynamic arrays. +begin +initialize; +print_ln(banner);@/ +@y +@<Define |parse_arguments|@> +begin +standard_input := stdin; +standard_output := stdout; +@# +pool_size := POOL_SIZE; +buf_size := BUF_SIZE; +max_bib_files := MAX_BIB_FILES; +max_glob_strs := MAX_GLOB_STRS; +max_fields := MAX_FIELDS; +max_cites := MAX_CITES; +wiz_fn_space := WIZ_FN_SPACE; +lit_stk_size := LIT_STK_SIZE; +@# +setup_params; +@# +{Add one to the sizes because that's what bibtex uses.} +bib_file := XTALLOC (max_bib_files + 1, alpha_file); +bib_list := XTALLOC (max_bib_files + 1, str_number); +entry_ints := nil; +entry_strs := nil; +wiz_functions := XTALLOC (wiz_fn_space + 1, hash_ptr2); +field_info := XTALLOC (max_fields + 1, str_number); +s_preamble := XTALLOC (max_bib_files + 1, str_number); +str_pool := XTALLOC (pool_size + 1, ASCII_code); +buffer := XTALLOC (buf_size + 1, ASCII_code); +sv_buffer := XTALLOC (buf_size + 1, ASCII_code); +ex_buf := XTALLOC (buf_size + 1, ASCII_code); +out_buf := XTALLOC (buf_size + 1, ASCII_code); +name_tok := XTALLOC (buf_size + 1, buf_pointer); +name_sep_char := XTALLOC (buf_size + 1, ASCII_code); +@# +glb_str_ptr := XTALLOC (max_glob_strs, str_number); +global_strs := XTALLOC (max_glob_strs * (glob_str_size + 1), ASCII_code); +glb_str_end := XTALLOC (max_glob_strs, integer); +@# +cite_list := XTALLOC (max_cites + 1, str_number); +type_list := XTALLOC (max_cites + 1, hash_ptr2); +entry_exists := XTALLOC (max_cites + 1, boolean); +cite_info := XTALLOC (max_cites + 1, str_number); +@# +str_start := XTALLOC (max_strings + 1, pool_pointer); +@# +hash_next := XTALLOC (hash_max + 1, hash_pointer); +hash_text := XTALLOC (hash_max + 1, str_number); +hash_ilk := XTALLOC (hash_max + 1, str_ilk); +ilk_info := XTALLOC (hash_max + 1, integer); +fn_type := XTALLOC (hash_max + 1, fn_class); +@# +lit_stack := XTALLOC (lit_stk_size + 1, integer); +lit_stk_type := XTALLOC (lit_stk_size + 1, stk_type); +@# +compute_hash_prime; +@# +initialize; +if verbose then begin + print (banner); + print (' ('); + print (stringcast(get_enc_string)); + print (')'); + print_ln (version_string); +end +else begin + log_pr (banner); + log_pr_ln (version_string); +end; +log_pr_ln ('Capacity: max_strings=', max_strings:1, + ', hash_size=', hash_size:1, ', hash_prime=', hash_prime:1); +@z + +% [10] Possibly exit with bad status. It doesn't seem worth it to move +% the definitions of the |history| values to above this module; hence the 1. +@x +exit_program: +end. +@y +if (history > 1) then uexit (history); +end. +@z + +@x [13] Remove nonlocal goto. + goto exit_program; +@y + uexit (1); +@z + +@x [14] Increase some constants, and uppercase others for dynamic arrays. +@<Constants in the outer block@>= +@y +@<Constants in the outer block@>= +@!hash_base = empty + 1; {lowest numbered hash-table location} +@!quote_next_fn = hash_base - 1; {special marker used in defining functions} +@z + +@x [still 14] +@!buf_size=1000; {maximum number of characters in an input line (or string)} +@y +@!BUF_SIZE=20000; {initial maximum number of characters in an input line + (or string)} +@z + +@x [still 14] +@!max_bib_files=20; {maximum number of \.{.bib} files allowed} +@!pool_size=65000; {maximum number of characters in strings} +@!max_strings=4000; {maximum number of strings, including pre-defined; + must be |<=hash_size|} +@!max_cites=750; {maximum number of distinct cite keys; must be + |<=max_strings|} +@!min_crossrefs=2; {minimum number of cross-refs required for automatic + |cite_list| inclusion} +@!wiz_fn_space=3000; {maximum amount of |wiz_defined|-function space} +@y [still 14] +@!MAX_BIB_FILES=20; {initial number of \.{.bib} files allowed} +@!POOL_SIZE=65000; {initial number of characters in strings} +@!MAX_STRINGS=4000; {minimum value for |max_strings|} +@!MAX_CITES=750; {initial number of distinct cite keys; must be + |<=max_strings|} +@!WIZ_FN_SPACE=3400; {initial amount of |wiz_defined|-function space} +{|min_crossrefs| can be set at runtime now.} +@z + +@x [still 14] +@!single_fn_space=100; {maximum amount for a single |wiz_defined|-function} +@y +@!SINGLE_FN_SPACE=50; {initial amount for a single |wiz_defined|-function} +@z + +@x [still 14] handle long citation strings +@!max_ent_ints=3000; {maximum number of |int_entry_var|s + (entries $\times$ |int_entry_var|s)} +@!max_ent_strs=3000; {maximum number of |str_entry_var|s + (entries $\times$ |str_entry_var|s)} +@!ent_str_size=100; {maximum size of a |str_entry_var|; must be |<=buf_size|} +@!glob_str_size=1000; {maximum size of a |str_global_var|; + must be |<=buf_size|} +@!max_fields=17250; {maximum number of fields (entries $\times$ fields, +@y +@!ENT_STR_SIZE=100; {maximum size of a |str_entry_var|; must be |<=buf_size|} +@!GLOB_STR_SIZE=1000; {maximum size of a |str_global_var|; + must be |<=buf_size|} +@!MAX_GLOB_STRS=10; {initial number of |str_global_var| names} +@!MAX_FIELDS=5000; {initial number of fields (entries $\times$ fields, +@z + +@x [still 14] +@!lit_stk_size=100; {maximum number of literal functions on the stack} +@y +@!LIT_STK_SIZE=50; {initial space for literal functions on the stack} +@z + +@x [15] Increase more constants in the web defines. +@d hash_size=5000 {must be |>= max_strings| and |>= hash_prime|} +@d hash_prime=4253 {a prime number about 85\% of |hash_size| and |>= 128| + and |< @t$2^{14}-2^6$@>|} +@d file_name_size=40 {file names shouldn't be longer than this} +@d max_glob_strs=10 {maximum number of |str_global_var| names} +@d max_glb_str_minus_1 = max_glob_strs-1 {to avoid wasting a |str_global_var|} +@y +{|hash_size| and |hash_prime| are now computed.} +@d HASH_SIZE=5000 {minimum value for |hash_size|} +@# +@d file_name_size==maxint {file names have no arbitrary maximum length} +@# +{For dynamic allocation.} +@d x_entry_strs_tail(#) == (#)] +@d x_entry_strs(#) == entry_strs[(#) * (ent_str_size+1) + x_entry_strs_tail +@d x_global_strs_tail(#) == (#)] +@d x_global_strs(#) == global_strs[(#) * (glob_str_size+1) + x_global_strs_tail +@z + +@x [16] Add new variables-that-used-to-be-constants for dynamic arrays. +@<Globals in the outer block@>= +@y +@<Globals in the outer block@>= +@!pool_size: integer; +@!max_bib_files: integer; +@!max_cites: integer; +@!wiz_fn_space: integer; +@!ent_str_size: integer; +@!glob_str_size: integer; +@!max_glob_strs: integer; +@!max_fields: integer; +@!lit_stk_size: integer; +@# +@!max_strings: integer; +@!hash_size: integer; +@!hash_prime: integer; +@# +@!hash_max: integer; {highest numbered hash-table location} +@!end_of_def: integer; {another special marker used in defining functions} +@!undefined: integer; {a special marker used for |type_list|} +@z + +@x [17] max_strings=hash_size settable at runtime. +if (hash_prime >= (16384-64)) then bad:=10*bad+6; +@y +if (hash_base <> 1) then bad:=10*bad+6; +@z + +@x [22, 23, 27, 28] Allow any character as input. [22] +@!ASCII_code=0..127; {seven-bit numbers} +@y +@!ASCII_code=0..255; {eight-bit numbers} +@z + +@x [23] +@d text_char == char {the data type of characters in text files} +@d first_text_char=0 {ordinal number of the smallest element of |text_char|} +@d last_text_char=127 {ordinal number of the largest element of |text_char|} + +@<Local variables for initialization@>= +i:0..last_text_char; {this is the first one declared} +@y +@d text_char == ASCII_code {the data type of characters in text files} +@d first_text_char=0 {ordinal number of the smallest element of |text_char|} +@d last_text_char=255 {ordinal number of the largest element of |text_char|} + +@<Local variables for initialization@>= +i:integer; +@z + +@x Changes for JBibTeX by Shouichi Matsui [27] +for i:=1 to @'37 do xchr[i]:=' '; +xchr[tab]:=chr(tab); +@y +for i:=1 to @'37 do xchr[i]:=' '; +xchr[tab]:=chr(tab); +for i:=@'200 to @'237 do xchr[i]:=chr(i-@'200); +for i:=@'240 to 255 do xchr[i]:=chr(i); +xchr[@'33]:=chr(@'33); {escape char} +@z + +@x Changes for JBibTeX by Shouichi Matsui [28] +@<Set initial values of key variables@>= +for i:=first_text_char to last_text_char do xord[chr(i)]:=invalid_code; +for i:=1 to @'176 do xord[xchr[i]]:=i; +@y +@<Set initial values of key variables@>= +for i:=first_text_char to last_text_char do xord[i]:=invalid_code; +for i:=1 to @'176 do xord[i]:= i; +for i:=@'200 to @'237 do xord[i]:= i-@'200; +for i:=@'240 to 255 do xord[i]:=i; +@z + +@x Changes for JBibTeX by Shouichi Matsui for ver. 0.30 +@d period = "." {these are three} +@d question_mark = "?" {string-ending characters} +@d exclamation_mark = "!" {of interest in \.{add.period\$}} +@y +@d period = "." {these are three} +@d question_mark = "?" {string-ending characters} +@d exclamation_mark = "!" {of interest in \.{add.period\$}} +@d zen_pun_first = 161 {Zenkaku punctuation first byte; in EUC} +@d zen_space = 161 {Zenkaku space first, second byte; in EUC} +@d zen_kuten = 162 {Zenkaku kuten second byte; in EUC} +@d zen_ten = 163 {Zenkaku ten second byte; in EUC} +@d zen_comma = 164 {Zenkaku comman second byte; in EUC} +@d zen_period = 165 {Zenkaku period second byte; in EUC} +@d zen_question = 169 {Zenkaku question mark second byte; in EUC} +@d zen_exclamation = 170 {Zenkaku exclamation mark second byte; in EUC} +@z + +% [32] Make RET a `white_space' character, so we won't choke on DOS +% files, which use CR/LF for line endings. +@x Changes for JBibTeX by Shouichi Matsui [32] +@<Set initial values of key variables@>= +for i:=0 to @'177 do lex_class[i] := other_lex; +for i:=0 to @'37 do lex_class[i] := illegal; +lex_class[invalid_code] := illegal; +lex_class[tab] := white_space; +lex_class[space] := white_space; +lex_class[tie] := sep_char; +lex_class[hyphen] := sep_char; +for i:=@'60 to @'71 do lex_class[i] := numeric; +for i:=@'101 to @'132 do lex_class[i] := alpha; +for i:=@'141 to @'172 do lex_class[i] := alpha; +@y +@<Set initial values of key variables@>= +for i:=0 to @'377 do lex_class[i] := other_lex; +for i:=0 to @'37 do lex_class[i] := illegal; +lex_class[invalid_code] := illegal; +lex_class[tab] := white_space; +lex_class[13] := white_space; +lex_class[space] := white_space; +lex_class[tie] := sep_char; +lex_class[hyphen] := sep_char; +for i:=@'60 to @'71 do lex_class[i] := numeric; +for i:=@'101 to @'132 do lex_class[i] := alpha; +for i:=@'141 to @'172 do lex_class[i] := alpha; +for i:=@'200 to @'237 do lex_class[i] := illegal; +for i:=@'240 to 255 do lex_class[i] := alpha; +lex_class[@'33]:=alpha; +@z + +@x Changes for JBibTeX by Shouichi Matsui [33] +@<Set initial values of key variables@>= +for i:=0 to @'177 do id_class[i] := legal_id_char; +for i:=0 to @'37 do id_class[i] := illegal_id_char; +id_class[space] := illegal_id_char; +id_class[tab] := illegal_id_char; +id_class[double_quote] := illegal_id_char; +id_class[number_sign] := illegal_id_char; +id_class[comment] := illegal_id_char; +id_class[single_quote] := illegal_id_char; +id_class[left_paren] := illegal_id_char; +id_class[right_paren] := illegal_id_char; +id_class[comma] := illegal_id_char; +id_class[equals_sign] := illegal_id_char; +id_class[left_brace] := illegal_id_char; +id_class[right_brace] := illegal_id_char; +@y +@<Set initial values of key variables@>= +for i:=0 to @'377 do id_class[i] := legal_id_char; +for i:=0 to @'37 do id_class[i] := illegal_id_char; +for i:=@'200 to @'237 do id_class[i] := illegal_id_char; +id_class[@'33] := legal_id_char; +id_class[space] := illegal_id_char; +id_class[tab] := illegal_id_char; +id_class[double_quote] := illegal_id_char; +id_class[number_sign] := illegal_id_char; +id_class[comment] := illegal_id_char; +id_class[single_quote] := illegal_id_char; +id_class[left_paren] := illegal_id_char; +id_class[right_paren] := illegal_id_char; +id_class[comma] := illegal_id_char; +id_class[equals_sign] := illegal_id_char; +id_class[left_brace] := illegal_id_char; +id_class[right_brace] := illegal_id_char; +@z + +@x Changes for JBibTeX by Shouichi Matsui [35] +char_width[@'167] := 722; +char_width[@'170] := 528; +char_width[@'171] := 528; +char_width[@'172] := 444; +char_width[@'173] := 500; +char_width[@'174] :=1000; +char_width[@'175] := 500; +char_width[@'176] := 500; +@y +char_width[@'167] := 722; +char_width[@'170] := 528; +char_width[@'171] := 528; +char_width[@'172] := 444; +char_width[@'173] := 500; +char_width[@'174] :=1000; +char_width[@'175] := 500; +char_width[@'176] := 500; +for i:=@'240 to 254 do char_width[i]:=514; +@z + +% [37] file_name_size no longer exists. See comments in tex.ch for why +% we change the element type to text_char. +@x +@!name_of_file:packed array[1..file_name_size] of char; + {on some systems this is a \&{record} variable} +@!name_length:0..file_name_size; + {this many characters are relevant in |name_of_file| (the rest are blank)} +@!name_ptr:0..file_name_size+1; {index variable into |name_of_file|} +@y +@!name_of_file:^text_char; +@!name_length:integer; + {this many characters are relevant in |name_of_file| } +@!name_ptr:integer; {index variable into |name_of_file|} +@z + +@x [38] File opening. +The \ph\ compiler with which the present version of \TeX\ was prepared has +extended the rules of \PASCAL\ in a very convenient way. To open file~|f|, +we can write +$$\vbox{\halign{#\hfil\qquad&#\hfil\cr +|reset(f,@t\\{name}@>,'/O')|&for input;\cr +|rewrite(f,@t\\{name}@>,'/O')|&for output.\cr}}$$ +The `\\{name}' parameter, which is of type `\ignorespaces|packed +array[@t\<\\{any}>@>] of text_char|', stands for the name of +the external file that is being opened for input or output. +Blank spaces that might appear in \\{name} are ignored. + +The `\.{/O}' parameter tells the operating system not to issue its own +error messages if something goes wrong. If a file of the specified name +cannot be found, or if such a file cannot be opened for some other reason +(e.g., someone may already be trying to write the same file), we will have +|@!erstat(f)<>0| after an unsuccessful |reset| or |rewrite|. This allows +\TeX\ to undertake appropriate corrective action. + +\TeX's file-opening procedures return |false| if no file identified by +|name_of_file| could be opened. + +@d reset_OK(#)==erstat(#)=0 +@d rewrite_OK(#)==erstat(#)=0 + +@<Procedures and functions for file-system interacting@>= +function erstat(var f:file):integer; extern; {in the runtime library} +@#@t\2@> +function a_open_in(var f:alpha_file):boolean; {open a text file for input} +begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f); +end; +@# +function a_open_out(var f:alpha_file):boolean; {open a text file for output} +begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f); +end; +@y +@ File opening will be done in C. +@d no_file_path = -1 +@z + +@x [39] Do file closing in C. +@<Procedures and functions for file-system interacting@>= +procedure a_close(var f:alpha_file); {close a text file} +begin close(f); +end; +@y +File closing will be done in C, too. +@z + +@x [42] Dynamic buf_size. +@!buffer:buf_type; {usually, lines of characters being read} +@y +@!buf_size:integer; {size of buffer} +@!buffer:buf_type; {usually, lines of characters being read} +@z + +@x [43] Dyanmic buf_size. +@!buf_pointer = 0..buf_size; {an index into a |buf_type|} +@!buf_type = array[buf_pointer] of ASCII_code; {for various buffers} +@y +@!buf_pointer = integer; {an index into a |buf_type|} +@!buf_type = ^ASCII_code; {for various buffers} +@z + +@x [47] Dynamic buf_size. +overflow('buffer size ',buf_size); +@y +BIB_XRETALLOC_NOSET ('buffer', buffer, ASCII_code, + buf_size, buf_size + BUF_SIZE); +BIB_XRETALLOC_NOSET ('sv_buffer', sv_buffer, ASCII_code, + buf_size, buf_size + BUF_SIZE); +BIB_XRETALLOC_NOSET ('ex_buf', ex_buf, ASCII_code, + buf_size, buf_size + BUF_SIZE); +BIB_XRETALLOC_NOSET ('out_buf', out_buf, ASCII_code, + buf_size, buf_size + BUF_SIZE); +BIB_XRETALLOC_NOSET ('name_tok', name_tok, buf_pointer, + buf_size, buf_size + BUF_SIZE); +BIB_XRETALLOC ('name_sep_char', name_sep_char, ASCII_code, + buf_size, buf_size + BUF_SIZE); +@z + +@x [48] web2c doesn't understand f^. JBibTeX + while (not eoln(f)) do + begin + if (last >= buf_size) then + buffer_overflow; + buffer[last]:=xord[f^]; + get(f); incr(last); + end; + get(f); +@y + last := input_line3(f,buffer,last,buf_size); + if (last < 0) then buffer_overflow; +@z + +@x [49] Dynamically allocate str_pool. +@!str_pool : packed array[pool_pointer] of ASCII_code; {the characters} +@!str_start : packed array[str_number] of pool_pointer; {the starting pointers} +@y +@!str_pool : ^ASCII_code; {the characters} +@!str_start :^pool_pointer; {the starting pointers} +@z + +@x [50] pool_size is a variable now, so can't be used as a constant. +@!pool_pointer = 0..pool_size; {for variables that point into |str_pool|} +@!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 = integer; {for variables that point into |str_start|} +@z + +@x [51] Add log_pr_pool_str macro. +@d trace_pr_pool_str(#) == begin + out_pool_str(log_file,#); + end +@y +@d trace_pr_pool_str(#) == begin + out_pool_str(log_file,#); + end +@# +@d log_pr_pool_str(#) == trace_pr_pool_str(#) +@z + +@x [54] Reallocate str_pool. We may need more than POOL_SIZE. + if (pool_ptr+# > pool_size) then +@y + while (pool_ptr+# > pool_size) do +@z +@x [54] Reallocate str_pool. +overflow('pool size ',pool_size); +@y +BIB_XRETALLOC ('str_pool', str_pool, ASCII_code, pool_size, + pool_size + POOL_SIZE); +@z + +% [59] (start_name) reallocate name_of_file for the new name and +% terminate with null. +@x +if (length(file_name) > file_name_size) then + begin + print ('File='); + print_pool_str (file_name); + print_ln (','); + file_nm_size_overflow; + end; +@y +free (name_of_file); +name_of_file := xmalloc_array (ASCII_code, length (file_name) + 1); +@z + +@x +name_length := length(file_name); +@y +name_length := length(file_name); +name_of_file[name_length + 1] := 0; +@z + +@x [60] (file_nm_size_overflow) This procedure is not used. +procedure file_nm_size_overflow; +begin +overflow('file name size ',file_name_size); +end; +@y +@z + +% [61] (add_extension) Don't pad name_of_file with blanks, terminate +% with null. And junk the overflow check, since Web2c can't translate +% the print statement properly and it can never happen, anyway. +@x +if (name_length + length(ext) > file_name_size) then + begin + print ('File=',name_of_file,', extension='); + print_pool_str (ext); print_ln (','); + file_nm_size_overflow; + end; +@y +@z +@x +name_ptr := name_length+1; +while (name_ptr <= file_name_size) do {pad with blanks} + begin + name_of_file[name_ptr] := ' '; + incr(name_ptr); + end; +@y +name_of_file[name_length + 1] := 0; +@z + +@x [62] (add_area) This procedure is not used. +procedure add_area(@!area:str_number); +var p_ptr: pool_pointer; {running index} +begin +if (name_length + length(area) > file_name_size) then + begin + print ('File='); + print_pool_str (area); print (name_of_file,','); + file_nm_size_overflow; + end; +name_ptr := name_length; +while (name_ptr > 0) do {shift up name} + begin + name_of_file[name_ptr+length(area)] := name_of_file[name_ptr]; + decr(name_ptr); + end; +name_ptr := 1; +p_ptr := str_start[area]; +while (p_ptr < str_start[area+1]) do + begin + name_of_file[name_ptr] := chr (str_pool[p_ptr]); + incr(name_ptr); incr(p_ptr); + end; +name_length := name_length + length(area); +end; +@y +@z + +@x [65] now Pascal consts or vars, instead of web macros. +@d hash_base = empty + 1 {lowest numbered hash-table location} +@d hash_max = hash_base + hash_size - 1 {highest numbered hash-table location} +@y +@z + +@x [65] max_strings=hash_size settable at runtime. +@!hash_loc=hash_base..hash_max; {a location within the hash table} +@!hash_pointer=empty..hash_max; {either |empty| or a |hash_loc|} +@y +@!hash_loc=integer; {a location within the hash table} +@!hash_pointer=integer; {either |empty| or a |hash_loc|} +@z + +@x [66] max_strings=hash_size settable at runtime. +@!hash_next : packed array[hash_loc] of hash_pointer; {coalesced-list link} +@!hash_text : packed array[hash_loc] of str_number; {pointer to a string} +@!hash_ilk : packed array[hash_loc] of str_ilk; {the type of string} +@!ilk_info : packed array[hash_loc] of integer; {|ilk|-specific info} +@!hash_used : hash_base..hash_max+1; {allocation pointer for hash table} +@y +@!hash_next : ^hash_pointer; {coalesced-list link} +@!hash_text : ^str_number; {pointer to a string} +@!hash_ilk : ^str_ilk; {the type of string} +@!ilk_info : ^integer; {|ilk|-specific info} +@!hash_used : integer; {allocation pointer for hash table} +@z + +@x [69] Not used anymore. +@d max_hash_value = hash_prime+hash_prime-2+127 {|h|'s maximum value} +@y +@z + +@x [69] max_strings=hash_size settable at runtime. +var h:0..max_hash_value; {hash code} +@y +var h:integer; {hash code} +@z + +@x [69] str_lookup - Avoid 'uninitialized' warning. +@!old_string:boolean; {set to |true| if it's an already encountered string} +@y +@z + +@x [69] str_lookup - Avoid 'uninitialized' warning. +old_string := false; +@y +str_num := 0; {set to |>0| if it's an already encountered string} +@z + +@x [71] str_lookup - Avoid 'uninitialized' warning. + old_string := true; +@y +@z + +@x [72] str_lookup - Avoid 'uninitialized' warning. +if (old_string) then {it's an already encountered string} +@y +if (str_num>0) then {it's an already encountered string} +@z + +@x [74] Pascal Web's char +@!pds_type = packed array [pds_loc] of char; +@y +@!pds_type = const_w2c_u_string; +@z + +@x [78] C strings start at zero instead of one. +for i:=1 to len do + buffer[i] := xord[pds[i]]; +@y +for i:=1 to len do + buffer[i] := xord[pds[i-1]]; +@z + +@x [98] Can't do this tangle-time arithmetic with file_name_size. +@!aux_name_length : 0..file_name_size+1; {\.{.aux} name sans extension} +@y +@!aux_name_length : integer; +@z + +@x [101] Reading the aux file name and command-line processing. +This procedure consists of a loop that reads and processes a (nonnull) +\.{.aux} file name. It's this module and the next two that must be +changed on those systems using command-line arguments. Note: The +|term_out| and |term_in| files are system dependent. + +@<Procedures and functions for the reading and processing of input files@>= +procedure get_the_top_level_aux_file_name; +label aux_found,@!aux_not_found; +var @<Variables for possible command-line processing@>@/ +begin +check_cmnd_line := false; {many systems will change this} +loop + begin + if (check_cmnd_line) then + @<Process a possible command line@> + else + begin + write (term_out,'Please type input file name (no extension)--'); + if (eoln(term_in)) then {so the first |read| works} + read_ln (term_in); + aux_name_length := 0; + while (not eoln(term_in)) do + begin + if (aux_name_length = file_name_size) then + begin + while (not eoln(term_in)) do {discard the rest of the line} + get(term_in); + sam_you_made_the_file_name_too_long; + end; + incr(aux_name_length); + name_of_file[aux_name_length] := term_in^; + get(term_in); + end; + end; + @<Handle this \.{.aux} name@>; +aux_not_found: + check_cmnd_line := false; + end; +aux_found: {now we're ready to read the \.{.aux} file} +end; +@y +@<Procedures and functions for the reading and processing of input files@>= +procedure get_the_top_level_aux_file_name; +label aux_found,@!aux_not_found; +begin + if (not set_enc_string (0,'EUC')) then uexit(1); + @<Process a possible command line@> + {Leave room for the \.., the extension, the junk byte at the + beginning, and the null byte at the end.} + name_of_file := xmalloc_array (ASCII_code, strlen (cmdline (optind)) + 5); + strcpy (stringcast(name_of_file + 1), cmdline (optind)); + aux_name_length := strlen (stringcast(name_of_file + 1)); + @<Handle this \.{.aux} name@>; +aux_not_found: uexit (1); +aux_found: {now we're ready to read the \.{.aux} file} +end; +@z + +% [101] Don't need this variable; we use argc to check if we have a +% command line. +@x +@<Variables for possible command-line processing@>= +@!check_cmnd_line : boolean; {|true| if we're to check the command line} +@y +@z + +@x [103] Get the aux file name from the command line. +@<Process a possible command line@>= +begin +do_nothing; {the ``default system'' doesn't use the command line} +end +@y +@<Process a possible command line@>= +parse_arguments; +@z + +% [107] Don't use a path to find the aux file, and don't add the +% extension if it's already there. +@x +add_extension (s_aux_extension); {this also sets |name_length|} +aux_ptr := 0; {initialize the \.{.aux} file stack} +if (not a_open_in(cur_aux_file)) then +@y +if (name_length < 4) or + (strcmp (stringcast(name_of_file + 1 + name_length - 4), '.aux') <> 0) +then + add_extension (s_aux_extension) {this also sets |name_length|} +else + aux_name_length := aux_name_length - 4; {set to length without \.{.aux}} +aux_ptr := 0; {initialize the \.{.aux} file stack} +if (not kpse_in_name_ok(stringcast(name_of_file+1)) or + not a_open_in(cur_aux_file,no_file_path)) then +@z + +@x [107] - Check log_file name. +if (not a_open_out(log_file)) then +@y +if (not kpse_out_name_ok(stringcast(name_of_file+1)) or + not a_open_out(log_file)) then +@z + +@x [107] - Check bbl_file name +if (not a_open_out(bbl_file)) then +@y +if (not kpse_out_name_ok(stringcast(name_of_file+1)) or + not a_open_out(bbl_file)) then +@z + +@x [109] Add log_pr_aux_name. +procedure print_aux_name; +begin +print_pool_str (cur_aux_str); +print_newline; +end; +@y +procedure print_aux_name; +begin +print_pool_str (cur_aux_str); +print_newline; +end; +@# +procedure log_pr_aux_name; +begin +log_pr_pool_str (cur_aux_str); +log_pr_newline; +end; +@z + +@x [111] Be silent unless verbose. +print ('The top-level auxiliary file: '); +print_aux_name; +@y +if verbose then begin + print ('The top-level auxiliary file: '); + print_aux_name; +end +else begin + log_pr ('The top-level auxiliary file: '); + log_pr_aux_name; +end; +@z + +@x [118] bib_list is dynamically allocated. +@!bib_list : array[bib_number] of str_number; {the \.{.bib} file list} +@y +@!bib_list : ^str_number; {the \.{.bib} file list} +@z +@x [still 118] bib_file also. +@!bib_file : array[bib_number] of alpha_file; {corresponding |file| variables} +@y +@!bib_file : ^alpha_file; {corresponding |file| variables} +@z + +@x [119] max_bib_files is a variable now, so can't be used as a const. +@!bib_number = 0..max_bib_files; {gives the |bib_list| range} +@y +@!bib_number = integer; {gives the |bib_list| range} +@z + +@x [122] Add log_pr_bib_name. +procedure print_bib_name; +begin +print_pool_str (cur_bib_str); +print_pool_str (s_bib_extension); +print_newline; +end; +@y +procedure print_bib_name; +begin +print_pool_str (cur_bib_str); +print_pool_str (s_bib_extension); +print_newline; +end; +@# +procedure log_pr_bib_name; +begin +log_pr_pool_str (cur_bib_str); +log_pr_pool_str (s_bib_extension); +log_pr_newline; +end; +@z + +@x [124] Reallocate when we run out of bib files. + overflow('number of database files ',max_bib_files); +@y +begin + {Keep old value of |max_bib_files| for the last array.} + BIB_XRETALLOC_NOSET ('bib_list', bib_list, str_number, max_bib_files, + max_bib_files + MAX_BIB_FILES); + BIB_XRETALLOC_NOSET ('bib_file', bib_file, alpha_file, max_bib_files, + max_bib_files + MAX_BIB_FILES); + BIB_XRETALLOC ('s_preamble', s_preamble, str_number, max_bib_files, + max_bib_files + MAX_BIB_FILES); +end; +@z + +@x [still 124] Use BIBINPUTS to search for the .bib file. +add_extension (s_bib_extension); +if (not a_open_in(cur_bib_file)) then + begin + add_area (s_bib_area); + if (not a_open_in(cur_bib_file)) then + open_bibdata_aux_err ('I couldn''t open database file '); + end; +@y +if (not kpse_in_name_ok(stringcast(name_of_file+1)) or + not a_open_in(cur_bib_file, kpse_bib_format)) then + open_bibdata_aux_err ('I couldn''t open database file '); +@z + +@x [128] Use BSTINPUTS/TEXINPUTS to search for .bst files. +add_extension (s_bst_extension); +if (not a_open_in(bst_file)) then + begin + add_area (s_bst_area); + if (not a_open_in(bst_file)) then + begin + print ('I couldn''t open style file '); + print_bst_name;@/ + bst_str := 0; {mark as unused again} + aux_err_return; + end; + end; +@y +if (not kpse_in_name_ok(stringcast(name_of_file+1)) or + not a_open_in(bst_file, kpse_bst_format)) then + begin + print ('I couldn''t open style file '); + print_bst_name;@/ + bst_str := 0; {mark as unused again} + aux_err_return; + end; +@z + +@x [128] Be silent unless verbose. +print ('The style file: '); +print_bst_name; +@y +if verbose then begin + print ('The style file: '); + print_bst_name; +end +else begin + log_pr ('The style file: '); + log_pr_bst_name; +end; +@z + +@x [129] Add log_pr_bst_name. +procedure print_bst_name; +begin +print_pool_str (bst_str); +print_pool_str (s_bst_extension); +print_newline; +end; +@y +procedure print_bst_name; +begin +print_pool_str (bst_str); +print_pool_str (s_bst_extension); +print_newline; +end; +@# +procedure log_pr_bst_name; +begin +log_pr_pool_str (bst_str); +log_pr_pool_str (s_bst_extension); +log_pr_newline; +end; +@z + +@x [130] cite_list is dynamically allocated. +@!cite_list : packed array[cite_number] of str_number; {the cite-key list} +@y +@!cite_list : ^str_number; {the cite-key list} +@z + +@x [131] max_cites is no longer const. +@!cite_number = 0..max_cites; {gives the |cite_list| range} +@y +@!cite_number = integer; {gives the |cite_list| range} +@z + +@x [139] Dynamic max_cites. +if (last_cite = max_cites) then + begin + print_pool_str (hash_text[cite_loc]); + print_ln (' is the key:'); + overflow('number of cite keys ',max_cites); +@y +if (last_cite = max_cites) then + begin + BIB_XRETALLOC_NOSET ('cite_list', cite_list, str_number, + max_cites, max_cites + MAX_CITES); + BIB_XRETALLOC_NOSET ('type_list', type_list, hash_ptr2, + max_cites, max_cites + MAX_CITES); + BIB_XRETALLOC_NOSET ('entry_exists', entry_exists, boolean, + max_cites, max_cites + MAX_CITES); + BIB_XRETALLOC ('cite_info', cite_info, str_number, + max_cites, max_cites + MAX_CITES); + while (last_cite < max_cites) do + begin + type_list[last_cite] := empty;@/ + cite_info[last_cite] := any_value; {to appeas \PASCAL's boolean evaluation} + incr(last_cite); + end; +@z + +% [142] Don't pad with blanks. +% Don't use a path to search for subsidiary aux files, either. +@x +while (name_ptr <= file_name_size) do {pad with blanks} + begin + name_of_file[name_ptr] := ' '; + incr(name_ptr); + end; +if (not a_open_in(cur_aux_file)) then +@y +name_of_file[name_ptr] := 0; +if (not kpse_in_name_ok(stringcast(name_of_file+1)) or + not a_open_in(cur_aux_file, no_file_path)) then +@z + +% [152] This goto gets turned into a setjmp/longjmp by ./convert -- +% unfortunately, it is a nonlocal goto. ekrell@ulysses.att.com +% implemented the conversion. +@x +buf_ptr2 := last; {to get the first input line} +loop + begin + if (not eat_bst_white_space) then {the end of the \.{.bst} file} + goto bst_done; + get_bst_command_and_process; + end; +bst_done: a_close (bst_file); +@y +buf_ptr2 := last; {to get the first input line} +hack1; + begin + if (not eat_bst_white_space) then {the end of the \.{.bst} file} + hack2; + get_bst_command_and_process; + end; +bst_done: a_close (bst_file); +@z + +% max_ent_ints and max_ent_strs are gone, max_fields is no longer const. +@x [161] quote_next_fn and end_of_def are Pascal consts, instead of web macros. +@d quote_next_fn = hash_base - 1 {special marker used in defining functions} +@d end_of_def = hash_max + 1 {another such special marker} + +@<Types in the outer block@>= +@!fn_class = 0..last_fn_class; {the \.{.bst} function classes} +@!wiz_fn_loc = 0..wiz_fn_space; {|wiz_defined|-function storage locations} +@!int_ent_loc = 0..max_ent_ints; {|int_entry_var| storage locations} +@!str_ent_loc = 0..max_ent_strs; {|str_entry_var| storage locations} +@!str_glob_loc = 0..max_glb_str_minus_1; {|str_global_var| storage locations} +@!field_loc = 0..max_fields; {individual field storage locations} +@y +@<Types in the outer block@>= +@!fn_class = 0..last_fn_class; {the \.{.bst} function classes} +@!wiz_fn_loc = integer; {|wiz_defined|-function storage locations} +@!int_ent_loc = integer; {|int_entry_var| storage locations} +@!str_ent_loc = integer; {|str_entry_var| storage locations} +@!str_glob_loc = integer; {|str_global_var| storage locations} +@!field_loc = integer; {individual field storage locations} +@z + +@x [162] max_strings=hash_size settable at runtime. +@!fn_type : packed array[hash_loc] of fn_class; +@y +@!fn_type : ^fn_class; +@z + +@x [162] Dynamically allocate wiz_functions. +@!wiz_functions : packed array[wiz_fn_loc] of hash_ptr2; +@y +@!wiz_functions : ^hash_ptr2; +@z + +% [still 162] Convert entry_ints and entry_strs to dynamically-allocated +% one-dimensional arrays; too bad C and Pascal lag Fortran in supporting +% run-time dimensioning of multidimensional arrays. Other changes that +% follow this one will convert every reference to entry_strs[p][q] to +% x_entry_strs(p)(q), the equivalent of entry_strs[p*(ent_str_size+1) + +% q], but hidden inside a macro to mask the addressing computation. +% Although WEB does not have multi-argument macros, webman.tex shows how +% to get the equivalent effect. +@x +@!entry_ints : array[int_ent_loc] of integer; +@!num_ent_ints : int_ent_loc; {the number of distinct |int_entry_var| names} +@!str_ent_ptr : str_ent_loc; {general |str_entry_var| location} +@!entry_strs : array[str_ent_loc] of + packed array[0..ent_str_size] of ASCII_code; +@y +@!entry_ints : ^integer; {dynamically-allocated array} +@!num_ent_ints : int_ent_loc; {the number of distinct |int_entry_var| names} +@!str_ent_ptr : str_ent_loc; {general |str_entry_var| location} +@!entry_strs : ^ASCII_code; {dynamically-allocated array} +@z + +@x [still 162] Dynamically allocate global strings +@!str_glb_ptr : 0..max_glob_strs; {general |str_global_var| location} +@!glb_str_ptr : array[str_glob_loc] of str_number; +@!global_strs : array[str_glob_loc] of array[0..glob_str_size] of ASCII_code; +@!glb_str_end : array[str_glob_loc] of 0..glob_str_size; {end markers} +@!num_glb_strs : 0..max_glob_strs; {number of distinct |str_global_var| names} +@y +@!str_glb_ptr : integer; {general |str_global_var| location} +@!glb_str_ptr : ^str_number; +@!global_strs : ^ASCII_code; +@!glb_str_end : ^integer; {end markers} +@!num_glb_strs : integer; {number of distinct |str_global_var| names} +@z + +@x [still 162] Dynamically allocate field_info. +@!field_info : packed array[field_loc] of str_number; +@y +@!field_info : ^str_number; +@z + +@x [188] Dynamically allocate singl_function. +type @!fn_def_loc = 0..single_fn_space; {for a single |wiz_defined|-function} +var singl_function : packed array[fn_def_loc] of hash_ptr2; +@y +type @!fn_def_loc = integer; {for a single |wiz_defined|-function} +var singl_function : ^hash_ptr2; +@!single_fn_space : integer; {space allocated for this |singl_function| instance} +@z + +@x [still 188] Dynamically allocate singl_function. +begin +eat_bst_white_and_eof_check ('function'); +@y +begin +single_fn_space := SINGLE_FN_SPACE; +singl_function := XTALLOC (single_fn_space + 1, hash_ptr2); +eat_bst_white_and_eof_check ('function'); +@z + +@x [still 188] Dynamically allocate singl_function. +exit: +end; +@y +exit: +libc_free (singl_function); +end; +@z + +@x [189] Reallocate if out of single function space. + singl_fn_overflow; +@y + begin + BIB_XRETALLOC ('singl_function', singl_function, hash_ptr2, + single_fn_space, single_fn_space + SINGLE_FN_SPACE); + end; +@z + +@x [still 189] Procedure |singl_fn_overflow| replaced by inline code. +procedure singl_fn_overflow; +begin +overflow('single function space ',single_fn_space); +end; +@y +@z + +@x [199] A variable named `int' is no good in C. +@<Procedures and functions for handling numbers, characters, and strings@>= +@y +@d int == the_int +@<Procedures and functions for handling numbers, characters, and strings@>= +@z + +@x [201] Reallocate if out of wizard space. +if (single_ptr + wiz_def_ptr > wiz_fn_space) then + begin + print (single_ptr + wiz_def_ptr : 0,': '); + overflow('wizard-defined function space ',wiz_fn_space); + end; +@y +while (single_ptr + wiz_def_ptr > wiz_fn_space) do + begin + BIB_XRETALLOC ('wiz_functions', wiz_functions, hash_ptr2, + wiz_fn_space, wiz_fn_space + WIZ_FN_SPACE); + end; +@z + +@x [217] Reallocate if out of global strings. + overflow('number of string global-variables ',max_glob_strs); +@y + begin + BIB_XRETALLOC_NOSET ('glb_str_ptr', glb_str_ptr, str_number, + max_glob_strs, max_glob_strs + MAX_GLOB_STRS); + BIB_XRETALLOC_STRING ('global_strs', global_strs, glob_str_size, + max_glob_strs, max_glob_strs + MAX_GLOB_STRS); + BIB_XRETALLOC ('glb_str_end', glb_str_end, integer, + max_glob_strs, max_glob_strs + MAX_GLOB_STRS); + str_glb_ptr := num_glb_strs; + while (str_glb_ptr < max_glob_strs) do {make new |str_global_var|s empty} + begin + glb_str_ptr[str_glb_ptr] := 0; + glb_str_end[str_glb_ptr] := 0; + incr(str_glb_ptr); + end; + end; +@z + +@x [220] undefined is now a Pascal const, instead of a web macro +@d undefined = hash_max + 1 {a special marker used for |type_list|} +@y +@z + +@x [220] type_list is dynamically allocated. +@!type_list : packed array[cite_number] of hash_ptr2; +@y +@!type_list : ^hash_ptr2; +@z +@x [220] entry_exists also. +@!entry_exists : packed array[cite_number] of boolean; +@y +@!entry_exists : ^boolean; +@z +@x [220] cite_info also. +@!cite_info : packed array[cite_number] of str_number; {extra |cite_list| info} +@y +@!cite_info : ^str_number; {extra |cite_list| info} +@z + +@x [225] Be silent unless verbose. + print ('Database file #',bib_ptr+1:0,': '); + print_bib_name;@/ +@y + if verbose then begin + print ('Database file #',bib_ptr+1:0,': '); + print_bib_name; + end + else begin + log_pr ('Database file #',bib_ptr+1:0,': '); + log_pr_bib_name; + end; +@z + +@x [227] Reallocate if out of fields. +procedure check_field_overflow (@!total_fields : integer); +begin +if (total_fields > max_fields) then + begin + print_ln (total_fields:0,' fields:'); + overflow('total number of fields ',max_fields); +@y +procedure check_field_overflow (@!total_fields : integer); +var @!f_ptr: field_loc; + @!start_fields: field_loc; +begin +if (total_fields > max_fields) then + begin + start_fields := max_fields; + BIB_XRETALLOC ('field_info', field_info, str_number, max_fields, + total_fields + MAX_FIELDS); + {Initialize to |missing|.} + for f_ptr := start_fields to max_fields - 1 do begin + field_info[f_ptr] := missing; + end; +@z + +@x [243] Reallocate when we run out of s_preamble's. + bib_err ('You''ve exceeded ',max_bib_files:0,' preamble commands'); +@y +begin + {Keep old value of |max_bib_files| for the last array.} + BIB_XRETALLOC_NOSET ('bib_list', bib_list, str_number, max_bib_files, + max_bib_files + MAX_BIB_FILES); + BIB_XRETALLOC_NOSET ('bib_file', bib_file, alpha_file, max_bib_files, + max_bib_files + MAX_BIB_FILES); + BIB_XRETALLOC ('s_preamble', s_preamble, str_number, max_bib_files, + max_bib_files + MAX_BIB_FILES); +end; +@z + +@x [264] Add check for fieldinfo[] overflow. +field_ptr := entry_cite_ptr * num_fields + fn_info[field_name_loc]; +@y +field_ptr := entry_cite_ptr * num_fields + fn_info[field_name_loc]; +if (field_ptr >= max_fields) then + confusion ('field_info index is out of range'); +@z + +@x [266] Fix bug in the add_database_cite procedure. +check_field_overflow (num_fields*new_cite); +@y +check_field_overflow (num_fields*(new_cite+1)); +@z + +@x [278] Add check for fieldinfo[] overflow. +@<Add cross-reference information@>= +begin +@y +@<Add cross-reference information@>= +begin +if ((num_cites - 1) * num_fields + crossref_num >= max_fields) then + confusion ('field_info index is out of range'); +@z + +@x [280] Add check for fieldinfo[] overflow. +@<Subtract cross-reference information@>= +begin +@y +@<Subtract cross-reference information@>= +begin +if ((num_cites - 1) * num_fields + crossref_num >= max_fields) then + confusion ('field_info index is out of range'); +@z + +@x [286] Add check for fieldinfo[] overflow. +@<Slide this cite key down to its permanent spot@>= +begin +@y +@<Slide this cite key down to its permanent spot@>= +begin +if ((cite_xptr + 1) * num_fields > max_fields) then + confusion ('field_info index is out of range'); +@z + +@x [288] Allocate entry_ints as needed. +if (num_ent_ints*num_cites > max_ent_ints) then + begin + print (num_ent_ints*num_cites,': '); + overflow('total number of integer entry-variables ',max_ent_ints); + end; +@y +entry_ints := XTALLOC ((num_ent_ints + 1) * (num_cites + 1), integer); +@z + +@x [289] Allocate entry_strs as needed. +if (num_ent_strs*num_cites > max_ent_strs) then + begin + print (num_ent_strs*num_cites,': '); + overflow('total number of string entry-variables ',max_ent_strs); + end; +@y +entry_strs := XTALLOC ((num_ent_strs + 1) * (num_cites + 1) * (ent_str_size + 1), ASCII_code); +@z + +@x [289] Macroize entry_strs[][]. + entry_strs[str_ent_ptr][0] := end_of_string; +@y + x_entry_strs(str_ent_ptr)(0) := end_of_string; +@z + +@x [291] Dynamic lit_stk_size. +@!lit_stack : array[lit_stk_loc] of integer; {the literal function stack} +@!lit_stk_type : array[lit_stk_loc] of stk_type; {their corresponding types} +@y +@!lit_stack : ^integer; {the literal function stack} +@!lit_stk_type : ^stk_type; {their corresponding types} +@z + +@x [292] Dynamic lit_stk_size. +@!lit_stk_loc = 0..lit_stk_size; {the stack range} +@y +@!lit_stk_loc = integer; {the stack range} +@z + +@x [302] Macroize entry_strs[][]. + char1 := entry_strs[ptr1][char_ptr]; + char2 := entry_strs[ptr2][char_ptr]; +@y + char1 := x_entry_strs(ptr1)(char_ptr); + char2 := x_entry_strs(ptr2)(char_ptr); +@z + +@x [308] Reallocate literal stack. + overflow('literal-stack size ',lit_stk_size); +@y + begin + BIB_XRETALLOC_NOSET ('lit_stack', lit_stack, integer, + lit_stk_size, lit_stk_size + LIT_STK_SIZE); + BIB_XRETALLOC ('lit_stk_type', lit_stk_type, stk_type, + lit_stk_size, lit_stk_size + LIT_STK_SIZE); + end; +@z + +@x Changes for JBibTeX by Shouichi Matsui [321] +procedure add_out_pool (@!p_str : str_number); +label loop1_exit,loop2_exit; +var break_ptr : buf_pointer; {the first character following the line break} +@!end_ptr : buf_pointer; {temporary end-of-buffer pointer} +break_pt_found : boolean; {a suitable |white_space| character} +unbreakable_tail : boolean; {as it contains no |white_space| character} +@y +procedure add_out_pool (@!p_str : str_number); +label loop1_exit,loop2_exit; +var break_ptr : buf_pointer; {the first character following the line break} +@!end_ptr : buf_pointer; {temporary end-of-buffer pointer} +break_pt_found : boolean; {a suitable |white_space| character} +unbreakable_tail : boolean; {because it contains no |white_space| character} +@!in_mid_kanji:boolean; {flag if |max_print_line|-1 is in mid kanji} +@!last_char_ptr : buf_pointer; +@!t : buf_pointer; +@z + +@x [321] Dynamic buf_size. + overflow('output buffer size ',buf_size); +@y + buffer_overflow; +@z + +% We shouldn't try to split a \% combo, as the result is an escaped % at +% end-of-line, and a line beginning with a %, which leads to rest being +% ignored. This is a special case of the general problem that we shouldn't +% split macro invocations either -- however, the best way to avoid that is +% not to split lines at all. +% @x [324] Check whether we're trying to break a \% combo. +% out_buf[end_ptr] := out_buf[max_print_line-1]; {save this character} +% out_buf[max_print_line-1] := comment; {so \TeX\ does the thing right} +% out_buf_length := max_print_line; +% break_ptr := out_buf_length - 1; {the `|-1|' allows for the restoration} +% output_bbl_line; {output what we can,} +% out_buf[max_print_line-1] := out_buf[end_ptr]; {restore this character} +% @y +% if out_buf[max_print_line-1] = comment then {assume \% combo here} +% out_buf_length := max_print_line - 1 +% else +% out_buf_length := max_print_line; +% break_ptr := out_buf_length - 1; {the `|-1|' allows for the restoration} +% out_buf[end_ptr] := out_buf[break_ptr]; {save this character} +% out_buf[break_ptr] := comment; {so \TeX\ does the thing right} +% output_bbl_line; {output what we can,} +% out_buf[break_ptr] := out_buf[end_ptr]; {restore this character} +% @z + +@x Changes for JBibTeX by Shouichi Matsui [324] +@<Break that unbreakably long line@>= +begin +out_buf_ptr := max_print_line + 1; {|break_pt_found| is still |false|} +while (out_buf_ptr < end_ptr) do + if (lex_class[out_buf[out_buf_ptr]] <> white_space) then + incr(out_buf_ptr) + else + goto loop1_exit; +loop1_exit: +if (out_buf_ptr = end_ptr) then + unbreakable_tail := true {because no |white_space| character} +else {at |white_space|, and |out_buf_ptr < end_ptr|} + begin + break_pt_found := true; + while (out_buf_ptr+1 < end_ptr) do {look for more |white_space|} + if (lex_class[out_buf[out_buf_ptr+1]] = white_space) then + incr(out_buf_ptr) {which then points to |white_space|} + else + goto loop2_exit; +loop2_exit: + end; +end +@y +@<Break that unbreakably long line@>= +begin +@<Check if |max_print_line|-1 is in mid kanji@>; +if in_mid_kanji then last_char_ptr:=max_print_line-1 + else last_char_ptr:=max_print_line; +out_buf[end_ptr] := out_buf[last_char_ptr-1]; {save this character} +out_buf[last_char_ptr-1] := comment; {so \TeX\ does the thing right} +out_buf_length := last_char_ptr; +break_ptr := out_buf_length - 1; {the `|-1|' allows for the restoration} +output_bbl_line; {output what we can,} +out_buf[last_char_ptr-1] := out_buf[end_ptr]; {restore this character} +out_buf_ptr := 0; +tmp_ptr := break_ptr; +while (tmp_ptr < end_ptr) do {and slide the rest down} + begin + out_buf[out_buf_ptr] := out_buf[tmp_ptr]; + incr(out_buf_ptr); + incr(tmp_ptr); + end; +out_buf_length := end_ptr - break_ptr; +end +@z + +@x [328] Add check for fieldinfo[] overflow. + field_ptr := cite_ptr*num_fields + fn_info[ex_fn_loc]; +@y + field_ptr := cite_ptr*num_fields + fn_info[ex_fn_loc]; + if (field_ptr >= max_fields) then + confusion ('field_info index is out of range'); +@z + +@x [330] Macroize entry_strs[][] + while (entry_strs[str_ent_ptr][ex_buf_ptr] <> end_of_string) do + {copy characters into the buffer} + append_ex_buf_char (entry_strs[str_ent_ptr][ex_buf_ptr]); +@y + while (x_entry_strs(str_ent_ptr)(ex_buf_ptr) <> end_of_string) do + {copy characters into the buffer} + append_ex_buf_char (x_entry_strs(str_ent_ptr)(ex_buf_ptr)); +@z + +@x [331] Macroize global_strs[][] + append_char (global_strs[str_glb_ptr][glob_chr_ptr]); +@y + append_char (x_global_strs(str_glb_ptr)(glob_chr_ptr)); +@z + +@x Changes for JBibTeX by Shouichi Matsui [332] +@!b_while : hash_loc; {\.{while\$}} +@!b_width : hash_loc; {\.{width\$}} +@!b_write : hash_loc; {\.{write\$}} +@!b_default : hash_loc; {either \.{skip\$} or \.{default.type}} +@y +@!b_while : hash_loc; {\.{while\$}} +@!b_width : hash_loc; {\.{width\$}} +@!b_write : hash_loc; {\.{write\$}} +@!b_default : hash_loc; {either \.{skip\$} or \.{default.type}} +@!b_is_kanji_str : hash_loc; {\.{is.kanji.str\$}} +@z + +@x Changes for JBibTeX by Shouichi Matsui [334] +@d n_while = 34 {\.{while\$}} +@d n_width = 35 {\.{width\$}} +@d n_write = 36 {\.{write\$}} + +@<Constants in the outer block@>= +@!num_blt_in_fns = 37; {one more than the previous number} +@y +@d n_while = 34 {\.{while\$}} +@d n_width = 35 {\.{width\$}} +@d n_write = 36 {\.{write\$}} +@d n_is_kanji_str = 37 {\.{is.kanji.str\$}} + +@<Constants in the outer block@>= +@!num_blt_in_fns = 38; {one more than the previous number} +@z + +@x Changes for JBibTeX by Shouichi Matsui [335] +build_in('width$ ',6,b_width,n_width); +build_in('while$ ',6,b_while,n_while); +build_in('width$ ',6,b_width,n_width); +build_in('write$ ',6,b_write,n_write); +@y +build_in('while$ ',6,b_while,n_while); +build_in('width$ ',6,b_width,n_width); +build_in('write$ ',6,b_write,n_write); +build_in('is.kanji.str$',13,b_is_kanji_str,n_is_kanji_str); +@z + +@x [338] s_preamble is dynamically allocated. +@!s_preamble : array[bib_number] of str_number; +@y +@!s_preamble : ^str_number; +@z + +@x Changes for JBibTeX by Shouichi Matsui [342] + n_width : x_width; + n_write : x_write; + othercases confusion ('Unknown built-in function') +endcases; +end +@y + n_width : x_width; + n_write : x_write; + n_is_kanji_str: x_is_kanji_str; + othercases confusion ('Unknown built-in function') +endcases; +end +@z + +@x Changes for JBibTeX by Shouichi Matsui [343] +@<|execute_fn|({\.{width\$}})@>@; +@<|execute_fn|({\.{write\$}})@>@; +@<|execute_fn| itself@> +@y +@<|execute_fn|({\.{width\$}})@>@; +@<|execute_fn|({\.{write\$}})@>@; +@<|execute_fn|({\.{is.kanji.str\$}})@>@; +@<|execute_fn| itself@> +@z + +@x [345] Dynamic buf_size. +@!name_tok : packed array[buf_pointer] of buf_pointer; {name-token ptr list} +@!name_sep_char : packed array[buf_pointer] of ASCII_code; {token-ending chars} +@y +@!name_tok : ^buf_pointer; {name-token ptr list} +@!name_sep_char : ^ASCII_code; {token-ending chars} +@z + +@x [358] Macroize entry_strs[][]. + while (sp_ptr < sp_xptr1) do + begin {copy characters into |entry_strs|} + entry_strs[str_ent_ptr][ent_chr_ptr] := str_pool[sp_ptr]; + incr(ent_chr_ptr); + incr(sp_ptr); + end; + entry_strs[str_ent_ptr][ent_chr_ptr] := end_of_string; +@y + while (sp_ptr < sp_xptr1) do + begin {copy characters into |entry_strs|} + x_entry_strs(str_ent_ptr)(ent_chr_ptr) := str_pool[sp_ptr]; + incr(ent_chr_ptr); + incr(sp_ptr); + end; + x_entry_strs(str_ent_ptr)(ent_chr_ptr) := end_of_string; +@z + +@x [360] Macroize global_strs[][] + global_strs[str_glb_ptr][glob_chr_ptr] := str_pool[sp_ptr]; +@y + x_global_strs(str_glb_ptr)(glob_chr_ptr) := str_pool[sp_ptr]; +@z + +@x Changes for JBibTeX by Shouichi Matsui --- add.period$ for ver. 0.30 +case (str_pool[sp_ptr]) of + period, + question_mark, + exclamation_mark : + repush_string; + othercases + @<Add the |period| (it's necessary) and push@> +@y +case (str_pool[sp_ptr]) of + period, + question_mark, + exclamation_mark : + repush_string; + zen_ten, + zen_period, + zen_question, + zen_exclamation: + if( str_pool[sp_ptr-1] = zen_pun_first ) then + repush_string + else + @<Add the |period| (it's necessary) and push@>; + othercases + @<Add the |period| (it's necessary) and push@> +@z + +@x Changes for JBibTeX by Shouichi Matsui [377] +else if (length(pop_lit1) <> 1) then + begin + print ('"'); + print_pool_str (pop_lit1); + bst_ex_warn ('" isn''t a single character'); + push_lit_stk (0, stk_int); + end +@y +else if (length(pop_lit1) <> 1) then + if(str_pool[str_start[pop_lit1]]>127) then { a KANJI char is 2byte long } + push_lit_stk(str_pool[str_start[pop_lit1]],stk_int) + else begin + print ('"'); + print_pool_str (pop_lit1); + bst_ex_warn ('" isn''t a single character'); + push_lit_stk (0, stk_int); + end +@z + +@x by Shouichi Matsui for Zenkaku comma +if (ex_buf_ptr < ex_buf_length) then {remove the ``and''} + ex_buf_ptr := ex_buf_ptr - 4; +@y +if (ex_buf_ptr < ex_buf_length) then {remove the ``and'', or Zenkau comma} + begin + if( (ex_buf[ex_buf_ptr-1]=zen_comma) or (ex_buf[ex_buf_ptr-1]=zen_kuten) ) + then ex_buf_ptr := ex_buf_ptr - 2 + else ex_buf_ptr := ex_buf_ptr - 4; + end; +@z + +@x Changes for JBibTeX by Shouichi Matsui for Zenkaku comma + "a", "A" : + begin + incr(ex_buf_ptr); + if (preceding_white) then + @<See if we have an ``and''@>; {if so, |and_found := true|} + preceding_white := false; + end; +@y + "a", "A" : + begin + incr(ex_buf_ptr); + if (preceding_white) then + @<See if we have an ``and''@>; {if so, |and_found := true|} + preceding_white := false; + end; + zen_pun_first: + begin + if((ex_buf[ex_buf_ptr+1]=zen_comma) or + (ex_buf[ex_buf_ptr+1]=zen_kuten) ) then + begin + preceding_white := false; + and_found := true + end + else if(ex_buf[ex_buf_ptr+1]=zen_space) then + begin + ex_buf[ex_buf_ptr] := space; + ex_buf[ex_buf_ptr+1] := space; + preceding_white := true; + end; + ex_buf_ptr := ex_buf_ptr + 2; + end; +@z +@x Changes for JBibTeX by Shouichi Matsui for Zenkaku comma[385] + othercases + if (lex_class[ex_buf[ex_buf_ptr]] = white_space) then + begin + incr(ex_buf_ptr); + preceding_white := true; + end + else + begin + incr(ex_buf_ptr); + preceding_white := false; + end + endcases; +check_brace_level (pop_lit_var); +end; +@y + othercases + if (lex_class[ex_buf[ex_buf_ptr]] = white_space) then + begin + incr(ex_buf_ptr); + preceding_white := true; + end + else + begin + if( ex_buf[ex_buf_ptr] > 127 ) then + ex_buf_ptr := ex_buf_ptr +2 + else + incr(ex_buf_ptr); + preceding_white := false; + end + endcases; +check_brace_level (pop_lit_var); +end; +@z + +% [389] bibtex.web has mutually exclusive tests here; Oren said he +% doesn't want to fix it until 1.0, since it's obviously of no practical +% import (or someone would have found it before GCC 2 did). Changing +% the second `and' to an `or' makes all but the last of multiple authors +% be omitted in the bbl file, so I simply removed the statement. +@x +while ((ex_buf_xptr < ex_buf_ptr) and + (lex_class[ex_buf[ex_buf_ptr]] = white_space) and + (lex_class[ex_buf[ex_buf_ptr]] = sep_char)) do + incr(ex_buf_xptr); {this removes leading stuff} +@y +@z + +@x Changes for JBibTeX by Shouichi Matsui [415] + if (lex_class[name_buf[name_bf_ptr]] = alpha) then + begin + append_ex_buf_char_and_check (name_buf[name_bf_ptr]); + goto loop_exit; + end + else if ((name_buf[name_bf_ptr] = left_brace) and +@y + if (lex_class[name_buf[name_bf_ptr]] = alpha) then + begin + if name_buf[name_bf_ptr]>127 then begin + append_ex_buf_char_and_check (name_buf[name_bf_ptr]); + incr(name_bf_ptr); + append_ex_buf_char_and_check (name_buf[name_bf_ptr]); + end + else + append_ex_buf_char_and_check (name_buf[name_bf_ptr]); + goto loop_exit; + end + else if ((name_buf[name_bf_ptr] = left_brace) and +@z + +@x Changes for JBibTeX by Shouichi Matsui [437] +@<|execute_fn|({\.{substring\$}})@>= +procedure x_substring; +label exit; +begin +@y +@<|execute_fn|({\.{substring\$}})@>= +procedure x_substring; +label exit; +var tps,tpe:pool_pointer; {temporary pointer} +begin +@z + +@x Changes for JBibTeX by Shouichi Matsui [438] +while (sp_ptr < sp_end) do {shift the substring} + begin + append_char (str_pool[sp_ptr]); + incr(sp_ptr); + end; +@y +{ 2 bytes Kanji code break check } +tps:=str_start[pop_lit3]; +while (tps < sp_ptr ) do + if str_pool[tps] > 127 + then tps := tps + 2 + else incr(tps); +tpe:=tps; +while (tpe < sp_end ) do begin + if str_pool[tpe] > 127 + then tpe := tpe+2 + else incr(tpe); +end; +if tps<>sp_ptr then begin + if tps>str_start[pop_lit3] + then decr(sp_ptr) + else incr(sp_ptr); +end; +if tpe<>sp_end then begin + if tpe<str_start[pop_lit3+1] + then incr(sp_end) + else decr(sp_end); +end; + +str_room(sp_end - sp_ptr); +while (sp_ptr < sp_end) do {shift the substring} + begin + if str_pool[sp_ptr] >127 then begin + append_char (str_pool[sp_ptr]); incr(sp_ptr); + append_char (str_pool[sp_ptr]); incr(sp_ptr); + end + else begin + append_char (str_pool[sp_ptr]); incr(sp_ptr); end; + end; +@z + +% Forgot to check for pool overflow here. Triggered by bibtex-mem.test (3). +@x [445] +if (pop_lit2 >= cmd_str_ptr) then {no shifting---merely change pointers} +@y +str_room(sp_brace_level + sp_end - sp_ptr); +if (pop_lit2 >= cmd_str_ptr) then {no shifting---merely change pointers} +@z + +@x Changes for JBibTeX by Shouichi Matsui [445] + else if (str_pool[sp_xptr1-1] = right_brace) then + begin + if (sp_brace_level > 0) then + decr(sp_brace_level); + end + else + incr(num_text_chars); + end; +@y + else if (str_pool[sp_xptr1-1] = right_brace) then + begin + if (sp_brace_level > 0) then + decr(sp_brace_level); + end + else if (str_pool[sp_xptr1-1]>127) then begin {kanji char} + incr(sp_xptr1); num_text_chars:=num_text_chars+2; + end + else + incr(num_text_chars); + end; +@z + +% [460] Eliminate unreferenced statement label, because `undefined' is +% now a constant expression that is not evaluated at the Web level. If +% this label were ever required, it could be replaced by the constant +% 9997, which is not used as a statement label in BibTeX. +@x + undefined : trace_pr ('unknown') +@y + trace_pr ('unknown') +@z + +@x [461] Macroize entry_strs[][]. + while (entry_strs[str_ent_ptr][ent_chr_ptr] <> end_of_string) do + begin + trace_pr (xchr[entry_strs[str_ent_ptr][ent_chr_ptr]]); + incr(ent_chr_ptr); + end; +@y + while (x_entry_strs(str_ent_ptr)(ent_chr_ptr) <> end_of_string) do + begin + trace_pr (xchr[x_entry_strs(str_ent_ptr)(ent_chr_ptr)]); + incr(ent_chr_ptr); + end; +@z + +@x [463] Add check for fieldinfo[] overflow. + field_ptr := cite_ptr * num_fields; + field_end_ptr := field_ptr + num_fields; +@y + field_ptr := cite_ptr * num_fields; + field_end_ptr := field_ptr + num_fields; + if (field_end_ptr > max_fields) then + confusion ('field_info index is out of range'); +@z + +@x [468] System-dependent changes. +This section should be replaced, if necessary, by changes to the program +that are necessary to make \BibTeX\ work at a particular installation. +It is usually best to design your change file so that all changes to +previous sections preserve the section numbering; then everybody's version +will be consistent with the printed program. More extensive changes, +which introduce new sections, can be inserted here; then only the index +itself will get a new section number. +@y +@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0) + +@<Define |parse_arguments|@> = +procedure parse_arguments; +const n_options = 5; {Pascal won't count array lengths for us.} +var @!long_options: array[0..n_options] of getopt_struct; + @!getopt_return_val: integer; + @!option_index: c_int_type; + @!current_option: 0..n_options; + @!version_switch: boolean; +begin + @<Initialize the option variables@>; + version_switch := false; + @<Define the option table@>; + repeat + getopt_return_val := getopt_long_only (argc, argv, '', long_options, + address_of (option_index)); + if getopt_return_val = -1 then begin + {End of arguments; we exit the loop below.} ; + + end else if getopt_return_val = "?" then begin + usage ('pbibtex'); + + end else if argument_is ('min-crossrefs') then begin + min_crossrefs := atoi (optarg); + + end else if argument_is ('help') then begin + usage_help (PBIBTEX_HELP, nil); + + end else if argument_is ('version') then begin + version_switch := true; + + end else if argument_is ('kanji') then begin + @<Set process kanji code@>; + + end; {Else it was a flag; |getopt| has already done the assignment.} + until getopt_return_val = -1; + if (version_switch) then + print_version_and_exit (banner, 'Oren Patashnik', nil, nil); + + {Now |optind| is the index of first non-option on the command line. + We must have one remaining argument.} + if (optind + 1 <> argc) then begin + write_ln (stderr, 'pbibtex: Need exactly one file argument.'); + usage ('pbibtex'); + end; +end; + +@ Here is the first of the options we allow. +@.-terse@> + +@<Define the option...@> = +current_option := 0; +long_options[0].name := 'terse'; +long_options[0].has_arg := 0; +long_options[0].flag := address_of (verbose); +long_options[0].val := 0; +incr (current_option); + +@ The global variable |verbose| determines whether or not we print +progress information. + +@<Glob...@> = +@!verbose: c_int_type; + +@ Start off |true|, to match the default behavior. + +@<Initialize the option...@> = +verbose := true; + +@ Here is an option to change the minimum number of cross-refs required +for automatic |cite_list| inclusion. +@.-min-crossrefs@> + +@<Define the option...@> = +long_options[current_option].name := 'min-crossrefs'; +long_options[current_option].has_arg := 1; +long_options[current_option].flag := 0; +long_options[current_option].val := 0; +incr (current_option); + +@ +@<Glob...@> = +@!min_crossrefs: integer; + +@ Set |min_crossrefs| to two by default, so we match the +documentation (\.{btxdoc.tex}). + +@<Initialize the option...@> = +min_crossrefs := 2; + +@ One of the standard options. +@.-help@> + +@<Define the option...@> = +long_options[current_option].name := 'help'; +long_options[current_option].has_arg := 0; +long_options[current_option].flag := 0; +long_options[current_option].val := 0; +incr (current_option); + +@ Another of the standard options. +@.-version@> + +@<Define the option...@> = +long_options[current_option].name := 'version'; +long_options[current_option].has_arg := 0; +long_options[current_option].flag := 0; +long_options[current_option].val := 0; +incr (current_option); + +@ Kanji option. +@.-kanji@> + +@<Define the option...@> = +long_options[current_option].name := 'kanji'; +long_options[current_option].has_arg := 1; +long_options[current_option].flag := 0; +long_options[current_option].val := 0; +incr(current_option); + +@ An element with all zeros always ends the list. + +@<Define the option...@> = +long_options[current_option].name := 0; +long_options[current_option].has_arg := 0; +long_options[current_option].flag := 0; +long_options[current_option].val := 0; + +@ Determine |ent_str_size|, |glob_str_size|, and |max_strings| from the +environment, configuration file, or default value. Set +|hash_size:=max_strings|, but not less than |HASH_SIZE|. + +{|setup_bound_var| stuff adapted from \.{tex.ch}.} +@d setup_bound_var(#)==bound_default:=#; setup_bound_var_end +@d setup_bound_var_end(#)==bound_name:=#; setup_bound_var_end_end +@d setup_bound_var_end_end(#)== + setup_bound_variable(address_of(#), bound_name, bound_default); + if # < bound_default then # := bound_default + +@<Procedures and functions for about everything@>= +procedure setup_params; +var bound_default: integer; {for setup} +@!bound_name: const_cstring; {for setup} +begin kpse_set_program_name (argv[0], 'pbibtex'); +setup_bound_var (ENT_STR_SIZE)('ent_str_size')(ent_str_size); +setup_bound_var (GLOB_STR_SIZE)('glob_str_size')(glob_str_size); +setup_bound_var (MAX_STRINGS)('max_strings')(max_strings); +@# +hash_size := max_strings; +if hash_size < HASH_SIZE then hash_size := HASH_SIZE; +hash_max := hash_size + hash_base - 1; +end_of_def := hash_max + 1; +undefined := hash_max + 1; +end; + +@ We use the algorithm from Knuth's \.{primes.web} to compute |hash_prime| +as the smallest prime number not less than 85\% of |hash_size| (and +|>=128|). + +@d primes == hash_next {array holding the first |k| primes} +@d mult == hash_text {array holding odd multiples of the first |o| primes} + +@<Procedures and functions for about everything@>= +procedure compute_hash_prime; +var hash_want: integer; {85\% of |hash_size|} +@!k: integer; {number of prime numbers $p_i$ in |primes|} +@!j: integer; {a prime number candidate} +@!o: integer; {number of odd multiples of primes in |mult|} +@!square: integer; {$p_o^2$} +@!n: integer; {loop index} +@!j_prime: boolean; {is |j| a prime?} +begin hash_want := (hash_size div 20) * 17; +j := 1; +k := 1; +hash_prime := 2; +primes[k] := hash_prime; +o := 2; +square := 9; +while hash_prime < hash_want do + begin + repeat + j := j + 2; + if j = square then + begin + mult[o] := j; + j := j + 2; + incr (o); + square := primes[o] * primes[o]; + end; + n := 2; + j_prime := true; + while (n < o) and j_prime do + begin + while mult[n] < j do mult[n] := mult[n] + 2 * primes[n]; + if mult[n] = j then j_prime := false; + incr (n); + end; + until j_prime; + incr (k); + hash_prime := j; + primes[k] := hash_prime; + end; +end; + +@ modules for JBibTeX + +@<Check if |max_print_line|-1 is in mid kanji@>= +t:=0; +while(t<max_print_line-1) do + if out_buf[t]>127 then t:=t+2 else t:=t+1; +in_mid_kanji:= t>=max_print_line; + +@ +@<|execute_fn|({\.{is.kanji.str\$}})@>= +procedure x_is_kanji_str; +label exit; +begin + pop_lit_stk(pop_lit1, pop_typ1); + if pop_typ1<> stk_str then + begin print_wrong_stk_lit(pop_lit1,pop_typ1,stk_str); + push_lit_stk(0,stk_int); + end else begin + sp_ptr := str_start[pop_lit1]; + sp_end := str_start[pop_lit1+1]; + while sp_ptr<sp_end do begin + if str_pool[sp_ptr]>127 then begin + push_lit_stk(1,stk_int); + return; + end else begin + incr(sp_ptr); + end; + end; + push_lit_stk(0,stk_int); + end; +exit:end; + +@ @<Set process kanji code@>= + if (not set_enc_string(optarg, 0)) then begin + write_ln('Bad kanjicode encoding "', stringcast(optarg), '".'); + end; +@z diff --git a/Build/source/texk/web2c/ptexdir/pbibtex.defines b/Build/source/texk/web2c/ptexdir/pbibtex.defines new file mode 100644 index 00000000000..9a83ef32721 --- /dev/null +++ b/Build/source/texk/web2c/ptexdir/pbibtex.defines @@ -0,0 +1,4 @@ +@define function inputline3(); +@define const PBIBTEXHELP; +@define function getencstring; +@define function setencstring (); diff --git a/Build/source/texk/web2c/ptexdir/pdvitype.ch b/Build/source/texk/web2c/ptexdir/pdvitype.ch new file mode 100644 index 00000000000..cee840f6620 --- /dev/null +++ b/Build/source/texk/web2c/ptexdir/pdvitype.ch @@ -0,0 +1,1177 @@ +% dvitype.ch for C compilation with web2c. +% +% 04/04/83 (PC) Merged with Pavel's change file and made to work with the +% version 1.0 of DVItype released with version 0.95 of TeX in +% February, 1983. +% 04/18/83 (PC) Added changes to module 47 so that it would work the same +% when input was a file (or pipe) as with a terminal. +% 06/29/83 (HWT) Brought up to version 1.1 as released with version 0.99 of +% TeX, with new change file format +% 07/28/83 (HWT) Brought up to version 2 as released with version 0.999. +% Only the banner changes. +% 11/21/83 (HWT) Brought up to version 2.2 as released with version 1.0. +% 02/19/84 (HWT) Made it use the TEXFONTS environment variable. +% 03/23/84 (HWT) Brought up to version 2.3. +% 07/11/84 (HWT) Brought up to version 2.6 as released with version 1.1. +% 11/07/84 (ETM) Brought up to version 2.7 as released with version 1.2. +% 03/09/88 (ETM) Brought up to version 2.9 +% 03/16/88 (ETM) Converted for use with WEB to C. +% 11/30/89 (KB) To version 3. +% 01/16/90 (SR) To version 3.2. +% 09/27/95 (KA) Supporting ASCII pTeX +% (more recent changes in the ChangeLog) + +@x [0] WEAVE: print changes only. +\pageno=\contentspagenumber \advance\pageno by 1 +@y +\pageno=\contentspagenumber \advance\pageno by 1 +\let\maybe=\iffalse +\def\title{DVI$\,$\lowercase{type} changes for C} +@z + +@x +@d banner=='This is DVItype, Version 3.6' {printed when the program starts} +@y +@d banner=='This is PDVItype, Version 3.6-p0.4' + {printed when the program starts} +@z + +% [3] Specify the output file to simplify web2c, and don't print the +% banner until later. +@x +@d print(#)==write(#) +@d print_ln(#)==write_ln(#) +@y +@d print(#)==write(stdout, #) +@d print_ln(#)==write_ln(stdout, #) +@z + +@x +procedure initialize; {this procedure gets things started properly} + var i:integer; {loop index for initializations} + begin print_ln(banner);@/ +@y +@<Define |parse_arguments|@> +procedure initialize; {this procedure gets things started properly} + var i:integer; {loop index for initializations} + begin + kpse_set_program_name (argv[0], nil); + parse_arguments; + print (banner); + print_ln (version_string); +@z + +@x [5] Allow more fonts, more widths, no arbitrary filename length. +@!max_fonts=100; {maximum number of distinct fonts per \.{DVI} file} +@!max_widths=10000; {maximum number of different characters among all fonts} +@y +@!max_fonts=500; {maximum number of distinct fonts per \.{DVI} file} +@!max_widths=25000; {maximum number of different characters among all fonts} +@z +@x +@!name_size=1000; {total length of all font file names} +@!name_length=50; {a file name shouldn't be longer than this} +@y +@!name_size=10000; {total length of all font file names} +@z + +@x [7] Remove non-local goto. +@d abort(#)==begin print(' ',#); jump_out; + end +@d bad_dvi(#)==abort('Bad DVI file: ',#,'!') +@.Bad DVI file@> + +@p procedure jump_out; +begin goto final_end; +end; +@y +@d jump_out==uexit(1) +@d abort(#)==begin write_ln(stderr,#); jump_out; end +@d bad_dvi(#)==abort('Bad DVI file: ',#,'!') +@.Bad DVI file@> +@z + +@x [8] Permissive input. +@!ASCII_code=" ".."~"; {a subrange of the integers} +@y +@!ASCII_code=0..255; {a subrange of the integers} +@z + +% [9] The text_char type is used as an array index into `xord'. The +% default type `char' produces signed integers, which are bad array +% indices in C. +@x +@d text_char == char {the data type of characters in text files} +@d first_text_char=0 {ordinal number of the smallest element of |text_char|} +@d last_text_char=127 {ordinal number of the largest element of |text_char|} +@y +@d text_char == ASCII_code {the data type of characters in text files} +@d first_text_char=0 {ordinal number of the smallest element of |text_char|} +@d last_text_char=255 {ordinal number of the largest element of |text_char|} +@z + +@x +for i:=@'177 to 255 do xchr[i]:='?'; +@y +for i:=@'177 to 255 do xchr[i]:=i; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% pTeX +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d undefined_commands==250,251,252,253,254,255 +@y +@d dir=255 {pTeX direction} +@d undefined_commands==250,251,252,253,254 +@z + +@x +@d id_byte=2 {identifies the kind of \.{DVI} files described here} +@y +@d id_byte=2 {identifies the kind of \.{DVI} files described here} +@d ptex_id_byte=3 {identifies the kind of pTeX \.{DVI} files described here} +@z + +@x [23] Fix up opening the files. +@p procedure open_dvi_file; {prepares to read packed bytes in |dvi_file|} +begin reset(dvi_file); +cur_loc:=0; +end; +@# +procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|} +begin reset(tfm_file,cur_name); +end; +@y +@p procedure open_dvi_file; {prepares to read packed bytes in |dvi_file|} +begin + cur_name := extend_filename (cmdline (optind), 'dvi'); + resetbin (dvi_file, cur_name); + cur_loc := 0; +end; +@# +procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|} +var full_name: ^char; +begin + full_name := kpse_find_tfm (cur_name); + if full_name then begin + tfm_file := fopen (full_name, FOPEN_RBIN_MODE); + end else begin + tfm_file := nil; + end; +end; +@z + +@x [24] No arbitrary limit on filename length. +@!cur_name:packed array[1..name_length] of char; {external name, + with no lower case letters} +@y +@!cur_name:^char; {external name} +@z + +@x [27] Make get_n_bytes routines work with 16-bit math. +get_two_bytes:=a*256+b; +@y +get_two_bytes:=a*intcast(256)+b; +@z +@x +get_three_bytes:=(a*256+b)*256+c; +@y +get_three_bytes:=(a*intcast(256)+b)*256+c; +@z +@x +if a<128 then signed_trio:=(a*256+b)*256+c +else signed_trio:=((a-256)*256+b)*256+c; +@y +if a<128 then signed_trio:=(a*intcast(256)+b)*256+c +else signed_trio:=((a-intcast(256))*256+b)*256+c; +@z +@x +if a<128 then signed_quad:=((a*256+b)*256+c)*256+d +else signed_quad:=(((a-256)*256+b)*256+c)*256+d; +@y +if a<128 then signed_quad:=((a*intcast(256)+b)*256+c)*256+d +else signed_quad:=(((a-256)*intcast(256)+b)*256+c)*256+d; +@z + +@x [28] dvi_length and move_to_byte. +@p function dvi_length:integer; +begin set_pos(dvi_file,-1); dvi_length:=cur_pos(dvi_file); +end; +@# +procedure move_to_byte(n:integer); +begin set_pos(dvi_file,n); cur_loc:=n; +end; +@y +@p function dvi_length:integer; +begin + xfseek (dvi_file, 0, 2, 'dvitype'); + cur_loc := xftell(dvi_file, 'dvitype'); + dvi_length := cur_loc; +end; +@# +procedure move_to_byte(n:integer); +begin + xfseek (dvi_file, n, 0, 'dvitype'); + cur_loc:=n; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% JFM and pTeX +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!width_ptr:0..max_widths; {the number of known character widths} +@y +@!width_ptr:0..max_widths; {the number of known character widths} +@!fnt_jfm_p:array [0..max_fonts] of boolean; +@!jfm_char_code:array [0..max_widths] of integer; +@!jfm_char_type:array [0..max_widths] of integer; +@!jfm_char_font:array [0..max_widths] of integer; +@!jfm_char_type_count:integer; +@!cur_jfm_char_type:integer; + +@ @d jfm_hash_size=347 + +@ @<Types...@>= +@!jfm_char_type_hash_value=0..jfm_hash_size-1; + +@ @<Glob...@>= +@!jfm_char_type_hash_table:array[jfm_char_type_hash_value] of integer; + { first pointer to character information. 0 means null pointer. } +@!jfm_char_type_hash_link:array[0..max_widths] of integer; + { next pointer to character information. 0 means null pointer. } + +@ @<Set init...@>= +for i:=0 to jfm_hash_size-1 do + jfm_char_type_hash_table[i] := 0; +jfm_char_type[0]:=0; +jfm_char_type_count:=1; + +@ Refer char_type table. + +@p function get_jfm_char_type(@!fntn:integer;@!jfmc:integer):integer; + var p:integer; ct:integer; +begin + p:=jfm_char_type_hash_table[(jfmc+fntn) mod jfm_hash_size]; + ct:=0; { default char_type is 0 } + while p <> 0 do + if (jfm_char_code[p] = jfmc) and (jfm_char_font[p] = fntn) then + begin ct:=jfm_char_type[p]; p:=0; end + else + p:=jfm_char_type_hash_link[p]; + get_jfm_char_type:=ct; +end; + +@ @<Glob...@>= +@!ptex_p:boolean; +@!dd:eight_bits; +@!ddstack:array [0..stack_size] of eight_bits; +@z + +@x +@!lh:integer; {length of the header data, in four-byte words} +@y +@!lh:integer; {length of the header data, in four-byte words} +@!nt:integer; +@!jfm_h:integer; +@z + +@x [35] Make 16-bit TFM calculations work. and JFM by K.A. +read_tfm_word; lh:=b2*256+b3; +read_tfm_word; font_bc[nf]:=b0*256+b1; font_ec[nf]:=b2*256+b3; +@y +read_tfm_word; lh:=b0*intcast(256)+b1; +if (lh = 11) or (lh = 9) then + begin + print(' (JFM'); + fnt_jfm_p[nf] := true; + if lh = 9 then print(' tate'); + print(')'); + nt:=b2*intcast(256)+b3; + read_tfm_word; + end +else + begin + nt:=0; + fnt_jfm_p[nf] := false; + end; +lh:=b2*intcast(256)+b3; +read_tfm_word; font_bc[nf]:=b0*intcast(256)+b1; font_ec[nf]:=b2*intcast(256)+b3; +@z +@x + if b0<128 then tfm_check_sum:=((b0*256+b1)*256+b2)*256+b3 + else tfm_check_sum:=(((b0-256)*256+b1)*256+b2)*256+b3 +@y + if b0<128 then tfm_check_sum:=((b0*intcast(256)+b1)*256+b2)*256+b3 + else tfm_check_sum:=(((b0-256)*intcast(256)+b1)*256+b2)*256+b3 +@z +@x JFM + tfm_design_size:=round(tfm_conv*(((b0*256+b1)*256+b2)*256+b3)) + else goto 9997; + end; +@y + tfm_design_size:=round(tfm_conv*(((b0*256+b1)*256+b2)*256+b3)) + else goto 9997; + end; +for k:=1 to nt do + begin + read_tfm_word; + jfm_char_code[jfm_char_type_count]:=b0*intcast(256)+b1; + jfm_char_type[jfm_char_type_count]:=b2*intcast(256)+b3; + jfm_char_font[jfm_char_type_count]:=nf; + jfm_h:= { hash value } + (jfm_char_code[jfm_char_type_count]+nf) mod jfm_hash_size; + jfm_char_type_hash_link[jfm_char_type_count]:= + jfm_char_type_hash_table[jfm_h]; + jfm_char_type_hash_table[jfm_h]:=jfm_char_type_count; + jfm_char_type_count := jfm_char_type_count + 1 + end; +@z + +@x [43] Initialize optional variables sooner. +@ @<Set init...@>= +out_mode:=the_works; max_pages:=1000000; start_vals:=0; start_there[0]:=false; +@y +@ Initializations are done sooner now. +@z + +@x [45] No dialog. +@ The |input_ln| routine waits for the user to type a line at his or her +terminal; then it puts ASCII-code equivalents for the characters on that line +into the |buffer| array. The |term_in| file is used for terminal input, +and |term_out| for terminal output. +@^system dependencies@> + +@<Glob...@>= +@!buffer:array[0..terminal_line_length] of ASCII_code; +@!term_in:text_file; {the terminal, considered as an input file} +@!term_out:text_file; {the terminal, considered as an output file} +@y +@ No dialog. +@z + +@x [47] No input_ln. +@p procedure input_ln; {inputs a line from the terminal} +var k:0..terminal_line_length; +begin update_terminal; reset(term_in); +if eoln(term_in) then read_ln(term_in); +k:=0; +while (k<terminal_line_length)and not eoln(term_in) do + begin buffer[k]:=xord[term_in^]; incr(k); get(term_in); + end; +buffer[k]:=" "; +end; +@y +@z + +@x [48] No dialog. +@ The global variable |buf_ptr| is used while scanning each line of input; +it points to the first unread character in |buffer|. + +@<Glob...@>= +@!buf_ptr:0..terminal_line_length; {the number of characters read} +@y +@ No dialog. +@z + +@x [49] No dialog. +@ Here is a routine that scans a (possibly signed) integer and computes +the decimal value. If no decimal integer starts at |buf_ptr|, the +value 0 is returned. The integer should be less than $2^{31}$ in +absolute value. + +@p function get_integer:integer; +var x:integer; {accumulates the value} +@!negative:boolean; {should the value be negated?} +begin if buffer[buf_ptr]="-" then + begin negative:=true; incr(buf_ptr); + end +else negative:=false; +x:=0; +while (buffer[buf_ptr]>="0")and(buffer[buf_ptr]<="9") do + begin x:=10*x+buffer[buf_ptr]-"0"; incr(buf_ptr); + end; +if negative then get_integer:=-x @+ else get_integer:=x; +end; + +@y +@ No dialog. +@z + +@x [50-55] No dialog. +@ The selected options are put into global variables by the |dialog| +procedure, which is called just as \.{DVItype} begins. +@^system dependencies@> + +@p procedure dialog; +label 1,2,3,4,5; +var k:integer; {loop variable} +begin rewrite(term_out); {prepare the terminal for output} +write_ln(term_out,banner); +@<Determine the desired |out_mode|@>; +@<Determine the desired |start_count| values@>; +@<Determine the desired |max_pages|@>; +@<Determine the desired |resolution|@>; +@<Determine the desired |new_mag|@>; +@<Print all the selected options@>; +end; + +@ @<Determine the desired |out_mode|@>= +1: write(term_out,'Output level (default=4, ? for help): '); +out_mode:=the_works; input_ln; +if buffer[0]<>" " then + if (buffer[0]>="0")and(buffer[0]<="4") then out_mode:=buffer[0]-"0" + else begin write(term_out,'Type 4 for complete listing,'); + write(term_out,' 0 for errors and fonts only,'); + write_ln(term_out,' 1 or 2 or 3 for something in between.'); + goto 1; + end + +@ @<Determine the desired |start...@>= +2: write(term_out,'Starting page (default=*): '); +start_vals:=0; start_there[0]:=false; +input_ln; buf_ptr:=0; k:=0; +if buffer[0]<>" " then + repeat if buffer[buf_ptr]="*" then + begin start_there[k]:=false; incr(buf_ptr); + end + else begin start_there[k]:=true; start_count[k]:=get_integer; + end; + if (k<9)and(buffer[buf_ptr]=".") then + begin incr(k); incr(buf_ptr); + end + else if buffer[buf_ptr]=" " then start_vals:=k + else begin write(term_out,'Type, e.g., 1.*.-5 to specify the '); + write_ln(term_out,'first page with \count0=1, \count2=-5.'); + goto 2; + end; + until start_vals=k + +@ @<Determine the desired |max_pages|@>= +3: write(term_out,'Maximum number of pages (default=1000000): '); +max_pages:=1000000; input_ln; buf_ptr:=0; +if buffer[0]<>" " then + begin max_pages:=get_integer; + if max_pages<=0 then + begin write_ln(term_out,'Please type a positive number.'); + goto 3; + end; + end + +@ @<Determine the desired |resolution|@>= +4: write(term_out,'Assumed device resolution'); +write(term_out,' in pixels per inch (default=300/1): '); +resolution:=300.0; input_ln; buf_ptr:=0; +if buffer[0]<>" " then + begin k:=get_integer; + if (k>0)and(buffer[buf_ptr]="/")and + (buffer[buf_ptr+1]>"0")and(buffer[buf_ptr+1]<="9") then + begin incr(buf_ptr); resolution:=k/get_integer; + end + else begin write(term_out,'Type a ratio of positive integers;'); + write_ln(term_out,' (1 pixel per mm would be 254/10).'); + goto 4; + end; + end + +@ @<Determine the desired |new_mag|@>= +5: write(term_out,'New magnification (default=0 to keep the old one): '); +new_mag:=0; input_ln; buf_ptr:=0; +if buffer[0]<>" " then + if (buffer[0]>="0")and(buffer[0]<="9") then new_mag:=get_integer + else begin write(term_out,'Type a positive integer to override '); + write_ln(term_out,'the magnification in the DVI file.'); + goto 5; + end +@y +@ No dialog (50). +@ No dialog (51). +@ No dialog (52). +@ No dialog (53). +@ No dialog (54). +@ No dialog (55). +@z + +@x [56] Fix printing of floating point number. +print_ln(' Resolution = ',resolution:12:8,' pixels per inch'); +if new_mag>0 then print_ln(' New magnification factor = ',new_mag/1000:8:3) +@y +print (' Resolution = '); +print_real (resolution, 12, 8); +print_ln (' pixels per inch'); +if new_mag > 0 +then begin + print (' New magnification factor = '); + print_real (new_mag / 1000.0, 8, 3); + print_ln('') +end +@z + +@x [59] We use r for something else. +@!r:0..name_length; {index into |cur_name|} +@y +@!r:0..name_size; {current filename length} +@z + +@x [62] <Load the new font...> close the file when we're done +if out_mode=errors_only then print_ln(' '); +@y +if out_mode=errors_only then print_ln(' '); +if tfm_file then + xfclose (tfm_file, cur_name); {should be the |kpse_find_tfm| result} +free (cur_name); {We |xmalloc|'d this before we got called.} +@z + +@x [64] Don't set default_directory_name. +@d default_directory_name=='TeXfonts:' {change this to the correct name} +@d default_directory_name_length=9 {change this to the correct length} + +@<Glob...@>= +@!default_directory:packed array[1..default_directory_name_length] of char; +@y +Under Unix, users have a path searched for fonts, there's no single +default directory. +@z + +@x [65] Remove initialization of default_directory. +@ @<Set init...@>= +default_directory:=default_directory_name; +@y +@ (No initialization needs to be done. Keep this module to preserve +numbering.) +@z + +@x [66] Don't append `.tfm' here, and keep lowercase. +@ The string |cur_name| is supposed to be set to the external name of the +\.{TFM} file for the current font. This usually means that we need to +prepend the name of the default directory, and +to append the suffix `\.{.TFM}'. Furthermore, we change lower case letters +to upper case, since |cur_name| is a \PASCAL\ string. +@^system dependencies@> + +@<Move font name into the |cur_name| string@>= +for k:=1 to name_length do cur_name[k]:=' '; +if p=0 then + begin for k:=1 to default_directory_name_length do + cur_name[k]:=default_directory[k]; + r:=default_directory_name_length; + end +else r:=0; +for k:=font_name[nf] to font_name[nf+1]-1 do + begin incr(r); + if r+4>name_length then + abort('DVItype capacity exceeded (max font name length=', + name_length:1,')!'); +@.DVItype capacity exceeded...@> + if (names[k]>="a")and(names[k]<="z") then + cur_name[r]:=xchr[names[k]-@'40] + else cur_name[r]:=xchr[names[k]]; + end; +cur_name[r+1]:='.'; cur_name[r+2]:='T'; cur_name[r+3]:='F'; cur_name[r+4]:='M' +@y +@ The string |cur_name| is supposed to be set to the external name of the +\.{TFM} file for the current font. We do not impose a maximum limit +here. It's too bad there is a limit on the total length of all +filenames, but it doesn't seem worth reprogramming all that. +@^system dependencies@> + +@d name_start == font_name[nf] +@d name_end == font_name[nf+1] + +@<Move font name into the |cur_name| string@>= +r := name_end - name_start; +cur_name := xmalloc_array (char, r); +{|strncpy| might be faster, but it's probably a good idea to keep the + |xchr| translation.} +for k := name_start to name_end do begin + cur_name[k - name_start] := xchr[names[k]]; +end; +cur_name[r] := 0; {Append null byte for C.} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% JFM +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x Not use fprintf() for JIS + for k:=1 to text_ptr do print(xchr[text_buf[k]]); + print_ln(']'); +@y + for k:=1 to text_ptr do print(xchr[text_buf[k]]); + print(']'); print_ln(''); +@z + +@x +@p procedure out_text(c:ASCII_code); +begin if text_ptr=line_length-2 then flush_text; +incr(text_ptr); text_buf[text_ptr]:=c; +end; +@y +@p procedure out_text(c:ASCII_code); +begin if text_ptr=line_length-2 then flush_text; +incr(text_ptr); +if c>=177 then text_buf[text_ptr]:=@'77 else text_buf[text_ptr]:=c; +end; + +@ @p procedure out_kanji(c:integer); +begin + if text_ptr>=line_length-3 then flush_text; + c:=toBUFF(fromDVI(c)); + incr(text_ptr); text_buf[text_ptr]:= Hi(c); + incr(text_ptr); text_buf[text_ptr]:= Lo(c); +end; + +@ output hexdecimal / octal character code. + +@d print_hex_digit(#)==if # <= 9 then print((#):1) + else case # of + 10: print(xchr['A']); + 11: print(xchr['B']); + 12: print(xchr['C']); + 13: print(xchr['D']); + 14: print(xchr['E']); + 15: print(xchr['F']); { no more cases } + end + +@p +ifdef('HEX_CHAR_CODE') +procedure print_hex_number(c:integer); +var n:integer; + b:array[1..8] of integer; +begin + n:=1; + while (n<8) and (c<>0) do + begin b[n]:=c mod 16; c:=c div 16; n:=n+1 end; + print('"'); + if n=1 then print(xchr['0']) + else + begin + n:=n-1; + while n>0 do + begin print_hex_digit(b[n]); n:=n-1 end + end +end; +endif('HEX_CHAR_CODE') +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% pTeX +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +z0: first_par:=z; +@y +z0: first_par:=z; +dir: first_par:=get_byte; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% pTeX +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +s:=0; h:=0; v:=0; w:=0; x:=0; y:=0; z:=0; hh:=0; vv:=0; +@y +s:=0; h:=0; v:=0; w:=0; x:=0; y:=0; z:=0; hh:=0; vv:=0; dd:=0; +@z +%%%%%%%%%%%%%%%%%%%%%%%%% End of pTeX%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +@x [80] (major,minor) optionally show opcode +@d show(#)==begin flush_text; showing:=true; print(a:1,': ',#); + end +@d major(#)==if out_mode>errors_only then show(#) +@d minor(#)==if out_mode>terse then + begin showing:=true; print(a:1,': ',#); +@y +@d show(#)==begin flush_text; showing:=true; print(a:1,': ',#); + if show_opcodes and (o >= 128) then print (' {', o:1, '}'); + end +@d major(#)==if out_mode>errors_only then show(#) +@d minor(#)==if out_mode>terse then + begin showing:=true; print(a:1,': ',#); + if show_opcodes and (o >= 128) then print (' {', o:1, '}'); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% pTeX +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x + four_cases(set1): begin major('set',o-set1+1:1,' ',p:1); goto fin_set; +@y + four_cases(set1): + begin + if fnt_jfm_p[cur_font]=true then + begin + cur_jfm_char_type:=get_jfm_char_type(cur_font,p); + out_kanji(p); + minor('set',o-set1+1:1,' ',p:1); +ifdef('HEX_CHAR_CODE') + print('('); + print_hex_number(p); + print(')'); +endif('HEX_CHAR_CODE') + print(' type=',cur_jfm_char_type); + p:=cur_jfm_char_type + end + else begin + major('set',o-set1+1:1,' ',p:1); +ifdef('HEX_CHAR_CODE') + print('('); + print_hex_number(p); + print(')'); +endif('HEX_CHAR_CODE') + end; + goto fin_set; +@z + +@x + put_rule: begin major('putrule'); goto fin_rule; + end; +@y + put_rule: begin major('putrule'); goto fin_rule; + end; + dir: begin major('dir ',p:1); dd:=p; goto done; + end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% pTeX +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x + hstack[s]:=h; vstack[s]:=v; wstack[s]:=w; +@y + ddstack[s]:=dd; + hstack[s]:=h; vstack[s]:=v; wstack[s]:=w; +@z + +@x + h:=hstack[s]; v:=vstack[s]; w:=wstack[s]; +@y + dd:=ddstack[s]; + h:=hstack[s]; v:=vstack[s]; w:=wstack[s]; +@z + +@x +@d out_space(#)==if (p>=font_space[cur_font])or(p<=-4*font_space[cur_font]) then + begin out_text(" "); hh:=pixel_round(h+p); + end + else hh:=hh+pixel_round(p); +@y +@d out_space(#)==if (p>=font_space[cur_font])or(p<=-4*font_space[cur_font]) then + begin out_text(" "); + if dd=0 then hh:=pixel_round(h+p) else vv:=pixel_round(v+p); + end + else if dd=0 then hh:=hh+pixel_round(p) else vv:=vv+pixel_round(p); +@z + +@x +@d out_vmove(#)==if abs(p)>=5*font_space[cur_font] then vv:=pixel_round(v+p) + else vv:=vv+pixel_round(p); +@y +@d out_vmove(#)==if abs(p)>=5*font_space[cur_font] then + begin if dd=0 then vv:=pixel_round(v+p) else hh:=pixel_round(h-p) end + else if dd=0 then vv:=vv+pixel_round(p) else hh:=hh-pixel_round(p); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Hexadecimal code +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ @<Translate a |set_char|...@>= +begin if (o>" ")and(o<="~") then + begin out_text(p); minor('setchar',p:1); + end +else major('setchar',p:1); +@y +@ @<Translate a |set_char|...@>= +begin if (o>" ")and(o<="~") then + begin out_text(p); minor('setchar',p:1); + end +else major('setchar',p:1); +ifdef('HEX_CHAR_CODE') + print(' ('); + print_hex_number(p); + print(')'); +endif('HEX_CHAR_CODE') +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% pTeX +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +else hh:=hh+char_pixel_width(cur_font)(p); +@y +else if dd=0 then hh:=hh+char_pixel_width(cur_font)(p) + else vv:=vv+char_pixel_width(cur_font)(p); +@z + +@x +hh:=hh+rule_pixels(q); goto move_right +@y +if dd=0 then hh:=hh+rule_pixels(q) else vv:=vv+rule_pixels(q); +goto move_right +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% pTeX +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@<Finish a command that sets |h:=h+q|, then |goto done|@>= +@y +@<Finish a command that sets |h:=h+q|, then |goto done|@>= +if dd=0 then begin +@z + +@x +goto done +@y +goto done end +else begin +if (v>0)and(q>0) then if v>infinity-q then + begin error('arithmetic overflow! parameter changed from ', +@.arithmetic overflow...@> + q:1,' to ',infinity-q:1); + q:=infinity-v; + end; +if (v<0)and(q<0) then if -v>q+infinity then + begin error('arithmetic overflow! parameter changed from ', + q:1, ' to ',(-v)-infinity:1); + q:=(-v)-infinity; + end; +hhh:=pixel_round(v+q); +if abs(hhh-vv)>max_drift then + if hhh>vv then vv:=hhh-max_drift + else vv:=hhh+max_drift; +if showing then if out_mode>mnemonics_only then + begin print(' v:=',v:1); + if q>=0 then print('+'); + print(q:1,'=',v+q:1,', vv:=',vv:1); + end; +v:=v+q; +if abs(v)>max_v_so_far then + begin if abs(v)>max_v+99 then + begin error('warning: |v|>',max_v:1,'!'); +@.warning: |v|...@> + max_v:=abs(v); + end; + max_v_so_far:=abs(v); + end; +goto done +end +@z + +@x +@ @<Finish a command that sets |v:=v+p|, then |goto done|@>= +@y +@ @<Finish a command that sets |v:=v+p|, then |goto done|@>= +if dd=0 then begin +@z + +@x +goto done +@y +goto done end +else begin +p:=-p; +if (h>0)and(p>0) then if h>infinity-p then + begin error('arithmetic overflow! parameter changed from ', +@.arithmetic overflow...@> + p:1,' to ',infinity-h:1); + p:=infinity-h; + end; +if (h<0)and(p<0) then if -h>p+infinity then + begin error('arithmetic overflow! parameter changed from ', + p:1, ' to ',(-h)-infinity:1); + p:=(-h)-infinity; + end; +vvv:=pixel_round(h+p); +if abs(vvv-hh)>max_drift then + if vvv>hh then hh:=vvv-max_drift + else hh:=vvv+max_drift; +if showing then if out_mode>mnemonics_only then + begin print(' h:=',h:1); + if p>=0 then print('+'); + print(p:1,'=',h+p:1,', hh:=',hh:1); + end; +h:=h+p; +if abs(h)>max_h_so_far then + begin if abs(h)>max_h+99 then + begin error('warning: |h|>',max_h:1,'!'); +@.warning: |h|...@> + max_h:=abs(h); + end; + max_h_so_far:=abs(h); + end; +goto done +end +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% pTeX +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x + print('level ',ss:1,':(h=',h:1,',v=',v:1, + ',w=',w:1,',x=',x:1,',y=',y:1,',z=',z:1, + ',hh=',hh:1,',vv=',vv:1,')'); +@y + begin + print('level ',ss:1,':(h=',h:1,',v=',v:1, + ',w=',w:1,',x=',x:1,',y=',y:1,',z=',z:1); + if ptex_p then print(',d=',dd:1); + print(',hh=',hh:1,',vv=',vv:1,')'); + end; +@z + +@x +if k<>id_byte then bad_dvi('ID byte is ',k:1); +@y +ptex_p:=(k=ptex_id_byte); +if (k<>id_byte) and (not ptex_p) then bad_dvi('ID byte is ',k:1); +@z + +@x +print_ln(', maxstackdepth=',max_s:1,', totalpages=',total_pages:1); +@y +print_ln(', maxstackdepth=',max_s:1,', totalpages=',total_pages:1); +if ptex_p then print_ln('pTeX DVI (id=',ptex_id_byte:1,')'); +@z + +@x +if m<>id_byte then print_ln('identification in byte ',cur_loc-1:1, +@.identification...should be n@> + ' should be ',id_byte:1,'!'); +@y +if (m<>id_byte) and (m<>ptex_id_byte) then + print_ln('identification in byte ',cur_loc-1:1, +@.identification...should be n@> + ' should be ',id_byte:1,' or ',ptex_id_byte:1,'!'); +@z + +@x [106] (main) No dialog; remove unused label. +dialog; {set up all the options} +@y +@<Print all the selected options@>; +@z + +@x +final_end:end. +@y +end. +@z + +@x [109] Fix another floating point print. +print_ln('magnification=',mag:1,'; ',conv:16:8,' pixels per DVI unit') +@y +print ('magnification=', mag:1, '; '); +print_real (conv, 16, 8); +print_ln (' pixels per DVI unit') +@z + +@x [111] System-dependent changes. +This section should be replaced, if necessary, by changes to the program +that are necessary to make \.{DVItype} work at a particular installation. +It is usually best to design your change file so that all changes to +previous sections preserve the section numbering; then everybody's version +will be consistent with the printed program. More extensive changes, +which introduce new sections, can be inserted here; then only the index +itself will get a new section number. +@^system dependencies@> +@y +Parse a Unix-style command line. + +@d argument_is (#) == (strcmp (long_options[option_index].name, #) = 0) + +@<Define |parse_arguments|@> = +procedure parse_arguments; +const n_options = 9; {Pascal won't count array lengths for us.} +var @!long_options: array[0..n_options] of getopt_struct; + @!getopt_return_val: integer; + @!option_index: c_int_type; + @!current_option: 0..n_options; + @!end_num:^char; {for \.{page-start}} +begin + @<Define the option table@>; + repeat + getopt_return_val := getopt_long_only (argc, argv, '', long_options, + address_of (option_index)); + if getopt_return_val = -1 then begin + {End of arguments; we exit the loop below.} ; + + end else if getopt_return_val = "?" then begin + usage ('pdvitype'); + + end else if argument_is ('help') then begin + usage_help (PDVITYPE_HELP, nil); + + end else if argument_is ('version') then begin + print_version_and_exit (banner, nil, 'D.E. Knuth', nil); + + end else if argument_is ('output-level') then begin + out_mode := atou (optarg); + if (out_mode = 0) or (out_mode > 4) then begin + write_ln (stderr, 'Value for --output-level must be >= 1 and <= 4.'); + uexit (1); + end; + + end else if argument_is ('page-start') then begin + @<Determine the desired |start_count| values from |optarg|@>; + + end else if argument_is ('max-pages') then begin + max_pages := atou (optarg); + + end else if argument_is ('dpi') then begin + resolution := atof (optarg); + + end else if argument_is ('magnification') then begin + new_mag := atou (optarg); + + end else if argument_is ('kanji') then begin + if (not set_enc_string(optarg,optarg)) then begin + write_ln('Bad kanjicode encoding "', stringcast(optarg), '".'); + end; + + end; {Else it was a flag; |getopt| has already done the assignment.} + until getopt_return_val = -1; + + {Now |optind| is the index of first non-option on the command line.} + if (optind + 1 <> argc) then begin + write_ln (stderr, 'pdvitype: Need exactly one file argument.'); + usage ('pdvitype'); + end; +end; + +@ Here are the options we allow. The first is one of the standard GNU options. +@.-help@> + +@<Define the option...@> = +current_option := 0; +long_options[current_option].name := 'help'; +long_options[current_option].has_arg := 0; +long_options[current_option].flag := 0; +long_options[current_option].val := 0; +incr (current_option); + +@ Another of the standard options. +@.-version@> + +@<Define the option...@> = +long_options[current_option].name := 'version'; +long_options[current_option].has_arg := 0; +long_options[current_option].flag := 0; +long_options[current_option].val := 0; +incr (current_option); + +@ How verbose to be. +@.-output-level@> + +@<Define the option...@> = +long_options[current_option].name := 'output-level'; +long_options[current_option].has_arg := 1; +long_options[current_option].flag := 0; +long_options[current_option].val := 0; +incr (current_option); +out_mode := the_works; {default} + +@ What page to start at. +@.-page-start@> + +@<Define the option...@> = +long_options[current_option].name := 'page-start'; +long_options[current_option].has_arg := 1; +long_options[current_option].flag := 0; +long_options[current_option].val := 0; +incr (current_option); + +@ Parsing the starting page specification is a bit complicated. + +@<Determine the desired |start_count|...@> = +k := 0; {which \.{\\count} register we're on} +m := 0; {position in |optarg|} +while optarg[m] do begin + if optarg[m] = "*" then begin + start_there[k] := false; + incr (m); + + end else if optarg[m] = "." then begin + incr (k); + if k >= 10 then begin + write_ln (stderr, 'dvitype: More than ten count registers specified.'); + uexit (1); + end; + incr (m); + + end else begin + start_count[k] := strtol (optarg + m, address_of (end_num), 10); + if end_num = optarg + m then begin + write_ln (stderr, 'dvitype: -page-start values must be numeric or *.'); + uexit (1); + end; + start_there[k] := true; + m := m + end_num - (optarg + m); + end; +end; +start_vals := k; + +@ How many pages to do. +@.-max-pages@> + +@<Define the option...@> = +long_options[current_option].name := 'max-pages'; +long_options[current_option].has_arg := 1; +long_options[current_option].flag := 0; +long_options[current_option].val := 0; +incr (current_option); +max_pages := 1000000; {default} + +@ Resolution, in pixels per inch. +@.-dpi@> + +@<Define the option...@> = +long_options[current_option].name := 'dpi'; +long_options[current_option].has_arg := 1; +long_options[current_option].flag := 0; +long_options[current_option].val := 0; +incr (current_option); +resolution := 300.0; {default} + +@ Magnification to apply. +@.-magnification@> + +@<Define the option...@> = +long_options[current_option].name := 'magnification'; +long_options[current_option].has_arg := 1; +long_options[current_option].flag := 0; +long_options[current_option].val := 0; +incr (current_option); +new_mag := 0; {default is to keep the old one} + +@ Whether to show numeric opcodes. +@.-show-opcodes@> + +@<Define the option...@> = +long_options[current_option].name := 'show-opcodes'; +long_options[current_option].has_arg := 0; +long_options[current_option].flag := address_of (show_opcodes); +long_options[current_option].val := 1; +incr (current_option); +new_mag := 0; {default is to keep the old one} + +@ Decide kanji encode +@.-kanji@> + +@<Define the option...@> = +long_options[current_option].name := 'kanji'; +long_options[current_option].has_arg := 1; +long_options[current_option].flag := 0; +long_options[current_option].val := 0; +incr (current_option); + +@ @<Glob...@> = +@!show_opcodes: c_int_type; + +@ An element with all zeros always ends the list. + +@<Define the option...@> = +long_options[current_option].name := 0; +long_options[current_option].has_arg := 0; +long_options[current_option].flag := 0; +long_options[current_option].val := 0; +@z diff --git a/Build/source/texk/web2c/ptexdir/ppltotf.ch b/Build/source/texk/web2c/ptexdir/ppltotf.ch new file mode 100644 index 00000000000..c85e047d89b --- /dev/null +++ b/Build/source/texk/web2c/ptexdir/ppltotf.ch @@ -0,0 +1,742 @@ +% This is a change file for TFtoPL +% +% (07/18/2006) ST PLtoTF p1.8 (3.5, Web2c 7.2) +% (11/13/2000) KN PLtoTF p1.4 (3.5, Web2c 7.2) +% (03/27/1998) KN PLtoTF p1.3 (3.5, Web2c 7.2) +% +@x [0] l.52 - pTeX: +\def\title{PL$\,$\lowercase{to}$\,$TF changes for C} +@y +\def\title{PL$\,$\lowercase{to}$\,$TF changes for C, and for KANJI} +@z + +@x [2] l.69 - pTeX: +@d banner=='This is PLtoTF, Version 3.5' {printed when the program starts} +@y +@d banner=='This is Nihongo PLtoTF, Version 3.5-p1.8' + {printed when the program starts} +@z + +@x [6] l.140 - pTeX: + print_ln (version_string); +@y + print_ln (version_string); + print ('process kanji code is '); + fputs(get_enc_string, stdout); + print_ln ('.'); +@z + +@x +@d char == 0..255 +@d first_ord=0 {ordinal number of the smallest element of |char|} +@y +@d uchar == 0..255 +@d first_ord=0 {ordinal number of the smallest element of |char|} +@z + +@x [18] l.495 - pTeX: +@!xord:array[char] of ASCII_code; {conversion table} +@y +@!xord:array[uchar] of ASCII_code; {conversion table} +@!xchr:array[uchar] of byte; {specifiles conversion of output character} +@z + +@x [19] l.506 - pTeX: +for k:=first_ord to last_ord do xord[chr(k)]:=invalid_code; +@y +for k:=0 to @'37 do xchr[k]:='?'; +for k:=@'40 to 255 do xchr[k]:=k; +for k:=first_ord to last_ord do xord[chr(k)]:=invalid_code; +@z + +@x [27] l.587 - pTeX: to convert putc of web2c +for k:=1 to loc do print(buffer[k]); {print the characters already scanned} +@y +for k:=1 to loc do print(xchr[buffer[k]]); + {print the characters already scanned} +@z + +@x [27] l.591 - pTeX: to convert putc of web2c +for k:=loc+1 to limit do print(buffer[k]); {print the characters yet unseen} +@y +for k:=loc+1 to limit do print(xchr[buffer[k]]); + {print the characters yet unseen} +@z + +@x [28] l.619 - pTeX: +else begin while (limit<buf_size-1)and(not eoln(pl_file)) do + begin incr(limit); read(pl_file,buffer[limit]); + end; +@y +else begin limit:=input_line2(pl_file,buffer,limit+1,buf_size)-1; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [28] This fixes a bug in the original. If get_byte is reading a +% number at the end of a line and the next line has a number +% at the beginning (possibly preceded by some spaces!!) these +% two numbers are run together. +% This bug may be found in other routines so... +% Fix: add some (more?) space at the end of each line, in fill_buffer. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x [28] l.622 - pTeX: + buffer[limit+1]:=' '; right_ln:=eoln(pl_file); + if left_ln then @<Set |loc| to the number of leading blanks in + the buffer, and check the indentation@>; + end; +end; +@y + buffer[limit+1]:=' '; right_ln:=eoln(pl_file); + if right_ln then begin incr(limit); buffer[limit+1]:=' '; + end; + if left_ln then @<Set |loc| to the number of leading blanks in + the buffer, and check the indentation@>; + end; +end; +@z + +@x [36] l.754 - pTeX: May have to increase some numbers to fit new commands +@d max_name_index=88 {upper bound on the number of keywords} +@d max_letters=600 {upper bound on the total length of all keywords} +@y +@d max_name_index=97 {upper bound on the number of keywords} +@d max_letters=700 {upper bound on the total length of all keywords} +@z + +@x [44] l.839 - pTeX: Add kanji related codes +@d character_code=12 +@y +@d character_code=12 +@d type_code=13 {|TYPE| property} +@d glue_kern_code=14 {|GLUEKRN| property} +@d chars_in_type_code=15 {|CHARSINTYPE| property} +@d dir_code=16 {|DIRECTION| property} +@z + +@x [44] l.856 - pTeX: +@d lig_code=74 +@y +@d lig_code=74 +@d glue_code=75 {|GLUE| property} +@# +@d undefined=0 {not decided file format yet} +@d tfm_format=1 {\.{TFM} file format} +@d jfm_or_vfm=2 {Yoko or Tate \.{JFM} file format} +@d jfm_format=3 {Yoko-kumi \.{JFM} file format} +@d vfm_format=4 {Tate-kumi \.{JFM} file format} +@z + +@x [84] l.1542 - pTeX: Change valid property code. +if cur_code=comment_code then skip_to_end_of_item +else if cur_code>character_code then + flush_error('This property name doesn''t belong on the outer level') +@.This property name doesn't belong...@> +@y +if cur_code=comment_code then skip_to_end_of_item +else if (cur_code>dir_code)or + ((file_format=tfm_format)and(cur_code>character_code)) then + flush_error('This property name doesn''t belong on the outer level') +@.This property name doesn't belong...@> +@z + +@x [85] l.1565 - pTeX: Added some property codes. +character_code: read_char_info; +@y +character_code: read_char_info; +type_code: read_kanji_info; +glue_kern_code: read_glue_kern; +chars_in_type_code: read_chars_in_type; +dir_code: read_direction; +@z + +@x [110] l.1915 - pTeX: there are no charlists in kanji format files. +for c:=0 to 255 do + @<Make sure that |c| is not the largest element of a charlist cycle@>; +@y +if file_format=tfm_format then + for c:=0 to 255 do + @<Make sure that |c| is not the largest element of a charlist cycle@>; +@z + +@x [120] l.2037 - pTeX: when checking glue_kern prog check glues as well + begin if lig_exam<>bchar then + check_existence(lig_exam)('LIG character examined by'); +@.LIG character examined...@> + check_existence(lig_gen)('LIG character generated by'); +@.LIG character generated...@> + if lig_gen>=128 then if(c<128)or(c=256) then + if(lig_exam<128)or(lig_exam=bchar) then seven_unsafe:=true; + end +@y + begin if file_format=tfm_format then + begin if lig_exam<>bchar then + check_existence(lig_exam)('LIG character examined by'); +@.LIG character examined...@> + check_existence(lig_gen)('LIG character generated by'); +@.LIG character generated...@> + if lig_gen>=128 then if(c<128)or(c=256) then + if(lig_exam<128)or(lig_exam=bchar) then seven_unsafe:=true; + end + else check_existence(lig_exam)('GLUE character generated by'); + end +@z + +@x [126] l.2178 - pTeX: Fix up output of bytes. +@<Doublecheck...@>= +if nl>0 then for lig_ptr:=0 to nl-1 do + if lig_kern[lig_ptr].b2<kern_flag then + begin if lig_kern[lig_ptr].b0<255 then + begin double_check_lig(b1)('LIG step'); double_check_lig(b3)('LIG step'); + end; + end + else double_check_lig(b1)('KRN step'); +@y +@<Doublecheck...@>= +@z + +@x [128] l.2207 - pTeX: Decide the |file_format|. +@<Do the output@>= +@y +@<Do the output@>= +case file_format of +tfm_format: do_nothing; +undefined,jfm_or_vfm: begin file_format:=jfm_format; + print_ln('Input file is in kanji YOKO-kumi format.'); + end; +jfm_format: print_ln('Input file is in kanji YOKO-kumi format.'); +vfm_format: print_ln('Input file is in kanji TATE-kumi format.'); +end; +@z + +@x [128] l.2211 - pTeX: Output kanji character +@<Output the character info@>; +@y +if file_format<>tfm_format then @<Output the kanji character type info@>; +@<Output the character info@>; +@z + +@x [128] l.2213 - pTeX: Output glue/kern programs +@<Output the ligature/kern program@>; +@y +@<Output the ligature/kern program@>; +if (file_format<>tfm_format)and(ng>0) then + for krn_ptr:=0 to ng-1 do + begin out_scaled(glue[3*krn_ptr+0]); + out_scaled(glue[3*krn_ptr+1]); + out_scaled(glue[3*krn_ptr+2]); + end; +@z + +@x [130] l.2238 - pTeX: +not_found:=true; bc:=0; +while not_found do + if (char_wd[bc]>0)or(bc=255) then not_found:=false + else incr(bc); +not_found:=true; ec:=255; +while not_found do + if (char_wd[ec]>0)or(ec=0) then not_found:=false + else decr(ec); +if bc>ec then bc:=1; +@y +if file_format<>tfm_format then + begin bc:=0; ec:=0; nt:=1; + for kanji_type_index:=0 to max_kanji do + begin if kanji_type[kanji_type_index]>0 then incr(nt); + if kanji_type[kanji_type_index]>ec then ec:=kanji_type[kanji_type_index]; + end; + end +else begin not_found:=true; bc:=0; + while not_found do + if (char_wd[bc]>0)or(bc=255) then not_found:=false + else incr(bc); + not_found:=true; ec:=255; + while not_found do + if (char_wd[ec]>0)or(ec=0) then not_found:=false + else decr(ec); + if bc>ec then bc:=1; + end; +@z + +@x [130] l.2250 - pTeX: +lf:=6+lh+(ec-bc+1)+memory[width]+memory[height]+memory[depth]+ +memory[italic]+nl+lk_offset+nk+ne+np; +@y +if file_format<>tfm_format then + lf:=7+nt+lh+(ec-bc+1)+memory[width]+memory[height]+memory[depth]+ + memory[italic]+nl+lk_offset+nk+3*ng+np +else + lf:=6+lh+(ec-bc+1)+memory[width]+memory[height]+memory[depth]+ + memory[italic]+nl+lk_offset+nk+ne+np; +@z + +@x [131] l.2256 - pTeX: +out_size(lf); out_size(lh); out_size(bc); out_size(ec); +out_size(memory[width]); out_size(memory[height]); +out_size(memory[depth]); out_size(memory[italic]); +out_size(nl+lk_offset); out_size(nk); out_size(ne); out_size(np); +@y +if file_format=jfm_format then + begin out_size(yoko_id_number); out_size(nt); + end +else if file_format=vfm_format then + begin out_size(tate_id_number); out_size(nt); + end; +out_size(lf); out_size(lh); out_size(bc); out_size(ec); +out_size(memory[width]); out_size(memory[height]); +out_size(memory[depth]); out_size(memory[italic]); +out_size(nl+lk_offset); out_size(nk); +if file_format<>tfm_format then begin out_size(ng*3) + end +else begin out_size(ne); + end; +out_size(np); +@z + +@x [146] l.2476 - pTeX: +@p procedure param_enter; +@y +@p +@<Declare kanji scanning routines@>@/ +procedure param_enter; +@z + +@x [146] l.2488 - pTeX: LIGTABLE command can not be used in JPL. +begin @<Read ligature/kern list@>; +end; +@y +begin @<If is jfm or vfm then print error@>; +@<Read ligature/kern list@>; +end; +@z + +@x [146] l.2493 - pTeX: CHARACTER command can not be used in JPL. +begin @<Read character info list@>; +end; +@y +begin @<If is jfm or vfm then print error@>; +@<Read character info list@>; +end; +@z + +@x [146] l.2506 - pTeX: +begin @<Correct and check the information@> +end; +@y +begin @<Correct and check the information@> +end; +@# +procedure read_kanji_info; {TYPE command} +var @!c:byte; {the char} +begin @<If is tfm then print error@>; +@<Read Kanji character type list@>; +end; +@# +procedure read_glue_kern; {GLUEKERN command} +var krn_ptr:0..max_kerns; {an index into |kern|} +@!c:byte; {runs through all character codes} +begin @<If is tfm then print error@>; +@<Read glue/kern list@>; +end; +@# +procedure read_chars_in_type; {CHARSINTYPE command} +var @!type_num:byte; {kanji character type number} +@!jis_code:integer; {sixteen bits Kanji character code} +begin @<If is tfm then print error@>; +@<Read Kanji characters list in this type@>; +end; +@# +procedure read_direction; {DIRECTION command} +begin @<If is tfm then print error@>; +@<Read direction@>; +end; +@z + +@x +const n_options = 3; {Pascal won't count array lengths for us.} +@y +const n_options = 4; {Pascal won't count array lengths for us.} +@z +@x +var @!long_options: array[0..n_options] of getopt_struct; + @!getopt_return_val: integer; + @!option_index: c_int_type; + @!current_option: 0..n_options; +begin + @<Initialize the option variables@>; +@y +var @!long_options: array[0..n_options] of getopt_struct; + @!getopt_return_val: integer; + @!option_index: c_int_type; + @!current_option: 0..n_options; + @!version_switch: boolean; +begin + @<Initialize the option variables@>; + version_switch := false; +@z +@x + usage_help (PLTOTF_HELP, nil); +@y + usage_help (PTEX_PLTOTF_HELP, nil); +@z +@x + end else if argument_is ('version') then begin + print_version_and_exit (banner, nil, 'D.E. Knuth', nil); + + end; {Else it was a flag; |getopt| has already done the assignment.} + until getopt_return_val = -1; +@y + end else if argument_is ('version') then begin + version_switch := true; + + end else if argument_is ('kanji') then begin + @<Set process kanji code@>; + + end; {Else it was a flag; |getopt| has already done the assignment.} + until getopt_return_val = -1; + if (version_switch) then + print_version_and_exit (banner, nil, 'D.E. Knuth', nil); +@z + +@x +@ An element with all zeros always ends the list. +@y +@ kanji option. + +@<Define the option...@> = +long_options[current_option].name := 'kanji'; +long_options[current_option].has_arg := 1; +long_options[current_option].flag := 0; +long_options[current_option].val := 0; +incr(current_option); + +@ An element with all zeros always ends the list. +@z + +@x [148] l.2620 - pTeX: +@* Index. +@y +@* For Japanese Font Metric routines. +We need to include some routines for handling kanji characters. + +@<Constants...@>= +max_kanji=7237; { maximam number of 2byte characters } +yoko_id_number=11; { is identifier for YOKO-kumi font} +tate_id_number=9; { is identifier for TATE-kumi font} + +@ @<Glob...@>= +file_format:undefined..vfm_format; {the format of the input file} +kanji_type:array[0..max_kanji] of -1..256; {the type of every kanji char } +kanji_type_index:0..max_kanji; { index into above } +nt:integer; {number of entries in character type table} +glue:array[0..768] of fix_word; {the distinct glue amounts} +ng:integer; {number of 3-word entries in glue table} + +@ @<Set init...@>= +file_format:=undefined; +for kanji_type_index:=0 to max_kanji do kanji_type[kanji_type_index]:=-1; +ng:=0; + +@ @<If is jfm or vfm then print error@>= +if (file_format>tfm_format) then + err_print('This is an illegal command for kanji format files.') +else if (file_format=undefined) then file_format:=tfm_format + +@ @<If is tfm then print error@>= +if (file_format=tfm_format) then + err_print('You can use this command only for kanji format files.') +else if (file_format=undefined) then file_format:=jfm_or_vfm + +@ These are extended propaties for \.{JFM}. + +@<Enter all of the names and ...@>= +load4("T")("Y")("P")("E")(type_code);@/ +load8("G")("L")("U")("E")("K")("E")("R")("N")(glue_kern_code);@/ +load11("C")("H")("A")("R")("S")("I")("N")("T")("Y")("P")("E") + (chars_in_type_code);@/ +load9("D")("I")("R")("E")("C")("T")("I")("O")("N")(dir_code);@/ +load4("G")("L")("U")("E")(glue_code);@/ + +@ @<Enter the parameter names@>= +load10("E")("X")("T")("R")("A")("S")("P")("A")("C")("E")(parameter_code+7);@/ +load12("E")("X")("T")("R")("A")("S")("T")("R")("E")("T")("C")("H") + (parameter_code+8);@/ +load11("E")("X")("T")("R")("A")("S")("H")("R")("I")("N")("K") + (parameter_code+9);@/ + + +@ Here, we declare kanji related routines and package gluekern stuff. +There routines a bit similar reading ligature/kern programs. + +@<Read glue/kern list@>= +begin while level=1 do + begin while cur_char=" " do get_next; + if cur_char="(" then @<Read a glue/kern command@> + else if cur_char=")" then skip_to_end_of_item + else junk_error; + end; +finish_inner_property_list; +end; + +@ @<Read a glue/kern command@>= +begin get_name; +if cur_code=comment_code then skip_to_end_of_item +else begin case cur_code of + label_code:@<Read a glue label step@>; + stop_code:@<Read a stop step@>; + krn_code:@<Read a (glue) kerning step@>; + glue_code:@<Read a glue step@>; + others: + flush_error('This property name doesn''t belong in a GLUEKERN list'); +@.This property name doesn't belong...@> + end; + finish_the_property; + end; +end + +@ When a character is about to be tagged, we use the following +so that an error message is given in case of multiple tags. + +@<Read a glue label step@>= +begin c:=get_byte; +case char_tag[c] of + no_tag: do_nothing; + lig_tag: err_print('This character already appeared in a GLUEKERN LABEL'); + @.This character already...@> + list_tag: err_print('Impossible: a list tag in a kanji format file?'); + ext_tag: err_print('Impossible: an extensible tag in a kanji format file?'); +end; +if nl>255 then + err_print('GLUEKERN with more than 255 commands cannot have further labels') +@.GLUEKERN with more than 255...@> +else begin char_tag[c]:=lig_tag; char_remainder[c]:=nl; + lk_step_ended:=false; + end; +end + +@ @<Read a (glue) kerning step@>= +begin lig_kern[nl].b0:=0; lig_kern[nl].b1:=get_byte;@/ +lig_kern[nl].b2:=kern_flag; kern[nk]:=get_fix; krn_ptr:=0; +while kern[krn_ptr]<>kern[nk] do incr(krn_ptr); +if krn_ptr=nk then + begin if nk<256 then incr(nk) + else begin err_print('At most 256 different kerns are allowed'); +@.At most 256 different kerns...@> + krn_ptr:=255; + end; + end; +lig_kern[nl].b3:=krn_ptr; +if nl=511 then + err_print('GLUEKERN table should never exceed 511 LIG/KRN commands') +@.GLUEKERN table should never...@> +else incr(nl); +lk_step_ended:=true; +end + +@ @<Read a glue step@>= +begin lig_kern[nl].b0:=0; lig_kern[nl].b1:=get_byte; lig_kern[nl].b2:=0;@/ +glue[3*ng+0]:=get_fix; glue[3*ng+1]:=get_fix; glue[3*ng+2]:=get_fix; +krn_ptr:=0; +while (glue[3*krn_ptr+0]<>glue[3*ng+0])or + (glue[3*krn_ptr+1]<>glue[3*ng+1])or + (glue[3*krn_ptr+2]<>glue[3*ng+2]) do incr(krn_ptr); +if krn_ptr=ng then + begin if ng<256 then incr(ng) + else begin err_print('At most 256 different glues are allowed'); + krn_ptr:=255; + end; + end; +lig_kern[nl].b3:=krn_ptr; +if nl=511 then + err_print('GLUEKERN table should never exceed 511 GLUE/KRN commands') +@.GLUEKERN table should never...@> +else incr(nl); +lk_step_ended:=true; +end + +@ The |TYPE| command like |CHARACTER| command, but |TYPE| only use +|CHARWD|, |CHARHT|, |CHARDP| and |CHARIT| + +@<Read Kanji character type list@>= +begin c:=get_byte; {read the character type that is begin specified} +if verbose then @<Print |c| in octal notation@>; +while level=1 do + begin while cur_char=" " do get_next; + if cur_char="(" then @<Read a kanji property@> + else if cur_char=")" then skip_to_end_of_item + else junk_error; + end; +if char_wd[c]=0 then char_wd[c]:=sort_in(width,0); {legitimatize c} +finish_inner_property_list; +end; + +@ @<Read a kanji property@>= +begin get_name; +if cur_code=comment_code then skip_to_end_of_item +else if (cur_code<char_wd_code)and(cur_code>char_ic_code) then + flush_error('This property name doesn''t belong in a TYPE list') +else begin case cur_code of + char_wd_code: char_wd[c]:=sort_in(width,get_fix); + char_ht_code: char_ht[c]:=sort_in(height,get_fix); + char_dp_code: char_dp[c]:=sort_in(depth,get_fix); + char_ic_code: char_ic[c]:=sort_in(italic,get_fix); + end;@/ + finish_the_property; + end; +end + +@ Next codes used to get KANJI codes from \.{JPL} file. + +@<Read Kanji characters list in this type@>= +begin type_num:=get_byte; +if type_num=0 then + skip_error('You cannot list the chars in type 0. It is the default type') +else begin repeat jis_code:=get_kanji; + if jis_code<0 then + err_print('Illegal characters. I was expecting a jis code or character') + else if jis_code=0 then { 0 signals |end_of_list| } + do_nothing + else if kanji_type[jis_to_index(jis_code)]>=0 then + err_print('jis code ', jis_code:1, ' is already in type ', + kanji_type[jis_to_index(jis_code)]) + else + kanji_type[jis_to_index(jis_code)]:=type_num; + until jis_code=0; + skip_to_paren; + end +end + +@ Next codes read and check direction. We can not decide |file_format| of +metric file whether for yoko-kumi or tate-kumi, until have scan |DIRECTION| +property (|dir_code| command). + +@<Read direction@>= +begin while cur_char=" " do get_next; +if cur_char="T" then + begin if verbose then err_print('This is tatekumi format'); + file_format:=vfm_format; + end +else if cur_char="Y" then + begin if verbose then err_print('This is yokokumi format'); + file_format:=jfm_format; + end +else err_print('The dir value should be "TATE" or "YOKO"'); +skip_to_paren; +end + +@ Next codes used to write |kanji_type| to \.{JFM}. + +@<Output the kanji character type info@>= +begin out_size(0); out_size(0); { the default } +for kanji_type_index:=0 to max_kanji do + begin if kanji_type[kanji_type_index]>0 then + begin out_size(index_to_jis(kanji_type_index)); + out_size(kanji_type[kanji_type_index]); + if verbose then begin + print('char index = ', kanji_type_index); + print(' (jis '); + print_jis_hex(index_to_jis(kanji_type_index)); + print(') is type '); + print_octal(kanji_type[kanji_type_index]); + write_ln(''); + end; + end; + end; +end; + +@ We also need to define some routines which handling 2bytes characters. +These routine is called from only |read_chars_in_type| command. + +The kanji jis code is taken from the |char_ext| and |char_code| values +set by the user. The index into the |kanji_type| array is based on the +kuten codes, with all unused codes removed and beginning at 0, not 0101. +The |jis_to_index| is called from |chars_in_type| command. + +@<Declare kanji scanning routines@>= +function get_next_raw:byte; {get next rawdata in buffer} +begin while loc=limit do fill_buffer; +incr(loc); get_next_raw:=buffer[loc]; +if multistrlen(buffer,loc+2,loc)=2 then cur_char:=" " +else cur_char:=xord[buffer[loc]]; +end; +@# +function todig(@!ch:char):byte; {convert character to number} +begin if (ch>="A")and(ch<="F") then todig:=ch-"A"+10 +else if (ch>="0")and(ch<="9") then todig:=ch-"0" +else skip_error('This expression is out of JIS-code encoding.'); +end; +@# +procedure print_jis_hex(jis_code:integer); {prints jiscode as four digits} +var dig:array[0..4] of byte; {holds jis hex codes} +i:byte; {index of array} +begin dig[0]:=Hi(jis_code) div 16; dig[1]:=Hi(jis_code) mod 16; +dig[2]:=Lo(jis_code) div 16; dig[3]:=Lo(jis_code) mod 16; +for i:=0 to 3 do + if dig[i]<10 then print(dig[i]) else + case dig[i] of + 10: print('A'); 11: print('B'); 12: print('C'); + 13: print('D'); 14: print('E'); 15: print('F'); + end; +end; +@# +function valid_jis_code(jis:integer):boolean; +var @!first_byte,@!second_byte:integer; { jis code bytes } +begin valid_jis_code:=true; +first_byte:=jis div @'400; second_byte:=jis mod @'400; +if (first_byte<@"21) + or((first_byte>@"28)and(first_byte<@"30)) + or(first_byte>@"74) then valid_jis_code:=false; +if (second_byte<@"21)or(second_byte>@"7E) then valid_jis_code:=false; +end; +@# +function jis_to_index(jis:integer):integer; +var @!first_byte,@!second_byte:integer; { jis code bytes } +begin +first_byte:=jis div @'400 -@"21; +second_byte:=jis mod @'400 -@"21; +if first_byte<8 then + jis_to_index:=first_byte*94+second_byte +else { next |first_byte| start 16 } + jis_to_index:=(first_byte-7)*94+second_byte; +end; +@# +function index_to_jis(ix:integer):integer; +begin if ix<=8*94-1 then + index_to_jis:=(ix div 94 +@"21)*@'400+(ix mod 94 +@"21) +else + index_to_jis:=((ix+7*94) div 94 +@"21)*@'400+((ix+7*94) mod 94 +@"21) +end; +@# +function get_kanji:integer; {get kanji character code} +var @!ch:byte; +@!cx,@!jis_code:integer; {sixteen bits kanji character code} +begin repeat ch:=get_next_raw; {|ch| is rawdata in buffer} +until ch<>' '; {skip the blanks before the kanji code} +if ch=')' then + begin decr(loc); jis_code:=0; + end +else if (ch='J')or(ch='j') then + begin repeat ch:=get_next_raw; until ch<>' '; + cx:=todig(xord[ch])*@"1000; + incr(loc); ch:=xord[buffer[loc]]; cx:=cx+todig(ch)*@"100; + incr(loc); ch:=xord[buffer[loc]]; cx:=cx+todig(ch)*@"10; + incr(loc); ch:=xord[buffer[loc]]; cx:=cx+todig(ch); + jis_code:=toDVI(fromJIS(cx)); cur_char:=ch; + if not valid_jis_code(jis_code) then + err_print('jis code ', jis_code:1, ' is invalid'); + end +else if multistrlen(buffer, loc+2, loc)=2 then + begin jis_code:=toDVI(fromBUFF(buffer, loc+2, loc)); + incr(loc); cur_char:=" "; + if not valid_jis_code(jis_code) then + err_print('jis code ', jis_code:1, ' is invalid'); + end +else jis_code:=-1; +get_kanji:=jis_code; +end; + +@ @<Set process kanji code@>= + if (not set_enc_string(optarg,optarg)) then + print_ln('Bad kanjicode encoding "', stringcast(optarg), '".'); + +@* Index. +@z diff --git a/Build/source/texk/web2c/ptexdir/ptex-base.ch b/Build/source/texk/web2c/ptexdir/ptex-base.ch new file mode 100644 index 00000000000..a7c4a2da015 --- /dev/null +++ b/Build/source/texk/web2c/ptexdir/ptex-base.ch @@ -0,0 +1,7630 @@ +% This is a change file for pTeX 3.1.11 +% By Sadayuki Tanaka and ASCII MEDIA WORKS. +% +% Thanks for : +% Ryoichi Kurasawa (us009185@interramp.com), +% Hisato Hamano, +% Hiroto Kagotani (kagotani@in.it.okayama-u.ac.jp), +% Takashi Kakiuchi (kakiuchi@sy6.isl.mei.co.jp), +% Yoichi Kawabata (kawabata@canon.co.jp), +% Makoto Kobayashi (makoto@lloem.fujidenki.co.jp), +% Yoshihiro Aoki (aoki@tokyo-shoseki-ptg.co.jp), +% Akira Kakuto (kakuto@fsci.fuk.kindai.ac.jp). +% Koich Inoue (inoue@ma.ns.musashi-tech.ac.jp). +% +% (??/??/87) RKS jTeX 2.9 -- j1.0 +% (??/??/89) RKS jTeX 2.93 -- j1.3 +% (12/ 9/89) H_2 pTeX 2.93 j1.3 p1.0.1 +% (12/??/89) RKS jTeX 2.95 -- j1.5 +% (12/??/89) RKS jTeX 2.99 -- j1.5 +% (02/02/90) RKS jTeX 2.99 -- j1.6 +% (04/16/90) H_2 pTeX 2.99 j1.6 p1.0.3 +% (09/14/90) H_2 pTeX 2.99 j1.6 p1.0.9 -- pre-release +% (10/29/90) H_2 Bug fix (p1.0.9a) +% (01/21/92) H_2 jTeX 2.99 - j1.7 +% (01/21/92) H_2 pTeX 2.99 j1.7 p1.0.9F +% (03/09/92) H_2 pTeX 2.99 j1.7 p1.0.9G jflag BUG +% (03/20/95) KN pTeX p2.0 (based on 3.1415) +% (09/08/95) KN pTeX p2.1 +% (09/20/95) KN pTeX p2.1.1 +% (11/21/95) KN pTeX p2.1.4 +% (08/27/97) KN pTeX p2.1.5 (based on 3.14159) +% (02/26/98) KN pTeX p2.1.6 +% (03/19/98) KN pTeX p2.1.7 +% (03/26/98) KN pTeX p2.1.8 (Web2c 7.2) +% (02/21/2000) KN pTeX p2.1.9 (Web2c 7.3.1) +% (11/13/2000) KN pTeX p2.1.10 +% (05/22/2001) KN pTeX p2.1.11 +% (03/10/2001) KN pTeX p3.0 (modified BSD licence) +% (09/02/2004) ST pTeX p3.1.4 +% (11/29/2004) KN pTeX p3.1.5 +% (12/13/2004) KN pTeX p3.1.8 +% (10/17/2005) ST pTeX p3.1.9 +% (07/18/2006) ST pTeX p3.1.10 +% (08/17/2009) ST pTeX p3.1.11 +% +@x [1.2] l.195 - pTeX: +@d TeX_banner_k=='This is TeXk, Version 3.1415926' {printed when \TeX\ starts} +@d TeX_banner=='This is TeX, Version 3.1415926' {printed when \TeX\ starts} +@y +@d TeX_banner_k=='This is pTeXk, Version 3.1415926-p3.1.11' {printed when p\TeX\ starts} +@d TeX_banner=='This is pTeX, Version 3.1415926-p3.1.11' {printed when p\TeX\ starts} +@z + +@x [2.??] l.586 - pTeX: +@!ASCII_code=0..255; {eight-bit numbers} +@y +@!ASCII_code=0..255; {eight-bit numbers} +@!KANJI_code=0..65535; {sixteen-bit numbers} +@z + +@x l.632 - pTeX +mubyte_read: array [ASCII_code] of pointer; + { non zero iff character begins the multi byte code } +mubyte_write: array [ASCII_code] of str_number; + { non zero iff character expands to multi bytes in log and write files } +mubyte_cswrite: array [0..127] of pointer; + { non null iff cs mod 128 expands to multi bytes in log and write files } +mubyte_skip: integer; { the number of bytes to skip in |buffer| } +mubyte_keep: integer; { the number of chars we need to keep unchanged } +mubyte_skeep: integer; { saved |mubyte_keep| } +mubyte_prefix: integer; { the type of mubyte prefix } +mubyte_tablein: boolean; { the input side of table will be updated } +mubyte_tableout: boolean; { the output side of table will be updated } +mubyte_relax: boolean; { the relax prefix is used } +mubyte_start: boolean; { we are making the token at the start of the line } +mubyte_sstart: boolean; { saved |mubyte_start| } +mubyte_token: pointer; { the token returned by |read_buffer| } +mubyte_stoken: pointer; { saved first token in mubyte primitive } +mubyte_sout: integer; { saved value of |mubyte_out| } +mubyte_slog: integer; { saved value of |mubyte_log| } +spec_sout: integer; { saved value of |spec_out| } +no_convert: boolean; { conversion supressed by noconvert primitive } +active_noconvert: boolean; { true if noconvert primitive is active } +write_noexpanding: boolean; { true only if we need not write expansion } +cs_converting: boolean; { true only if we need csname converting } +special_printing: boolean; { true only if we need converting in special } +message_printing: boolean; { true if message or errmessage prints to string } +@y +@z + +@x l.803 - pTeX +{Initialize enc\TeX\ data.} +for i:=0 to 255 do mubyte_read[i]:=null; +for i:=0 to 255 do mubyte_write[i]:=0; +for i:=0 to 128 do mubyte_cswrite[i]:=null; +mubyte_keep := 0; mubyte_start := false; +write_noexpanding := false; cs_converting := false; +special_printing := false; message_printing := false; +no_convert := false; active_noconvert := false; +@y +@z + + +@x [4.??] l.870 - pTeX: +@!eight_bits=0..255; {unsigned one-byte quantity} +@y +@!eight_bits=0..255; {unsigned one-byte quantity} +@!sixteen_bits=0..65535; {unsigned two-bytes quantity} +@z + +@x [3.??] l.891 - pTeX: +@ All of the file opening functions are defined in C. +@y +@ All of the file opening functions are defined in C. + +@ Kanji code handling. +@z + +@x [4.47] l.1325 - pTeX: +@!init function get_strings_started:boolean; {initializes the string pool, + but returns |false| if something goes wrong} +label done,exit; +var k,@!l:0..255; {small indices or counters} +@y +@!init function get_strings_started:boolean; {initializes the string pool, + but returns |false| if something goes wrong} +label done,exit; +var k,@!l:KANJI_code; {small indices or counters} +@z + +@x [4.49] l.1384 - pTeX: +@<Character |k| cannot be printed@>= + (k<" ")or(k>"~") +@y +@<Character |k| cannot be printed@>= + not (ismultiprn(k) or xprn[k]) +@z + +@x [5.54] l.1514 - pTeX: Global variables +@!trick_buf:array[0..ssup_error_line] of ASCII_code; {circular buffer for + pseudoprinting} +@y +@!trick_buf:array[0..ssup_error_line] of ASCII_code; {circular buffer for + pseudoprinting} +@!trick_buf2:array[0..ssup_error_line] of 0..2; {pTeX: buffer for KANJI} +@!kcode_pos: 0..2; {pTeX: denotes whether first byte or second byte of KANJI} +@z + +@x [5.55] l.1519 - pTeX: Initialize the kcode_pos +@ @<Initialize the output routines@>= +selector:=term_only; tally:=0; term_offset:=0; file_offset:=0; +@y +@ @<Initialize the output routines@>= +selector:=term_only; tally:=0; term_offset:=0; file_offset:=0; +kcode_pos:=0; +@z + +@x [5.57] l.1538 - pTeX: kcode_pos +procedure print_ln; {prints an end-of-line} +begin case selector of +term_and_log: begin wterm_cr; wlog_cr; + term_offset:=0; file_offset:=0; + end; +log_only: begin wlog_cr; file_offset:=0; + end; +term_only: begin wterm_cr; term_offset:=0; + end; +no_print,pseudo,new_string: do_nothing; +othercases write_ln(write_file[selector]) +endcases;@/ +@y +procedure print_ln; {prints an end-of-line} +begin case selector of +term_and_log: begin + if kcode_pos=1 then begin wterm(' '); wlog(' '); end; + wterm_cr; wlog_cr; term_offset:=0; file_offset:=0; + end; +log_only: begin if kcode_pos=1 then wlog(' '); + wlog_cr; file_offset:=0; + end; +term_only: begin if kcode_pos=1 then wterm(' '); + wterm_cr; term_offset:=0; + end; +no_print,pseudo,new_string: do_nothing; +othercases write_ln(write_file[selector]) +endcases;@/ +kcode_pos:=0; +@z + +@x [5.58] l.1557 - pTeX: kcode_pos, trick_buf2 +procedure print_char(@!s:ASCII_code); {prints a single character} +label exit; +begin if @<Character |s| is the current new-line character@> then + if selector<pseudo then + begin print_ln; return; + end; +case selector of +term_and_log: begin wterm(xchr[s]); wlog(xchr[s]); + incr(term_offset); incr(file_offset); + if term_offset=max_print_line then + begin wterm_cr; term_offset:=0; + end; + if file_offset=max_print_line then + begin wlog_cr; file_offset:=0; + end; + end; +log_only: begin wlog(xchr[s]); incr(file_offset); + if file_offset=max_print_line then print_ln; + end; +term_only: begin wterm(xchr[s]); incr(term_offset); + if term_offset=max_print_line then print_ln; + end; +no_print: do_nothing; +pseudo: if tally<trick_count then trick_buf[tally mod error_line]:=s; +@y +procedure print_char(@!s:ASCII_code); {prints a single character} +label exit; {label is not used but nonetheless kept (for other changes?)} +begin if @<Character |s| is the current new-line character@> then + if selector<pseudo then + begin print_ln; return; + end; +if kcode_pos=1 then kcode_pos:=2 +else if iskanji1(xchr[s]) then + begin kcode_pos:=1; + if (selector=term_and_log)or(selector=log_only) then + if file_offset>=max_print_line-1 then + begin wlog_cr; file_offset:=0; + end; + if (selector=term_and_log)or(selector=term_only) then + if term_offset>=max_print_line-1 then + begin wterm_cr; term_offset:=0; + end; + end +else kcode_pos:=0; +case selector of +term_and_log: begin wterm(xchr[s]); incr(term_offset); + if term_offset=max_print_line then + begin wterm_cr; term_offset:=0; + end; + wlog(xchr[s]); incr(file_offset); + if file_offset=max_print_line then + begin wlog_cr; file_offset:=0; + end; + end; +log_only: begin wlog(xchr[s]); incr(file_offset); + if file_offset=max_print_line then print_ln; + end; +term_only: begin wterm(xchr[s]); incr(term_offset); + if term_offset=max_print_line then print_ln; + end; +no_print: do_nothing; +pseudo: if tally<trick_count then + begin trick_buf[tally mod error_line]:=s; + trick_buf2[tally mod error_line]:=kcode_pos; + end; +@z + +@x l.1603 - pTeX +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) and (not special_printing) + and (not message_printing) then + begin print_char(s); return; {internal strings are not expanded} + end; + if (@<Character |s| is the current new-line character@>) then + if selector<pseudo then + begin print_ln; no_convert := false; return; + end + else if message_printing then + begin print_char(s); no_convert := false; return; + end; + if (mubyte_log>0) and (not no_convert) and (mubyte_write[s]>0) then + s := mubyte_write[s] + else if xprn[s] or special_printing then + begin print_char(s); no_convert := false; return; end; + no_convert := false; + nl:=new_line_char; new_line_char:=-1; + {temporarily disable new-line character} + j:=str_start[s]; + while j<str_start[s+1] do + begin print_char(so(str_pool[j])); incr(j); + end; + new_line_char:=nl; return; + end; +j:=str_start[s]; +while j<str_start[s+1] do + begin print_char(so(str_pool[j])); incr(j); + end; +exit:end; +@y +procedure print(@!s:integer); {prints string |s|} +label exit; +var j:pool_pointer; {current character code position} +@!nl:integer; {new-line character to restore} +begin if s>=str_ptr then s:="???" {this can't happen} +@.???@> +else if s<256 then + if s<0 then s:="???" {can't happen} + else begin if selector>pseudo then + begin print_char(s); return; {internal strings are not expanded} + end; + if (@<Character |s| is the current new-line character@>) then + if selector<pseudo then + begin print_ln; return; + end; + nl:=new_line_char; new_line_char:=-1; + {temporarily disable new-line character} + j:=str_start[s]; + while j<str_start[s+1] do + begin print_char(so(str_pool[j])); incr(j); + end; + new_line_char:=nl; return; + end; +j:=str_start[s]; +while j<str_start[s+1] do + begin print_char(so(str_pool[j])); incr(j); + end; +exit:end; +@z + +@x [5.61] l.1656 - pTeX: +@<Initialize the output...@>= +if src_specials_p or file_line_error_style_p or parse_first_line_p then + wterm(banner_k) +else + wterm(banner); +@y +@<Initialize the output...@>= +if src_specials_p or file_line_error_style_p or parse_first_line_p then + wterm(banner_k) +else + wterm(banner); + wterm(' ('); + wterm(stringcast(get_enc_string)); + wterm(')'); +@z + +@x l.1820 - pTeX +k:=first; while k < last do begin print_buffer(k) end; +@y +if last<>first then for k:=first to last-1 do print(buffer[k]); +@z + +@x [8.112] l.2588 - pTeX: +@d ho(#)==# {to take a sixteen-bit item from a halfword} +@y +@d ho(#)==# {to take a sixteen-bit item from a halfword} +@d KANJI(#)==# {pTeX: to output an KANJI code into a halfword} +@d tokanji(#)==# {pTeX: to take an KANJI code into a halfword} +@d tonum(#)==# {pTeX: to put an KANJI code into a halfword} +@z + +@x [10.135] l.3008 - pTeX: box_dir, space_ptr, xspace_ptr +@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 box_dir(#) == subtype(#) {direction mode of a box} +@d dir_default == qi(0) {direction of the box, default Left to Right} +@d dir_dtou == qi(1) {direction of the box, Bottom to Top} +@d dir_tate == qi(3) {direction of the box, Top to Bottom} +@d dir_yoko == qi(4) {direction of the box, equal default} +@d any_dir == dir_yoko,dir_tate,dir_dtou +@# +@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 space_offset = 7 {position of |glue_set| in a box node} +@d space_ptr(#) == link(#+space_offset) +@d xspace_ptr(#) == info(#+space_offset) +@z + +@x [10.136] l.3037 - pTeX: space_ptr, xspace_ptr +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)); +@y +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)); +space_ptr(p):=zero_glue; xspace_ptr(p):=zero_glue; +add_glue_ref(zero_glue); add_glue_ref(zero_glue); +@z + +@x [10.137] l.3045 - pTeX: direction change node +@d vlist_node=1 {|type| of vlist nodes} +@y +@d vlist_node=1 {|type| of vlist nodes} + +@ A |dir_node| stands for direction change. + +@d dir_node=2 {|type| of dir nodes} + +@p function new_dir_node(b:pointer; dir:eight_bits):pointer; +var p:pointer; {the new node} +begin if type(b)>vlist_node then confusion("new_dir_node:not box"); +p:=new_null_box; type(p):=dir_node; box_dir(p):=dir; +case box_dir(b) of + dir_yoko: @<Yoko to other direction@>; + dir_tate: @<Tate to other direction@>; + dir_dtou: @<DtoU to other direction@>; + othercases confusion("new_dir_node:illegal dir"); +endcases; +link(b):=null; list_ptr(p):=b; +new_dir_node:=p; +end; + +@ @<Yoko to other direction@>= + case dir of + dir_tate: begin width(p):=height(b)+depth(b); + depth(p):=width(b)/2; height(p):=width(b)-depth(p); + end; + dir_dtou: begin width(p):=height(b)+depth(b); + depth(p):=0; height(p):=width(b); + end; + othercases confusion("new_dir_node:y->?"); + endcases + +@ @<Tate to other direction@>= + case dir of + dir_yoko: begin width(p):=height(b)+depth(b); + depth(p):=0; height(p):=width(b); + end; + dir_dtou: begin width(p):=width(b); + depth(p):=height(b); height(p):=depth(b); + end; + othercases confusion("new_dir_node:t->?"); + endcases + +@ @<DtoU to other direction@>= + case dir of + dir_yoko: begin width(p):=height(b)+depth(b); + depth(p):=0; height(p):=width(b); + end; + dir_tate: begin width(p):=width(b); + depth(p):=height(b); height(p):=depth(b); + end; + othercases confusion("new_dir_node:d->?"); + endcases +@z + +@x [10.138] l.3054 - pTeX: renumber rule_node +@d rule_node=2 {|type| of rule nodes} +@y +@d rule_node=3 {|type| of rule nodes} +@z + +@x [10.140] l.3083 - pTeX: renumber ins_node, add ins_dir field +@d ins_node=3 {|type| of insertion nodes} +@d ins_node_size=5 {number of words to allocate for an insertion} +@d float_cost(#)==mem[#+1].int {the |floating_penalty| to be used} +@d ins_ptr(#)==info(#+4) {the vertical list to be inserted} +@d split_top_ptr(#)==link(#+4) {the |split_top_skip| to be used} +@y +@d ins_node=4 {|type| of insertion nodes} +@d ins_node_size=6 {number of words to allocate for an insertion} +@d float_cost(#)==mem[#+1].int {the |floating_penalty| to be used} +@d ins_ptr(#)==info(#+4) {the vertical list to be inserted} +@d split_top_ptr(#)==link(#+4) {the |split_top_skip| to be used} +@d ins_dir(#)==subtype(#+5) {direction of |ins_node|} +@z + +@x [10.141] l.3089 - pTeX: disp_node +@ A |mark_node| has a |mark_ptr| field that points to the reference count +@y +@ A |disp_node| has a |disp_dimen| field that points to the displacement +distance of the baselineshift between Latin characters and Kanji chatacters. + +@d disp_node=5 {|type| of a displace node} +@d disp_dimen(#)==mem[#+1].sc + +@ A |mark_node| has a |mark_ptr| field that points to the reference count +@z + +@x [10.140] l.3095 - pTeX: renumber nodes +@d mark_node=4 {|type| of a mark node} +@y +@d mark_node=6 {|type| of a mark node} +@z + +@x [10.141] l.3105 - pTeX: renumber nodes +@d adjust_node=5 {|type| of an adjust node} +@y +@d adjust_node=7 {|type| of an adjust node} +@z + +@x [10.142] l.3122 - pTeX: renumber nodes +@d ligature_node=6 {|type| of a ligature node} +@y +@d ligature_node=8 {|type| of a ligature node} +@z + +@x [10.145] l.3163 - pTeX: renumber nodes +@d disc_node=7 {|type| of a discretionary node} +@y +@d disc_node=9 {|type| of a discretionary node} +@z + +@x [10.146] l.3191 - pTeX: renumber nodes +@d whatsit_node=8 {|type| of special extension nodes} +@y +@d whatsit_node=10 {|type| of special extension nodes} +@z + +@x [10.147] l.3198 - pTeX: renumber nodes +@d math_node=9 {|type| of a math node} +@y +@d math_node=11 {|type| of a math node} +@z + +@x [10.150] l.3244 - pTeX: renumber nodes +@d glue_node=10 {|type| of node that points to a glue specification} +@y +@d glue_node=12 {|type| of node that points to a glue specification} +@z + +@x [10.155] l.3342 - pTeX: renumber nodes +@d kern_node=11 {|type| of a kern node} +@d explicit=1 {|subtype| of kern nodes from \.{\\kern} and \.{\\/}} +@d acc_kern=2 {|subtype| of kern nodes from accents} +@y +@d kern_node=13 {|type| of a kern node} +@d explicit=1 {|subtype| of kern nodes from \.{\\kern}} +@d acc_kern=2 {|subtype| of kern nodes from accents} +@d ita_kern=3 {|subtype| of kern nodes from \.{\\/}} +@z + +@x [10.157] l.3363 - pTeX: renumber nodes +@d penalty_node=12 {|type| of a penalty node} +@y +@d penalty_node=14 {|type| of a penalty node} +@d widow_pena=1 {|subtype| of penalty nodes from \.{\\jchrwidowpenalty}} +@d kinsoku_pena=2 {|subtype| of penalty nodes from kinsoku} +@z + +@x [10.159] l.3392 - pTeX: renumber nodes +@d unset_node=13 {|type| for an unset node} +@y +@d unset_node=15 {|type| for an unset node} +@z + +@x [10.160] l.3397 - pTeX: renumber nodes +@ 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=16|; and a number +of larger type codes will also be defined, for use in math mode only. +@z + +@x [12.174] l.3662 - pTeX: print KANJI + print_ASCII(qo(character(p))); +@y + if font_dir[font(p)]<>dir_default then + begin p:=link(p); print_kanji(info(p)); + end + else print_ASCII(qo(character(p))); +@z + +@x [12.175] l.3672 - pTeX: Print a short indication of dir_nodes. +hlist_node,vlist_node,ins_node,whatsit_node,mark_node,adjust_node, + unset_node: print("[]"); +@y +hlist_node,vlist_node,dir_node,ins_node,whatsit_node, + mark_node,adjust_node,unset_node: print("[]"); +@z + +@x [12.176] l.3698 - pTeX: print KANJI. + print_char(" "); print_ASCII(qo(character(p))); +@y + print_char(" "); + if font_dir[font(p)]<>dir_default then + begin p:=link(p); print_kanji(info(p)); + end + else print_ASCII(qo(character(p))); +@z + +@x [12.183] l.3815 - pTeX: display char_node and disp_node. +if is_char_node(p) then print_font_and_char(p) +else case type(p) of + hlist_node,vlist_node,unset_node: @<Display box |p|@>; + rule_node: @<Display rule |p|@>; + ins_node: @<Display insertion |p|@>; + whatsit_node: @<Display the whatsit node |p|@>; +@y +if is_char_node(p) then + begin print_font_and_char(p); + if font_dir[font(p)]<>dir_default then p:=link(p) + end +else case type(p) of + hlist_node,vlist_node,dir_node,unset_node: @<Display box |p|@>; + rule_node: @<Display rule |p|@>; + ins_node: @<Display insertion |p|@>; + whatsit_node: @<Display the whatsit node |p|@>; + disp_node: begin print_esc("displace "); print_scaled(disp_dimen(p)); + end; +@z + +@x [12.184] l.3833 - pTeX: display dir_node. +@ @<Display box |p|@>= +begin if type(p)=hlist_node then print_esc("h") +else if type(p)=vlist_node then print_esc("v") +else print_esc("unset"); +@y +@ @<Display box |p|@>= +begin case type(p) of + hlist_node: print_esc("h"); + vlist_node: print_esc("v"); + dir_node: print_esc("dir"); + othercases print_esc("unset") + endcases@/; +@z +@x [12.184] l.3842 - pTeX: display dir_node. + if shift_amount(p)<>0 then + begin print(", shifted "); print_scaled(shift_amount(p)); + end; +@y + if shift_amount(p)<>0 then + begin print(", shifted "); print_scaled(shift_amount(p)); + end; + if box_dir(p)<>dir_default then + begin print(", "); print_direction(box_dir(p)); + end; +@z + +@x [12.188] l.3896 - pTeX: Display insertion and ins_dir. +@ @<Display insertion |p|@>= +begin print_esc("insert"); print_int(qo(subtype(p))); +print(", natural size "); print_scaled(height(p)); +@y +@ @<Display insertion |p|@>= +begin print_esc("insert"); print_int(qo(subtype(p))); +print_dir(ins_dir(p)); +print(", natural size "); print_scaled(height(p)); +@z + +@x [12.194] l.3961 - pTeX: Display penalty usage +@ @<Display penalty |p|@>= +begin print_esc("penalty "); print_int(penalty(p)); +end +@y +@ @<Display penalty |p|@>= +begin print_esc("penalty "); print_int(penalty(p)); +if subtype(p)=widow_pena then print("(for \jchrwidowpenalty)") +else if subtype(p)=kinsoku_pena then print("(for kinsoku)"); +end +@z + +@x [13.202] l.4043 - pTeX: dir_node, disp_node + hlist_node,vlist_node,unset_node: begin flush_node_list(list_ptr(p)); + free_node(p,box_node_size); goto done; + end; +@y + hlist_node,vlist_node,dir_node,unset_node: + begin flush_node_list(list_ptr(p)); + fast_delete_glue_ref(space_ptr(p)); + fast_delete_glue_ref(xspace_ptr(p)); + free_node(p,box_node_size); goto done; + end; +@z + +@x [13.202] l.4056 - pTeX: + kern_node,math_node,penalty_node: do_nothing; +@y + kern_node,disp_node,math_node,penalty_node: do_nothing; +@z + +@x [14.206] l.4121 - pTeX: space_ptr, xspace_ptr, dir_node, disp_node +@ @<Case statement to copy...@>= +case type(p) of +hlist_node,vlist_node,unset_node: begin r:=get_node(box_node_size); + mem[r+6]:=mem[p+6]; mem[r+5]:=mem[p+5]; {copy the last two words} + list_ptr(r):=copy_node_list(list_ptr(p)); {this affects |mem[r+5]|} + words:=5; + end; +rule_node: begin r:=get_node(rule_node_size); words:=rule_node_size; + end; +ins_node: begin r:=get_node(ins_node_size); mem[r+4]:=mem[p+4]; + add_glue_ref(split_top_ptr(p)); + ins_ptr(r):=copy_node_list(ins_ptr(p)); {this affects |mem[r+4]|} + words:=ins_node_size-1; + end; +@y +@ @<Case statement to copy...@>= +case type(p) of +hlist_node,vlist_node,dir_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} + add_glue_ref(space_ptr(r)); add_glue_ref(xspace_ptr(r)); + list_ptr(r):=copy_node_list(list_ptr(p)); {this affects |mem[r+5]|} + words:=5; + end; +rule_node: begin r:=get_node(rule_node_size); words:=rule_node_size; + end; +ins_node: begin r:=get_node(ins_node_size); + mem[r+5]:=mem[p+5]; mem[r+4]:=mem[p+4]; + add_glue_ref(split_top_ptr(p)); + ins_ptr(r):=copy_node_list(ins_ptr(p)); {this affects |mem[r+4]|} + words:=ins_node_size-2; + end; +@z + +@x [14.206] l.4140 - pTeX: disp_node +kern_node,math_node,penalty_node: begin r:=get_node(small_node_size); + words:=small_node_size; + end; +@y +kern_node,disp_node,math_node,penalty_node: + begin r:=get_node(small_node_size); words:=small_node_size; + end; +@z + +@x [15.207] l.4201 - pTeX: Add kanji, kana, other_kchar category codes. +@d max_char_code=15 {largest catcode for individual characters} +@y +@d kanji=16 {kanji} +@d kana=17 {hiragana, katakana, alphabet} +@d other_kchar=18 {kanji codes} +@d max_char_code=18 {largest catcode for individual characters} +@z + +@x [15.208] l.4207 - pTeX: Add inhibit_glue, chg_dir. +@d char_num=16 {character specified numerically ( \.{\\char} )} +@d math_char_num=17 {explicit math code ( \.{\\mathchar} )} +@d mark=18 {mark definition ( \.{\\mark} )} +@d xray=19 {peek inside of \TeX\ ( \.{\\show}, \.{\\showbox}, etc.~)} +@d make_box=20 {make a box ( \.{\\box}, \.{\\copy}, \.{\\hbox}, etc.~)} +@d hmove=21 {horizontal motion ( \.{\\moveleft}, \.{\\moveright} )} +@d vmove=22 {vertical motion ( \.{\\raise}, \.{\\lower} )} +@d un_hbox=23 {unglue a box ( \.{\\unhbox}, \.{\\unhcopy} )} +@d un_vbox=24 {unglue a box ( \.{\\unvbox}, \.{\\unvcopy} )} +@d remove_item=25 {nullify last item ( \.{\\unpenalty}, + \.{\\unkern}, \.{\\unskip} )} +@d hskip=26 {horizontal glue ( \.{\\hskip}, \.{\\hfil}, etc.~)} +@d vskip=27 {vertical glue ( \.{\\vskip}, \.{\\vfil}, etc.~)} +@d mskip=28 {math glue ( \.{\\mskip} )} +@d kern=29 {fixed space ( \.{\\kern})} +@d mkern=30 {math kern ( \.{\\mkern} )} +@d leader_ship=31 {use a box ( \.{\\shipout}, \.{\\leaders}, etc.~)} +@d halign=32 {horizontal table alignment ( \.{\\halign} )} +@d valign=33 {vertical table alignment ( \.{\\valign} )} +@d no_align=34 {temporary escape from alignment ( \.{\\noalign} )} +@d vrule=35 {vertical rule ( \.{\\vrule} )} +@d hrule=36 {horizontal rule ( \.{\\hrule} )} +@d insert=37 {vlist inserted in box ( \.{\\insert} )} +@d vadjust=38 {vlist inserted in enclosing paragraph ( \.{\\vadjust} )} +@d ignore_spaces=39 {gobble |spacer| tokens ( \.{\\ignorespaces} )} +@d after_assignment=40 {save till assignment is done ( \.{\\afterassignment} )} +@d after_group=41 {save till group is done ( \.{\\aftergroup} )} +@d break_penalty=42 {additional badness ( \.{\\penalty} )} +@d start_par=43 {begin paragraph ( \.{\\indent}, \.{\\noindent} )} +@d ital_corr=44 {italic correction ( \.{\\/} )} +@d accent=45 {attach accent in text ( \.{\\accent} )} +@d math_accent=46 {attach accent in math ( \.{\\mathaccent} )} +@d discretionary=47 {discretionary texts ( \.{\\-}, \.{\\discretionary} )} +@d eq_no=48 {equation number ( \.{\\eqno}, \.{\\leqno} )} +@d left_right=49 {variable delimiter ( \.{\\left}, \.{\\right} )} +@d math_comp=50 {component of formula ( \.{\\mathbin}, etc.~)} +@d limit_switch=51 {diddle limit conventions ( \.{\\displaylimits}, etc.~)} +@d above=52 {generalized fraction ( \.{\\above}, \.{\\atop}, etc.~)} +@d math_style=53 {style specification ( \.{\\displaystyle}, etc.~)} +@d math_choice=54 {choice specification ( \.{\\mathchoice} )} +@d non_script=55 {conditional math glue ( \.{\\nonscript} )} +@d vcenter=56 {vertically center a vbox ( \.{\\vcenter} )} +@d case_shift=57 {force specific case ( \.{\\lowercase}, \.{\\uppercase}~)} +@d message=58 {send to user ( \.{\\message}, \.{\\errmessage} )} +@d extension=59 {extensions to \TeX\ ( \.{\\write}, \.{\\special}, etc.~)} +@d in_stream=60 {files for reading ( \.{\\openin}, \.{\\closein} )} +@d begin_group=61 {begin local grouping ( \.{\\begingroup} )} +@d end_group=62 {end local grouping ( \.{\\endgroup} )} +@d omit=63 {omit alignment template ( \.{\\omit} )} +@d ex_space=64 {explicit space ( \.{\\\ } )} +@d no_boundary=65 {suppress boundary ligatures ( \.{\\noboundary} )} +@d radical=66 {square root and similar signs ( \.{\\radical} )} +@d end_cs_name=67 {end control sequence ( \.{\\endcsname} )} +@d min_internal=68 {the smallest code that can follow \.{\\the}} +@d char_given=68 {character code defined by \.{\\chardef}} +@d math_given=69 {math code defined by \.{\\mathchardef}} +@d last_item=70 {most recent item ( \.{\\lastpenalty}, + \.{\\lastkern}, \.{\\lastskip} )} +@d max_non_prefixed_command=70 {largest command code that can't be \.{\\global}} +@y +@d char_num=max_char_code+1 {character specified numerically ( \.{\\char} )} +@d math_char_num=char_num+1 {explicit math code ( \.{\\mathchar} )} +@d mark=math_char_num+1 {mark definition ( \.{\\mark} )} +@d xray=mark+1 {peek inside of \TeX\ ( \.{\\show}, \.{\\showbox}, etc.~)} +@d make_box=xray+1 {make a box ( \.{\\box}, \.{\\copy}, \.{\\hbox}, etc.~)} +@d hmove=make_box+1 {horizontal motion ( \.{\\moveleft}, \.{\\moveright} )} +@d vmove=hmove+1 {vertical motion ( \.{\\raise}, \.{\\lower} )} +@d un_hbox=vmove+1 {unglue a box ( \.{\\unhbox}, \.{\\unhcopy} )} +@d un_vbox=un_hbox+1 {unglue a box ( \.{\\unvbox}, \.{\\unvcopy} )} +@d remove_item=un_vbox+1 {nullify last item ( \.{\\unpenalty}, + \.{\\unkern}, \.{\\unskip} )} +@d hskip=remove_item+1 {horizontal glue ( \.{\\hskip}, \.{\\hfil}, etc.~)} +@d vskip=hskip+1 {vertical glue ( \.{\\vskip}, \.{\\vfil}, etc.~)} +@d mskip=vskip+1 {math glue ( \.{\\mskip} )} +@d kern=mskip+1 {fixed space ( \.{\\kern})} +@d mkern=kern+1 {math kern ( \.{\\mkern} )} +@d leader_ship=mkern+1 {use a box ( \.{\\shipout}, \.{\\leaders}, etc.~)} +@d halign=leader_ship+1 {horizontal table alignment ( \.{\\halign} )} +@d valign=halign+1 {vertical table alignment ( \.{\\valign} )} +@d no_align=valign+1 {temporary escape from alignment ( \.{\\noalign} )} +@d vrule=no_align+1 {vertical rule ( \.{\\vrule} )} +@d hrule=vrule+1 {horizontal rule ( \.{\\hrule} )} +@d insert=hrule+1 {vlist inserted in box ( \.{\\insert} )} +@d vadjust=insert+1 {vlist inserted in enclosing paragraph ( \.{\\vadjust} )} +@d ignore_spaces=vadjust+1 {gobble |spacer| tokens ( \.{\\ignorespaces} )} +@d after_assignment=ignore_spaces+1 {save till assignment is done ( \.{\\afterassignment} )} +@d after_group=after_assignment+1 {save till group is done ( \.{\\aftergroup} )} +@d break_penalty=after_group+1 {additional badness ( \.{\\penalty} )} +@d start_par=break_penalty+1 {begin paragraph ( \.{\\indent}, \.{\\noindent} )} +@d ital_corr=start_par+1 {italic correction ( \.{\\/} )} +@d accent=ital_corr+1 {attach accent in text ( \.{\\accent} )} +@d math_accent=accent+1 {attach accent in math ( \.{\\mathaccent} )} +@d discretionary=math_accent+1 {discretionary texts ( \.{\\-}, \.{\\discretionary} )} +@d eq_no=discretionary+1 {equation number ( \.{\\eqno}, \.{\\leqno} )} +@d left_right=eq_no+1 {variable delimiter ( \.{\\left}, \.{\\right} )} +@d math_comp=left_right+1 {component of formula ( \.{\\mathbin}, etc.~)} +@d limit_switch=math_comp+1 {diddle limit conventions ( \.{\\displaylimits}, etc.~)} +@d above=limit_switch+1 {generalized fraction ( \.{\\above}, \.{\\atop}, etc.~)} +@d math_style=above+1 {style specification ( \.{\\displaystyle}, etc.~)} +@d math_choice=math_style+1 {choice specification ( \.{\\mathchoice} )} +@d non_script=math_choice+1 {conditional math glue ( \.{\\nonscript} )} +@d vcenter=non_script+1 {vertically center a vbox ( \.{\\vcenter} )} +@d case_shift=vcenter+1 {force specific case ( \.{\\lowercase}, \.{\\uppercase}~)} +@d message=case_shift+1 {send to user ( \.{\\message}, \.{\\errmessage} )} +@d extension=message+1 {extensions to \TeX\ ( \.{\\write}, \.{\\special}, etc.~)} +@d in_stream=extension+1 {files for reading ( \.{\\openin}, \.{\\closein} )} +@d begin_group=in_stream+1 {begin local grouping ( \.{\\begingroup} )} +@d end_group=begin_group+1 {end local grouping ( \.{\\endgroup} )} +@d omit=end_group+1 {omit alignment template ( \.{\\omit} )} +@d ex_space=omit+1 {explicit space ( \.{\\\ } )} +@d no_boundary=ex_space+1 {suppress boundary ligatures ( \.{\\noboundary} )} +@d radical=no_boundary+1 {square root and similar signs ( \.{\\radical} )} +@d end_cs_name=radical+1 {end control sequence ( \.{\\endcsname} )} +@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 last_item=math_given+1 {most recent item ( \.{\\lastpenalty}, + \.{\\lastkern}, \.{\\lastskip} )} +@d inhibit_glue=last_item+1 {inhibit adjust glue ( \.{\\inhibitglue} )} +@d chg_dir=inhibit_glue+1 {change dir mode by \.{\\tate}, \.{\\yoko}} +@d max_non_prefixed_command=chg_dir {largest command code that can't be \.{\\global}} +@z + +@x [15.209] l.4272 - pTeX: def_jfont, def_tfont, set_auto_spacing +@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.~)} + {or \.{\\charsubdef}} +@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 assign_kinsoku=assign_font_int+1 + {user-defined kinsoku character ( \.{\\prebreakpenalty}, + \.{\\postbreakpenalty} )} +@d assign_inhibit_xsp_code=assign_kinsoku+1 + {user-defined inhibit xsp character ( \.{\\inhibitxspcode} )} +@d set_kansuji_char=assign_inhibit_xsp_code+1 + {user-defined kansuji character ( \.{\\kansujichar} )} +@d set_aux=set_kansuji_char+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 def_jfont=def_font+1 {define a font file ( \.{\\jfont} )} +@d def_tfont=def_jfont+1 {define a font file ( \.{\\tfont} )} +@d register=def_tfont+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 set_auto_spacing=set_interaction+1 {set auto spaceing mode + ( \.{\\autospacing}, \.{\\noautospacing}, ( \.{\\autospacing}, \.{\\noautospacing} )} +@d max_command=set_auto_spacing {the largest command code seen at |big_switch|} +@z + +@x [16.212] l.4437 - pTeX: last_jchr, direction, adjust direction +@<Types...@>= +@!list_state_record=record@!mode_field:-mmode..mmode;@+ + @!head_field,@!tail_field: pointer; +@y +@<Types...@>= +@!list_state_record=record@!mode_field:-mmode..mmode;@+ + @!dir_field,@!adj_dir_field: -dir_dtou..dir_dtou; + @!pdisp_field: scaled; + @!head_field,@!tail_field,@!pnode_field,@!last_jchr_field: pointer; +@z + +@x [16.213] l.4445 - pTeX: last_jchr, direction, adjust_dir, prev_{node,disp} +@d head==cur_list.head_field {header node of current list} +@d tail==cur_list.tail_field {final node on current list} +@y +@d direction==cur_list.dir_field {current direction} +@d adjust_dir==cur_list.adj_dir_field {current adjust direction} +@d head==cur_list.head_field {header node of current list} +@d tail==cur_list.tail_field {final node on current list} +@d prev_node==cur_list.pnode_field {previous to last |disp_node|} +@d prev_disp==cur_list.pdisp_field {displacemant at |prev_node|} +@d last_jchr==cur_list.last_jchr_field {final jchar node on current list} +@z + +@x [16.214] l.4464 - pTeX: prev_append: disp_node +@d tail_append(#)==begin link(tail):=#; tail:=link(tail); + end +@y +@d tail_append(#)==begin link(tail):=#; tail:=link(tail); + end +@d prev_append(#)==begin link(prev_node):=#; + link(link(prev_node)):=tail; prev_node:=link(prev_node); + end +@z + +@x [16.215] l.4477 - pTeX: last_jchar, direction, adjust_dir, prev_node +mode:=vmode; head:=contrib_head; tail:=contrib_head; +@y +mode:=vmode; head:=contrib_head; tail:=contrib_head; prev_node:=tail; +direction:=dir_yoko; adjust_dir:=direction; prev_disp:=0; last_jchr:=null; +@z + +@x [16.216] l.4496 - pTeX: last_jchr, displacement. +incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line; +@y +incr(nest_ptr); head:=new_null_box; tail:=head; prev_node:=tail; +prev_graf:=0; prev_disp:=0; last_jchr:=null; mode_line:=line; +@z + +@x [16.217] l.4504 - pTeX: pop_nest last_jchr +@p procedure pop_nest; {leave a semantic level, re-enter the old} +begin free_avail(head); decr(nest_ptr); cur_list:=nest[nest_ptr]; +end; +@y +@p procedure pop_nest; {leave a semantic level, re-enter the old} +begin +fast_delete_glue_ref(space_ptr(head)); fast_delete_glue_ref(xspace_ptr(head)); +free_node(head,box_node_size); decr(nest_ptr); cur_list:=nest[nest_ptr]; +end; +@z + +@x [16.218] l.4521 - pTeX: show_activities : direction + print_nl("### "); print_mode(m); +@y + print_nl("### "); print_direction(nest[p].dir_field); + print(", "); print_mode(m); +@z + +@x [17.224] l.4711 - pTeX: kanji_skip_code xkanji_skip_code, jfm_skip +@d thin_mu_skip_code=15 {thin space in math formula} +@d med_mu_skip_code=16 {medium space in math formula} +@d thick_mu_skip_code=17 {thick space in math formula} +@d glue_pars=18 {total number of glue parameters} +@y +@d kanji_skip_code=15 {between kanji-kanji space} +@d xkanji_skip_code=16 {between latin-kanji or kanji-latin space} +@d thin_mu_skip_code=17 {thin space in math formula} +@d med_mu_skip_code=18 {medium space in math formula} +@d thick_mu_skip_code=19 {thick space in math formula} +@d jfm_skip=20 {space refer from JFM} +@d glue_pars=21 {total number of glue parameters} +@z + +@x [17.224] l.4739 - kanji_skip, xkanji_skip +@d thick_mu_skip==glue_par(thick_mu_skip_code) +@y +@d thick_mu_skip==glue_par(thick_mu_skip_code) +@d kanji_skip==glue_par(kanji_skip_code) +@d xkanji_skip==glue_par(xkanji_skip_code) +@z + +@x [17.225] l.4767 - pTeX: kanji_skip_code xkanji_skip_code +thick_mu_skip_code: print_esc("thickmuskip"); +othercases print("[unknown glue parameter!]") +@y +thick_mu_skip_code: print_esc("thickmuskip"); +kanji_skip_code: print_esc("kanjiskip"); +xkanji_skip_code: print_esc("xkanjiskip"); +jfm_skip: print("refer from jfm"); +othercases print("[unknown glue parameter!]") +@z + +@x [17.226] l.4813 - pTeX: kanji_skip_code xkanji_skip_code +primitive("thickmuskip",assign_mu_glue,glue_base+thick_mu_skip_code);@/ +@!@:thick_mu_skip_}{\.{\\thickmuskip} primitive@> +@y +primitive("thickmuskip",assign_mu_glue,glue_base+thick_mu_skip_code);@/ +@!@:thick_mu_skip_}{\.{\\thickmuskip} primitive@> +primitive("kanjiskip",assign_glue,glue_base+kanji_skip_code);@/ +@!@:kanji_skip_}{\.{\\kanjiskip} primitive@> +primitive("xkanjiskip",assign_glue,glue_base+xkanji_skip_code);@/ +@!@:xkanji_skip_}{\.{\\xkanjiskip} primitive@> +@z + +@x [17.230] l.4867 - pTeX: cat_code_size, cur_jfont_loc, auto_spacing, auto_xspacing, inhibit_xsp_code, cur_tfont_loc +@d xord_code_base=cur_font_loc+1 +@d xchr_code_base=xord_code_base+1 +@d xprn_code_base=xchr_code_base+1 +@d math_font_base=xprn_code_base+1 +@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} +@y +@d math_font_base=cur_font_loc+1 {table of 48 math font numbers} +@d cur_jfont_loc=math_font_base+48 +@d cur_tfont_loc=cur_jfont_loc+1 +@d auto_spacing_code=cur_tfont_loc+1 +@d auto_xspacing_code=auto_spacing_code+1 +@d cat_code_base=auto_xspacing_code+1 + {table of 256 command codes (the ``catcodes'')} +@d kcat_code_base=cat_code_base+256 + {table of 256 command codes for the wchar's catcodes } +@d auto_xsp_code_base=kcat_code_base+256 {table of 256 auto spacer flag} +@d inhibit_xsp_code_base=auto_xsp_code_base+256 +@d kinsoku_base=inhibit_xsp_code_base+256 {table of 256 kinsoku mappings} +@d kansuji_base=kinsoku_base+256 {table of 10 kansuji mappings} +@d lc_code_base=kansuji_base+10 {table of 256 lowercase mappings} +@z + +@x [17.230] l.4900 - pTeX: +@d char_sub_code(#)==equiv(char_sub_code_base+#) + {Note: |char_sub_code(c)| is the true substitution info plus |min_halfword|} +@y +@d char_sub_code(#)==equiv(char_sub_code_base+#) + {Note: |char_sub_code(c)| is the true substitution info plus |min_halfword|} +@# +@d cur_jfont==equiv(cur_jfont_loc) {pTeX: } +@d cur_tfont==equiv(cur_tfont_loc) +@d auto_spacing==equiv(auto_spacing_code) +@d auto_xspacing==equiv(auto_xspacing_code) +@d kcat_code(#)==equiv(kcat_code_base+#) +@d auto_xsp_code(#)==equiv(auto_xsp_code_base+#) +@d inhibit_xsp_type(#)==eq_type(inhibit_xsp_code_base+#) +@d inhibit_xsp_code(#)==equiv(inhibit_xsp_code_base+#) +@d kinsoku_type(#)==eq_type(kinsoku_base+#) +@d kinsoku_code(#)==equiv(kinsoku_base+#) +@d kansuji_char(#)==equiv(kansuji_base+#) +@z + +@x [17.232] l.4959 - pTeX: initialize cat_code, cur_jfont, cur_tfont +cur_font:=null_font; eq_type(cur_font_loc):=data; +eq_level(cur_font_loc):=level_one;@/ +@y +cur_font:=null_font; eq_type(cur_font_loc):=data; +eq_level(cur_font_loc):=level_one;@/ +cur_jfont:=null_font; eq_type(cur_jfont_loc):=data; +eq_level(cur_jfont_loc):=level_one;@/ +cur_tfont:=null_font; eq_type(cur_tfont_loc):=data; +eq_level(cur_tfont_loc):=level_one;@/ +@z + +@x [17.232] l.4965 - pTeX: initialize cat_code, cur_jfont, cur_tfont +for k:=0 to 255 do + begin cat_code(k):=other_char; math_code(k):=hi(k); sf_code(k):=1000; + end; +@y +eqtb[auto_spacing_code]:=eqtb[cat_code_base]; +eqtb[auto_xspacing_code]:=eqtb[cat_code_base]; +for k:=0 to 255 do + begin cat_code(k):=other_char; kcat_code(k):=other_kchar; + math_code(k):=hi(k); sf_code(k):=1000; + auto_xsp_code(k):=0; inhibit_xsp_code(k):=0; inhibit_xsp_type(k):=0; + kinsoku_code(k):=0; kinsoku_type(k):=0; + end; +@z +@x [17.232] l.4971 - pTeX: initialize cat_code, cur_jfont, cur_tfont +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 +for k:="0" to "9" do + begin math_code(k):=hi(k+var_code); + auto_xsp_code(k):=3; + end; +kansuji_char(0):=toDVI(fromJIS(@"213B)); +kansuji_char(1):=toDVI(fromJIS(@"306C)); +kansuji_char(2):=toDVI(fromJIS(@"4673)); +kansuji_char(3):=toDVI(fromJIS(@"3B30)); +kansuji_char(4):=toDVI(fromJIS(@"3B4D)); +kansuji_char(5):=toDVI(fromJIS(@"385E)); +kansuji_char(6):=toDVI(fromJIS(@"4F3B)); +kansuji_char(7):=toDVI(fromJIS(@"3C37)); +kansuji_char(8):=toDVI(fromJIS(@"482C)); +kansuji_char(9):=toDVI(fromJIS(@"3665)); +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;@/ + auto_xsp_code(k):=3; auto_xsp_code(k+"a"-"A"):=3;@/ + sf_code(k):=999; + end; +@t\hskip10pt@>kcat_code(@"20+1):=other_kchar; {1 ku} +@t\hskip10pt@>kcat_code(@"20+2):=other_kchar; {2 ku} +@+@t\1@>for k:=3 to 6 do kcat_code(@"20+k):=kana; {3 ku ... 6 ku} +@+@t\1@>for k:=7 to 8 do kcat_code(@"20+k):=other_kchar; {7 ku ... 8 ku} +@+@t\1@>for k:=16 to 84 do kcat_code(@"20+k):=kanji; {16 ku ... 84 ku} +{ @"20+k = kcatcodekey(fromKUTEN(HILO(k,1)) } +@z + +@x [17.236] l.5092 - pTeX: cur_jfam_code, jchr_widow_penalty +@d cur_fam_code=44 {current family} +@d escape_char_code=45 {escape character for token output} +@d default_hyphen_char_code=46 {value of \.{\\hyphenchar} when a font is loaded} +@d default_skew_char_code=47 {value of \.{\\skewchar} when a font is loaded} +@d end_line_char_code=48 {character placed at the right end of the buffer} +@d new_line_char_code=49 {character that prints as |print_ln|} +@d language_code=50 {current hyphenation table} +@d left_hyphen_min_code=51 {minimum left hyphenation fragment size} +@d right_hyphen_min_code=52 {minimum right hyphenation fragment size} +@d holding_inserts_code=53 {do not remove insertion nodes from \.{\\box255}} +@d error_context_lines_code=54 {maximum intermediate line pairs shown} +@d tex_int_pars=55 {total number of \TeX's integer parameters} +@# +@d web2c_int_base=tex_int_pars {base for web2c's integer parameters} +@d char_sub_def_min_code=web2c_int_base {smallest value in the charsubdef list} +@d char_sub_def_max_code=web2c_int_base+1 {largest value in the charsubdef list} +@d tracing_char_sub_def_code=web2c_int_base+2 {traces changes to a charsubdef def} +@d mubyte_in_code=web2c_int_base+3 {if positive then reading mubytes is active} +@d mubyte_out_code=web2c_int_base+4 {if positive then printing mubytes is active} +@d mubyte_log_code=web2c_int_base+5 {if positive then print mubytes to log and terminal} +@d spec_out_code=web2c_int_base+6 {if positive then print specials by mubytes} +@d web2c_int_pars=web2c_int_base+7 {total number of web2c's integer parameters} +@# +@d int_pars=web2c_int_pars {total number of integer parameters} +@d count_base=int_base+int_pars {256 user \.{\\count} registers} +@y +@d cur_fam_code=44 {current family} +@d cur_jfam_code=45 {current kanji family} +@d escape_char_code=46 {escape character for token output} +@d default_hyphen_char_code=47 {value of \.{\\hyphenchar} when a font is loaded} +@d default_skew_char_code=48 {value of \.{\\skewchar} when a font is loaded} +@d end_line_char_code=49 {character placed at the right end of the buffer} +@d new_line_char_code=50 {character that prints as |print_ln|} +@d language_code=51 {current hyphenation table} +@d left_hyphen_min_code=52 {minimum left hyphenation fragment size} +@d right_hyphen_min_code=53 {minimum right hyphenation fragment size} +@d holding_inserts_code=54 {do not remove insertion nodes from \.{\\box255}} +@d error_context_lines_code=55 {maximum intermediate line pairs shown} +@d jchr_widow_penalty_code=56 + {penalty for creating a widow KANJI character line} +@d char_sub_def_min_code=57 {smallest value in the charsubdef list} +@d char_sub_def_max_code=58 {largest value in the charsubdef list} +@d tracing_char_sub_def_code=59 {traces changes to a charsubdef def} +@d int_pars=60 {total number of integer parameters} +@d count_base=int_base+int_pars {256 user \.{\\count} registers} +@z + +@x [17.236] l.5167 - pTeX: cur_jfam, |jchr_widow_penalty| +@d cur_fam==int_par(cur_fam_code) +@d escape_char==int_par(escape_char_code) +@y +@d cur_fam==int_par(cur_fam_code) +@d cur_jfam==int_par(cur_jfam_code) +@d escape_char==int_par(escape_char_code) +@d jchr_widow_penalty==int_par(jchr_widow_penalty_code) +@z + +@x l.5181 - pTeX +@d tracing_char_sub_def==int_par(tracing_char_sub_def_code) +@d mubyte_in==int_par(mubyte_in_code) +@d mubyte_out==int_par(mubyte_out_code) +@d mubyte_log==int_par(mubyte_log_code) +@d spec_out==int_par(spec_out_code) +@y +@d tracing_char_sub_def==int_par(tracing_char_sub_def_code) +@z + +@x [17.237] l.5244 - pTeX: cur_jfam_code, jchr_window_penalty_code +new_line_char_code:print_esc("newlinechar"); +@y +new_line_char_code:print_esc("newlinechar"); +cur_jfam_code:print_esc("jfam"); +jchr_widow_penalty_code:print_esc("jcharwidowpenalty"); +@z + +@x l.5252 - pTeX +tracing_char_sub_def_code:print_esc("tracingcharsubdef"); +mubyte_in_code:print_esc("mubytein"); +mubyte_out_code:print_esc("mubyteout"); +mubyte_log_code:print_esc("mubytelog"); +spec_out_code:print_esc("specialout"); +@y +tracing_char_sub_def_code:print_esc("tracingcharsubdef"); +@z + +@x [17.238] l.5365 - pTeX: cur_jfam_code, jchr_window_penalty_code +primitive("newlinechar",assign_int,int_base+new_line_char_code);@/ +@!@:new_line_char_}{\.{\\newlinechar} primitive@> +@y +primitive("newlinechar",assign_int,int_base+new_line_char_code);@/ +@!@:new_line_char_}{\.{\\newlinechar} primitive@> +primitive("jfam",assign_int,int_base+cur_jfam_code);@/ +@!@:cur_jfam_}{\.{\\jfam} primitive@> +primitive("jcharwidowpenalty",assign_int,int_base+jchr_widow_penalty_code);@/ +@!@:jchr_widow_penalty}{\.{\\jcharwidowpenalty} primitive@> +@z + +@x l.5387 - pTeX +if enctex_p then + begin enctex_enabled_p:=true; + primitive("mubytein",assign_int,int_base+mubyte_in_code);@/ +@!@:mubyte_in_}{\.{\\mubytein} primitive@> + primitive("mubyteout",assign_int,int_base+mubyte_out_code);@/ +@!@:mubyte_out_}{\.{\\mubyteout} primitive@> + primitive("mubytelog",assign_int,int_base+mubyte_log_code);@/ +@!@:mubyte_log_}{\.{\\mubytelog} primitive@> + primitive("specialout",assign_int,int_base+spec_out_code);@/ +@!@:spec_out_}{\.{\\specialout} primitive@> +end; +@y +@z + +@x [17.247] l.5490 - pTeX: kinsoku, t_baseline_shift, y_baseline_shift +@d h_offset_code=18 {amount of horizontal offset when shipping pages out} +@d v_offset_code=19 {amount of vertical offset when shipping pages out} +@d emergency_stretch_code=20 {reduces badnesses on final pass of line-breaking} +@d dimen_pars=21 {total number of dimension parameters} +@d scaled_base=dimen_base+dimen_pars + {table of 256 user-defined \.{\\dimen} registers} +@d eqtb_size=scaled_base+255 {largest subscript of |eqtb|} +@y +@d h_offset_code=18 {amount of horizontal offset when shipping pages out} +@d v_offset_code=19 {amount of vertical offset when shipping pages out} +@d emergency_stretch_code=20 {reduces badnesses on final pass of line-breaking} +@d t_baseline_shift_code=21 {shift amount when mixing TATE-kumi and Alphabet} +@d y_baseline_shift_code=22 {shift amount when mixing YOKO-kumi and Alphabet} +@d dimen_pars=23 {total number of dimension parameters} +@d scaled_base=dimen_base+dimen_pars + {table of 256 user-defined \.{\\dimen} registers} +@d kinsoku_penalty_base=scaled_base+256 {table of 256 kinsoku registers} +@d eqtb_size=kinsoku_penalty_base+255 {largest subscript of |eqtb|} +@z + +@x l.5498 - pTeX: kinsoku, t_baseline_shift, y_baseline_shift +@d dimen(#)==eqtb[scaled_base+#].sc +@d dimen_par(#)==eqtb[dimen_base+#].sc {a scaled quantity} +@y +@d dimen(#)==eqtb[scaled_base+#].sc +@d dimen_par(#)==eqtb[dimen_base+#].sc {a scaled quantity} +@d kinsoku_penalty(#)==eqtb[kinsoku_penalty_base+#].int +@z + +@x l.5518 - pTeX: +@d h_offset==dimen_par(h_offset_code) +@d v_offset==dimen_par(v_offset_code) +@y +@d h_offset==dimen_par(h_offset_code) +@d v_offset==dimen_par(v_offset_code) +@d t_baseline_shift==dimen_par(t_baseline_shift_code) +@d y_baseline_shift==dimen_par(y_baseline_shift_code) +@z + +@x l.5542 - pTeX: +h_offset_code:print_esc("hoffset"); +v_offset_code:print_esc("voffset"); +emergency_stretch_code:print_esc("emergencystretch"); +othercases print("[unknown dimen parameter!]") +@y +h_offset_code:print_esc("hoffset"); +v_offset_code:print_esc("voffset"); +t_baseline_shift_code:print_esc("tbaselineshift"); +y_baseline_shift_code:print_esc("ybaselineshift"); +emergency_stretch_code:print_esc("emergencystretch"); +othercases print("[unknown dimen parameter!]") +@z + +@x [17.248] l.5588 - pTeX: rotate offset +primitive("hoffset",assign_dimen,dimen_base+h_offset_code);@/ +@!@:h_offset_}{\.{\\hoffset} primitive@> +primitive("voffset",assign_dimen,dimen_base+v_offset_code);@/ +@!@:v_offset_}{\.{\\voffset} primitive@> +@y +primitive("hoffset",assign_dimen,dimen_base+h_offset_code);@/ +@!@:h_offset_}{\.{\\hoffset} primitive@> +primitive("voffset",assign_dimen,dimen_base+v_offset_code);@/ +@!@:v_offset_}{\.{\\voffset} primitive@> +primitive("tbaselineshift",assign_dimen,dimen_base+t_baseline_shift_code);@/ +@!@:t_baseline_shift_}{\.{\\tbaselineshift} primitive@> +primitive("ybaselineshift",assign_dimen,dimen_base+y_baseline_shift_code);@/ +@!@:y_baseline_shift_}{\.{\\ybaselineshift} primitive@> +@z + +@x [17.252] l.5622 - pTeX: show eqtb +else if n<=eqtb_size then @<Show equivalent |n|, in region 6@> +else print_char("?"); {this can't happen either} +end; +tats +@y +else if n<kinsoku_penalty_base then @<Show equivalent |n|, in region 6@> +else if n<=eqtb_size then print("kinsoku") +else print_char("?"); {this can't happen either} +end; +tats +@z + +@x l.5777 - pTeX +The conversion from control sequence to byte sequence for enc\TeX is +implemented here. Of course, the simplest way is to implement an array +of string pointers with |hash_size| length, but we assume that only a +few control sequences will need to be converted. So |mubyte_cswrite|, +an array with only 128 items, is used. The items point to the token +lists. First token includes a csname number and the second points the +string to be output. The third token includes the number of another +csname and fourth token its pointer to the string etc. We need to do +the sequential searching in one of the 128 token lists. + +@y +@z + +@x l.5788 - pTeX +procedure print_cs(@!p:integer); {prints a purported control sequence} +var q: pointer; + s: str_number; +begin + if active_noconvert and (not no_convert) and + (eq_type(p) = let) and (equiv(p) = normal+11) then { noconvert } + begin + no_convert := true; + return; + end; + s := 0; + if cs_converting and (not no_convert) then + begin + q := mubyte_cswrite [p mod 128] ; + while q <> null do + if info (q) = p then + begin + s := info (link(q)); q := null; + end else q := link (link (q)); + end; + no_convert := false; + if s > 0 then print (s) + else if p<hash_base then {single character} +@y +procedure print_cs(@!p:integer); {prints a purported control sequence} +begin if p<hash_base then {single character} +@z + +@x l.5828 - pTeX +exit: end; +@y +end; +@z + +@x l.5893 - pTeX +if enctex_p then +begin + primitive("endmubyte",end_cs_name,10);@/ +@!@:end_mubyte_}{\.{\\endmubyte} primitive@> +end; +@y +@z + +@x [18.265] l.5903 - pTeX: \jfont \tfont +primitive("font",def_font,0);@/ +@!@:font_}{\.{\\font} primitive@> +@y +primitive("font",def_font,0);@/ +@!@:font_}{\.{\\font} primitive@> +primitive("jfont",def_jfont,0);@/ +@!@:jfont_}{\.{\\jfont} primitive@> +primitive("tfont",def_tfont,0);@/ +@!@:tfont_}{\.{\\tfont} primitive@> +@z + +@x [18.266] l.5979 - pTeX: \jfont, \tfont +def_font: print_esc("font"); +@y +def_font: print_esc("font"); +def_jfont: print_esc("jfont"); +def_tfont: print_esc("tfont"); +@z + +@x l.5982 - pTeX +end_cs_name: if chr_code = 10 then print_esc("endmubyte") + else print_esc("endcsname"); +@y +end_cs_name: print_esc("endcsname"); +@z + +@x [20.289] l.6387 - pTeX: cs_token_flag +@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} +@y +@d cs_token_flag==@"FFFF {amount added to the |eqtb| location in a +token that stands for a control sequence; is a multiple of~256, less~1} +@z + +@x [20.293] l.6496 - pTeX: show_token_list +@ @<Display token |p|...@>= +if (p<hi_mem_min) or (p>mem_end) then + begin print_esc("CLOBBERED."); return; +@.CLOBBERED@> + end; +if info(p)>=cs_token_flag then print_cs(info(p)-cs_token_flag) +else begin m:=info(p) div @'400; c:=info(p) mod @'400; + if info(p)<0 then print_esc("BAD.") +@.BAD@> + else @<Display the token $(|m|,|c|)$@>; + end +@y +@ @<Display token |p|...@>= +if (p<hi_mem_min) or (p>mem_end) then + begin print_esc("CLOBBERED."); return; +@.CLOBBERED@> + end; +if info(p)>=cs_token_flag then print_cs(info(p)-cs_token_flag) {wchar_token} +else begin + if check_kanji(info(p)) then {wchar_token} + begin m:=kcat_code(kcatcodekey(info(p))); c:=info(p); + end + else begin m:=Hi(info(p)); c:=Lo(info(p)); + end; + if (m<kanji)and(c>256) then print_esc("BAD.") +@.BAD@> + else @<Display the token $(|m|,|c|)$@>; +end +@z + +@x [20.294] l.6512 - pTeX: show_token_list +@<Display the token ...@>= +case m of +left_brace,right_brace,math_shift,tab_mark,sup_mark,sub_mark,spacer, + letter,other_char: print(c); +@y +@<Display the token ...@>= +case m of +kanji,kana,other_kchar: print_kanji(KANJI(c)); +left_brace,right_brace,math_shift,tab_mark,sup_mark,sub_mark,spacer, + letter,other_char: print(c); +@z + +@x [21.298] l.6632 - pTeX: print KANJI +other_char: chr_cmd("the character "); +@y +other_char: chr_cmd("the character "); +kanji,kana,other_kchar: begin print("kanji character "); + print_kanji(KANJI(chr_code)); end; +@z + +@x [22.303] l.6726 - pTeX: state mid_kanji +1) |state=mid_line| is the normal state.\cr +2) |state=skip_blanks| is like |mid_line|, but blanks are ignored.\cr +3) |state=new_line| is the state at the beginning of a line.\cr}}$$ +@y +1) |state=mid_line| is the normal state.\cr +2) |state=mid_kanji| is like |mid_line|, and internal KANJI string.\cr +3) |state=skip_blanks| is like |mid_line|, but blanks are ignored.\cr +4) |state=new_line| is the state at the beginning of a line.\cr}}$$ +@z + +@x [22.303] l.6736 - pTeX: state mid_kanji +@d mid_line=1 {|state| code when scanning a line of characters} +@d skip_blanks=2+max_char_code {|state| code when ignoring blanks} +@d new_line=3+max_char_code+max_char_code {|state| code at start of line} +@y +@d mid_line=1 {|state| code when scanning a line of characters} +@d mid_kanji=2+max_char_code {|state| code when scanning a line of characters} +@d skip_blanks=3+max_char_code+max_char_code {|state| code when ignoring blanks} +@d new_line=4+max_char_code+max_char_code+max_char_code + {|state| code at start of line} +@z + +@x [22.311] l.6986 - pTeX: label +@p procedure show_context; {prints where the scanner is} +label done; +var old_setting:0..max_selector; {saved |selector| setting} +@y +@p procedure show_context; {prints where the scanner is} +label done, done1; +var old_setting:0..max_selector; {saved |selector| setting} +@!s: pointer; {temporary pointer} +@z + +@x [22.316] l.7110 - pTeX: init kcode_pos +@d begin_pseudoprint== + begin l:=tally; tally:=0; selector:=pseudo; + trick_count:=1000000; + end +@y +@d begin_pseudoprint== + begin l:=tally; tally:=0; selector:=pseudo; kcode_pos:=0; + trick_count:=1000000; + end +@z +@x [22.316] l.7114 - pTeX: kcode_pos +@d set_trick_count== + begin first_count:=tally; + trick_count:=tally+1+error_line-half_error_line; + if trick_count<error_line then trick_count:=error_line; + end +@y +@d set_trick_count== + begin first_count:=tally; + if (first_count>0)and(trick_buf2[(first_count-1)mod error_line]=1) then + incr(first_count); + trick_count:=first_count+1+error_line-half_error_line; + if trick_count<error_line then trick_count:=error_line; + end +@z + +@x [22.317] l.7133 - pTeX: adjust kanji code pos +for q:=p to first_count-1 do print_char(trick_buf[q mod error_line]); +print_ln; +for q:=1 to n do print_char(" "); {print |n| spaces to begin line~2} +if m+n<=error_line then p:=first_count+m else p:=first_count+(error_line-n-3); +@y +if trick_buf2[p mod error_line]=2 then + begin p:=p+1; n:=n-1; + end; +for q:=p to first_count-1 do print_char(trick_buf[q mod error_line]); +print_ln; +for q:=1 to n do print_char(" "); {print |n| spaces to begin line~2} +if m+n<=error_line then p:=first_count+m else p:=first_count+(error_line-n-3); +if trick_buf2[(p-1) mod error_line]=1 then p:=p-1; +@z + +@x l.7148 - pTeX +@<Pseudoprint the line@>= +begin_pseudoprint; +if buffer[limit]=end_line_char then j:=limit +else j:=limit+1; {determine the effective end of the line} +i := start; mubyte_skeep := mubyte_keep; +mubyte_sstart := mubyte_start; mubyte_start := false; +if j>0 then while i < j do +begin + if i=loc then set_trick_count; + print_buffer(i); +end; +mubyte_keep := mubyte_skeep; mubyte_start := mubyte_sstart +@y +@<Pseudoprint the line@>= +begin_pseudoprint; +if buffer[limit]=end_line_char then j:=limit +else j:=limit+1; {determine the effective end of the line} +if j>0 then for i:=start to j-1 do + begin if i=loc then set_trick_count; + print(buffer[i]); + end +@z + +@x [22.319] l.7157 - pTeX: adjust kanji code token +@ @<Pseudoprint the token list@>= +begin_pseudoprint; +if token_type<macro then show_token_list(start,loc,100000) +else show_token_list(link(start),loc,100000) {avoid reference count} +@y +@ @<Pseudoprint the token list@>= +begin_pseudoprint; +if token_type<macro then + begin if (token_type=backed_up)and(loc<>null) then + begin if (link(start)=null)and(check_kanji(info(start))) then {wchar_token} + begin cur_input:=input_stack[base_ptr-1]; + s:=get_avail; info(s):=Lo(buffer[loc]); + cur_input:=input_stack[base_ptr]; + link(start):=s; + show_token_list(start,loc,100000); + free_avail(s);link(start):=null; + goto done1; + end; + end; + show_token_list(start,loc,100000); + end +else show_token_list(link(start),loc,100000); {avoid reference count} +done1: +@z + +@x l.7354 - pTeX +Some additional routines used by the enc\TeX extension have to be +declared at this point. + +@p @t\4@>@<Declare additional routines for enc\TeX@>@/ + +@y +@z + +@x l.7476 - pTeX +@!i,@!j: 0..buf_size; {more indexes for encTeX} +@!mubyte_incs: boolean; {control sequence is converted by mubyte} +@!p:pointer; {for encTeX test if noexpanding} +@y +@z + +@x [24.341] l.7479 - pTeX: set last_chr +@!cat:0..max_char_code; {|cat_code(cur_chr)|, usually} +@y +@!cat:escape..max_char_code; {|cat_code(cur_chr)|, usually} +@!l:0..buf_size; {temporary index into |buffer|} +@z + +@x [24.343] l.7500 - pTeX: input external file +@ @<Input from external file, |goto restart| if no input found@>= +@^inner loop@> +begin switch: if loc<=limit then {current line not yet finished} + begin + { Use |k| instead of |loc| for type correctness. } + k := loc; + cur_chr := read_buffer (k); + loc := k; incr (loc); + if (mubyte_token > 0) then + begin + state := mid_line; + cur_cs := mubyte_token - cs_token_flag; + goto found; + end; + reswitch: cur_cmd:=cat_code(cur_chr); +@y +@ @<Input from external file, |goto restart| if no input found@>= +@^inner loop@> +begin switch: if loc<=limit then {current line not yet finished} + begin cur_chr:=buffer[loc]; incr(loc); + if (multistrlen(buffer, limit+1, loc-1)=2) then + begin cur_chr:=fromBUFF(buffer, limit+1, loc-1); + cur_cmd:=kcat_code(kcatcodekey(cur_chr)); + incr(loc); + end + else reswitch: cur_cmd:=cat_code(cur_chr); +@z + +@x [24.344] l.7535 - pTeX: ASCII-KANJI space handling +@d any_state_plus(#) == mid_line+#,skip_blanks+#,new_line+# +@y +@d any_state_plus(#) == mid_line+#,mid_kanji+#,skip_blanks+#,new_line+# +@z + +@x [24.347] l.7569 - pTeX: scaner +@ @d add_delims_to(#)==#+math_shift,#+tab_mark,#+mac_param, + #+sub_mark,#+letter,#+other_char +@y +@ @d add_delims_to(#)==#+math_shift,#+tab_mark,#+mac_param, + #+sub_mark,#+letter,#+other_char +@d all_jcode(#)==#+kanji,#+kana,#+other_kchar +@z + +@x [24.347] l.7573 - pTeX: scaner +mid_line+spacer:@<Enter |skip_blanks| state, emit a space@>; +mid_line+car_ret:@<Finish line, emit a space@>; +skip_blanks+car_ret,any_state_plus(comment): + @<Finish line, |goto switch|@>; +new_line+car_ret:@<Finish line, emit a \.{\\par}@>; +mid_line+left_brace: incr(align_state); +skip_blanks+left_brace,new_line+left_brace: begin + state:=mid_line; incr(align_state); + end; +mid_line+right_brace: decr(align_state); +skip_blanks+right_brace,new_line+right_brace: begin + state:=mid_line; decr(align_state); + end; +add_delims_to(skip_blanks),add_delims_to(new_line): state:=mid_line; +@y +mid_kanji+spacer,mid_line+spacer:@<Enter |skip_blanks| state, emit a space@>; +mid_line+car_ret:@<Finish line, emit a space@>; +mid_kanji+car_ret: if skip_mode then @<Finish line, |goto switch|@> + else @<Finish line, emit a space@>; +skip_blanks+car_ret,any_state_plus(comment): + @<Finish line, |goto switch|@>; +new_line+car_ret:@<Finish line, emit a \.{\\par}@>; +mid_line+left_brace,mid_kanji+left_brace: incr(align_state); +skip_blanks+left_brace,new_line+left_brace: begin + state:=mid_line; incr(align_state); + end; +mid_line+right_brace,mid_kanji+right_brace: decr(align_state); +skip_blanks+right_brace,new_line+right_brace: begin + state:=mid_line; decr(align_state); + end; +add_delims_to(skip_blanks),add_delims_to(new_line),add_delims_to(mid_kanji): + state:=mid_line; +all_jcode(skip_blanks),all_jcode(new_line),all_jcode(mid_line): + state:=mid_kanji; + +@ @<Global...@>= +skip_mode:boolean; + +@ @<Set init...@>= +skip_mode:=true; +@z + +@x [24.354] l.7659 - pTeX: scan control sequence +@<Scan a control...@>= +begin if loc>limit then cur_cs:=null_cs {|state| is irrelevant in this case} +else begin start_cs: + mubyte_incs := false; k := loc; mubyte_skeep := mubyte_keep; + cur_chr := read_buffer (k); cat := cat_code (cur_chr); + if (mubyte_in>0) and (not mubyte_incs) and + ((mubyte_skip>0) or (cur_chr<>buffer[k])) then mubyte_incs := true; + incr (k); + if mubyte_token > 0 then + begin + state := mid_line; + cur_cs := mubyte_token - cs_token_flag; + goto found; + end; + if cat=letter then state:=skip_blanks + else if cat=spacer then state:=skip_blanks + else state:=mid_line; + if (cat=letter)and(k<=limit) then + @<Scan ahead in the buffer until finding a nonletter; + if an expanded code is encountered, reduce it + and |goto start_cs|; otherwise if a multiletter control + sequence is found, adjust |cur_cs| and |loc|, and + |goto found|@> + else @<If an expanded code is present, reduce it and |goto start_cs|@>; + mubyte_keep := mubyte_skeep; + cur_cs:=single_base + read_buffer(loc); incr(loc); + end; +found: cur_cmd:=eq_type(cur_cs); cur_chr:=equiv(cur_cs); +if cur_cmd>=outer_call then check_outer_validity; +if write_noexpanding then +begin + p := mubyte_cswrite [cur_cs mod 128]; + while p <> null do + if info (p) = cur_cs then + begin + cur_cmd := relax; cur_chr := 256; p := null; + end else p := link (link (p)); +end; +end +@y +@<Scan a control...@>= +begin if loc>limit then cur_cs:=null_cs {|state| is irrelevant in this case} +else begin k:=loc; cur_chr:=buffer[k]; incr(k); + if (multistrlen(buffer, limit+1, k-1)=2) then + begin cat:=kcat_code(kcatcodekey(fromBUFF(buffer, limit+1, k-1))); incr(k); + end + else cat:=cat_code(cur_chr); +start_cs: + if (cat=letter)or(cat=kanji)or(cat=kana) then state:=skip_blanks + else if cat=spacer then state:=skip_blanks + else state:=mid_line; + if cat=other_kchar then + begin cur_cs:=id_lookup(loc,k-loc); loc:=k; goto found; + end + else if ((cat=letter)or(cat=kanji)or(cat=kana))and(k<=limit) then + @<Scan ahead in the buffer until finding a nonletter; + if an expanded code is encountered, reduce it + and |goto start_cs|; otherwise if a multiletter control + sequence is found, adjust |cur_cs| and |loc|, and + |goto found|@> + else @<If an expanded code is present, reduce it and |goto start_cs|@>; + cur_cs:=single_base+buffer[loc]; incr(loc); + end; +found: cur_cmd:=eq_type(cur_cs); cur_chr:=equiv(cur_cs); +if cur_cmd>=outer_call then check_outer_validity; +end +@z + +@x +@<If an expanded...@>= +begin if buffer[k]=cur_chr then @+if cat=sup_mark then @+if k<limit then + begin c:=buffer[k+1]; @+if c<@'200 then {yes, one is indeed present} + begin d:=2; + if is_hex(c) then @+if k+2<=limit then + begin cc:=buffer[k+2]; @+if is_hex(cc) then incr(d); + end; + if d>2 then + begin hex_to_cur_chr; buffer[k-1]:=cur_chr; + end + else if c<@'100 then buffer[k-1]:=c+@'100 + else buffer[k-1]:=c-@'100; + limit:=limit-d; first:=first-d; + while k<=limit do + begin buffer[k]:=buffer[k+d]; incr(k); + end; + goto start_cs; + end; + end; +end +@y +@<If an expanded...@>= +begin if buffer[k]=cur_chr then @+if cat=sup_mark then @+if k<limit then + begin c:=buffer[k+1]; @+if c<@'200 then {yes, one is indeed present} + begin d:=2; + if is_hex(c) then @+if k+2<=limit then + begin cc:=buffer[k+2]; @+if is_hex(cc) then incr(d); + end; + if d>2 then + begin hex_to_cur_chr; buffer[k-1]:=cur_chr; + end + else if c<@'100 then buffer[k-1]:=c+@'100 + else buffer[k-1]:=c-@'100; + limit:=limit-d; first:=first-d; + l:=k; cur_chr:=buffer[k-1]; cat:=cat_code(cur_chr); + while l<=limit do + begin buffer[l]:=buffer[l+d]; incr(l); + end; + goto start_cs; + end; + end; +end +@z + +@x [24.356] l.7727 - pTeX: scan control sequence (cont) +@ @<Scan ahead in the buffer...@>= +begin + repeat cur_chr := read_buffer (k); cat := cat_code (cur_chr); + if mubyte_token>0 then cat := escape; + if (mubyte_in>0) and (not mubyte_incs) and (cat=letter) and + ((mubyte_skip>0) or (cur_chr<>buffer[k])) then mubyte_incs := true; + incr (k); + until (cat <> letter) or (k > limit); + @<If an expanded...@>; + if cat <> letter then + begin + decr (k); k := k - mubyte_skip; + end; + if k > loc + 1 then { multiletter control sequence has been scanned } + begin + if mubyte_incs then { multibyte in csname occurrs } + begin + i := loc; j := first; mubyte_keep := mubyte_skeep; + if j - loc + k > max_buf_stack then + begin + max_buf_stack := j - loc + k; + if max_buf_stack >= buf_size then + begin + max_buf_stack := buf_size; + overflow ("buffer size", buf_size); + end; + end; + while i < k do + begin + buffer [j] := read_buffer (i); + incr (i); incr (j); + end; + if j = first+1 then + cur_cs := single_base + buffer [first] + else + cur_cs := id_lookup (first, j-first); + end else cur_cs := id_lookup (loc, k-loc) ; + loc := k; + goto found; + end; +end +@y +@ @<Scan ahead in the buffer...@>= +begin repeat cur_chr:=buffer[k]; incr(k); + if (multistrlen(buffer, limit+1, k-1)=2) then + begin cat:=kcat_code(kcatcodekey(fromBUFF(buffer, limit+1, k-1))); incr(k); + end + else cat:=cat_code(cur_chr); + while (buffer[k]=cur_chr)and(cat=sup_mark)and(k<limit) do + begin c:=buffer[k+1]; @+if c<@'200 then {yes, one is indeed present} + begin d:=2; + if is_hex(c) then @+if k+2<=limit then + begin cc:=buffer[k+2]; @+if is_hex(cc) then incr(d); + end; + if d>2 then + begin hex_to_cur_chr; + end + else if c<@'100 then cur_chr:=c+@'100 + else cur_chr:=c-@'100; + cat:=cat_code(cur_chr); + if (cat=letter)or(cat=sup_mark) then + begin buffer[k-1]:=cur_chr; + limit:=limit-d; first:=first-d; + l:=k; + while l<=limit do + begin buffer[l]:=buffer[l+d]; incr(l); + end; + end; + end; + end; +until not((cat=letter)or(cat=kanji)or(cat=kana))or(k>limit); +{@@<If an expanded...@@>;} +if not((cat=letter)or(cat=kanji)or(cat=kana)) then decr(k); +if cat=other_kchar then decr(k); {now |k| points to first nonletter} +if k>loc+1 then {multiletter control sequence has been scanned} + begin cur_cs:=id_lookup(loc,k-loc); loc:=k; goto found; + end; +end +@z + +@x [24.357] l.7771 - pTeX: input from token list +@<Input from token list, |goto restart| if end of list or + if a parameter needs to be expanded@>= +if loc<>null then {list not exhausted} +@^inner loop@> + begin t:=info(loc); loc:=link(loc); {move to next} + if t>=cs_token_flag then {a control sequence token} + begin cur_cs:=t-cs_token_flag; + cur_cmd:=eq_type(cur_cs); cur_chr:=equiv(cur_cs); + if cur_cmd>=outer_call then + if cur_cmd=dont_expand then + @<Get the next token, suppressing expansion@> + else check_outer_validity; + if write_noexpanding then + begin + p := mubyte_cswrite [cur_cs mod 128]; + while p <> null do + if info (p) = cur_cs then + begin + cur_cmd := relax; cur_chr := 256; p := null; + end else p := link (link (p)); + end; + end + else begin cur_cmd:=t div @'400; cur_chr:=t mod @'400; + case cur_cmd of + left_brace: incr(align_state); + right_brace: decr(align_state); + out_param: @<Insert macro parameter and |goto restart|@>; + othercases do_nothing + endcases; + end; + end +else begin {we are done with this token list} + end_token_list; goto restart; {resume previous level} + end +@y +@<Input from token list, |goto restart| if end of list or + if a parameter needs to be expanded@>= +if loc<>null then {list not exhausted} +@^inner loop@> + begin t:=info(loc); loc:=link(loc); {move to next} + if t>=cs_token_flag then {a control sequence token} + begin cur_cs:=t-cs_token_flag; + cur_cmd:=eq_type(cur_cs); cur_chr:=equiv(cur_cs); + if cur_cmd>=outer_call then + if cur_cmd=dont_expand then + @<Get the next token, suppressing expansion@> + else check_outer_validity; + end + else if check_kanji(t) then {wchar_token} + begin cur_chr:=t; cur_cmd:=kcat_code(kcatcodekey(t)); + end + else + begin cur_cmd:=Hi(t); cur_chr:=Lo(t); + case cur_cmd of + left_brace: incr(align_state); + right_brace: decr(align_state); + out_param: @<Insert macro parameter and |goto restart|@>; + othercases do_nothing + endcases; + end; + end +else begin {we are done with this token list} + end_token_list; goto restart; {resume previous level} + end +@z + +@x l.7898 - pTeX + k := start; + while k < limit do begin print_buffer(k) end; +@y + if start<limit then for k:=start to limit-1 do print(buffer[k]); +@z + +@x [24.365] l.7935 - pTeX: get_token +@p procedure get_token; {sets |cur_cmd|, |cur_chr|, |cur_tok|} +begin no_new_control_sequence:=false; get_next; no_new_control_sequence:=true; +@^inner loop@> +if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr +else cur_tok:=cs_token_flag+cur_cs; +end; +@y +@p procedure get_token; {sets |cur_cmd|, |cur_chr|, |cur_tok|} +begin no_new_control_sequence:=false; get_next; no_new_control_sequence:=true; +@^inner loop@> +if cur_cs=0 then + if (cur_cmd=kanji)or(cur_cmd=kana)or(cur_cmd=other_kchar) then {wchar_token} + cur_tok:=cur_chr + else cur_tok:=(cur_cmd*@'400)+cur_chr +else cur_tok:=cs_token_flag+cur_cs; +end; +@z + +%@x [25.367] l.8019 - pTeX: expand +%@<Suppress expansion...@>= +%begin save_scanner_status:=scanner_status; scanner_status:=normal; +%get_token; scanner_status:=save_scanner_status; t:=cur_tok; +%back_input; {now |start| and |loc| point to the backed-up token |t|} +%if t>=cs_token_flag then +% begin p:=get_avail; info(p):=cs_token_flag+frozen_dont_expand; +% link(p):=loc; start:=p; loc:=p; +% end; +%end +%@y +%@<Suppress expansion...@>= +%begin save_scanner_status:=scanner_status; scanner_status:=normal; +%get_token; scanner_status:=save_scanner_status; t:=cur_tok; +%back_input; {now |start| and |loc| point to the backed-up token |t|} +%if t>=cs_token_flag then +% begin p:=get_avail; info(p):=cs_token_flag+frozen_dont_expand; +% link(p):=loc; start:=p; loc:=p; +% end; +%end +%@z + +@x [25.374] l.8073 - pTeX: get_chr +@ @<Look up the characters of list |r| in the hash table...@>= +j:=first; p:=link(r); +while p<>null do + begin if j>=max_buf_stack then + begin max_buf_stack:=j+1; + if max_buf_stack=buf_size then + overflow("buffer size",buf_size); +@:TeX capacity exceeded buffer size}{\quad buffer size@> + end; + buffer[j]:=info(p) mod @'400; incr(j); p:=link(p); + end; +@y +@ @<Look up the characters of list |r| in the hash table...@>= +j:=first; p:=link(r); +while p<>null do + begin if j>=max_buf_stack then + begin max_buf_stack:=j+1; + if max_buf_stack=buf_size then + overflow("buffer size",buf_size); +@:TeX capacity exceeded buffer size}{\quad buffer size@> + end; + if check_kanji(info(p)) then {wchar_token} + begin buffer[j]:=Hi(info(p)); incr(j); + end; + buffer[j]:=Lo(info(p)); incr(j); p:=link(p); + end; +@z + +@x [25.380] l.8221 - pTeX: get_x_token +@p procedure get_x_token; {sets |cur_cmd|, |cur_chr|, |cur_tok|, + and expands macros} +label restart,done; +begin restart: get_next; +@^inner loop@> +if cur_cmd<=max_command then goto done; +if cur_cmd>=call then + if cur_cmd<end_template then macro_call + else begin cur_cs:=frozen_endv; cur_cmd:=endv; + goto done; {|cur_chr=null_list|} + end +else expand; +goto restart; +done: if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr +else cur_tok:=cs_token_flag+cur_cs; +end; +@y +@p procedure get_x_token; {sets |cur_cmd|, |cur_chr|, |cur_tok|, + and expands macros} +label restart,done; +begin restart: get_next; +@^inner loop@> +if cur_cmd<=max_command then goto done; +if cur_cmd>=call then + if cur_cmd<end_template then macro_call + else begin cur_cs:=frozen_endv; cur_cmd:=endv; + goto done; {|cur_chr=null_list|} + end +else expand; +goto restart; +done: if cur_cs=0 then + if (cur_cmd=kanji)or(cur_cmd=kana)or(cur_cmd=other_kchar) then + cur_tok:=cur_chr + else cur_tok:=(cur_cmd*@'400)+cur_chr +else cur_tok:=cs_token_flag+cur_cs; +end; +@z + +@x [25.381] l.8151 - pTeX: x_token +@p procedure x_token; {|get_x_token| without the initial |get_next|} +begin while cur_cmd>max_command do + begin expand; + get_next; + end; +if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr +else cur_tok:=cs_token_flag+cur_cs; +@y +@p procedure x_token; {|get_x_token| without the initial |get_next|} +begin while cur_cmd>max_command do + begin expand; + get_next; + end; +if cur_cs=0 then + if (cur_cmd=kanji)or(cur_cmd=kana)or(cur_cmd=other_kchar) then + cur_tok:=cur_chr + else cur_tok:=(cur_cmd*@'400)+cur_chr +else cur_tok:=cs_token_flag+cur_cs; +@z + +@x [26.413] l.8659 - pTeX: scan_somthing_internal +@p procedure scan_something_internal(@!level:small_number;@!negative:boolean); + {fetch an internal parameter} +var m:halfword; {|chr_code| part of the operand token} +@!p:0..nest_size; {index into |nest|} +begin m:=cur_chr; +case cur_cmd of +def_code: @<Fetch a character code from some table@>; +toks_register,assign_toks,def_family,set_font,def_font: @<Fetch a token list or + font identifier, provided that |level=tok_val|@>; +@y +@p @t\4@>@<Declare procedures needed in |scan_something|@>@t@>@/ +procedure scan_something_internal(@!level:small_number;@!negative:boolean); + {fetch an internal parameter} +var m:halfword; {|chr_code| part of the operand token} +@!p:0..nest_size; {index into |nest|} +@!q:pointer; +begin m:=cur_chr; +case cur_cmd of +assign_kinsoku: @<Fetch breaking penalty from some table@>; +assign_inhibit_xsp_code: @<Fetch inhibit type from some table@>; +def_code: @<Fetch a character code from some table@>; +toks_register,assign_toks,def_family,set_font,def_font,def_jfont,def_tfont: + @<Fetch a token list or font identifier, provided that |level=tok_val|@>; +@z + +@x [26.414] l.8693 - pTeX: +if m=xord_code_base then scanned_result(xord[cur_val])(int_val) +else if m=xchr_code_base then scanned_result(xchr[cur_val])(int_val) +else if m=xprn_code_base then scanned_result(xprn[cur_val])(int_val) +else if m=math_code_base then scanned_result(ho(math_code(cur_val)))(int_val) +else if m<math_code_base then scanned_result(equiv(m+cur_val))(int_val) +else scanned_result(eqtb[m+cur_val].int)(int_val); +@y +if m=math_code_base then scanned_result(ho(math_code(cur_val)))(int_val) +else if m=kcat_code_base then scanned_result(equiv(m+kcatcodekey(cur_val)))(int_val) +else if m<math_code_base then + begin if is_kanji(cur_val) then + scanned_result(equiv(m+Hi(cur_val)))(int_val) + else scanned_result(equiv(m+cur_val))(int_val) + end +else scanned_result(eqtb[m+cur_val].int)(int_val); +@z + +@x [26.420] l.8799 - pTeX: Fetch a box dimension: dir_node +if box(cur_val)=null then cur_val:=0 @+else cur_val:=mem[box(cur_val)+m].sc; +@y +if box(cur_val)=null then cur_val:=0 +else + begin q:=box(cur_val); + while (q<>null)and(box_dir(q)<>abs(direction)) do q:=link(q); + if q=null then + begin q:=new_dir_node(box(cur_val),abs(direction)); + cur_val:=mem[q+m].sc; + delete_glue_ref(space_ptr(q)); delete_glue_ref(xspace_ptr(q)); + free_node(q,box_node_size); + end + else cur_val:=mem[q+m].sc; + end; +@z + +@x [26.435] l.8940 - pTeX: scan_char_num +procedure scan_char_num; +begin scan_int; +if (cur_val<0)or(cur_val>255) then + begin print_err("Bad character code"); +@.Bad character code@> + help2("A character number must be between 0 and 255.")@/ + ("I changed this one to zero."); int_error(cur_val); cur_val:=0; + end; +end; +@y +procedure scan_char_num; +begin scan_int; +if (not is_char_ascii(cur_val))and(not check_kanji(cur_val)) then {wchar_token} + begin print_err("Bad character code"); +@.Bad character code@> + help2("A character number must be between 0 and 255, or KANJI code.")@/ + ("I changed this one to zero."); int_error(cur_val); cur_val:=0; + end; +end; +@z + +@x [26.442] l.9045 - pTeX: KANJI character scanning +@<Scan an alphabetic character code into |cur_val|@>= +begin get_token; {suppress macro expansion} +if cur_tok<cs_token_flag then + begin cur_val:=cur_chr; + if cur_cmd<=right_brace then + if cur_cmd=right_brace then incr(align_state) + else decr(align_state); + end +else if cur_tok<cs_token_flag+single_base then + cur_val:=cur_tok-cs_token_flag-active_base +else cur_val:=cur_tok-cs_token_flag-single_base; +if cur_val>255 then + begin print_err("Improper alphabetic constant"); +@.Improper alphabetic constant@> + help2("A one-character control sequence belongs after a ` mark.")@/ + ("So I'm essentially inserting \0 here."); + cur_val:="0"; back_error; + end +else @<Scan an optional space@>; +end +@y +@<Scan an alphabetic character code into |cur_val|@>= +begin get_token; {suppress macro expansion} +if cur_tok<cs_token_flag then + if (cur_cmd=kanji)or(cur_cmd=kana)or(cur_cmd=other_kchar) then {wchar_token} + begin skip_mode:=false; cur_val:=tonum(cur_chr); + end + else begin cur_val:=cur_chr; + if cur_cmd<=right_brace then + if cur_cmd=right_brace then incr(align_state) + else decr(align_state); + end +else if cur_tok<cs_token_flag+single_base then + cur_val:=cur_tok-cs_token_flag-active_base +else cur_val:=cur_tok-cs_token_flag-single_base; +if (cur_val>255)and(cur_cmd<kanji) then + begin print_err("Improper alphabetic or KANJI constant"); +@.Improper alphabetic constant@> + help2("A one-character control sequence belongs after a ` mark.")@/ + ("So I'm essentially inserting \0 here."); + cur_val:="0"; back_error; + end +else @<Scan an optional space@>; +skip_mode:=true; +end +@z + +@x [26.455] l.9288 - pTeX: zw, zh: zenkaku width & height +if scan_keyword("em") then v:=(@<The em width for |cur_font|@>) +@.em@> +else if scan_keyword("ex") then v:=(@<The x-height for |cur_font|@>) +@.ex@> +else goto not_found; +@y +if scan_keyword("em") then v:=(@<The em width for |cur_font|@>) +@.em@> +else if scan_keyword("ex") then v:=(@<The x-height for |cur_font|@>) +@.ex@> +else if scan_keyword("zw") then @<The KANJI width for |cur_jfont|@> +@.ze@> +else if scan_keyword("zh") then @<The KANJI height for |cur_jfont|@> +@.zh@> +else goto not_found; +@z + +@x [26.458] l.9345 - pTeX: dimension unit: Q, H (1/4 mm) +else if scan_keyword("sp") then goto done +@.sp@> +@y +else if scan_keyword("H") then set_conversion(7227)(10160) +@.H@> +else if scan_keyword("Q") then set_conversion(7227)(10160) +@.Q@> +else if scan_keyword("sp") then goto done +@.sp@> +@z + +@x [27.464] l.9475 - pTeX: str_toks + if t=" " then t:=space_token + else t:=other_token+t; +@y + if (multistrlen(str_pool, pool_ptr, k)=2) then + begin t:=fromBUFF(str_pool, pool_ptr, k); incr(k); + end + else if t=" " then t:=space_token + else t:=other_token+t; +@z + +@x [27.468] l.9531 - pTeX: convert KANJI code +@d number_code=0 {command code for \.{\\number}} +@d roman_numeral_code=1 {command code for \.{\\romannumeral}} +@d string_code=2 {command code for \.{\\string}} +@d meaning_code=3 {command code for \.{\\meaning}} +@d font_name_code=4 {command code for \.{\\fontname}} +@d job_name_code=5 {command code for \.{\\jobname}} +@y +@d number_code=0 {command code for \.{\\number}} +@d roman_numeral_code=1 {command code for \.{\\romannumeral}} +@d kansuji_code=2 {command code for \.{\\kansuji}} +@d string_code=3 {command code for \.{\\string}} +@d meaning_code=4 {command code for \.{\\meaning}} +@d font_name_code=5 {command code for \.{\\fontname}} +@d euc_code=6 {command code for \.{\\euc}} +@d sjis_code=7 {command code for \.{\\sjis}} +@d jis_code=8 {command code for \.{\\jis}} +@d kuten_code=9 {command code for \.{\\kuten}} +@d job_name_code=10 {command code for \.{\\jobname}} +@z + +@x [27.468] l.9547 - pTeX: +primitive("fontname",convert,font_name_code);@/ +@!@:font_name_}{\.{\\fontname} primitive@> +@y +primitive("fontname",convert,font_name_code);@/ +@!@:font_name_}{\.{\\fontname} primitive@> +primitive("kansuji",convert,kansuji_code); +@!@:kansuji_}{\.{\\kansuji} primitive@> +primitive("euc",convert,euc_code); +@!@:euc_}{\.{\\euc} primitive@> +primitive("sjis",convert,sjis_code); +@!@:sjis_}{\.{\\sjis} primitive@> +primitive("jis",convert,jis_code); +@!@:jis_}{\.{\\jis} primitive@> +primitive("kuten",convert,kuten_code); +@!@:kuten_}{\.{\\kuten} primitive@> +@z + +@x [27.469] l.9558 - pTeX: + font_name_code: print_esc("fontname"); +@y + font_name_code: print_esc("fontname"); + kansuji_code: print_esc("kansuji"); + euc_code:print_esc("euc"); + sjis_code:print_esc("sjis"); + jis_code:print_esc("jis"); + kuten_code:print_esc("kuten"); +@z + +@x [27.470] l.9566 - pTeX: convert KANJI code continue +@p procedure conv_toks; +var old_setting:0..max_selector; {holds |selector| setting} +@y +@p procedure conv_toks; +var old_setting:0..max_selector; {holds |selector| setting} +@!cx:KANJI_code; {temporary register for KANJI} +@z + +@x [27.471] l.9577 - pTeX: convert KANJI code continue +@ @<Scan the argument for command |c|@>= +case c of +number_code,roman_numeral_code: scan_int; +string_code, meaning_code: begin save_scanner_status:=scanner_status; + scanner_status:=normal; get_token; scanner_status:=save_scanner_status; + end; +@y +@ @<Scan the argument for command |c|@>= +KANJI(cx):=0; +case c of +number_code,roman_numeral_code, +kansuji_code,euc_code,sjis_code,jis_code,kuten_code: scan_int; +string_code, meaning_code: begin save_scanner_status:=scanner_status; + scanner_status:=normal; get_token; + if (cur_cmd=kanji)or(cur_cmd=kana)or(cur_cmd=other_kchar) then {wchar_token} + KANJI(cx):=cur_tok; + scanner_status:=save_scanner_status; + end; +@z + +@x [27.471] l.9587 - pTeX: convert KANJI code continue +@ @<Print the result of command |c|@>= +case c of +number_code: print_int(cur_val); +roman_numeral_code: print_roman_int(cur_val); +string_code:if cur_cs<>0 then sprint_cs(cur_cs) + else print_char(cur_chr); +@y +@ @<Print the result of command |c|@>= +case c of +number_code: print_int(cur_val); +roman_numeral_code: print_roman_int(cur_val); +jis_code: print_int(fromJIS(cur_val)); +euc_code: print_int(fromEUC(cur_val)); +sjis_code: print_int(fromSJIS(cur_val)); +kuten_code: print_int(fromKUTEN(cur_val)); +kansuji_code: print_kansuji(cur_val); +string_code:if cur_cs<>0 then sprint_cs(cur_cs) + else if KANJI(cx)=0 then print_char(cur_chr) + else print_kanji(cx); +@z + +@x [28.487] l.9852 - pTeX: iftdir, ifydir, iftbox, ifybox +@d if_case_code=16 { `\.{\\ifcase}' } +@y +@d if_case_code=16 { `\.{\\ifcase}' } +@d if_tdir_code=17 { `\.{\\iftdir}' } +@d if_ydir_code=18 { `\.{\\ifydir}' } +@d if_mdir_code=19 { `\.{\\ifmdir}' } +@d if_tbox_code=20 { `\.{\\iftbox}' } +@d if_ybox_code=21 { `\.{\\ifybox}' } +@z + +@x [28.487] l.9887 - pTeX: iftdir, ifydir, iftbox, ifybox +primitive("ifcase",if_test,if_case_code); +@!@:if_case_}{\.{\\ifcase} primitive@> +@y +primitive("ifcase",if_test,if_case_code); +@!@:if_case_}{\.{\\ifcase} primitive@> +primitive("iftdir",if_test,if_tdir_code); +@!@:if_tdir_}{\.{\\iftdir} primitive@> +primitive("ifydir",if_test,if_ydir_code); +@!@:if_ydir_}{\.{\\ifydir} primitive@> +primitive("ifmdir",if_test,if_mdir_code); +@!@:if_mdir_}{\.{\\ifmdir} primitive@> +primitive("iftbox",if_test,if_tbox_code); +@!@:if_tbox_}{\.{\\iftbox} primitive@> +primitive("ifybox",if_test,if_ybox_code); +@!@:if_ybox_}{\.{\\ifybox} primitive@> +@z + +@x [28.488] l.9907 - pTeX: iftdir, ifydir, iftbox, ifybox + if_case_code:print_esc("ifcase"); +@y + if_case_code:print_esc("ifcase"); + if_tdir_code:print_esc("iftdir"); + if_ydir_code:print_esc("ifydir"); + if_mdir_code:print_esc("ifmdir"); + if_tbox_code:print_esc("iftbox"); + if_ybox_code:print_esc("ifybox"); +@z + +@x [28.501] l.10073 - pTeX: iftdir, ifydir, iftbox, ifybox +if_void_code, if_hbox_code, if_vbox_code: @<Test box register status@>; +@y +if_tdir_code: b:=(abs(direction)=dir_tate); +if_ydir_code: b:=(abs(direction)=dir_yoko); +if_mdir_code: b:=(direction<0); +if_void_code, if_hbox_code, if_vbox_code, if_tbox_code, if_ybox_code: + @<Test box register status@>; +@z + +@x [28.505] l.10118 - pTeX: Test box register status : iftbox, ifybox +if this_if=if_void_code then b:=(p=null) +else if p=null then b:=false +else if this_if=if_hbox_code then b:=(type(p)=hlist_node) +else b:=(type(p)=vlist_node); +@y +if this_if=if_void_code then b:=(p=null) +else if p=null then b:=false +else begin + if type(p)=dir_node then p:=list_ptr(p); + if this_if=if_hbox_code then b:=(type(p)=hlist_node) + else if this_if=if_vbox_code then b:=(type(p)=vlist_node) + else if this_if=if_tbox_code then b:=(box_dir(p)=dir_tate) + else b:=(box_dir(p)=dir_yoko); + end +@z + +@x [28.502] l.10138 - pTeX: ifx : Test character : KANJI character +if (cur_cmd>active_char)or(cur_chr>255) then {not a character} + begin m:=relax; n:=256; + end +else begin m:=cur_cmd; n:=cur_chr; + end; +get_x_token_or_active_char; +if (cur_cmd>active_char)or(cur_chr>255) then + begin cur_cmd:=relax; cur_chr:=256; + end; +@y +if (cur_cmd=kanji)or(cur_cmd=kana)or(cur_cmd=other_kchar) then + begin m:=cur_cmd; n:=cur_chr; + end +else if (cur_cmd>active_char)or(cur_chr>255) then + begin m:=relax; n:=256; + end +else begin m:=cur_cmd; n:=cur_chr; + end; +get_x_token_or_active_char; +if (cur_cmd=kanji)or(cur_cmd=kana)or(cur_cmd=other_kchar) then + begin cur_cmd:=cur_cmd; + end {dummy} +else if (cur_cmd>active_char)or(cur_chr>255) then + begin cur_cmd:=relax; cur_chr:=256; + end; +@z + +@x [29.523] l.10571 - pTeX: xord +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 +if name_of_file then libc_free (name_of_file); +name_of_file := xmalloc (1 + n + (b - a + 1) + format_ext_length + 1); +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]]); +@z + +@x [29.526] l.10668 - pTeX: scan file name +loop@+begin if (cur_cmd>other_char)or(cur_chr>255) then {not a character} + begin back_input; goto done; + end; + {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; + get_x_token; + end; +done: end_name; name_in_progress:=false; +@y +skip_mode:=false; +loop@+begin + if (cur_cmd=kanji)or(cur_cmd=kana)or(cur_cmd=other_kchar) then {is kanji} + begin str_room(2); + append_char(Hi(cur_chr)); {kanji upper byte} + append_char(Lo(cur_chr)); {kanji lower byte} + end + else if (cur_cmd>other_char)or(cur_chr>255) then {not a alphabet} + begin back_input; goto done; + end + {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.} + else if ((cur_chr=" ") and (state<>token_list) and (loc>limit)) or not more_name(cur_chr) then goto done; + get_x_token; + end; +done: end_name; name_in_progress:=false; +skip_mode:=true; +@z + +@x l.10797 - pTeX +if enctex_enabled_p then + begin wlog_cr; wlog(encTeX_banner); wlog(', reencoding enabled'); + if translate_filename then + begin wlog_cr; + wlog(' (\xordcode, \xchrcode, \xprncode overridden by TCX)'); + end; + end; +@y +@z + +@x [29.536] l.10834 - pTeX: +begin +if src_specials_p or file_line_error_style_p or parse_first_line_p +then + wlog(banner_k) +else + wlog(banner); +@y +begin +if src_specials_p or file_line_error_style_p or parse_first_line_p +then + wlog(banner_k) +else + wlog(banner); + wlog(' ('); + wlog(stringcast(get_enc_string)); + wlog(')'); +@z + +@x [30.560] l.10968 - pTeX: +This is called BigEndian order. +@!@^BigEndian order@> +@y +This is called BigEndian order. +@!@^BigEndian order@> + +We use to get \TeX\ knowledge about KANJI fonts from \.{JFM} files. +The \.{JFM} format holds more two 16-bit integers ,|id| and |nt|, +at the top of the file. +$$\vbox{\halign{\hfil#&$\null=\null$#\hfil\cr +|id|&identification code of the file;\cr +|nt|&number of words in the |char_type| table;\cr}}$$ +The identification byte, |id| equals~11 or~9. When \TeX read a font file, +the |id| equals~11 or~9 then the font is the \.{JFM}, othercases it is +the \.{TFM} file. The \.{TFM} holds |lf| at the same postion of |id|, +usually it take a larger number than~9 or~11. +The |nt| is nonngative and less than $2^{15}$. + +We must have |ec=0|, +$$\hbox{|lf=7+lh+nt+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np|.}$$ + +@d yoko_jfm_id=11 {for `yoko-kumi' fonts} +@d tate_jfm_id=9 {for `tate-kumi' fonts} +@z + +@x [30.544] l.11085 - pTeX: gk_tag +operation looks for both |list_tag| and |ext_tag|. +@y +operation looks for both |list_tag| and |ext_tag|. + +If the \.{JFM}, the |lig_tag| is called |gk_tag|. The |gk_tag| means that +this character has a glue/kerning program starting at position |remainder| +in the |glue_kern| array. And a \.{JFM} not used |tag=2| and |tag=3|. +@z + +@x [30.544] l.11088 - pTeX: gk_tag +@d lig_tag=1 {character has a ligature/kerning program} +@y +@d lig_tag=1 {character has a ligature/kerning program} +@d gk_tag=1 {character has a glue/kerning program} +@z + +@x [30.549] l.11228 - pTeX: +@<Glob...@>= +@!font_info: ^fmemory_word; +@y +@<Glob...@>= +@!font_info: ^memory_word; {pTeX: use halfword for |char_type| table.} +@!font_dir: ^eight_bits; + {pTeX: direction of fonts, 0 is default, 1 is Yoko, 2 is Tate} +@!font_num_ext: ^integer; + {pTeX: number of the |char_type| table.} +@z + +@x [30.550] l.11270 - pTeX: +@!char_base: ^integer; + {base addresses for |char_info|} +@y +@!char_base: ^integer; + {base addresses for |char_info|} +@!ctype_base: ^integer; + {pTeX: base addresses for KANJI character type parameters} +@z + +@x [30.554] l.11373 - pTeX: +@d orig_char_info_end(#)==#].qqqq +@d orig_char_info(#)==font_info[char_base[#]+orig_char_info_end +@y +@d orig_char_info_end(#)==#].qqqq +@d orig_char_info(#)==font_info[char_base[#]+orig_char_info_end +@# +@d kchar_code_end(#)==#].hh.rh +@d kchar_code(#)==font_info[ctype_base[#]+kchar_code_end +@d kchar_type_end(#)==#].hh.lhfield +@d kchar_type(#)==font_info[ctype_base[#]+kchar_type_end +@z + +@x [30.557] l.11413 - pTeX: glue_kern_start +@d lig_kern_start(#)==lig_kern_base[#]+rem_byte {beginning of lig/kern program} +@y +@d lig_kern_start(#)==lig_kern_base[#]+rem_byte {beginning of lig/kern program} +@d glue_kern_start(#)==lig_kern_base[#]+rem_byte + {beginning of glue/kern program} +@z + +@x [30.560] l.11457 - pTeX: jfm_flag, jfm_id, nt, cx +var k:font_index; {index into |font_info|} +@y +var k:font_index; {index into |font_info|} +@!jfm_flag:dir_default..dir_tate; {direction of the \.{JFM}} +@!nt:halfword; {number of the |char_type| tables} +@!cx:KANJI_code; {kanji code} +@z + +@x [30.565] l.11548 - pTeX: read tfm size +@ @<Read the {\.{TFM}} size fields@>= +begin read_sixteen(lf); +fget; read_sixteen(lh); +fget; read_sixteen(bc); +fget; read_sixteen(ec); +if (bc>ec+1)or(ec>255) then abort; +if bc>255 then {|bc=256| and |ec=255|} + begin bc:=1; ec:=0; + end; +fget; read_sixteen(nw); +fget; read_sixteen(nh); +fget; read_sixteen(nd); +fget; read_sixteen(ni); +fget; read_sixteen(nl); +fget; read_sixteen(nk); +fget; read_sixteen(ne); +fget; read_sixteen(np); +if lf<>6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np then abort; +if (nw=0)or(nh=0)or(nd=0)or(ni=0) then abort; +end +@y +@ @<Read the {\.{TFM}} size fields@>= +begin read_sixteen(lf); +fget; read_sixteen(lh); +if lf=yoko_jfm_id then + begin jfm_flag:=dir_yoko; nt:=lh; + fget; read_sixteen(lf); + fget; read_sixteen(lh); + end +else if lf=tate_jfm_id then + begin jfm_flag:=dir_tate; nt:=lh; + fget; read_sixteen(lf); + fget; read_sixteen(lh); + end +else begin jfm_flag:=dir_default; nt:=0; + end; +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 jfm_flag<>dir_default then + begin if lf<>7+lh+nt+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np then abort + end +else + begin if lf<>6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np then abort + end; +if (nw=0)or(nh=0)or(nd=0)or(ni=0) then abort; +end +@z + +@x [30.566] l.11574 - pTeX: set font_dir & font_num_ext +@<Use size fields to allocate font information@>= +lf:=lf-6-lh; {|lf| words should be loaded into |font_info|} +if np<7 then lf:=lf+7-np; {at least seven parameters will appear} +if (font_ptr=font_max)or(fmem_ptr+lf>font_mem_size) then + @<Apologize for not loading the font, |goto done|@>; +f:=font_ptr+1; +char_base[f]:=fmem_ptr-bc; +width_base[f]:=char_base[f]+ec+1; +height_base[f]:=width_base[f]+nw; +depth_base[f]:=height_base[f]+nh; +italic_base[f]:=depth_base[f]+nd; +lig_kern_base[f]:=italic_base[f]+ni; +kern_base[f]:=lig_kern_base[f]+nl-kern_base_offset; +exten_base[f]:=kern_base[f]+kern_base_offset+nk; +param_base[f]:=exten_base[f]+ne +@y +@<Use size fields to allocate font information@>= +if jfm_flag<>dir_default then + lf:=lf-7-lh {If \.{JFM}, |lf| holds more two-16bit records than \.{TFM}} +else + lf:=lf-6-lh; {|lf| words should be loaded into |font_info|} +if np<7 then lf:=lf+7-np; {at least seven parameters will appear} +if (font_ptr=font_max)or(fmem_ptr+lf>font_mem_size) then + @<Apologize for not loading the font, |goto done|@>; +f:=font_ptr+1; +font_dir[f]:=jfm_flag; +font_num_ext[f]:=nt; +ctype_base[f]:=fmem_ptr; +char_base[f]:=ctype_base[f]+nt-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; +@z + +@x [30.569] l.11619 - pTeX: read char_type +@ @<Read character data@>= +for k:=fmem_ptr to width_base[f]-1 do + begin store_four_quarters(font_info[k].qqqq); +@y +@ @<Read character data@>= +if jfm_flag<>dir_default then + for k:=ctype_base[f] to ctype_base[f]+nt-1 do + begin + fget; read_sixteen(cx); font_info[k].hh.rh:=tokanji(cx); {|kchar_code|} + fget; read_sixteen(cx); font_info[k].hh.lhfield:=tonum(cx); {|kchar_type|} + end; +for k:=char_base[f]+bc to width_base[f]-1 do + begin store_four_quarters(font_info[k].qqqq); +@z + +@x [30.570] l.11638 - pTeX: +@d current_character_being_worked_on==k+bc-fmem_ptr +@y +@d current_character_being_worked_on==k-char_base[f] +@z + +@x [30.573] l.11704 - pTeX: jfm + 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; +@y + 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 begin + if jfm_flag<>dir_default then begin if d>=ne then abort; end + else check_existence(d); {check ligature} + end 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; +@z + +@x [30.574] l.11720 - pTeX: read jfm exten +for k:=exten_base[f] to param_base[f]-1 do + begin store_four_quarters(font_info[k].qqqq); +@y +if jfm_flag<>dir_default then + for k:=exten_base[f] to param_base[f]-1 do + store_scaled(font_info[k].sc) {NOTE: this area subst for glue program} +else for k:=exten_base[f] to param_base[f]-1 do + begin store_four_quarters(font_info[k].qqqq); +@z + +@x [30.576] l.11765 - pTeX: adjust ctype_base +adjust(char_base); adjust(width_base); adjust(lig_kern_base); +@y +adjust(ctype_base); +adjust(char_base); adjust(width_base); adjust(lig_kern_base); +@z + +@x [30.577] l.11778 - pTeX: jfont, tfont +if cur_cmd=def_font then f:=cur_font +@y +if cur_cmd=def_jfont then f:=cur_jfont +else if cur_cmd=def_tfont then f:=cur_tfont +else if cur_cmd=def_font then f:=cur_font +@z + +@x +@p procedure char_warning(@!f:internal_font_number;@!c:eight_bits); +begin if tracing_lost_chars>0 then + begin begin_diagnostic; + print_nl("Missing character: There is no "); +@.Missing character@> + print_ASCII(c); print(" in font "); + slow_print(font_name[f]); print_char("!"); end_diagnostic(false); + end; +end; +@y +@d print_lc_hex(#)==l:=#; + if l<10 then print_char(l+"0")@+else print_char(l-10+"a") + +@p procedure char_warning(@!f:internal_font_number;@!c:eight_bits); +var @!l:0..255; {small indices or counters} +begin if tracing_lost_chars>0 then + begin begin_diagnostic; + print_nl("Missing character: There is no "); +@.Missing character@> + if (c<" ")or(c>"~") then + begin print_char("^"); print_char("^"); + if c<64 then print_char(c+64) + else if c<128 then print_char(c-64) + else begin print_lc_hex(c div 16); print_lc_hex(c mod 16); end + end + else print_ASCII(c); + print(" in font "); + slow_print(font_name[f]); print_char("!"); end_diagnostic(false); + end; +end; +@z + +@x [31.586] l.12189 - pTeX: define set2 +@d set1=128 {typeset a character and move right} +@y +@d set1=128 {typeset a character and move right} +@d set2=129 {typeset a character and move right} +@z +@x [31.586] l.12214 - pTeX: define dirchg +@d post_post=249 {postamble ending} +@y +@d post_post=249 {postamble ending} +@d dirchg=255 {direction change} +@z + +@x [31.587] l.12246 - pTeX: ex_id_byte +@d id_byte=2 {identifies the kind of \.{DVI} files described here} +@y +@d id_byte=2 {identifies the kind of \.{DVI} files described here} +@d ex_id_byte=3 {identifies the kind of extended \.{DVI} files} +@z + +@x [32.590] l.12329 - pTeX: ex_id_byte: This dvi is extended! +@ The last part of the postamble, following the |post_post| byte that +signifies the end of the font definitions, contains |q|, a pointer to the +|post| command that started the postamble. An identification byte, |i|, +comes next; this currently equals~2, as in the preamble. +@y +@ The last part of the postamble, following the |post_post| byte that +signifies the end of the font definitions, contains |q|, a pointer to the +|post| command that started the postamble. An identification byte, |i|, +comes next; this equals~2 or~3. If not used p\TeX primitives then the +identification byte equals~2, othercase this is set to~3. +@z + +@x [32.592] l.12405 - pTeX: + {character and font in current |char_node|} +@!c:quarterword; +@!f:internal_font_number; +@y + {character and font in current |char_node|} +@!c:quarterword; +@!f:internal_font_number; +@!dir_used:boolean; {Is this dvi extended?} +@z + +@x [32.593] l.12414 - pTeX: dir_used: Is this dvi extended? +doing_leaders:=false; dead_cycles:=0; cur_s:=-1; +@y +doing_leaders:=false; dead_cycles:=0; cur_s:=-1; dir_used:=false; +@z + +@x [32.617] l.12846 - pTeX: Initialize dvi_dir as shipout begins +dvi_h:=0; dvi_v:=0; cur_h:=h_offset; dvi_f:=null_font; +@y +dvi_h:=0; dvi_v:=0; cur_h:=h_offset; dvi_f:=null_font; +dvi_dir:=dir_yoko; cur_dir:=dvi_dir; +@z + +@x [32.619] l.12892 - pTeX: hlist_out Kanji, disp_node +procedure hlist_out; {output an |hlist_node| box} +label reswitch, move_past, fin_rule, next_p, continue, found; +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, continue, found; +var base_line: scaled; {the baseline coordinate for this box} +@!disp: scaled; {displacement} +@!save_dir:eight_bits; {what |dvi_dir| should pop to} +@!jc:KANJI_code; {temporary register for KANJI codes} +@!ksp_ptr:pointer; {position of |auto_spacing_glue| in the hlist} +@z +@x [32.619] l.12913 - pTeX: hlist_out Kanji, disp_node +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; +@y +ksp_ptr:=space_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; +synch_dir; +base_line:=cur_v; left_edge:=cur_h; disp:=0; +@z + +@x [32.622] l.12945 - pTeX: chain +@<Output node |p| for |hlist_out|...@>= +reswitch: if is_char_node(p) then + begin synch_h; synch_v; + repeat f:=font(p); c:=character(p); + if f<>dvi_f then @<Change font |dvi_f| to |f|@>; + if font_ec[f]>=qo(c) then if font_bc[f]<=qo(c) then + if char_exists(orig_char_info(f)(c)) then {N.B.: not |char_info|} + begin if c>=qi(128) then dvi_out(set1); + dvi_out(qo(c));@/ + cur_h:=cur_h+char_width(f)(orig_char_info(f)(c)); + goto continue; + end; + if mltex_enabled_p then + @<Output a substitution, |goto continue| if not possible@>; +continue: + p:=link(p); + until not is_char_node(p); + dvi_h:=cur_h; + end +else @<Output the non-|char_node| |p| for |hlist_out| + and move to the next node@> +@y +@<Output node |p| for |hlist_out|...@>= +reswitch: if is_char_node(p) then + begin synch_h; synch_v; + chain:=false; + repeat f:=font(p); c:=character(p); + if f<>dvi_f then @<Change font |dvi_f| to |f|@>; + if font_dir[f]=dir_default then + begin chain:=false; + if font_ec[f]>=qo(c) then if font_bc[f]<=qo(c) then + if char_exists(orig_char_info(f)(c)) then {N.B.: not |char_info|} + begin if c>=qi(128) then dvi_out(set1); + dvi_out(qo(c));@/ + cur_h:=cur_h+char_width(f)(orig_char_info(f)(c)); + goto continue; + end; + if mltex_enabled_p then + @<Output a substitution, |goto continue| if not possible@>; +continue: + end + else + begin if chain=false then chain:=true + else begin cur_h:=cur_h+width(ksp_ptr); + if g_sign<>normal then + begin if g_sign=stretching then + begin if stretch_order(ksp_ptr)=g_order then + cur_h:=cur_h+round(float(glue_set(this_box))*stretch(ksp_ptr)); +@^real multiplication@> + end + else + begin if shrink_order(ksp_ptr)=g_order then + cur_h:=cur_h-round(float(glue_set(this_box))*shrink(ksp_ptr)); +@^real multiplication@> + end; + end; + synch_h; + end; + p:=link(p); + jc:=toDVI(KANJI(info(p))); + dvi_out(set2); dvi_out(Hi(jc)); dvi_out(Lo(jc)); + cur_h:=cur_h+char_width(f)(orig_char_info(f)(c)); {not |jc|} + end; + dvi_h:=cur_h; p:=link(p); + until not is_char_node(p); + chain:=false; + end +else @<Output the non-|char_node| |p| for |hlist_out| + and move to the next node@> +@z + +@x [32.623] l.12982 - pTeX: disp_node, dir_node +@ @<Output the non-|char_node| |p| for |hlist_out|...@>= +begin case type(p) of +hlist_node,vlist_node:@<Output a box in an hlist@>; +rule_node: begin rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p); + goto fin_rule; + end; +whatsit_node: @<Output the whatsit node |p| in an hlist@>; +@y +@ @<Output the non-|char_node| |p| for |hlist_out|...@>= +begin case type(p) of +hlist_node,vlist_node,dir_node:@<Output a box in an hlist@>; +rule_node: begin rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p); + goto fin_rule; + end; +whatsit_node: @<Output the whatsit node |p| in an hlist@>; +disp_node: begin disp:=disp_dimen(p); cur_v:=base_line+disp; end; +@z + +@x [32.624] l.13000 - pTeX: output a box(and dir_node) with disp +@ @<Output a box in an hlist@>= +if list_ptr(p)=null then cur_h:=cur_h+width(p) +else begin save_h:=dvi_h; save_v:=dvi_v; + cur_v:=base_line+shift_amount(p); {shift the box down} + temp_ptr:=p; edge:=cur_h; + if type(p)=vlist_node then vlist_out@+else hlist_out; + dvi_h:=save_h; dvi_v:=save_v; + cur_h:=edge+width(p); cur_v:=base_line; + end +@y +@ @<Output a box in an hlist@>= +if list_ptr(p)=null then cur_h:=cur_h+width(p) +else begin save_h:=dvi_h; save_v:=dvi_v; save_dir:=dvi_dir; + cur_v:=base_line+disp+shift_amount(p); {shift the box down} + temp_ptr:=p; edge:=cur_h; + case type(p) of + hlist_node:hlist_out; + vlist_node:vlist_out; + dir_node:dir_out; + endcases; + dvi_h:=save_h; dvi_v:=save_v; dvi_dir:=save_dir; + cur_h:=edge+width(p); cur_v:=base_line+disp; cur_dir:=save_dir; + end +@z + +@x [32.625] l.13010 - pTeX: Output a rule with disp +@ @<Output a rule in an hlist@>= +if is_running(rule_ht) then rule_ht:=height(this_box); +if is_running(rule_dp) then rule_dp:=depth(this_box); +@y +@ @<Output a rule in an hlist@>= +if is_running(rule_ht) then rule_ht:=height(this_box)+disp; +if is_running(rule_dp) then rule_dp:=depth(this_box)-disp; +@z + +@x [32.629] l.13103 - pTeX: Output a leader box(and dir_node) with disp +@<Output a leader box at |cur_h|, ...@>= +begin cur_v:=base_line+shift_amount(leader_box); synch_v; save_v:=dvi_v;@/ +synch_h; save_h:=dvi_h; temp_ptr:=leader_box; +outer_doing_leaders:=doing_leaders; doing_leaders:=true; +if type(leader_box)=vlist_node then vlist_out@+else hlist_out; +doing_leaders:=outer_doing_leaders; +dvi_v:=save_v; dvi_h:=save_h; cur_v:=base_line; +cur_h:=save_h+leader_wd+lx; +end +@y +@<Output a leader box at |cur_h|, ...@>= +begin cur_v:=base_line+disp+shift_amount(leader_box); synch_v; save_v:=dvi_v;@/ +synch_h; save_h:=dvi_h; save_dir:=dvi_dir; temp_ptr:=leader_box; +outer_doing_leaders:=doing_leaders; doing_leaders:=true; +case type(leader_box) of + hlist_node:hlist_out; + vlist_node:vlist_out; + dir_node:dir_out; +endcases; +doing_leaders:=outer_doing_leaders; +dvi_v:=save_v; dvi_h:=save_h; dvi_dir:=save_dir; +cur_v:=base_line; cur_h:=save_h+leader_wd+lx; cur_dir:=save_dir; +end +@z + +@x [32.630] l.13133 - pTeX: vlist_out +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); +@y +@!save_dir:integer; {what |dvi_dir| should pop to} +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; +synch_dir; +left_edge:=cur_h; cur_v:=cur_v-height(this_box); +@z + +@x [32.632] l.13155 - pTeX: output non-char-node +@ @<Output the non-|char_node| |p| for |vlist_out|@>= +begin case type(p) of +hlist_node,vlist_node:@<Output a box in a vlist@>; +rule_node: begin rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p); + goto fin_rule; + end; +@y +@ @<Output the non-|char_node| |p| for |vlist_out|@>= +begin case type(p) of +hlist_node,vlist_node,dir_node: @<Output a box in a vlist@>; +rule_node: begin rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p); + goto fin_rule; + end; +@z + +@x [32.633] l.13175 - pTeX: Output a box in a vlist +@<Output a box in a vlist@>= +if list_ptr(p)=null then cur_v:=cur_v+height(p)+depth(p) +else begin cur_v:=cur_v+height(p); synch_v; + save_h:=dvi_h; save_v:=dvi_v; + cur_h:=left_edge+shift_amount(p); {shift the box right} + temp_ptr:=p; + if type(p)=vlist_node then vlist_out@+else hlist_out; + dvi_h:=save_h; dvi_v:=save_v; + cur_v:=save_v+depth(p); cur_h:=left_edge; + end +@y +@<Output a box in a vlist@>= +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; save_dir:=dvi_dir; + cur_h:=left_edge+shift_amount(p); {shift the box right} + temp_ptr:=p; + case type(p) of + hlist_node:hlist_out; + vlist_node:vlist_out; + dir_node:dir_out; + endcases; + dvi_h:=save_h; dvi_v:=save_v; dvi_dir:=save_dir; + cur_v:=save_v+depth(p); cur_h:=left_edge; cur_dir:=save_dir; + end +@z + +@x [32.637] l.13256 - pTeX: Output a leader in a vlist +@<Output a leader box at |cur_v|, ...@>= +begin cur_h:=left_edge+shift_amount(leader_box); synch_h; save_h:=dvi_h;@/ +cur_v:=cur_v+height(leader_box); synch_v; save_v:=dvi_v; +temp_ptr:=leader_box; +outer_doing_leaders:=doing_leaders; doing_leaders:=true; +if type(leader_box)=vlist_node then vlist_out@+else hlist_out; +doing_leaders:=outer_doing_leaders; +dvi_v:=save_v; dvi_h:=save_h; cur_h:=left_edge; +cur_v:=save_v-height(leader_box)+leader_ht+lx; +end +@y +@<Output a leader box at |cur_v|, ...@>= +begin 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; save_dir:=dvi_dir; +temp_ptr:=leader_box; +outer_doing_leaders:=doing_leaders; doing_leaders:=true; +case type(leader_box) of + hlist_node:hlist_out; + vlist_node:vlist_out; + dir_node:dir_out; +endcases; +doing_leaders:=outer_doing_leaders; +dvi_v:=save_v; dvi_h:=save_h; dvi_dir:=save_dir; +cur_h:=left_edge; cur_v:=save_v-height(leader_box)+leader_ht+lx; +cur_dir:=save_dir; +end +@z + +@x [32.638] l.13270 - pTeX: ship out +@p procedure ship_out(@!p:pointer); {output the box |p|} +label done; +var page_loc:integer; {location of the current |bop|} +@y +@p procedure ship_out(@!p:pointer); {output the box |p|} +label done; +var page_loc:integer; {location of the current |bop|} +@!del_node:pointer; {used when delete the |dir_node| continued box} +@z +@x [32.640] l.13294 - pTeX: ship out +@<Ship box |p| out@>; +@y +if type(p)=dir_node then + begin del_node:=p; p:=list_ptr(p); + delete_glue_ref(space_ptr(del_node)); + delete_glue_ref(xspace_ptr(del_node)); + free_node(del_node,box_node_size); + end; +flush_node_list(link(p)); link(p):=null; +if box_dir(p)<>dir_yoko then p:=new_dir_node(p,dir_yoko); +@<Ship box |p| out@>; +@z + +@x [32.641] l.13327 - pTeX: dir_node +if type(p)=vlist_node then vlist_out@+else hlist_out; +@y +case type(p) of + hlist_node:hlist_out; + vlist_node:vlist_out; + dir_node:dir_out; +endcases; +@z + +@x [33.642] l.13394 - pTeX: postamble's id_byte + @<Output the font definitions for all fonts that were used@>; + dvi_out(post_post); dvi_four(last_bop); dvi_out(id_byte);@/ +@y + @<Output the font definitions for all fonts that were used@>; + dvi_out(post_post); dvi_four(last_bop); + if dir_used then dvi_out(ex_id_byte) else dvi_out(id_byte);@/ +@z + +@x [33.647] l.13515 - pTeX: cur_kanji_skip, cur_xkanji_skip, last_disp +@< Glob...@>= +@!adjust_tail:pointer; {tail of adjustment list} +@y +@< Glob...@>= +@!adjust_tail:pointer; {tail of adjustment list} +@!last_disp:scaled; {displacement at end of list} +@!cur_kanji_skip:pointer; +@!cur_xkanji_skip:pointer; +@z + +@x [33.648] l.13518 - pTeX: cur_kanji_skip, cur_xkanji_skip +@ @<Set init...@>=adjust_tail:=null; last_badness:=0; +@y +@ @<Set init...@>=adjust_tail:=null; last_badness:=0; + cur_kanji_skip:=zero_glue; cur_xkanji_skip:=zero_glue; +{ koko + |incr(glue_ref_count(cur_kanji_skip));| + |incr(glue_ref_count(cur_xkanji_skip));| +} +@z + +@x [33.649] l.13522 - pTeX: hpack +@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} +@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} +@!k:pointer; {points to a |kanji_space| specification} +@!disp:scaled; {displacement} +@z + +@x [33.649] l.13533 - pTeX: hpack +begin last_badness:=0; r:=get_node(box_node_size); type(r):=hlist_node; +subtype(r):=min_quarterword; shift_amount(r):=0; +q:=r+list_offset; link(q):=p;@/ +h:=0; @<Clear dimensions to zero@>; +while p<>null do @<Examine node |p| in the hlist, taking account of its effect + on the dimensions of the new box, or moving it to the adjustment list; + then advance |p| to the next node@>; +if adjust_tail<>null then link(adjust_tail):=null; +height(r):=h; depth(r):=d;@/ +@<Determine the value of |width(r)| and the appropriate glue setting; + then |return| or |goto common_ending|@>; +common_ending: @<Finish issuing a diagnostic message + for an overfull or underfull hbox@>; +exit: hpack:=r; +end; +@y +begin last_badness:=0; r:=get_node(box_node_size); type(r):=hlist_node; +subtype(r):=min_quarterword; shift_amount(r):=0; +space_ptr(r):=cur_kanji_skip; xspace_ptr(r):=cur_xkanji_skip; +add_glue_ref(cur_kanji_skip); add_glue_ref(cur_xkanji_skip); +k:=cur_kanji_skip; +q:=r+list_offset; link(q):=p;@/ +h:=0; @<Clear dimensions to zero@>; +disp:=0; +while p<>null do @<Examine node |p| in the hlist, taking account of its effect + on the dimensions of the new box, or moving it to the adjustment list; + then advance |p| to the next node@>; +if adjust_tail<>null then link(adjust_tail):=null; +height(r):=h; depth(r):=d;@/ +@<Determine the value of |width(r)| and the appropriate glue setting; + then |return| or |goto common_ending|@>; +common_ending: + @<Finish issuing a diagnostic message for an overfull or underfull hbox@>; +exit: last_disp:=disp; hpack:=r; +end; +@z + +@x [33.651] l.13556 - pTeX: dir_node, disp_node, reset chain +@ @<Examine node |p| in the hlist, taking account of its effect...@>= +@^inner loop@> +begin reswitch: while is_char_node(p) do + @<Incorporate character dimensions into the dimensions of + the hbox that will contain~it, then move to the next node@>; +if p<>null then + begin case type(p) of + hlist_node,vlist_node,rule_node,unset_node: + @<Incorporate box dimensions into the dimensions of + the hbox that will contain~it@>; + ins_node,mark_node,adjust_node: if adjust_tail<>null then + @<Transfer node |p| to the adjustment list@>; + whatsit_node:@<Incorporate a whatsit node into an hbox@>; + glue_node:@<Incorporate glue into the horizontal totals@>; + kern_node,math_node: x:=x+width(p); + ligature_node: @<Make node |p| look like a |char_node| + and |goto reswitch|@>; + othercases do_nothing + endcases;@/ + p:=link(p); + end; +end +@y +@ @<Examine node |p| in the hlist, taking account of its effect...@>= +@^inner loop@> +begin reswitch: chain:=false; +while is_char_node(p) do + @<Incorporate character dimensions into the dimensions of + the hbox that will contain~it, then move to the next node@>; +if p<>null then + begin case type(p) of + hlist_node,vlist_node,dir_node,rule_node,unset_node: + @<Incorporate box dimensions into the dimensions of + the hbox that will contain~it@>; + ins_node,mark_node,adjust_node: + if adjust_tail<>null then @<Transfer node |p| to the adjustment list@>; + whatsit_node:@<Incorporate a whatsit node into an hbox@>; + disp_node:disp:=disp_dimen(p); + glue_node:@<Incorporate glue into the horizontal totals@>; + kern_node,math_node:x:=x+width(p); + ligature_node:@<Make node |p| look like a |char_node| and |goto reswitch|@>; + othercases do_nothing + endcases;@/ + p:=link(p); + end; +end +@z + +@x [33.653] l.13589 - pTeX: displacement +@<Incorporate box dimensions into the dimensions of the hbox...@>= +begin x:=x+width(p); +if type(p)>=rule_node then s:=0 @+else s:=shift_amount(p); +if height(p)-s>h then h:=height(p)-s; +if depth(p)+s>d then d:=depth(p)+s; +end +@y +@<Incorporate box dimensions into the dimensions of the hbox...@>= +begin x:=x+width(p); +if type(p)>=rule_node then s:=disp @+else s:=shift_amount(p)+disp; +if height(p)-s>h then h:=height(p)-s; +if depth(p)+s>d then d:=depth(p)+s; +end +@z + +@x [33.654] l.13601 - pTeX: auto spacing, displacement +@<Incorporate character dimensions into the dimensions of the hbox...@>= +begin f:=font(p); i:=char_info(f)(character(p)); hd:=height_depth(i); +x:=x+char_width(f)(i);@/ +s:=char_height(f)(hd);@+if s>h then h:=s; +s:=char_depth(f)(hd);@+if s>d then d:=s; +p:=link(p); +end +@y +@<Incorporate character dimensions into the dimensions of the hbox...@>= +begin f:=font(p); i:=char_info(f)(character(p)); hd:=height_depth(i); +x:=x+char_width(f)(i);@/ +s:=char_height(f)(hd)-disp; if s>h then h:=s; +s:=char_depth(f)(hd)+disp; if s>d then d:=s; +if font_dir[f]<>dir_default then + begin p:=link(p); + if chain then + begin x:=x+width(k);@/ + o:=stretch_order(k); total_stretch[o]:=total_stretch[o]+stretch(k); + o:=shrink_order(k); total_shrink[o]:=total_shrink[o]+shrink(k); + end + else chain:=true; + end +else chain:=false; +p:=link(p); +end +@z + +@x [33.668] l.13779 - pTeX: vpackage +begin last_badness:=0; r:=get_node(box_node_size); type(r):=vlist_node; +subtype(r):=min_quarterword; shift_amount(r):=0; +@y +begin last_badness:=0; r:=get_node(box_node_size); type(r):=vlist_node; +subtype(r):=min_quarterword; shift_amount(r):=0; +space_ptr(r):=zero_glue; xspace_ptr(r):=zero_glue; +add_glue_ref(zero_glue); add_glue_ref(zero_glue); +@z + +@x [33.669] l.13797 - pTeX: dir_node +@ @<Examine node |p| in the vlist, taking account of its effect...@>= +begin if is_char_node(p) then confusion("vpack") +@:this can't happen vpack}{\quad vpack@> +else case type(p) of + hlist_node,vlist_node,rule_node,unset_node: + @<Incorporate box dimensions into the dimensions of + the vbox that will contain~it@>; +@y +@ @<Examine node |p| in the vlist, taking account of its effect...@>= +begin if is_char_node(p) then confusion("vpack") +@:this can't happen vpack}{\quad vpack@> +else case type(p) of + hlist_node,vlist_node,dir_node,rule_node,unset_node: + @<Incorporate box dimensions into the dimensions of + the vbox that will contain~it@>; +@z + +@x [34.681] l.14026 - pTeX: math noad +@d noad_size=4 {number of words in a normal noad} +@d nucleus(#)==#+1 {the |nucleus| field of a noad} +@d supscr(#)==#+2 {the |supscr| field of a noad} +@d subscr(#)==#+3 {the |subscr| field of a noad} +@y +\yskip\hang In Japanese, |math_type(q)=math_jchar| means that |fam(q)| +refers to one of the sixteen kanji font families, and |KANJI(q)| is the +internal kanji code number. +@^Japanese extentions@> + +@d noad_size=5 {number of words in a normal noad} +@d nucleus(#)==#+1 {the |nucleus| field of a noad} +@d supscr(#)==#+2 {the |supscr| field of a noad} +@d subscr(#)==#+3 {the |subscr| field of a noad} +@d kcode_noad(#)==#+4 +@d math_kcode(#)==info(#+4) {the |kanji character| field of a noad} +@d kcode_noad_nucleus(#)==#+3 +@d math_kcode_nucleus(#)==info(#+3) + {the |kanji character| field offset from nucleus} +@# +@d math_jchar=5 +@d math_text_jchar=6 +@z + +@x [34.686] l.14129 - pTeX: new_noad +mem[supscr(p)].hh:=empty_field; +new_noad:=p; +@y +mem[supscr(p)].hh:=empty_field; +mem[kcode_noad(p)].hh:=empty_field; +new_noad:=p; +@z + +@x [34.691] l.14236 - pTeX: print_fam_and_char +procedure print_fam_and_char(@!p:pointer); {prints family and character} +begin print_esc("fam"); print_int(fam(p)); print_char(" "); +print_ASCII(qo(character(p))); +@y +procedure print_fam_and_char(@!p:pointer;@!t:small_number); + {prints family and character} +var @!cx:KANJI_code; {temporary register for KANJI} +begin print_esc("fam"); print_int(fam(p)); print_char(" "); +if t=math_char then print_ASCII(qo(character(p))) +else begin KANJI(cx):=math_kcode_nucleus(p); print_kanji(cx); + end; +@z + +@x [34.692] l.14266 - pTeX: print_subsidiary_data + math_char: begin print_ln; print_current_string; print_fam_and_char(p); +@y + math_char, math_jchar: begin print_ln; print_current_string; + print_fam_and_char(p,math_type(p)); +@z + +@x [34.696] l.14327 - pTeX: print_fam_and_char +accent_noad: begin print_esc("accent"); print_fam_and_char(accent_chr(p)); +@y +accent_noad: begin print_esc("accent"); + print_fam_and_char(accent_chr(p),math_char); +@z + +@x [35.715] l.14687 - pTeX: rebox + begin if type(b)=vlist_node then b:=hpack(b,natural); + p:=list_ptr(b); + if (is_char_node(p))and(link(p)=null) then + begin f:=font(p); v:=char_width(f)(char_info(f)(character(p))); + if v<>width(b) then link(p):=new_kern(width(b)-v); + end; +@y + begin if type(b)<>hlist_node then b:=hpack(b,natural); + p:=list_ptr(b); + if is_char_node(p) then + if font_dir[font(p)]<>dir_default then + begin if link(link(p))=null then + begin f:=font(p); v:=char_width(f)(orig_char_info(f)(character(p))); + if v<>width(b) then link(link(p)):=new_kern(width(b)-v); + end + end + else if link(p)=null then + begin f:=font(p); v:=char_width(f)(orig_char_info(f)(character(p))); + if v<>width(b) then link(p):=new_kern(width(b)-v); + end; + delete_glue_ref(space_ptr(b)); delete_glue_ref(xspace_ptr(b)); +@z + +@x [36.720] l.14783 - pTeX: clean_box +function clean_box(@!p:pointer;@!s:small_number):pointer; +@y +function clean_box(@!p:pointer;@!s:small_number;@!jc:halfword):pointer; +@z + +@x [36.720] l.14790 - pTeX: clean_box +math_char: begin cur_mlist:=new_noad; mem[nucleus(cur_mlist)]:=mem[p]; + end; +@y +math_char: begin cur_mlist:=new_noad; mem[nucleus(cur_mlist)]:=mem[p]; + end; +math_jchar: begin cur_mlist:=new_noad; mem[nucleus(cur_mlist)]:=mem[p]; + math_kcode(cur_mlist):=jc; + end; +@z + +@x [36.720] l.14802 - pTeX: clean_box +found: if is_char_node(q)or(q=null) then x:=hpack(q,natural) + else if (link(q)=null)and(type(q)<=vlist_node)and(shift_amount(q)=0) then + x:=q {it's already clean} + else x:=hpack(q,natural); +@y +found: if is_char_node(q)or(q=null) then x:=hpack(q,natural) + else if (link(q)=null)and(type(q)<=dir_node)and(shift_amount(q)=0) then + x:=q {it's already clean} + else x:=hpack(q,natural); +@z + +@x [36.721] l.14814 - pTeX: skip 2nd kanji node +if is_char_node(q) then + begin r:=link(q); +@y +if is_char_node(q) then + begin if font_dir[font(q)]<>dir_default then q:=link(q); + r:=link(q); +@z + +@x [36.722] l.14833 - pTeX: fetch +else begin if (qo(cur_c)>=font_bc[cur_f])and(qo(cur_c)<=font_ec[cur_f]) then + cur_i:=orig_char_info(cur_f)(cur_c) + else cur_i:=null_character; + if not(char_exists(cur_i)) then + begin char_warning(cur_f,qo(cur_c)); + math_type(a):=empty; + end; + end; +@y +else begin if font_dir[cur_f]<>dir_default then + cur_c:=qi(get_jfm_pos(KANJI(math_kcode_nucleus(a)),cur_f)); + if (qo(cur_c)>=font_bc[cur_f])and(qo(cur_c)<=font_ec[cur_f]) then + cur_i:=orig_char_info(cur_f)(cur_c) + else cur_i:=null_character; + if not(char_exists(cur_i)) then + begin char_warning(cur_f,qo(cur_c)); + math_type(a):=empty; + end; + end; +@z + +@x [36.726] l.14892 - pTeX: mlist_to_hlist +var mlist:pointer; {beginning of the given list} +@!penalties:boolean; {should penalty nodes be inserted?} +@!style:small_number; {the given style} +@y +var mlist:pointer; {beginning of the given list} +@!penalties:boolean; {should penalty nodes be inserted?} +@!style:small_number; {the given style} +@!u:pointer; {temporary register} +@z + +@x [36.726] l.14913 - pTeX: mlist_to_hlist +@<Make a second pass over the mlist, removing all noads and inserting the + proper spacing and penalties@>; +end; +@y +@<Make a second pass over the mlist, removing all noads and inserting the + proper spacing and penalties@>; +p:=new_null_box; link(p):=link(temp_head); +adjust_hlist(p,false); link(temp_head):=link(p); +delete_glue_ref(space_ptr(p)); delete_glue_ref(xspace_ptr(p)); +free_node(p,box_node_size); +end; +@z + +@x [36.727] l.14928 - pTeX: free box +free_node(z,box_node_size); +@y +delete_glue_ref(space_ptr(z)); delete_glue_ref(xspace_ptr(z)); +free_node(z,box_node_size); +@z + +@x [36.730] l.14976 - pTeX: free box: disp_node +kern_node: begin math_kern(q,cur_mu); goto done_with_node; + end; +@y +kern_node: begin math_kern(q,cur_mu); goto done_with_node; + end; +disp_node: goto done_with_node; +@z + +@x [36.734] l.15046 - pTeX: make_over:clean_box + overbar(clean_box(nucleus(q),cramped_style(cur_style)),@| +@y + overbar(clean_box(nucleus(q),cramped_style(cur_style),math_kcode(q)),@| +@z + +@x [36.735] l.15055 - pTeX: make_under:clean_box +begin x:=clean_box(nucleus(q),cur_style); +@y +begin x:=clean_box(nucleus(q),cur_style,math_kcode(q)); +@z + +@x [36.736] l.15069 - pTeX: make_under:clean_box +if type(v)<>vlist_node then confusion("vcenter"); +@y +if type(v)=dir_node then + begin if type(list_ptr(v))<>vlist_node then confusion("dircenter") + end +else begin if type(v)<>vlist_node then confusion("vcenter") + end; +@z + +@x [36.737] l.15089 - pTeX: make_radical:clean_box +begin x:=clean_box(nucleus(q),cramped_style(cur_style)); +@y +begin x:=clean_box(nucleus(q),cramped_style(cur_style),math_kcode(q)); +@z + +@x [36.738] l.15123 - pTeX: make_math_accent:clean_box + x:=clean_box(nucleus(q),cramped_style(cur_style)); w:=width(x); h:=height(x); +@y + x:=clean_box(nucleus(q),cramped_style(cur_style),math_kcode(q)); + w:=width(x); h:=height(x); +@z + +@x [36.742] l.15186 - pTeX: make_math_accent:clean_box +x:=clean_box(nucleus(q),cur_style); delta:=delta+height(x)-h; h:=height(x); +@y +x:=clean_box(nucleus(q),cur_style,math_kcode(q)); +delta:=delta+height(x)-h; h:=height(x); +@z + +@x [36.744] l.15211 - pTeX: make_fraction:clean_box +x:=clean_box(numerator(q),num_style(cur_style)); +z:=clean_box(denominator(q),denom_style(cur_style)); +@y +x:=clean_box(numerator(q),num_style(cur_style),math_kcode(q)); +z:=clean_box(denominator(q),denom_style(cur_style),math_kcode(q)); +@z + +@x [36.749] l.15304 - pTeX: make_op:clean_box + delta:=char_italic(cur_f)(cur_i); x:=clean_box(nucleus(q),cur_style); +@y + delta:=char_italic(cur_f)(cur_i); + x:=clean_box(nucleus(q),cur_style,math_kcode(q)); +@z + +@x [36.750] l.15321 - pTeX: make_op:clean_box +begin x:=clean_box(supscr(q),sup_style(cur_style)); +y:=clean_box(nucleus(q),cur_style); +z:=clean_box(subscr(q),sub_style(cur_style)); +@y +begin x:=clean_box(supscr(q),sup_style(cur_style),math_kcode(q)); +y:=clean_box(nucleus(q),cur_style,math_kcode(q)); +z:=clean_box(subscr(q),sub_style(cur_style),math_kcode(q)); +@z + +@x [36.751] l.15342 - pTeX: free box node + begin free_node(x,box_node_size); list_ptr(v):=y; + end +@y + begin + delete_glue_ref(space_ptr(x)); delete_glue_ref(xspace_ptr(x)); + free_node(x,box_node_size); list_ptr(v):=y; + end +@z + +@x [36.751] l.15350 - pTeX: free box node +if math_type(subscr(q))=empty then free_node(z,box_node_size) +@y +if math_type(subscr(q))=empty then begin + delete_glue_ref(space_ptr(z)); delete_glue_ref(xspace_ptr(z)); + free_node(z,box_node_size) +end +@z + +@x [36.752] l.15369 - pTeX: make_ord +procedure make_ord(@!q:pointer); +label restart,exit; +var a:integer; {address of lig/kern instruction} +@!p,@!r:pointer; {temporary registers for list manipulation} +begin restart:@t@>@;@/ +if math_type(subscr(q))=empty then if math_type(supscr(q))=empty then + if math_type(nucleus(q))=math_char then + begin p:=link(q); + if p<>null then if (type(p)>=ord_noad)and(type(p)<=punct_noad) then + if math_type(nucleus(p))=math_char then + if fam(nucleus(p))=fam(nucleus(q)) then + begin math_type(nucleus(q)):=math_text_char; + fetch(nucleus(q)); + if char_tag(cur_i)=lig_tag then + begin a:=lig_kern_start(cur_f)(cur_i); + cur_c:=character(nucleus(p)); + cur_i:=font_info[a].qqqq; + if skip_byte(cur_i)>stop_flag then + begin a:=lig_kern_restart(cur_f)(cur_i); + cur_i:=font_info[a].qqqq; + end; + loop@+ begin @<If instruction |cur_i| is a kern with |cur_c|, attach + the kern after~|q|; or if it is a ligature with |cur_c|, combine + noads |q| and~|p| appropriately; then |return| if the cursor has + moved past a noad, or |goto restart|@>; + if skip_byte(cur_i)>=stop_flag then return; + a:=a+qo(skip_byte(cur_i))+1; + cur_i:=font_info[a].qqqq; + end; + end; + end; + end; +exit:end; +@y +procedure make_ord(@!q:pointer); +label restart,exit; +var a:integer; {address of lig/kern instruction} +@!gp,@!gq,@!p,@!r:pointer; {temporary registers for list manipulation} +@!rr:halfword; +begin restart:@t@>@;@/ +if (math_type(subscr(q))=empty)and(math_type(supscr(q))=empty)and@| +((math_type(nucleus(q))=math_char)or(math_type(nucleus(q))=math_jchar)) then + begin p:=link(q); + if p<>null then if (type(p)>=ord_noad)and(type(p)<=punct_noad) then + if fam(nucleus(p))=fam(nucleus(q)) then + if math_type(nucleus(p))=math_char then + begin math_type(nucleus(q)):=math_text_char; + fetch(nucleus(q)); + if char_tag(cur_i)=lig_tag then + begin a:=lig_kern_start(cur_f)(cur_i); + cur_c:=character(nucleus(p)); + cur_i:=font_info[a].qqqq; + if skip_byte(cur_i)>stop_flag then + begin a:=lig_kern_restart(cur_f)(cur_i); + cur_i:=font_info[a].qqqq; + end; + loop@+ begin @<If instruction |cur_i| is a kern with |cur_c|, attach + the kern after~|q|; or if it is a ligature with |cur_c|, combine + noads |q| and~|p| appropriately; then |return| if the cursor has + moved past a noad, or |goto restart|@>; + if skip_byte(cur_i)>=stop_flag then return; + a:=a+qo(skip_byte(cur_i))+1; + cur_i:=font_info[a].qqqq; + end; + end; + end + else if math_type(nucleus(p))=math_jchar then + begin math_type(nucleus(q)):=math_text_jchar; + fetch(nucleus(p)); a:=cur_c; fetch(nucleus(q)); + if char_tag(cur_i)=gk_tag then + begin cur_c:=a; a:=glue_kern_start(cur_f)(cur_i); + {|cur_c|:=qi(|get_jfm_pos|(|math_kcode|(p), + |fam_fnt|(fam(nucleus(p))+|cur_size|)));} + repeat + cur_i:=font_info[a].qqqq; + if next_char(cur_i)=cur_c then + if op_byte(cur_i)<kern_flag then + begin gp:=font_glue[cur_f]; rr:=rem_byte(cur_i); + if gp<>null then begin + while((type(gp)<>rr)and(link(gp)<>null)) do begin gp:=link(gp); + end; + gq:=glue_ptr(gp); + end + else begin gp:=get_node(small_node_size); + font_glue[cur_f]:=gp; gq:=null; + end; + if gq=null then + begin type(gp):=rr; gq:=new_spec(zero_glue); glue_ptr(gp):=gq; + a:=exten_base[cur_f]+qi((qo(rr))*3); width(gq):=font_info[a].sc; + stretch(gq):=font_info[a+1].sc; shrink(gq):=font_info[a+2].sc; + add_glue_ref(gq); link(gp):=get_node(small_node_size); + gp:=link(gp); glue_ptr(gp):=null; link(gp):=null; + end; + p:=new_glue(gq); link(p):=link(q); link(q):=p; return; + end + else begin p:=new_kern(char_kern(cur_f)(cur_i)); + link(p):=link(q); link(q):=p; return; + end; + incr(a); + until skip_byte(cur_i)>=stop_flag; + end; + end; + end; +exit:end; +@z + +@x [36.754] l.15452 - pTeX: +math_char, math_text_char: +@y +math_char, math_text_char, math_jchar, math_text_jchar: +@z + +@x [36.755] l.15475 - pTeX: convert math text to KANJI char_node + begin delta:=char_italic(cur_f)(cur_i); p:=new_character(cur_f,qo(cur_c)); + if (math_type(nucleus(q))=math_text_char)and(space(cur_f)<>0) then + delta:=0; {no italic correction in mid-word of text font} + if (math_type(subscr(q))=empty)and(delta<>0) then + begin link(p):=new_kern(delta); delta:=0; +@y + begin delta:=char_italic(cur_f)(cur_i); p:=new_character(cur_f,qo(cur_c)); + u:=p; + if font_dir[cur_f]<>dir_default then begin + link(u):=get_avail; u:=link(u); info(u):=math_kcode(q); + end; + if ((math_type(nucleus(q))=math_text_char)or + (math_type(nucleus(q))=math_text_jchar))and(space(cur_f)<>0) then + delta:=0; {no italic correction in mid-word of text font} + if (math_type(subscr(q))=empty)and(delta<>0) then begin + link(u):=new_kern(delta); delta:=0; +@z + +@x [36.756] l.15505 - pTeX: free box + shift_down:=depth(z)+sub_drop(t); + free_node(z,box_node_size); + end; +@y + shift_down:=depth(z)+sub_drop(t); + delete_glue_ref(space_ptr(z)); delete_glue_ref(xspace_ptr(z)); + free_node(z,box_node_size); + end; +@z + +@x [36.757] l.15526 - pTeX: make_scripts:clean_box +begin x:=clean_box(subscr(q),sub_style(cur_style)); +@y +begin x:=clean_box(subscr(q),sub_style(cur_style),math_kcode(q)); +@z + +@x [36.758] l.15538 - pTeX: make_scripts:clean_box +begin x:=clean_box(supscr(q),sup_style(cur_style)); +@y +begin x:=clean_box(supscr(q),sup_style(cur_style),math_kcode(q)); +@z + +@x [36.758] l.15555 - pTeX: make_scripts:clean_box +begin y:=clean_box(subscr(q),sub_style(cur_style)); +@y +begin y:=clean_box(subscr(q),sub_style(cur_style),math_kcode(q)); +@z + +@x [36.760] l.15616 - pTeX: disp_node +othercases confusion("mlist3") +@y +disp_node: begin link(p):=q; p:=q; q:=link(q); link(p):=null; goto done; + end; +othercases confusion("mlist3") +@z + +@x [37.796] l.16276 - pTeX: call adjust_hlist + begin adjust_tail:=cur_tail; u:=hpack(link(head),natural); w:=width(u); +@y + begin adjust_tail:=cur_tail; adjust_hlist(head,false); + delete_glue_ref(cur_kanji_skip); delete_glue_ref(cur_xkanji_skip); + cur_kanji_skip:=space_ptr(head); cur_xkanji_skip:=xspace_ptr(head); + add_glue_ref(cur_kanji_skip); add_glue_ref(cur_xkanji_skip); + u:=hpack(link(head),natural); w:=width(u); +@z + +@x [37.799] l.16331 - pTeX: call adjust_hlist + begin p:=hpack(link(head),natural); +@y + begin adjust_hlist(head,false); + delete_glue_ref(cur_kanji_skip); delete_glue_ref(cur_xkanji_skip); + cur_kanji_skip:=space_ptr(head); cur_xkanji_skip:=xspace_ptr(head); + add_glue_ref(cur_kanji_skip); add_glue_ref(cur_xkanji_skip); + p:=hpack(link(head),natural); +@z + +@x [37.800] l.16353 - pTeX: call adjust_hlist +var @!p,@!q,@!r,@!s,@!u,@!v: pointer; {registers for the list operations} +@y +var @!p,@!q,@!r,@!s,@!u,@!v,@!z: pointer; {registers for the list operations} +@z + +@x [37.804] l.16456 - pTeX: call adjust_hlist + p:=hpack(preamble,saved(1),saved(0)); overfull_rule:=rule_save; +@y + z:=new_null_box; link(z):=preamble; + adjust_hlist(z,false); + delete_glue_ref(cur_kanji_skip); delete_glue_ref(cur_xkanji_skip); + cur_kanji_skip:=space_ptr(z); cur_xkanji_skip:=xspace_ptr(z); + add_glue_ref(cur_kanji_skip); add_glue_ref(cur_xkanji_skip); + p:=hpack(preamble,saved(1),saved(0)); overfull_rule:=rule_save; + delete_glue_ref(space_ptr(z)); delete_glue_ref(xspace_ptr(z)); + free_node(z,box_node_size); +@z + +@x [37.807] l.16499 - pTeX: unset box -> BOX +glue_order(q):=glue_order(p); glue_sign(q):=glue_sign(p); +glue_set(q):=glue_set(p); shift_amount(q):=o; +r:=link(list_ptr(q)); s:=link(list_ptr(p)); +@y +box_dir(q):=abs(direction); +glue_order(q):=glue_order(p); glue_sign(q):=glue_sign(p); +glue_set(q):=glue_set(p); shift_amount(q):=o; +r:=link(list_ptr(q)); s:=link(list_ptr(p)); +@z + +@x [37.809] l.16541 - pTeX: unset box -> BOX +s:=link(s); link(u):=new_null_box; u:=link(u); t:=t+width(s); +if mode=-vmode then width(u):=width(s)@+else + begin type(u):=vlist_node; height(u):=width(s); + end +@y +s:=link(s); link(u):=new_null_box; u:=link(u); t:=t+width(s); +if mode=-vmode then width(u):=width(s)@+else + begin type(u):=vlist_node; height(u):=width(s); + end; +box_dir(u):=abs(direction) +@z + +@x [37.810] l.16564 - pTeX: unset box -> BOX +width(r):=w; type(r):=hlist_node; +end +@y +width(r):=w; type(r):=hlist_node; +box_dir(r):=abs(direction); +end +@z + +@x [37.811] l.16585 - pTeX: unset box -> BOX +height(r):=w; type(r):=vlist_node; +@y +height(r):=w; type(r):=vlist_node; +box_dir(r):=abs(direction); +@z + +@x [38.816] l.16687 - pTeX: init chain, delete disp_node +link(temp_head):=link(head); +if is_char_node(tail) then tail_append(new_penalty(inf_penalty)) +else if type(tail)<>glue_node then tail_append(new_penalty(inf_penalty)) +@y +first_use:=true; chain:=false; +delete_glue_ref(cur_kanji_skip); delete_glue_ref(cur_xkanji_skip); +cur_kanji_skip:=space_ptr(head); cur_xkanji_skip:=xspace_ptr(head); +add_glue_ref(cur_kanji_skip); add_glue_ref(cur_xkanji_skip); +link(temp_head):=link(head); +if (not is_char_node(tail))and(type(tail)=disp_node) then + begin free_node(tail,small_node_size); tail:=prev_node; link(tail):=null + end; +if is_char_node(tail) then tail_append(new_penalty(inf_penalty)) +else if type(tail)<>glue_node then tail_append(new_penalty(inf_penalty)) +@z + +@x [38.828] l.16946 - pTeX: Global variable |chain| +@!cur_p:pointer; {the current breakpoint under consideration} +@y +@!cur_p:pointer; {the current breakpoint under consideration} +@!chain:boolean; {chain current line and next line?} +@z + +% chain が真の場合、後ろに cur_kanji_skip が挿入されるので、ここで +% break_width から引いておかなければならない。 +@x [38.837] l.17125 - pTeX: add kanji_skip width, ita_kern +begin no_break_yet:=false; do_all_six(set_break_width_to_background); +s:=cur_p; +if break_type>unhyphenated then if cur_p<>null then + @<Compute the discretionary |break_width| values@>; +while s<>null do + begin if is_char_node(s) then goto done; +@y +begin no_break_yet:=false; do_all_six(set_break_width_to_background); +s:=cur_p; +if break_type>unhyphenated then if cur_p<>null then + @<Compute the discretionary |break_width| values@>; +while s<>null do + begin if is_char_node(s) then + begin if chain then + begin break_width[1]:=break_width[1]-width(cur_kanji_skip); + break_width[2+stretch_order(cur_kanji_skip)]:= + break_width[2+stretch_order(cur_kanji_skip)]-stretch(cur_kanji_skip); + break_width[6]:=break_width[6]-shrink(cur_kanji_skip); + end; + goto done end; +@z + +@x [38.837] l.17135 - pTeX: + kern_node: if subtype(s)<>explicit then goto done + else break_width[1]:=break_width[1]-width(s); +@y + kern_node: if (subtype(s)<>explicit)and(subtype(s)<>ita_kern) then + goto done + else break_width[1]:=break_width[1]-width(s); +@z + +@x [38.841] l.17186 - pTeX: +if is_char_node(v) then + begin f:=font(v); + break_width[1]:=break_width[1]-char_width(f)(char_info(f)(character(v))); + end +else case type(v) of + ligature_node: begin f:=font(lig_char(v));@/ + break_width[1]:=@|break_width[1]- + char_width(f)(char_info(f)(character(lig_char(v)))); + end; + hlist_node,vlist_node,rule_node,kern_node: + break_width[1]:=break_width[1]-width(v); + othercases confusion("disc1") +@:this can't happen disc1}{\quad disc1@> + endcases +@y +if is_char_node(v) then + begin f:=font(v); + break_width[1]:=break_width[1]-char_width(f)(orig_char_info(f)(character(v))); + if font_dir[f]<>dir_default then v:=link(v); + end +else case type(v) of + ligature_node: begin f:=font(lig_char(v));@/ + break_width[1]:=@|break_width[1]- + char_width(f)(orig_char_info(f)(character(lig_char(v)))); + end; + hlist_node,vlist_node,dir_node,rule_node,kern_node: + break_width[1]:=break_width[1]-width(v); + disp_node: do_nothing; + othercases confusion("disc1") +@:this can't happen disc1}{\quad disc1@> + endcases +@z + +@x [38.842] l.17204 - pTeX: + 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 + break_width[1]:=@|break_width[1]+char_width(f)(orig_char_info(f)(character(s))); + if font_dir[f]<>dir_default then s:=link(s); + end +else case type(s) of + ligature_node: begin f:=font(lig_char(s)); + break_width[1]:=break_width[1]+ + char_width(f)(orig_char_info(f)(character(lig_char(s)))); + end; + hlist_node,vlist_node,dir_node,rule_node,kern_node: + break_width[1]:=break_width[1]+width(s); + disp_node: do_nothing; +@z + +@x [38.856] l.17467 - pTeX: print symbolic feasibe node +if cur_p=null then print_esc("par") +else if type(cur_p)<>glue_node then + begin if type(cur_p)=penalty_node then print_esc("penalty") + else if type(cur_p)=disc_node then print_esc("discretionary") +@y +if cur_p=null then print_esc("par") +else if (type(cur_p)<>glue_node)and(not is_char_node(cur_p)) then + begin if type(cur_p)=penalty_node then print_esc("penalty") + else if type(cur_p)=disc_node then print_esc("discretionary") +@z + +@x [39.862] l.17584 - pTeX: local valiable for line breaking +@!auto_breaking:boolean; {is node |cur_p| outside a formula?} +@!prev_p:pointer; {helps to determine when glue nodes are breakpoints} +@!q,@!r,@!s,@!prev_s:pointer; {miscellaneous nodes of temporary interest} +@!f:internal_font_number; {used when calculating character widths} +@y +@!auto_breaking:boolean; {is node |cur_p| outside a formula?} +@!prev_p:pointer; {helps to determine when glue nodes are breakpoints} +@!q,@!r,@!s,@!prev_s:pointer; {miscellaneous nodes of temporary interest} +@!f,@!post_f:internal_font_number; {used when calculating character widths} +@!post_p:pointer; +@!cc:ASCII_code; +@!first_use:boolean; +@z + +@x [39.866] l.17677 - pTeX: dir_node, disp_node, ita_kern +case type(cur_p) of +hlist_node,vlist_node,rule_node: act_width:=act_width+width(cur_p); +@y +case type(cur_p) of +hlist_node,vlist_node,dir_node,rule_node: act_width:=act_width+width(cur_p); +@z + +@x [39.866] l.17685 - pTeX: +kern_node: if subtype(cur_p)=explicit then kern_break + else act_width:=act_width+width(cur_p); +@y +kern_node: if (subtype(cur_p)=explicit)or(subtype(cur_p)=ita_kern) then + kern_break + else act_width:=act_width+width(cur_p); +@z + +@x [39.866] l.17694 - pTeX: +mark_node,ins_node,adjust_node: do_nothing; +@y +disp_node,mark_node,ins_node,adjust_node: do_nothing; +@z + +% ここで、連続する漢字コード間に cur_kanji_skip を挿入する。 +% penalty_node や box_node には、adjust_hlist ルーチンによって既に実際の +% glue_node が挿入されているものと仮定している。 +% chain は、try_break で cur_kanji_skip のアジャストのために使われる。 +@x [39.867] l.17708 - pTeX: add kanji char width +@<Advance \(c)|cur_p| to the node following the present string...@>= +begin prev_p:=cur_p; +repeat f:=font(cur_p); +act_width:=act_width+char_width(f)(char_info(f)(character(cur_p))); +cur_p:=link(cur_p); +until not is_char_node(cur_p); +end +@y +@<Advance \(c)|cur_p| to the node following the present string...@>= +begin chain:=false; +if is_char_node(cur_p) then + if font_dir[font(cur_p)]<>dir_default then + begin case type(prev_p) of + hlist_node,vlist_node,dir_node,rule_node, + ligature_node,disc_node,math_node: begin + cur_p:=prev_p; try_break(0,unhyphenated); cur_p:=link(cur_p); + end; + othercases do_nothing; + endcases; + end; + prev_p:=cur_p; post_p:=cur_p; post_f:=font(post_p); + repeat f:=post_f; cc:=character(cur_p); + act_width:=act_width+char_width(f)(orig_char_info(f)(cc)); + post_p:=link(cur_p); + if font_dir[f]<>dir_default then + begin prev_p:=cur_p; cur_p:=post_p; post_p:=link(post_p); + if is_char_node(post_p) then + begin post_f:=font(post_p); + if font_dir[post_f]<>dir_default then chain:=true else chain:=false; + try_break(0,unhyphenated); + end + else + begin chain:=false; + case type(post_p) of + hlist_node,vlist_node,dir_node,rule_node,ligature_node, + disc_node,math_node: try_break(0,unhyphenated); + othercases do_nothing; + endcases; + end; + if chain then + begin if first_use then + begin check_shrinkage(cur_kanji_skip); + first_use:=false; + end; + act_width:=act_width+width(cur_kanji_skip);@| + active_width[2+stretch_order(cur_kanji_skip)]:=@| + active_width[2+stretch_order(cur_kanji_skip)] + +stretch(cur_kanji_skip);@/ + active_width[6]:=active_width[6]+shrink(cur_kanji_skip); + end; + prev_p:=cur_p; + end + else if is_char_node(post_p) then + begin post_f:=font(post_p); chain:=false; + if font_dir[post_f]<>dir_default then try_break(0,unhyphenated); + end; + cur_p:=post_p; + until not is_char_node(cur_p); +chain:=false; +end +@z + +@x [39.868] l.17723 - pTeX: ita_kern + else if (type(prev_p)=kern_node)and(subtype(prev_p)<>explicit) then + try_break(0,unhyphenated); +@y + else if (type(prev_p)=kern_node) then + if (subtype(prev_p)<>explicit)and(subtype(prev_p)<>ita_kern) then + try_break(0,unhyphenated); +@z + +@x [39.871] l.17756 - pTeX: add kanji char width, dir_node width, disp_node + 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 + disc_width:=disc_width+char_width(f)(orig_char_info(f)(character(s))); + if font_dir[f]<>dir_default then s:=link(s) + end +else case type(s) of + ligature_node: begin f:=font(lig_char(s)); + disc_width:=disc_width+ + char_width(f)(orig_char_info(f)(character(lig_char(s)))); + end; + hlist_node,vlist_node,dir_node,rule_node,kern_node: + disc_width:=disc_width+width(s); + disp_node: do_nothing; +@z + +@x [39.872] l.17772 - pTeX: add kanji char width, dir_node width, disp_node + 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 + act_width:=act_width+char_width(f)(orig_char_info(f)(character(s))); + if font_dir[f]<>dir_default then s:=link(s) + end +else case type(s) of + ligature_node: begin f:=font(lig_char(s)); + act_width:=act_width+ + char_width(f)(orig_char_info(f)(character(lig_char(s)))); + end; + hlist_node,vlist_node,dir_node,rule_node,kern_node: + act_width:=act_width+width(s); + disp_node: do_nothing; +@z + +@x [39.877] l.17879 - pTeX: last_disp +cur_line:=prev_graf+1; +@y +cur_line:=prev_graf+1; last_disp:=0; +@z + +@x [39.879] l.17919 - pTeX: ita_kern + if type(q)=kern_node then if subtype(q)<>explicit then goto done1; +@y + if type(q)=kern_node then + if (subtype(q)<>explicit)and(subtype(q)<>ita_kern) then goto done1; +@z + +@x [39.881] l.17950 - pTeX: |q| may be a |char_node| +if q<>null then {|q| cannot be a |char_node|} + if type(q)=glue_node then + begin delete_glue_ref(glue_ptr(q)); + glue_ptr(q):=right_skip; + subtype(q):=right_skip_code+1; add_glue_ref(right_skip); + goto done; + end + else begin if type(q)=disc_node then + @<Change discretionary to compulsory and set + |disc_break:=true|@> + else if (type(q)=math_node)or(type(q)=kern_node) then width(q):=0; + end +@y +if q<>null then {|q| may be a |char_node|} + begin if not is_char_node(q) then + if type(q)=glue_node then + begin delete_glue_ref(glue_ptr(q)); + glue_ptr(q):=right_skip; + subtype(q):=right_skip_code+1; add_glue_ref(right_skip); + goto done; + end + else begin if type(q)=disc_node then + @<Change discretionary to compulsory and set + |disc_break:=true|@> + else if (type(q)=math_node)or(type(q)=kern_node) then width(q):=0; + end + end +@z + +@x [39.887] l.18014 - pTeX: disp_node at begin-of-line +r:=link(q); link(q):=null; q:=link(temp_head); link(temp_head):=r; +@y +r:=link(q); link(q):=null; q:=link(temp_head); link(temp_head):=r; +if last_disp<>0 then begin + r:=get_node(small_node_size); + type(r):=disp_node; disp_dimen(r):=last_disp; + link(r):=q; q:=r; + end; +@z + +@x [40.896] l.18177 - pTeX: hyphenation +loop@+ begin if is_char_node(s) then + begin c:=qo(character(s)); hf:=font(s); + end +@y +loop@+ begin if is_char_node(s) then + begin hf:=font(s); + if font_dir[hf]<>dir_default then + begin prev_s:=s; s:=link(prev_s); c:=info(s); goto continue; + end else c:=qo(character(s)); + end + else if type(s)=disp_node then goto continue + else if (type(s)=penalty_node)and(not subtype(s)=normal) then goto continue +@z + +@x [40.899] l.18248 - pTeX: disp_node + whatsit_node,glue_node,penalty_node,ins_node,adjust_node,mark_node: + goto done4; +@y + disp_node: do_nothing; + whatsit_node,glue_node,penalty_node,ins_node,adjust_node,mark_node: + goto done4; +@z + +@x [44.968] l.19535 - pTeX: dir_node + hlist_node,vlist_node,rule_node:@<Insert glue for |split_top_skip| + and set~|p:=null|@>; +@y + hlist_node,vlist_node,dir_node,rule_node: + @<Insert glue for |split_top_skip| and set~|p:=null|@>; +@z + +@x [44.973] l.19626 - pTeX: dir_node +hlist_node,vlist_node,rule_node: begin@t@>@;@/ + cur_height:=cur_height+prev_dp+height(p); prev_dp:=depth(p); +@y +hlist_node,vlist_node,dir_node,rule_node: begin@t@>@;@/ + cur_height:=cur_height+prev_dp+height(p); prev_dp:=depth(p); +@z + +@x [44.977] l.19710 - pTeX: free box node +var v:pointer; {the box to be split} +@y +var v:pointer; {the box to be split} +w:pointer; {|dir_node|} +@z + +@x [44.977] l.19722 - pTeX: free box node +q:=prune_page_top(q); p:=list_ptr(v); free_node(v,box_node_size); +if q=null then box(n):=null {the |eq_level| of the box stays the same} +else box(n):=vpack(q,natural); +vsplit:=vpackage(p,h,exactly,split_max_depth); +@y +q:=prune_page_top(q); p:=list_ptr(v); +if q=null then box(n):=null {the |eq_level| of the box stays the same} +else begin + box(n):=vpack(q,natural); box_dir(box(n)):=box_dir(v); + end; +q:=vpackage(p,h,exactly,split_max_depth); +box_dir(q):=box_dir(v); +delete_glue_ref(space_ptr(v)); delete_glue_ref(xspace_ptr(v)); +free_node(v,box_node_size); +vsplit:=q; +@z + +@x [44.978] l.19732 - pTeX: bad box for vsplit +if type(v)<>vlist_node then + begin print_err(""); print_esc("vsplit"); print(" needs a "); + print_esc("vbox"); +@:vsplit_}{\.{\\vsplit needs a \\vbox}@> + help2("The box you are trying to split is an \hbox.")@/ + ("I can't split such a box, so I'll leave it alone."); + error; vsplit:=null; return; + end +@y +if type(v)=dir_node then begin + w:=v; v:=list_ptr(v); + delete_glue_ref(space_ptr(w)); + delete_glue_ref(xspace_ptr(w)); + free_node(w,box_node_size); +end; +if type(v)<>vlist_node then begin + print_err(""); print_esc("vsplit"); print(" needs a "); + print_esc("vbox"); +@:vsplit_}{\.{\\vsplit needs a \\vbox}@> + help2("The box you are trying to split is an \hbox.")@/ + ("I can't split such a box, so I'll leave it alone."); + error; vsplit:=null; return; +end; +flush_node_list(link(v)); link(v):=null +@z + +@x [45.993] l.20053 - pTeX: ensure_vbox +begin p:=box(n); +if p<>null then if type(p)=hlist_node then + begin print_err("Insertions can only be added to a vbox"); +@y +begin p:=box(n); +if p<>null then if (type(p)=dir_node) then + begin p:=list_ptr(p); + delete_glue_ref(space_ptr(box(n))); + delete_glue_ref(xspace_ptr(box(n))); + free_node(box(n),box_node_size); + box(n):=p +end; +if p<>null then if type(p)<>vlist_node then begin + print_err("Insertions can only be added to a vbox"); +@z + +@x [45.1000] l.20146 - pTeX: dir_node +hlist_node,vlist_node,rule_node: if page_contents<box_there then + @<Initialize the current page, insert the \.{\\topskip} glue + ahead of |p|, and |goto continue|@> +@y +hlist_node,vlist_node,dir_node,rule_node: if page_contents<box_there then + @<Initialize the current page, insert the \.{\\topskip} glue + ahead of |p|, and |goto continue|@> +@z + +@x [45.1009] l.20291 - pTeX: ins_dir +if box(n)=null then height(r):=0 +else height(r):=height(box(n))+depth(box(n)); +@y +if box(n)=null then height(r):=0 +else + begin if ins_dir(p)<>box_dir(box(n)) then + begin print_err("Insertions can only be added to a same direction vbox"); +@.Insertions can only...@> + help3("Tut tut: You're trying to \insert into a")@/ + ("\box register that now have a different direction.")@/ + ("Proceed, and I'll discard its present contents."); + box_error(n) + end + else + height(r):=height(box(n))+depth(box(n)); + end; +@z + +@x [45.1017] l.20470 - pTeX: page dir +box(255):=vpackage(link(page_head),best_size,exactly,page_max_depth); +@y +box(255):=vpackage(link(page_head),best_size,exactly,page_max_depth); +box_dir(box(255)):=page_dir; +@z + +@x [45.1020] l.20513 - pTeX: check ins_dir +if best_ins_ptr(r)=null then wait:=true +else begin wait:=false; s:=last_ins_ptr(r); link(s):=ins_ptr(p); +@y +if best_ins_ptr(r)=null then wait:=true +else begin wait:=false; + n:=qo(subtype(p)); + case box_dir(box(n)) of + any_dir: + if ins_dir(p)<>box_dir(box(n)) then begin + print_err("Insertions can only be added to a same direction vbox"); +@.Insertions can only...@> + help3("Tut tut: You're trying to \insert into a")@/ + ("\box register that now have a different direction.")@/ + ("Proceed, and I'll discard its present contents."); + box_error(n); + box(n):=new_null_box; last_ins_ptr(r):=box(n)+list_offset; + end; + othercases + box_dir(box(n)):=ins_dir(p); + endcases; + s:=last_ins_ptr(r); link(s):=ins_ptr(p); +@z + +@x [45.1021] l.20537 - pTeX: free box node, ins_dir + free_node(temp_ptr,box_node_size); wait:=true; +@y + delete_glue_ref(space_ptr(temp_ptr)); + delete_glue_ref(xspace_ptr(temp_ptr)); + free_node(temp_ptr,box_node_size); wait:=true; +@z + +@x [45.1021] l.20543 - pTeX: free box node, ins_dir +free_node(box(n),box_node_size); +box(n):=vpack(temp_ptr,natural); +@y +delete_glue_ref(space_ptr(box(n))); +delete_glue_ref(xspace_ptr(box(n))); +flush_node_list(link(box(n))); +free_node(box(n),box_node_size); +box(n):=vpack(temp_ptr,natural); box_dir(box(n)):=ins_dir(p); +@z + +@x [46.1030] l.20687 - pTeX:main_control +@d append_normal_space=120 {go here to append a normal space between words} +@y +@d append_normal_space=120 {go here to append a normal space between words} +@d main_loop_j=130 {like |main_loop|, but |cur_chr| holds a KANJI code} +@d skip_loop=141 +@d again_2=150 +@z + +@x [46.1030] l.20691 - pTeX: main_control +procedure main_control; {governs \TeX's activities} +label big_switch,reswitch,main_loop,main_loop_wrapup, +@y +procedure main_control; {governs \TeX's activities} +label big_switch,reswitch,main_loop,main_loop_wrapup, + main_loop_j,main_loop_j+1,main_loop_j+3,skip_loop,again_2, +@z + +@x [46.1030] l.20697 - pTeX: main_control +var@!t:integer; {general-purpose temporary variable} +@y +var@!t:integer; {general-purpose temporary variable} +@!cx:KANJI_code; {kanji character} +@!kp:pointer; {kinsoku penalty register} +@!gp,gq:pointer; {temporary registers for list manipulation} +@!disp:scaled; {displacement register} +@!ins_kp:boolean; {whether insert kinsoku penalty} +@z + +@x [46.1030] l.20701 - pTeX: main_control +case abs(mode)+cur_cmd of +hmode+letter,hmode+other_char,hmode+char_given: goto main_loop; +hmode+char_num: begin scan_char_num; cur_chr:=cur_val; goto main_loop;@+end; +hmode+no_boundary: begin get_x_token; + if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given)or + (cur_cmd=char_num) then cancel_boundary:=true; + goto reswitch; + end; +@y +ins_kp:=false; +case abs(mode)+cur_cmd of +hmode+letter,hmode+other_char: goto main_loop; +hmode+kanji,hmode+kana,hmode+other_kchar: goto main_loop_j; +hmode+char_given: + if is_char_ascii(cur_chr) then goto main_loop else goto main_loop_j; +hmode+char_num: begin scan_char_num; cur_chr:=cur_val; + if is_char_ascii(cur_chr) then goto main_loop else goto main_loop_j; + end; +hmode+no_boundary: begin get_x_token; + if (cur_cmd=letter)or(cur_cmd=other_char)or + (cur_cmd=kanji)or(cur_cmd=kana)or(cur_cmd=other_kchar)or + (cur_cmd=char_given)or(cur_cmd=char_num) then cancel_boundary:=true; + goto reswitch; + end; +@z + +@x [46.1030] l.20715 - pTeX: main_control +main_loop:@<Append character |cur_chr| and the following characters (if~any) + to the current hlist in the current font; |goto reswitch| when + a non-character has been fetched@>; +@y +main_loop_j:@<Append KANJI-character |cur_chr| + to the current hlist in the current font; |goto reswitch| when + a non-character has been fetched@>; +main_loop:@<Append character |cur_chr| and the following characters (if~any) + to the current hlist in the current font; |goto reswitch| when + a non-character has been fetched@>; +@z + +@x [46.1034] l.20788 - pTeX: disp_node +@<Append character |cur_chr|...@>= +if ((head=tail) and (mode>0)) then begin + if (insert_src_special_auto) then append_src_special; +end; +adjust_space_factor;@/ +@y +@<Append character |cur_chr|...@>= +if ((head=tail) and (mode>0)) then begin + if (insert_src_special_auto) then append_src_special; +end; +adjust_space_factor;@/ +if direction=dir_tate then disp:=t_baseline_shift else disp:=y_baseline_shift; +@<Append |disp_node| at begin of displace area@>; +@z + +%@x [46.1035] l.20850 - pTeX: kinsoku penalty +%@<Make a ligature node, if |ligature_present|;...@>= +%wrapup(rt_hit) +%@y +%@<Make a ligature node, if |ligature_present|;...@>= +%wrapup(rt_hit); +%if ins_kp=true then +% begin cx:=KANJI(cur_l); @<Insert kinsoku penalty@>; +% ins_kp:=false; +% end +%@z + +@x [46.1036] l.20854 - pTeX: disp_node +if lig_stack=null then goto reswitch; +@y +if lig_stack=null then + begin @<Append |disp_node| at end of displace area@>; + goto reswitch; + end; +@z + +@x [46.1037] l.20886 - pTeX: Look ahead for another character +@<Look ahead for another character...@>= +get_next; {set only |cur_cmd| and |cur_chr|, for speed} +if cur_cmd=letter then goto main_loop_lookahead+1; +if cur_cmd=other_char then goto main_loop_lookahead+1; +if cur_cmd=char_given then goto main_loop_lookahead+1; +x_token; {now expand and set |cur_cmd|, |cur_chr|, |cur_tok|} +if cur_cmd=letter then goto main_loop_lookahead+1; +if cur_cmd=other_char then goto main_loop_lookahead+1; +if cur_cmd=char_given then goto main_loop_lookahead+1; +if cur_cmd=char_num then + begin scan_char_num; cur_chr:=cur_val; goto main_loop_lookahead+1; + end; +if cur_cmd=no_boundary then bchar:=non_char; +cur_r:=bchar; lig_stack:=null; goto main_lig_loop; +main_loop_lookahead+1: adjust_space_factor; +fast_get_avail(lig_stack); font(lig_stack):=main_f; +cur_r:=qi(cur_chr); character(lig_stack):=cur_r; +if cur_r=false_bchar then cur_r:=non_char {this prevents spurious ligatures} +@y +@<Look ahead for another character...@>= +get_next; {set only |cur_cmd| and |cur_chr|, for speed} +if cur_cmd=letter then goto main_loop_lookahead+1; +if (cur_cmd=kanji)or(cur_cmd=kana)or(cur_cmd=other_kchar) then + @<goto |main_lig_loop|@>; +if cur_cmd=other_char then goto main_loop_lookahead+1; +if cur_cmd=char_given then + begin if is_char_ascii(cur_chr) then goto main_loop_lookahead+1 + else @<goto |main_lig_loop|@>; + end; +x_token; {now expand and set |cur_cmd|, |cur_chr|, |cur_tok|} +if cur_cmd=letter then goto main_loop_lookahead+1; +if (cur_cmd=kanji)or(cur_cmd=kana)or(cur_cmd=other_kchar) then + @<goto |main_lig_loop|@>; +if cur_cmd=other_char then goto main_loop_lookahead+1; +if cur_cmd=char_given then + begin if is_char_ascii(cur_chr) then goto main_loop_lookahead+1 + else @<goto |main_lig_loop|@>; + end; +if cur_cmd=char_num then + begin scan_char_num; cur_chr:=cur_val; + if is_char_ascii(cur_chr) then goto main_loop_lookahead+1 + else @<goto |main_lig_loop|@>; + end; +if cur_cmd=inhibit_glue then + begin inhibit_glue_flag:=true; goto main_loop_lookahead; + end; +if cur_cmd=no_boundary then bchar:=non_char; +cur_r:=bchar; lig_stack:=null; goto main_lig_loop; +main_loop_lookahead+1: adjust_space_factor; +fast_get_avail(lig_stack); font(lig_stack):=main_f; +cur_r:=qi(cur_chr); character(lig_stack):=cur_r; +if cur_r=false_bchar then cur_r:=non_char {this prevents spurious ligatures} + +@ @<goto |main_lig_loop|@>= +begin bchar:=non_char; cur_r:=bchar; lig_stack:=null; +if ligature_present then pack_lig(rt_hit); +if ins_kp=true then + begin cx:=cur_l; @<Insert kinsoku penalty@>; + end; +ins_kp:=false; +goto main_loop_j; +end +@z + +@x [46.1041] l.20999 - pTeX: disp_node +link(tail):=temp_ptr; tail:=temp_ptr; +@y +if (not is_char_node(tail))and(type(tail)=disp_node) then + begin link(prev_node):=temp_ptr; link(temp_ptr):=tail; prev_node:=temp_ptr; + end +else begin link(tail):=temp_ptr; tail:=temp_ptr; + end; +@z + +@x [46.1043] l.21029 - pTeX: disp_node +link(tail):=q; tail:=q; +@y +if (not is_char_node(tail))and(type(tail)=disp_node) then + begin link(prev_node):=q; link(q):=tail; prev_node:=q; + end +else begin link(tail):=q; tail:=q; + end +@z + +@x [47.1061] l.21277 - pTeX: append kern +begin s:=cur_chr; scan_dimen(s=mu_glue,false,false); +tail_append(new_kern(cur_val)); subtype(tail):=s; +end; +@y +begin s:=cur_chr; scan_dimen(s=mu_glue,false,false); +if (not is_char_node(tail))and(type(tail)=disp_node) then + begin prev_append(new_kern(cur_val)); subtype(prev_node):=s; + end +else + begin tail_append(new_kern(cur_val)); subtype(tail):=s; + end; +end; +@z + +@x [47.1068] l.21377 - pTeX: +var p,@!q:pointer; {for short-term use} +@y +var p,@!q:pointer; {for short-term use} +@!r:pointer; {temporaly} +@z + +@x [47.1071] l.21485 - pTeX: \tate, \yoko, \dtou +primitive("hbox",make_box,vtop_code+hmode);@/ +@!@:hbox_}{\.{\\hbox} primitive@> +@y +primitive("hbox",make_box,vtop_code+hmode);@/ +@!@:hbox_}{\.{\\hbox} primitive@> +primitive("tate",chg_dir,dir_tate);@/ +@!@:tate_}{\.{\\tate} primitive@> +primitive("yoko",chg_dir,dir_yoko);@/ +@!@:yoko_}{\.{\\yoko} primitive@> +primitive("dtou",chg_dir,dir_dtou);@/ +@!@:dtou_}{\.{\\dtou} primitive@> +@z + +@x [47.1072] l.21506 - pTeX: \tate, \yoko, \dtou + othercases print_esc("hbox") + endcases; +leader_ship: if chr_code=a_leaders then print_esc("leaders") +@y + othercases print_esc("hbox") + endcases; +chg_dir: + case chr_code of + dir_yoko: print_esc("yoko"); + dir_tate: print_esc("tate"); + dir_dtou: print_esc("dtou"); + endcases; +leader_ship: if chr_code=a_leaders then print_esc("leaders") +@z + +@x [47.1073] l.21523 - pTeX: \tate, \yoko +any_mode(make_box): begin_box(0); +@y +any_mode(make_box): begin_box(0); +any_mode(chg_dir): + begin if cur_group<>align_group then + if head=tail then + begin direction:=cur_chr; + if mode=vmode then page_dir:=cur_chr; + end + else begin print_err("Use `"); print_cmd_chr(cur_cmd,cur_chr); + print("' at top of list"); + help2("Direction change command is available only while") + ("current list is null."); error; + end + else begin print_err("You can't use `"); print_cmd_chr(cur_cmd,cur_chr); + print("' in an align"); + help2("To change direction in an align,") + ("you shold use \hbox or \vbox with \tate or \yoko."); error; + end + end; +@z + +@x [47.1075] l.21538 - pTeX: box_end +var p:pointer; {|ord_noad| for new box in math mode} +@y +var p:pointer; {|ord_noad| for new box in math mode} +q:pointer; +@z + +@x [47.1076] l.21553 - pTeX: box_dir adjust +begin if cur_box<>null then + begin shift_amount(cur_box):=box_context; + if abs(mode)=vmode then + begin append_to_vlist(cur_box); + if adjust_tail<>null then + begin if adjust_head<>adjust_tail then + begin link(tail):=link(adjust_head); tail:=adjust_tail; + end; + adjust_tail:=null; + end; + if mode>0 then build_page; + end + else begin if abs(mode)=hmode then space_factor:=1000 + else begin p:=new_noad; + math_type(nucleus(p)):=sub_box; + info(nucleus(p)):=cur_box; cur_box:=p; + end; + link(tail):=cur_box; tail:=cur_box; + end; + end; +end +@y +begin if cur_box<>null then + begin p:=link(cur_box); link(cur_box):=null; + while p<>null do begin + q:=p; p:=link(p); + if box_dir(q)=abs(direction) then + begin list_ptr(q):=cur_box; cur_box:=q; link(cur_box):=null; + end + else begin + delete_glue_ref(space_ptr(q)); + delete_glue_ref(xspace_ptr(q)); + free_node(q,box_node_size); + end; + end; + if box_dir(cur_box)<>abs(direction) then + cur_box:=new_dir_node(cur_box,abs(direction)); + shift_amount(cur_box):=box_context; + if abs(mode)=vmode then + begin append_to_vlist(cur_box); + if adjust_tail<>null then + begin if adjust_head<>adjust_tail then + begin link(tail):=link(adjust_head); tail:=adjust_tail; + end; + adjust_tail:=null; + end; + if mode>0 then build_page; + end + else begin + if abs(mode)=hmode then + space_factor:=1000 + else begin p:=new_noad; + math_type(nucleus(p)):=sub_box; + info(nucleus(p)):=cur_box; cur_box:=p; + end; + link(tail):=cur_box; tail:=cur_box; + end; +end; +end +@z + +@x [47.1078] l.21585 - pTeX: box_dir adjust + begin append_glue; subtype(tail):=box_context-(leader_flag-a_leaders); + leader_ptr(tail):=cur_box; + end +@y + begin append_glue; subtype(tail):=box_context-(leader_flag-a_leaders); + if type(cur_box)<=dir_node then + begin p:=link(cur_box); link(cur_box):=null; + while p<>null do + begin q:=p; p:=link(p); + if box_dir(q)=abs(direction) then + begin list_ptr(q):=cur_box; cur_box:=q; link(cur_box):=null; + end + else begin + delete_glue_ref(space_ptr(q)); + delete_glue_ref(xspace_ptr(q)); + free_node(q,box_node_size); + end; + end; + if box_dir(cur_box)<>abs(direction) then + cur_box:=new_dir_node(cur_box,abs(direction)); + end; + leader_ptr(tail):=cur_box; + end +@z + +@x [47.1079] l.21605 - pTeX: disp_node, adjust direction +var @!p,@!q:pointer; {run through the current list} +@!m:quarterword; {the length of a replacement list} +@!k:halfword; {0 or |vmode| or |hmode|} +@!n:eight_bits; {a box number} +@y +var @!p,@!q:pointer; {run through the current list} +@!m:quarterword; {the length of a replacement list} +@!k:halfword; {0 or |vmode| or |hmode|} +@!n:eight_bits; {a box number} +@!a_dir:eight_bits; {adjust direction} +@!d:pointer; {last |disp_node|} +@!disp,@!pdisp:scaled; {displacement} +@!pp,pnode:pointer; +@z + +@x [47.1080] l.21636 - pTeX: disp_node, check head=tail +else begin if not is_char_node(tail) then + if (type(tail)=hlist_node)or(type(tail)=vlist_node) then + @<Remove the last box, unless it's part of a discretionary@>; + end; +@y +else begin + if (not is_char_node(tail))and(type(tail)=disp_node) then + begin d:=tail; tail:=prev_node; + end + else d:=null; + if (not is_char_node(tail))and(head<>tail) then + if (type(tail)=hlist_node)or(type(tail)=vlist_node) + or(type(tail)=dir_node) then + @<Remove the last box, unless it's part of a discretionary@>; + if d<>null then + if (not is_char_node(tail))and(type(tail)=disp_node) then + begin prev_node:=pnode; prev_disp:=pdisp; + if prev_disp=disp_dimen(d) then free_node(tail,small_node_size) + else disp_dimen(tail):=disp_dimen(d); + free_node(d,small_node_size); + end + else tail_append(d); + end; +@z + +@x [47.1081] l.21642 - pTeX: disp_node +@ @<Remove the last box...@>= +begin q:=head; +repeat p:=q; +if not is_char_node(q) then if type(q)=disc_node then + begin for m:=1 to replace_count(q) do p:=link(p); + if p=tail then goto done; + end; +q:=link(p); +until q=tail; +cur_box:=tail; shift_amount(cur_box):=0; +tail:=p; link(p):=null; +done:end +@y +@ @<Remove the last box...@>= +begin q:=head; disp:=0; pdisp:=0; +repeat p:=q; +if not is_char_node(q) then + if type(q)=disc_node then + begin for m:=1 to replace_count(q) do p:=link(p); + if p=tail then goto done; + end + else if type(q)=disp_node then + begin pnode:=pp; pdisp:=disp; disp:=disp_dimen(q); + end; +pp:=q; q:=link(p); +until q=tail; +cur_box:=tail; shift_amount(cur_box):=0; +tail:=p; link(p):=null; +if type(cur_box)=dir_node then + begin link(list_ptr(cur_box)):=cur_box; + cur_box:=list_ptr(cur_box); + list_ptr(link(cur_box)):=null; + end +else + if box_dir(cur_box)=dir_default then box_dir(cur_box):=abs(direction); +done:end +@z + +@x [47.1083] l.21675 - pTeX: adjust_dir +if k=hmode then + if (box_context<box_flag)and(abs(mode)=vmode) then + scan_spec(adjusted_hbox_group,true) + else scan_spec(hbox_group,true) +else begin if k=vmode then scan_spec(vbox_group,true) + else begin scan_spec(vtop_group,true); k:=vmode; + end; + normal_paragraph; + end; +push_nest; mode:=-k; +@y +a_dir:=adjust_dir; +if k=hmode then + if (box_context<box_flag)and(abs(mode)=vmode) then + begin a_dir:=abs(direction); scan_spec(adjusted_hbox_group,true); + end + else scan_spec(hbox_group,true) +else begin if k=vmode then scan_spec(vbox_group,true) + else begin scan_spec(vtop_group,true); k:=vmode; + end; + normal_paragraph; + end; +push_nest; mode:=-k; adjust_dir:=a_dir; +@z + +@x [47.1085] l.21717 - pTeX: end of box, call adjust_hlist +hbox_group: package(0); +adjusted_hbox_group: begin adjust_tail:=adjust_head; package(0); + end; +@y +hbox_group: begin adjust_hlist(head,false); package(0); + end; +adjusted_hbox_group: begin adjust_hlist(head,false); + adjust_tail:=adjust_head; package(0); + end; +@z + +@x [47.1086] l.21730 - pTeX: set cur_kanji_skip, cur_xkanji_skip +begin d:=box_max_depth; unsave; save_ptr:=save_ptr-3; +if mode=-hmode then cur_box:=hpack(link(head),saved(2),saved(1)) +else begin cur_box:=vpackage(link(head),saved(2),saved(1),d); + if c=vtop_code then @<Readjust the height and depth of |cur_box|, + for \.{\\vtop}@>; + end; +pop_nest; box_end(saved(0)); +end; +@y +begin d:=box_max_depth; + delete_glue_ref(cur_kanji_skip); delete_glue_ref(cur_xkanji_skip); + if auto_spacing>0 then cur_kanji_skip:=kanji_skip + else cur_kanji_skip:=zero_glue; + if auto_xspacing>0 then cur_xkanji_skip:=xkanji_skip + else cur_xkanji_skip:=zero_glue; + add_glue_ref(cur_kanji_skip); add_glue_ref(cur_xkanji_skip); + unsave; save_ptr:=save_ptr-3; + if mode=-hmode then begin + cur_box:=hpack(link(head),saved(2),saved(1)); + box_dir(cur_box):=abs(direction); pop_nest; + end else begin + cur_box:=vpackage(link(head),saved(2),saved(1),d); + box_dir(cur_box):=abs(direction); pop_nest; + if c=vtop_code then + @<Readjust the height and depth of |cur_box|, for \.{\\vtop}@>; + end; + box_end(saved(0)); +end; +@z + +@x [47.1090] l.21765 - pTeX: apend vmode case +vmode+letter,vmode+other_char,vmode+char_num,vmode+char_given, + vmode+math_shift,vmode+un_hbox,vmode+vrule, + vmode+accent,vmode+discretionary,vmode+hskip,vmode+valign, + vmode+ex_space,vmode+no_boundary:@t@>@;@/ + begin back_input; new_graf(true); + end; +@y +vmode+letter,vmode+other_char,vmode+char_num,vmode+char_given, + vmode+math_shift,vmode+un_hbox,vmode+vrule, + vmode+accent,vmode+discretionary,vmode+hskip,vmode+valign, + vmode+kanji,vmode+kana,vmode+other_kchar, + vmode+ex_space,vmode+no_boundary:@t@>@;@/ + begin back_input; new_graf(true); + end; +@z + +@x [47.1091] l.21782 - pTeX: new_graf, adjust direction +push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang; +@y +push_nest; adjust_dir:=abs(direction); +mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang; +@z + +@x [47.1096] l.21842 - pTeX: end_graf, call adjust_hlist + begin if head=tail then pop_nest {null paragraphs are ignored} + else line_break(widow_penalty); +@y + begin if head=tail then pop_nest {null paragraphs are ignored} + else begin adjust_hlist(head,true); line_break(widow_penalty) + end; +@z + +@x [47.1099] l.21871 - pTeX: insert and adjust +new_save_level(insert_group); scan_left_brace; normal_paragraph; +push_nest; mode:=-vmode; prev_depth:=ignore_depth; +@y +new_save_level(insert_group); scan_left_brace; normal_paragraph; +push_nest; mode:=-vmode; direction:=adjust_dir; prev_depth:=ignore_depth; +@z + +@x [47.1100] l.21876 - pTeX: free box node, ins_dir +insert_group: begin end_graf; q:=split_top_skip; add_glue_ref(q); + d:=split_max_depth; f:=floating_penalty; unsave; decr(save_ptr); + {now |saved(0)| is the insertion number, or 255 for |vadjust|} + p:=vpack(link(head),natural); pop_nest; + if saved(0)<255 then + begin tail_append(get_node(ins_node_size)); + type(tail):=ins_node; subtype(tail):=qi(saved(0)); + height(tail):=height(p)+depth(p); ins_ptr(tail):=list_ptr(p); + split_top_ptr(tail):=q; depth(tail):=d; float_cost(tail):=f; + end + else begin tail_append(get_node(small_node_size)); + type(tail):=adjust_node;@/ + subtype(tail):=0; {the |subtype| is not used} + adjust_ptr(tail):=list_ptr(p); delete_glue_ref(q); + end; + free_node(p,box_node_size); + if nest_ptr=0 then build_page; + end; +@y +insert_group: begin end_graf; q:=split_top_skip; add_glue_ref(q); + d:=split_max_depth; f:=floating_penalty; unsave; decr(save_ptr); + {now |saved(0)| is the insertion number, or 255 for |vadjust|} + p:=vpack(link(head),natural); box_dir(p):=abs(direction); pop_nest; + if saved(0)<255 then + begin r:=get_node(ins_node_size); + type(r):=ins_node; subtype(r):=qi(saved(0)); + height(r):=height(p)+depth(p); ins_ptr(r):=list_ptr(p); + split_top_ptr(r):=q; depth(r):=d; float_cost(r):=f; + ins_dir(r):=box_dir(p); + if (not is_char_node(tail))and(type(tail)=disp_node) then + prev_append(r) + else tail_append(r); + end + else begin + if box_dir(p)<>adjust_dir then + begin print_err("Direction Incompatible."); + help1("\vadjust's argument and outer vlist must have same direction."); + error; flush_node_list(list_ptr(p)); + end + else begin + r:=get_node(small_node_size); type(r):=adjust_node;@/ + adjust_ptr(r):=list_ptr(p); delete_glue_ref(q); + if (not is_char_node(tail))and(type(tail)=disp_node) then + prev_append(r) + else tail_append(r); + end; + end; + delete_glue_ref(space_ptr(p)); + delete_glue_ref(xspace_ptr(p)); + free_node(p,box_node_size); + if nest_ptr=0 then build_page; + end; +@z + +@x [47.1101] l.21901 - pTeX: mark_node, prev_append +mark_ptr(p):=def_ref; link(tail):=p; tail:=p; +@y +mark_ptr(p):=def_ref; +if (not is_char_node(tail))and(type(tail)=disp_node) then + prev_append(p) +else tail_append(p); +@z + +@x [47.1103] l.21911 - pTeX: penalty, prev_append +procedure append_penalty; +begin scan_int; tail_append(new_penalty(cur_val)); +if mode=vmode then build_page; +end; +@y +procedure append_penalty; +begin scan_int; + if (not is_char_node(tail))and(type(tail)=disp_node) then + prev_append(new_penalty(cur_val)) + else tail_append(new_penalty(cur_val)); + if mode=vmode then build_page; +end; +@z + +@x [47.1105] l.21932 - pTeX: delete_last: disp_node +var @!p,@!q:pointer; {run through the current list} +@!m:quarterword; {the length of a replacement list} +@y +var @!p,@!q:pointer; {run through the current list} +@!m:quarterword; {the length of a replacement list} +@!d:pointer; {last |disp_node|} +@!disp,@!pdisp:scaled; {displacement} +@!pp,pnode:pointer; +@z + +@x [47.1105] l.21937 - pTeX: delete_last: disp_node +else begin if not is_char_node(tail) then if type(tail)=cur_chr then + begin q:=head; + repeat p:=q; + if not is_char_node(q) then if type(q)=disc_node then + begin for m:=1 to replace_count(q) do p:=link(p); + if p=tail then return; + end; + q:=link(p); + until q=tail; + link(p):=null; flush_node_list(tail); tail:=p; + end; + end; +exit:end; +@y +else begin + if (not is_char_node(tail))and(type(tail)=disp_node) then + begin d:=tail; tail:=prev_node; link(tail):=null; + end + else d:=null; + if not is_char_node(tail) then if type(tail)=cur_chr then + begin q:=head; pp:=null; disp:=0; pdisp:=0; + repeat p:=q; + if not is_char_node(q) then + if type(q)=disc_node then + begin for m:=1 to replace_count(q) do p:=link(p); + if p=tail then + begin if d<>null then tail_append(d); + return; + end + end + else if type(q)=disp_node then + begin pnode:=pp; pdisp:=disp; disp:=disp_dimen(q); + end; + pp:=q; q:=link(p); + until q=tail; + link(p):=null; flush_node_list(tail); tail:=p; + end; + prev_node:=pnode; prev_disp:=pdisp; + if d<>null then + if (not is_char_node(tail))and(type(tail)=disp_node) then + begin if prev_disp=disp_dimen(d) then + free_node(tail,small_node_size) + else disp_dimen(tail):=disp_dimen(d); + free_node(d,small_node_size) + end + else + begin prev_node:=tail; prev_disp:=disp; tail_append(d) + end + end; +exit:end; +@z + +@x [47.1110] l.21997 -pTeX: free box node, delete kanji_skip +var p:pointer; {the box} +@!c:box_code..copy_code; {should we copy?} +@y +var p:pointer; {the box} +@!c:box_code..copy_code; {should we copy?} +@!disp:scaled; {displacement} +@z + +@x [47.1110] l.22001 - pTeX: free box node, delete kanji_skip +if (abs(mode)=mmode)or((abs(mode)=vmode)and(type(p)<>vlist_node))or@| + ((abs(mode)=hmode)and(type(p)<>hlist_node)) then + begin print_err("Incompatible list can't be unboxed"); +@.Incompatible list...@> + help3("Sorry, Pandora. (You sneaky devil.)")@/ + ("I refuse to unbox an \hbox in vertical mode or vice versa.")@/ + ("And I can't open any boxes in math mode.");@/ + error; return; + end; +if c=copy_code then link(tail):=copy_node_list(list_ptr(p)) +else begin link(tail):=list_ptr(p); box(cur_val):=null; + free_node(p,box_node_size); + end; +while link(tail)<>null do tail:=link(tail); +@y +if type(p)=dir_node then p:=list_ptr(p); +if (abs(mode)=mmode)or((abs(mode)=vmode)and(type(p)<>vlist_node))or@| + ((abs(mode)=hmode)and(type(p)<>hlist_node)) then + begin print_err("Incompatible list can't be unboxed"); +@.Incompatible list...@> + help3("Sorry, Pandora. (You sneaky devil.)")@/ + ("I refuse to unbox an \hbox in vertical mode or vice versa.")@/ + ("And I can't open any boxes in math mode.");@/ + error; return; +end; +case box_dir(p) of + any_dir: + if abs(direction)<>box_dir(p) then begin + print_err("Incompatible direction list can't be unboxed"); + help2("Sorry, Pandora. (You sneaky devil.)")@/ + ("I refuse to unbox a box in differrent direction.");@/ + error; return; + end; +endcases; +disp:=0; +if c=copy_code then link(tail):=copy_node_list(list_ptr(p)) +else + begin if type(box(cur_val))=dir_node then + begin delete_glue_ref(space_ptr(box(cur_val))); + delete_glue_ref(xspace_ptr(box(cur_val))); + free_node(box(cur_val),box_node_size); + end; + flush_node_list(link(p)); + link(tail):=list_ptr(p); box(cur_val):=null; + delete_glue_ref(space_ptr(p)); + delete_glue_ref(xspace_ptr(p)); + free_node(p,box_node_size); + end; +while link(tail)<>null do + begin p:=tail; tail:=link(tail); + if not is_char_node(tail) then + case type(tail) of + glue_node : + if (subtype(tail)=kanji_skip_code+1) + or(subtype(tail)=xkanji_skip_code+1) then + begin link(p):=link(tail); + delete_glue_ref(glue_ptr(tail)); + free_node(tail,small_node_size); tail:=p; + end; + penalty_node : + if subtype(tail)=widow_pena then + begin link(p):=link(tail); free_node(tail,small_node_size); + tail:=p; + end; + disp_node : + begin prev_disp:=disp; disp:=disp_dimen(tail); prev_node:=p; + end; + endcases; + end; +@z + +@x [47.1113] l.22028 - pTeX: italic correction, ita_kern +procedure append_italic_correction; +label exit; +var p:pointer; {|char_node| at the tail of the current list} +@!f:internal_font_number; {the font in the |char_node|} +begin if tail<>head then + begin if is_char_node(tail) then p:=tail + else if type(tail)=ligature_node then p:=lig_char(tail) + else return; + f:=font(p); + tail_append(new_kern(char_italic(f)(char_info(f)(character(p))))); + subtype(tail):=explicit; + end; +@y +procedure append_italic_correction; +label exit; +var p:pointer; {|char_node| at the tail of the current list} +@!f:internal_font_number; {the font in the |char_node|} +@!d:pointer; {|disp_node|} +begin if tail<>head then + begin + if (not is_char_node(tail))and(type(tail)=disp_node) then + begin d:=tail; tail:=prev_node; + end + else d:=null; + if (last_jchr<>null)and(link(last_jchr)=tail)and(is_char_node(tail)) then + p:=last_jchr + else if is_char_node(tail) then p:=tail + else if type(tail)=ligature_node then p:=lig_char(tail) + else return; + f:=font(p); + tail_append(new_kern(char_italic(f)(char_info(f)(character(p))))); + subtype(tail):=ita_kern; + if d<>null then + begin prev_node:=tail; tail_append(d); + end; + end; +@z + +@x [47.1120] l.22119 - pTeX: discretionary with disp_node +decr(save_ptr); return; +@y +decr(save_ptr); +prev_node:=tail; tail_append(get_node(small_node_size)); +type(tail):=disp_node; disp_dimen(tail):=0; prev_disp:=0; +return; +@z + +@x [47.1121] l.22127 - pTeX: discretionary with disp_node + begin if not is_char_node(p) then if type(p)>rule_node then + if type(p)<>kern_node then if type(p)<>ligature_node then + begin print_err("Improper discretionary list"); +@y + begin if not is_char_node(p) then + if (type(p)>rule_node)and(type(p)<>kern_node)and + (type(p)<>ligature_node)and(type(p)<>disp_node) then + if (type(p)=penalty_node)and(subtype(p)<>normal) then + begin link(q):=link(p); free_node(p,small_node_size); p:=q; + end + else + begin print_err("Improper discretionary list"); +@z + +@x [47.1123] l.22160 - pTeX: make_accent, Kanji, insert disp_node +var s,@!t: real; {amount of slant} +@y +var s,@!t: real; {amount of slant} +@!disp:scaled; {displacement} +@!cx:KANJI_code; {temporary register for KANJI} +@z + +@x [47.1123] l.22165 - pTeX: make_accent, Kanji, insert disp_node +begin scan_char_num; f:=cur_font; p:=new_character(f,cur_val); +@y +begin scan_char_num; +if (not is_char_ascii(cur_val)) then + begin KANJI(cx):=cur_val; + if direction=dir_tate then f:=cur_tfont else f:=cur_jfont; + p:=new_character(f,get_jfm_pos(KANJI(cx),f)); + {DEBUG if p<>null then ...} + link(p):=get_avail; info(link(p)):=KANJI(cx); + end +else begin f:=cur_font; p:=new_character(f,cur_val); + end; +@z + +@x [47.1123] l.22175 - pTeX: make_accent, Kanji, insert disp_node + link(tail):=p; tail:=p; space_factor:=1000; +@y + link(tail):=p; + if link(p)<>null then tail:=link(p) else tail:=p; + @<Append |disp_node| at end of displace area@>; + space_factor:=1000; +@z + +@x [47.1124] l.22180 - pTeX: make_accent Kanji, insert disp_node +q:=null; f:=cur_font; +if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given) then + q:=new_character(f,cur_chr) +else if cur_cmd=char_num then + begin scan_char_num; q:=new_character(f,cur_val); + end +else back_input +@y +q:=null; f:=cur_font; KANJI(cx):=empty; +if (cur_cmd=letter)or(cur_cmd=other_char) then + q:=new_character(f,cur_chr) +else if (cur_cmd=kanji)or(cur_cmd=kana)or(cur_cmd=other_kchar) then + begin if direction=dir_tate then f:=cur_tfont else f:=cur_jfont; + cx:=cur_chr; + end +else if cur_cmd=char_given then + if is_char_ascii(cur_chr) then q:=new_character(f,cur_chr) + else begin + if direction=dir_tate then f:=cur_tfont else f:=cur_jfont; + KANJI(cx):=cur_chr + end + else if cur_cmd=char_num then + begin scan_char_num; + if is_char_ascii(cur_chr) then q:=new_character(f,cur_val) + else begin + if direction=dir_tate then f:=cur_tfont else f:=cur_jfont; + KANJI(cx):=cur_chr + end + end +else back_input; +if direction=dir_tate then + begin if font_dir[f]=dir_tate then disp:=0 + else if font_dir[f]=dir_yoko then disp:=t_baseline_shift-y_baseline_shift + else disp:=t_baseline_shift + end +else begin if font_dir[f]=dir_yoko then disp:=0 + else if font_dir[f]=dir_tate then disp:=y_baseline_shift-t_baseline_shift + else disp:=y_baseline_shift + end; +@<Append |disp_node| at begin of displace area@>; +if KANJI(cx)<>empty then + begin q:=new_character(f,get_jfm_pos(KANJI(cx),f)); + link(q):=get_avail; info(link(q)):=KANJI(cx); + end; +@z + +@x [47.1125] l.22200 - pTeX: make_accent Kanji +if h<>x then {the accent must be shifted up or down} + begin p:=hpack(p,natural); shift_amount(p):=x-h; + end; +@y +if h<>x then {the accent must be shifted up or down} + begin delete_glue_ref(cur_kanji_skip); delete_glue_ref(cur_xkanji_skip); + cur_kanji_skip:=zero_glue; cur_xkanji_skip:=zero_glue; + add_glue_ref(cur_kanji_skip); add_glue_ref(cur_xkanji_skip); + p:=hpack(p,natural); shift_amount(p):=x-h; + end; +@z + +@x l.22334 - pTeX +procedure cs_error; +begin +if cur_chr = 10 then +begin + print_err("Extra "); print_esc("endmubyte"); +@.Extra \\endmubyte@> + help1("I'm ignoring this, since I wasn't doing a \mubyte."); +end else begin + print_err("Extra "); print_esc("endcsname"); +@.Extra \\endcsname@> + help1("I'm ignoring this, since I wasn't doing a \csname."); +end; +@y +procedure cs_error; +begin print_err("Extra "); print_esc("endcsname"); +@.Extra \\endcsname@> +help1("I'm ignoring this, since I wasn't doing a \csname."); +@z + +@x [48.1138] l.22385 - pTeX: init math : direction < 0 ... math direction +if (cur_cmd=math_shift)and(mode>0) then @<Go into display math mode@> +else begin back_input; @<Go into ordinary math mode@>; + end; +@y +if (cur_cmd=math_shift)and(mode>0) then @<Go into display math mode@> +else begin back_input; @<Go into ordinary math mode@>; + end; +direction:=-abs(direction); +@z + +@x [48.1145] l.22435 - pTeX: Call adjust_hlist at begin of display +else begin line_break(display_widow_penalty);@/ +@y +else begin adjust_hlist(head,true); line_break(display_widow_penalty);@/ +@z + +@x [48.1147] l.22471 - pTeX: Skip kanji 2nd node, dir_node +reswitch: if is_char_node(p) then + begin f:=font(p); d:=char_width(f)(char_info(f)(character(p))); + goto found; + end; +case type(p) of +hlist_node,vlist_node,rule_node: begin d:=width(p); goto found; + end; +@y +reswitch: if is_char_node(p) then + begin f:=font(p); d:=char_width(f)(orig_char_info(f)(character(p))); + if font_dir[f]<>dir_default then p:=link(p); + goto found; + end; +case type(p) of +hlist_node,vlist_node,dir_node,rule_node: begin d:=width(p); goto found; + end; +@z + +@x [48.1150] l.22541 - pTeX: scan_math +mmode+left_brace: begin tail_append(new_noad); + back_input; scan_math(nucleus(tail)); + end; +@y +mmode+left_brace: begin tail_append(new_noad); + back_input; scan_math(nucleus(tail),kcode_noad(tail)); + end; +@z + +@x [48.1151] l.22555 - pTeX: scan_math: use Kanji in math_mode +procedure scan_math(@!p:pointer); +label restart,reswitch,exit; +var c:integer; {math character code} +begin restart:@<Get the next non-blank non-relax...@>; +reswitch:case cur_cmd of +letter,other_char,char_given: begin c:=ho(math_code(cur_chr)); + if c=@'100000 then + begin @<Treat |cur_chr| as an active character@>; + goto restart; + end; + end; +@y +procedure scan_math(@!p,@!q:pointer); +label restart,reswitch,exit; +var c:integer; {math character code} +cx:KANJI_code; {temporary register for KANJI} +begin KANJI(cx):=0; +restart: @<Get the next non-blank non-relax...@>; +reswitch:case cur_cmd of +letter,other_char,char_given: + if (is_char_ascii(cur_chr) or (cur_chr=256)) then begin + c:=ho(math_code(cur_chr)); + if c=@'100000 then + begin @<Treat |cur_chr| as an active character@>; + goto restart; + end; + end + else + KANJI(cx):=cur_chr; +kanji,kana,other_kchar: cx:=cur_chr; +@z + +@x [48.1151] l.22576 - pTeX: scan_math: use Kanji in math_mode +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; +@y +if KANJI(cx)=0 then + begin 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; + if font_dir[fam_fnt(fam(p)+cur_size)]<>dir_default then + begin print_err("Not one-byte family"); + help1("IGNORE.");@/ + error; + end + end +else begin + if q=null then + begin math_type(p):=sub_mlist; info(p):=new_noad; + p:=nucleus(info(p)); q:=kcode_noad_nucleus(p); + end; + math_type(p):=math_jchar; fam(p):=cur_jfam; character(p):=qi(0); + info(q):=KANJI(cx); + if font_dir[fam_fnt(fam(p)+cur_size)]=dir_default then + begin print_err("Not two-byte family"); + help1("IGNORE.");@/ + error; + end + end; +@z + +@x [48.1154] l.22605 - pTeX: math mode +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; +@y +mmode+letter,mmode+other_char,mmode+char_given: + if is_char_ascii(cur_chr) then + if cur_chr<128 then set_math_char(ho(math_code(cur_chr))) + else set_math_char(cur_chr) + else set_math_kchar(cur_chr); +mmode+kanji,mmode+kana,mmode+other_kchar: begin + cx:=cur_chr; set_math_kchar(KANJI(cx)); + end; +mmode+char_num: begin scan_char_num; cur_chr:=cur_val; + if is_char_ascii(cur_chr) then + if cur_chr<128 then set_math_char(ho(math_code(cur_chr))) + else set_math_char(cur_chr) + else set_math_kchar(cur_chr); + end; +@z + +@x [48.1155] l.22635 - pTeX: set_math_char + link(tail):=p; tail:=p; +@y + link(tail):=p; tail:=p; + if font_dir[fam_fnt(fam(nucleus(p))+cur_size)]<>dir_default then begin + print_err("Not one-byte family"); + help1("IGNORE.");@/ + error; + end +@z + +@x [48.1158] l.22690 - pTeX: scan_math + type(tail):=cur_chr; scan_math(nucleus(tail)); +@y + type(tail):=cur_chr; scan_math(nucleus(tail),kcode_noad(tail)); +@z + +@x [48.1163] l.22750 - pTeX: scan_math +scan_delimiter(left_delimiter(tail),true); scan_math(nucleus(tail)); +@y +scan_delimiter(left_delimiter(tail),true); +scan_math(nucleus(tail),kcode_noad(tail)); +@z + +@x [48.1164] l.22770 - pTeX: scan_math +scan_math(nucleus(tail)); +@y +scan_math(nucleus(tail),kcode_noad(tail)); +@z + +@x [48.1164] l.22790 - pTeX: vcenter : dir +vcenter_group: begin end_graf; unsave; save_ptr:=save_ptr-2; + p:=vpack(link(head),saved(1),saved(0)); pop_nest; + tail_append(new_noad); type(tail):=vcenter_noad; + math_type(nucleus(tail)):=sub_box; info(nucleus(tail)):=p; + end; +@y +vcenter_group: begin end_graf; unsave; save_ptr:=save_ptr-2; + p:=vpack(link(head),saved(1),saved(0)); + box_dir(p):=abs(direction); pop_nest; + if box_dir(p)<>abs(direction) then p:=new_dir_node(p,abs(direction)); + tail_append(new_noad); type(tail):=vcenter_noad; + math_type(nucleus(tail)):=sub_box; info(nucleus(tail)):=p; + end; +@z + +@x [48.1176] l.22864 - pTeX: scan_math +scan_math(p); +@y +scan_math(p,null); +@z + +@x [48.1186] l.23006 - pTeX: copy kanji code + if math_type(supscr(p))=empty then + begin mem[saved(0)].hh:=mem[nucleus(p)].hh; +@y + if ((math_type(supscr(p))=empty)and(math_kcode(p)=null)) then + begin mem[saved(0)].hh:=mem[nucleus(p)].hh; +@z + +@x [48.1194] l.23078 - pTeX: set cur_kanji_skip, cur_xkanji_skip +var l:boolean; {`\.{\\leqno}' instead of `\.{\\eqno}'} +@y +var l:boolean; {`\.{\\leqno}' instead of `\.{\\eqno}'} +@!disp:scaled; {displacement} +@z + +@x [48.1194] l.23087 - pTeX: set cur_kanji_skip, cur_xkanji_skip +m:=mode; l:=false; p:=fin_mlist(null); {this pops the nest} +@y +delete_glue_ref(cur_kanji_skip); delete_glue_ref(cur_xkanji_skip); +if auto_spacing>0 then cur_kanji_skip:=kanji_skip +else cur_kanji_skip:=zero_glue; +if auto_xspacing>0 then cur_xkanji_skip:=xkanji_skip +else cur_xkanji_skip:=zero_glue; +add_glue_ref(cur_kanji_skip); add_glue_ref(cur_xkanji_skip); +m:=mode; l:=false; p:=fin_mlist(null); {this pops the nest} +@z + +@x [48.1196] l.23134 - pTeX: insert disp_node +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 if direction=dir_tate then disp:=t_baseline_shift + else disp:=y_baseline_shift; +@<Append |disp_node| at begin of displace area@>; +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)); +@<Append |disp_node| at end of displace area@>; +space_factor:=1000; unsave; +end +@z + +@x [48.1200] l.23203 - pTeX: adjust direction +push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang; +@y +push_nest; adjust_dir:=abs(direction); +mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang; +@z + +@x [48.1201] l.23217 - pTeX: free box node + begin free_node(b,box_node_size); +@y + begin delete_glue_ref(space_ptr(b)); delete_glue_ref(xspace_ptr(b)); + free_node(b,box_node_size); +@z + +@x [48.1201] l.23222 - pTeX: free box node + begin free_node(b,box_node_size); +@y + begin delete_glue_ref(space_ptr(b)); delete_glue_ref(xspace_ptr(b)); + free_node(b,box_node_size); +@z + +@x [49.1210] l.23361 - pTeX: set_auto_spacing +any_mode(toks_register), +any_mode(assign_toks), +any_mode(assign_int), +@y +any_mode(assign_kinsoku), +any_mode(assign_inhibit_xsp_code), +any_mode(set_auto_spacing), +any_mode(set_kansuji_char), +any_mode(toks_register), +any_mode(assign_toks), +any_mode(assign_int), +any_mode(def_jfont), +any_mode(def_tfont), +@z + +@x [49.1211] l.23397 - pTeX: prefixed_command +procedure prefixed_command; +label done,exit; +var a:small_number; {accumulated prefix codes so far} +@y +procedure prefixed_command; +label done,exit; +var a:small_number; {accumulated prefix codes so far} +@!m:integer; {ditto} +@z + +@x l.23403 - pTeX +@!p,@!q,@!r:pointer; {for temporary short-term use} +@y +@!p,@!q:pointer; {for temporary short-term use} +@z + +@x [49.1217] l.23487 - pTeX: select cur font +set_font: define(cur_font_loc,data,cur_chr); +@y +set_font: begin + if font_dir[cur_chr]=dir_yoko then + define(cur_jfont_loc,data,cur_chr) + else if font_dir[cur_chr]=dir_tate then + define(cur_tfont_loc,data,cur_chr) + else + define(cur_font_loc,data,cur_chr) +end; +@z + +@x l.23504 - pTeX +primitive("futurelet",let,normal+1);@/ +@!@:future_let_}{\.{\\futurelet} primitive@> +if enctex_p then +begin + primitive("mubyte",let,normal+10);@/ +@!@:mubyte_}{\.{\\mubyte} primitive@> + primitive("noconvert",let,normal+11);@/ +@!@:noconvert_}{\.{\\noconvert} primitive@> +end; + +@ @<Cases of |print_cmd_chr|...@>= +let: if chr_code<>normal then + if chr_code = normal+10 then print_esc("mubyte") + else if chr_code = normal+11 then print_esc("noconvert") + else print_esc("futurelet") + else print_esc("let"); + +@ @<Assignments@>= +let: if cur_chr = normal+11 then do_nothing { noconvert primitive } + else if cur_chr = normal+10 then { mubyte primitive } + begin + selector:=term_and_log; + get_token; + mubyte_stoken := cur_tok; + if cur_tok <= cs_token_flag then mubyte_stoken := cur_tok mod 256; + mubyte_prefix := 60; mubyte_relax := false; + mubyte_tablein := true; mubyte_tableout := true; + get_x_token; + if cur_cmd = spacer then get_x_token; + if cur_cmd = sub_mark then + begin + mubyte_tableout := false; get_x_token; + if cur_cmd = sub_mark then + begin + mubyte_tableout := true; mubyte_tablein := false; + get_x_token; + end; + end else if (mubyte_stoken > cs_token_flag) and + (cur_cmd = mac_param) then + begin + mubyte_tableout := false; + scan_int; mubyte_prefix := cur_val; get_x_token; + if mubyte_prefix > 50 then mubyte_prefix := 52; + if mubyte_prefix <= 0 then mubyte_prefix := 51; + end + else if (mubyte_stoken > cs_token_flag) and (cur_cmd = relax) then + begin + mubyte_tableout := true; mubyte_tablein := false; + mubyte_relax := true; get_x_token; + end; + r := get_avail; p := r; + while cur_cs = 0 do begin store_new_token (cur_tok); get_x_token; end; + if (cur_cmd <> end_cs_name) or (cur_chr <> 10) then + begin + print_err("Missing "); print_esc("endmubyte"); print(" inserted"); + help2("The control sequence marked <to be read again> should")@/ +("not appear in <byte sequence> between \mubyte and \endmubyte."); + back_error; + end; + p := link(r); + if (p = null) and mubyte_tablein then + begin + print_err("The empty <byte sequence>, "); + print_esc("mubyte"); print(" ignored"); + help2("The <byte sequence> in")@/ +("\mubyte <token> <byte sequence>\endmubyte should not be empty."); + error; + end else begin + while p <> null do + begin + append_char (info(p) mod 256); + p := link (p); + end; + flush_list (r); + if (str_start [str_ptr] + 1 = pool_ptr) and + (str_pool [pool_ptr-1] = mubyte_stoken) then + begin + if mubyte_read [mubyte_stoken] <> null + and mubyte_tablein then { clearing data } + dispose_munode (mubyte_read [mubyte_stoken]); + if mubyte_tablein then mubyte_read [mubyte_stoken] := null; + if mubyte_tableout then mubyte_write [mubyte_stoken] := 0; + pool_ptr := str_start [str_ptr]; + end else begin + if mubyte_tablein then mubyte_update; { updating input side } + if mubyte_tableout then { updating output side } + begin + if mubyte_stoken > cs_token_flag then { control sequence } + begin + dispose_mutableout (mubyte_stoken-cs_token_flag); + if (str_start [str_ptr] < pool_ptr) or mubyte_relax then + begin { store data } + r := mubyte_cswrite[(mubyte_stoken-cs_token_flag) mod 128]; + p := get_avail; + mubyte_cswrite[(mubyte_stoken-cs_token_flag) mod 128] := p; + info (p) := mubyte_stoken-cs_token_flag; + link (p) := get_avail; + p := link (p); + if mubyte_relax then begin + info (p) := 0; pool_ptr := str_start [str_ptr]; + end else info (p) := slow_make_string; + link (p) := r; + end; + end else begin { single character } + if str_start [str_ptr] = pool_ptr then + mubyte_write [mubyte_stoken] := 0 + else + mubyte_write [mubyte_stoken] := slow_make_string; + end; + end else pool_ptr := str_start [str_ptr]; + end; + end; + end else begin { let primitive } + n:=cur_chr; +@y +primitive("futurelet",let,normal+1);@/ +@!@:future_let_}{\.{\\futurelet} primitive@> + +@ @<Cases of |print_cmd_chr|...@>= +let: if chr_code<>normal then print_esc("futurelet")@+else print_esc("let"); + +@ @<Assignments@>= +let: begin n:=cur_chr; +@z + +@x [49.1228] l.23785 - pTeX: assign jfam +assign_int: begin p:=cur_chr; scan_optional_equals; scan_int; + word_define(p,cur_val); + end; +@y +assign_int: begin p:=cur_chr; scan_optional_equals; scan_int; + if p=int_base+cur_fam_code then + begin if font_dir[fam_fnt(cur_val)]<>dir_default then + word_define(int_base+cur_jfam_code,cur_val) + else word_define(p,cur_val); + end + else word_define(p,cur_val); + end; +@z + +@x [49.1230] l.23812 - pTeX: xspcode, kcatcode +@<Put each...@>= +primitive("catcode",def_code,cat_code_base); +@!@:cat_code_}{\.{\\catcode} primitive@> +@y +@<Put each...@>= +primitive("catcode",def_code,cat_code_base); +@!@:cat_code_}{\.{\\catcode} primitive@> +primitive("kcatcode",def_code,kcat_code_base); +@!@:cat_code_}{\.{\\kcatcode} primitive@> +primitive("xspcode",def_code,auto_xsp_code_base); +@!@:auto_xsp_code_}{\.{\\xspcode} primitive@> +@z + +@x l.23815 - pTeX +if enctex_p then +begin + primitive("xordcode",def_code,xord_code_base); +@!@:xord_code_}{\.{\\xordcode} primitive@> + primitive("xchrcode",def_code,xchr_code_base); +@!@:xchr_code_}{\.{\\xchrcode} primitive@> + primitive("xprncode",def_code,xprn_code_base); +@!@:xprn_code_}{\.{\\xprncode} primitive@> +end; +@y +@z + +@x [49.1231] l.23842 - pTeX: xspcode, kcatcode +def_code: if chr_code=xord_code_base then print_esc("xordcode") + else if chr_code=xchr_code_base then print_esc("xchrcode") + else if chr_code=xprn_code_base then print_esc("xprncode") + else if chr_code=cat_code_base then print_esc("catcode") + else if chr_code=math_code_base then print_esc("mathcode") +@y +def_code: if chr_code=cat_code_base then print_esc("catcode") + else if chr_code=kcat_code_base then print_esc("kcatcode") + else if chr_code=auto_xsp_code_base then print_esc("xspcode") + else if chr_code=math_code_base then print_esc("mathcode") +@z + +@x [49.1232] l.23857 - pTeX: kcatcode +def_code: begin @<Let |n| be the largest legal code value, based on |cur_chr|@>; + p:=cur_chr; scan_char_num; + if p=xord_code_base then p:=cur_val + else if p=xchr_code_base then p:=cur_val+256 + else if p=xprn_code_base then p:=cur_val+512 + else p:=p+cur_val; + scan_optional_equals; + scan_int; + if ((cur_val<0)and(p<del_code_base))or(cur_val>n) then + begin print_err("Invalid code ("); print_int(cur_val); +@.Invalid code@> + if p<del_code_base then print("), should be in the range 0..") + else print("), should be at most "); + print_int(n); + help1("I'm going to use 0 instead of that illegal code value.");@/ + error; cur_val:=0; + end; + if p<256 then xord[p]:=cur_val + else if p<512 then xchr[p-256]:=cur_val + else if p<768 then xprn[p-512]:=cur_val + else if p<math_code_base then define(p,data,cur_val) + else if p<del_code_base then define(p,data,hi(cur_val)) + else word_define(p,cur_val); + end; +@y +def_code: begin + @<Let |m| be the minimal legal code value, based on |cur_chr|@>; + @<Let |n| be the largest legal code value, based on |cur_chr|@>; + p:=cur_chr; scan_char_num; + if p=kcat_code_base then p:=p+kcatcodekey(cur_val) else p:=p+cur_val; + scan_optional_equals; scan_int; + if ((cur_val<m)and(p<del_code_base))or(cur_val>n) then + begin print_err("Invalid code ("); print_int(cur_val); +@.Invalid code@> + if p<del_code_base then + begin print("), should be in the range "); print_int(m); print(".."); + end + else print("), should be at most "); + print_int(n); + if m=0 then + begin help1("I'm going to use 0 instead of that illegal code value.");@/ + error; + end + else + begin help1("I'm going to use 16 instead of that illegal code value.");@/ + error; + end; + cur_val:=m; + end; + if p<math_code_base then define(p,data,cur_val) + else if p<del_code_base then define(p,data,hi(cur_val)) + else word_define(p,cur_val); + end; +@z + +@x [49.1233] l.23882 - pTeX: kcatcode +@ @<Let |n| be the largest...@>= +if cur_chr=cat_code_base then n:=max_char_code +@y +@ @<Let |m| be the minimal...@>= +if cur_chr=kcat_code_base then m:=kanji else m:=0 + +@ @<Let |n| be the largest...@>= +if cur_chr=cat_code_base then n:=invalid_char {1byte |max_char_code|} +else if cur_chr=kcat_code_base then n:=max_char_code +@z + +@x [49.1247] l.24083 - pTeX: alter_box_dimen : box_dir +procedure alter_box_dimen; +var c:small_number; {|width_offset| or |height_offset| or |depth_offset|} +@!b:eight_bits; {box number} +begin c:=cur_chr; scan_eight_bit_int; b:=cur_val; scan_optional_equals; +scan_normal_dimen; +if box(b)<>null then mem[box(b)+c].sc:=cur_val; +end; +@y +procedure alter_box_dimen; +var c:small_number; {|width_offset| or |height_offset| or |depth_offset|} +@!b:eight_bits; {box number} +@!p,q:pointer; {temporary registers} +begin c:=cur_chr; scan_eight_bit_int; b:=cur_val; scan_optional_equals; +scan_normal_dimen; +if box(b)<>null then + begin q:=box(b); p:=link(q); + while p<>null do + begin if abs(direction)=box_dir(p) then q:=p; + p:=link(p); + end; + if box_dir(q)<>abs(direction) then + begin q:=new_dir_node(q,abs(direction)); list_ptr(q):=null; + link(q):=link(box(b)); link(box(b)):=q; + end; + mem[q+c].sc:=cur_val; + end; +end; +@z + +@x [49.1256] l.24163 - pTeX: def_tfont +def_font: new_font(a); +@y +def_tfont,def_jfont,def_font: new_font(a); +@z + +@x l.24369 - pTeX +message_printing := true; active_noconvert := true; +token_show(def_ref); +message_printing := false; active_noconvert := false; +selector:=old_setting; +@y +token_show(def_ref); selector:=old_setting; +@z + +@x [49.1292] l.24451 - pTeX: shift_case +@<Change the case of the token in |p|, if a change is appropriate@>= +t:=info(p); +if t<cs_token_flag+single_base then + begin c:=t mod 256; + if equiv(b+c)<>0 then info(p):=t-c+equiv(b+c); + end +@y +@<Change the case of the token in |p|, if a change is appropriate@>= +t:=info(p); +if (t<cs_token_flag+single_base)and(not check_kanji(t)) then + begin c:=t mod 256; + if equiv(b+c)<>0 then info(p):=t-c+equiv(b+c); + end +@z + +@x [49.1291] l.24467 - pTeX: show_mode +@d show_lists=3 { \.{\\showlists} } +@y +@d show_lists=3 { \.{\\showlists} } +@d show_mode=4 { \.{\\showmode} } +@z + +@x [49.1291] l.24476 - pTeX: show_mode +primitive("showlists",xray,show_lists); +@!@:show_lists_}{\.{\\showlists} primitive@> +@y +primitive("showlists",xray,show_lists); +@!@:show_lists_}{\.{\\showlists} primitive@> +primitive("showmode",xray,show_mode); +@!@:show_mode_}{\.{\\showmode} primitive@> +@z + +@x [49.1292] l.24483 - pTeX: show_mode + show_lists:print_esc("showlists"); + othercases print_esc("show") +@y + show_lists:print_esc("showlists"); + show_mode:print_esc("showmode"); + othercases print_esc("show") +@z + +@x [49.1293] l.24495 - pTeX: show_mode +show_code: @<Show the current meaning of a token, then |goto common_ending|@>; +@y +show_code: @<Show the current meaning of a token, then |goto common_ending|@>; +show_mode: @<Show the current japanese processing mode@>; +@z + +@x l.24597 - pTeX +@<Dump ML\TeX-specific data@>; +@<Dump enc\TeX-specific data@>; +@y +@<Dump ML\TeX-specific data@>; +@z + +@x l.24631 - pTeX +@<Undump ML\TeX-specific data@>; +@<Undump enc\TeX-specific data@>; +@y +@<Undump ML\TeX-specific data@>; +@z + +@x l.24982 +font_info:=xmalloc_array(fmemory_word, font_mem_size); +@y +font_info:=xmalloc_array(memory_word, font_mem_size); +@z + +@x [50.1320] l.24988 - pTeX: +@ @<Dump the array info for internal font number |k|@>= +begin +dump_things(font_check[null_font], font_ptr+1-null_font); +@y +@ @<Dump the array info for internal font number |k|@>= +begin +dump_things(font_dir[null_font], font_ptr+1-null_font); +dump_things(font_num_ext[null_font], font_ptr+1-null_font); +dump_things(font_check[null_font], font_ptr+1-null_font); +@z + +@x [50.1321] l.25000 - pTeX: +dump_things(char_base[null_font], font_ptr+1-null_font); +@y +dump_things(ctype_base[null_font], font_ptr+1-null_font); +dump_things(char_base[null_font], font_ptr+1-null_font); +@z + +@x [50.1322] l.25024 - pTeX: +@<Undump the array info for internal font number |k|@>= +begin {Allocate the font arrays} +@y +@<Undump the array info for internal font number |k|@>= +begin {Allocate the font arrays} +font_dir:=xmalloc_array(eight_bits, font_max); +font_num_ext:=xmalloc_array(integer, font_max); +@z + +@x [50.1322] l.25040 - pTeX: +char_base:=xmalloc_array(integer, font_max); +@y +ctype_base:=xmalloc_array(integer, font_max); +char_base:=xmalloc_array(integer, font_max); +@z + +@x [50.1322] l.25050 - pTeX: +undump_things(font_check[null_font], font_ptr+1-null_font); +@y +undump_things(font_dir[null_font], font_ptr+1-null_font); +undump_things(font_num_ext[null_font], font_ptr+1-null_font); +undump_things(font_check[null_font], font_ptr+1-null_font); +@z + +@x [50.1322] l.25064 - pTeX: +undump_things(char_base[null_font], font_ptr+1-null_font); +@y +undump_things(ctype_base[null_font], font_ptr+1-null_font); +undump_things(char_base[null_font], font_ptr+1-null_font); +@z + +@x l.25363 - pTeX + font_info:=xmalloc_array (fmemory_word, font_mem_size); +@y + font_info:=xmalloc_array (memory_word, font_mem_size); +@z + +@x l.25539 - pTeX +if enctex_enabled_p then + begin wterm(encTeX_banner); wterm_ln(', reencoding enabled.'); + if translate_filename then begin + wterm_ln(' (\xordcode, \xchrcode, \xprncode overridden by TCX)'); + end; + end; +@y +@z + +@x [51.1337] l.25563 - pTeX: + font_check:=xmalloc_array(four_quarters, font_max); +@y + font_dir:=xmalloc_array(eight_bits, font_max); + font_num_ext:=xmalloc_array(integer, font_max); + font_check:=xmalloc_array(four_quarters, font_max); +@z + +@x [51.1337] l.25577 - pTeX: + char_base:=xmalloc_array(integer, font_max); +@y + ctype_base:=xmalloc_array(integer, font_max); + char_base:=xmalloc_array(integer, font_max); +@z + +@x [51.1337] l.25587 - pTeX: + font_ptr:=null_font; fmem_ptr:=7; +@y + font_ptr:=null_font; fmem_ptr:=7; + font_dir[null_font]:=dir_default; + font_num_ext[null_font]:=0; +@z + +@x [51.1337] l.25594 - pTeX: + char_base[null_font]:=0; width_base[null_font]:=0; +@y + ctype_base[null_font]:=0; char_base[null_font]:=0; width_base[null_font]:=0; +@z + +@x l.25747 - pTeX +@d write_stream(#) == type(#+1) {stream number (0 to 17)} +@d mubyte_zero == 64 +@d write_mubyte(#) == subtype(#+1) {mubyte value + |mubyte_zero|} +@y +@d write_stream(#) == info(#+1) {stream number (0 to 17)} +@z + +@x l.25849 - pTeX + else if (cur_val>15) and (cur_val <> 18) then cur_val:=16; + end; +write_stream(tail):=cur_val; +if mubyte_out + mubyte_zero < 0 then write_mubyte(tail) := 0 +else if mubyte_out + mubyte_zero >= 2*mubyte_zero then + write_mubyte(tail) := 2*mubyte_zero - 1 + else write_mubyte(tail) := mubyte_out + mubyte_zero; +@y + else if (cur_val>15) and (cur_val <> 18) then cur_val:=16; + end; +write_stream(tail):=cur_val; +@z + +@x l.25881 - pTeX +begin new_whatsit(special_node,write_node_size); +if spec_out + mubyte_zero < 0 then write_stream(tail) := 0 +else if spec_out + mubyte_zero >= 2*mubyte_zero then + write_stream(tail) := 2*mubyte_zero - 1 + else write_stream(tail) := spec_out + mubyte_zero; +if mubyte_out + mubyte_zero < 0 then write_mubyte(tail) := 0 +else if mubyte_out + mubyte_zero >= 2*mubyte_zero then + write_mubyte(tail) := 2*mubyte_zero - 1 + else write_mubyte(tail) := mubyte_out + mubyte_zero; +if (spec_out = 2) or (spec_out = 3) then + if (mubyte_out > 2) or (mubyte_out = -1) or (mubyte_out = -2) then + write_noexpanding := true; +p:=scan_toks(false,true); write_tokens(tail):=def_ref; +write_noexpanding := false; +@y +begin new_whatsit(special_node,write_node_size); write_stream(tail):=null; +p:=scan_toks(false,true); write_tokens(tail):=def_ref; +@z + +@x l.25909 - pTeX +if (s = "write") and (write_mubyte (p) <> mubyte_zero) then +begin + print_char ("<"); print_int (write_mubyte(p)-mubyte_zero); print_char (">"); +end; +@y +@z + +@x l.25925 - pTeX +if write_stream(p) <> mubyte_zero then +begin + print_char ("<"); print_int (write_stream(p)-mubyte_zero); + if (write_stream(p)-mubyte_zero = 2) or + (write_stream(p)-mubyte_zero = 3) then + begin + print_char (":"); print_int (write_mubyte(p)-mubyte_zero); + end; + print_char (">"); +end; +@y +@z + +@x l.26009 - pTeX +spec_sout := spec_out; spec_out := write_stream(p) - mubyte_zero; +mubyte_sout := mubyte_out; mubyte_out := write_mubyte(p) - mubyte_zero; +active_noconvert := true; +mubyte_slog := mubyte_log; +mubyte_log := 0; +if (mubyte_out > 0) or (mubyte_out = -1) then mubyte_log := 1; +if (spec_out = 2) or (spec_out = 3) then +begin + if (mubyte_out > 0) or (mubyte_out = -1) then + begin + special_printing := true; mubyte_log := 1; + end; + if mubyte_out > 1 then cs_converting := true; +end; +@y +@z + +@x l.26031 - pTeX +if (spec_out = 1) or (spec_out = 3) then + for k:=str_start[str_ptr] to pool_ptr-1 do + str_pool[k] := si(xchr[so(str_pool[k])]); +for k:=str_start[str_ptr] to pool_ptr-1 do dvi_out(so(str_pool[k])); +spec_out := spec_sout; mubyte_out := mubyte_sout; mubyte_log := mubyte_slog; +special_printing := false; cs_converting := false; +active_noconvert := false; +@y + for k:=str_start[str_ptr] to pool_ptr-1 do dvi_out(so(str_pool[k])); +@z + +@x l.26062 - pTeX +begin +mubyte_sout := mubyte_out; mubyte_out := write_mubyte(p) - mubyte_zero; +if (mubyte_out > 2) or (mubyte_out = -1) or (mubyte_out = -2) then + write_noexpanding := true; +@<Expand macros in the token list +@y +begin @<Expand macros in the token list +@z + +@x l.26077 - pTeX +active_noconvert := true; +if mubyte_out > 1 then cs_converting := true; +mubyte_slog := mubyte_log; +if (mubyte_out > 0) or (mubyte_out = -1) then mubyte_log := 1 +else mubyte_log := 0; +token_show(def_ref); print_ln; +cs_converting := false; write_noexpanding := false; +active_noconvert := false; +mubyte_out := mubyte_sout; mubyte_log := mubyte_slog; +@y + token_show(def_ref); print_ln; +@z + +@x [53.1376] l.26309 - pTeX: +@<Glob...@> = +@!debug_format_file: boolean; +@y +@<Glob...@> = +@!debug_format_file: boolean; + +@ @<Set init...@>= +@!debug debug_format_file:=true; @+gubed; +@z + +@x l.26685 - pTeX +@* \[54/enc\TeX] System-dependent changes for enc\TeX. + +@d encTeX_banner == ' encTeX v. Jun. 2004' + +@ The boolean variable |enctex_p| is set by web2c according to the given +command line option (or an entry in the configuration file) before any +\TeX{} function is called. + +@<Global...@> = +@!enctex_p: boolean; + + +@ The boolean variable |enctex_enabled_p| is used to enable enc\TeX's +primitives. It is initialised to |false|. When loading a \.{FMT} it +is set to the value of the boolean |enctex_p| saved in the \.{FMT} file. +Additionally it is set to the value of |enctex_p| in Ini\TeX. + +@<Glob...@>= +@!enctex_enabled_p:boolean; {enable encTeX} + + +@ @<Set init...@>= +enctex_enabled_p:=false; + + +@ Auxiliary functions/procedures for enc\TeX{} (by Petr Olsak) follow. +These functions implement the \.{\\mubyte} code to convert +the multibytes in |buffer| to one byte or to one control +sequence. These functions manipulate a mubyte tree: each node of +this tree is token list with n+1 tokens (first token consist the byte +from the byte sequence itself and the other tokens point to the +branches). If you travel from root of the tree to a leaf then you +find exactly one byte sequence which we have to convert to one byte or +control sequence. There are two variants of the leaf: the ``definitive +end'' or the ``middle leaf'' if a longer byte sequence exists and the mubyte +tree continues under this leaf. First variant is implemented as one +memory word where the link part includes the token to +which we have to convert and type part includes the number 60 (normal +conversion) or 1..52 (insert the control sequence). +The second variant of ``middle leaf'' is implemented as two memory words: +first one has a type advanced by 64 and link points to the second +word where info part includes the token to which we have to convert +and link points to the next token list with the branches of +the subtree. + +The inverse: one byte to multi byte (for log printing and \.{\\write} +printing) is implemented via a pool. Each multibyte sequence is stored +in a pool as a string and |mubyte_write|[{\it printed char\/}] points +to this string. + +@d new_mubyte_node == + link (p) := get_avail; p := link (p); info (p) := get_avail; p := info (p) +@d subinfo (#) == subtype (#) + +@<Basic printing...@>= +{ read |buffer|[|i|] and convert multibyte. |i| should have been + of type 0..|buf_size|, but web2c doesn't like that construct in + argument lists. } +function read_buffer(var i:integer):ASCII_code; +var p: pointer; + last_found: integer; + last_type: integer; +begin + mubyte_skip := 0; mubyte_token := 0; + read_buffer := buffer[i]; + if mubyte_in = 0 then + begin + if mubyte_keep > 0 then mubyte_keep := 0; + return ; + end; + last_found := -2; + if (i = start) and (not mubyte_start) then + begin + mubyte_keep := 0; + if (end_line_char >= 0) and (end_line_char < 256) then + if mubyte_read [end_line_char] <> null then + begin + mubyte_start := true; mubyte_skip := -1; + p := mubyte_read [end_line_char]; + goto continue; + end; + end; +restart: + mubyte_start := false; + if (mubyte_read [buffer[i]] = null) or (mubyte_keep > 0) then + begin + if mubyte_keep > 0 then decr (mubyte_keep); + return ; + end; + p := mubyte_read [buffer[i]]; +continue: + if type (p) >= 64 then + begin + last_type := type (p) - 64; + p := link (p); + mubyte_token := info (p); last_found := mubyte_skip; + end else if type (p) > 0 then + begin + last_type := type (p); + mubyte_token := link (p); + goto found; + end; + incr (mubyte_skip); + if i + mubyte_skip > limit then + begin + mubyte_skip := 0; + if mubyte_start then goto restart; + return; + end; + repeat + p := link (p); + if subinfo (info(p)) = buffer [i+mubyte_skip] then + begin + p := info (p); goto continue; + end; + until link (p) = null; + mubyte_skip := 0; + if mubyte_start then goto restart; + if last_found = -2 then return; { no found } + mubyte_skip := last_found; +found: + if mubyte_token < 256 then { multibyte to one byte } + begin + read_buffer := mubyte_token; mubyte_token := 0; + i := i + mubyte_skip; + if mubyte_start and (i >= start) then mubyte_start := false; + return; + end else begin { multibyte to control sequence } + read_buffer := 0; + if last_type = 60 then { normal conversion } + i := i + mubyte_skip + else begin { insert control sequence } + decr (i); mubyte_keep := last_type; + if i < start then mubyte_start := true; + if last_type = 52 then mubyte_keep := 10000; + if last_type = 51 then mubyte_keep := mubyte_skip + 1; + mubyte_skip := -1; + end; + if mubyte_start and (i >= start) then mubyte_start := false; + return; + end; +exit: end; + +@ @<Declare additional routines for enc\TeX@>= +procedure mubyte_update; { saves new string to mubyte tree } +var j: pool_pointer; + p: pointer; + q: pointer; + in_mutree: integer; +begin + j := str_start [str_ptr]; + if mubyte_read [so(str_pool[j])] = null then + begin + in_mutree := 0; + p := get_avail; + mubyte_read [so(str_pool[j])] := p; + subinfo (p) := so(str_pool[j]); type (p) := 0; + end else begin + in_mutree := 1; + p := mubyte_read [so(str_pool[j])]; + end; + incr (j); + while j < pool_ptr do + begin + if in_mutree = 0 then + begin + new_mubyte_node; subinfo (p) := so(str_pool[j]); type (p) := 0; + end else { |in_mutree| = 1 } + if (type (p) > 0) and (type (p) < 64) then + begin + type (p) := type (p) + 64; + q := link (p); link (p) := get_avail; p := link (p); + info (p) := q; + new_mubyte_node; subinfo (p) := so(str_pool[j]); type (p) := 0; + in_mutree := 0; + end else begin + if type (p) >= 64 then p := link (p); + repeat + p := link (p); + if subinfo (info(p)) = so(str_pool[j]) then + begin + p := info (p); + goto continue; + end; + until link (p) = null; + new_mubyte_node; subinfo (p) := so(str_pool[j]); type (p) := 0; + in_mutree := 0; + end; +continue: + incr (j); + end; + if in_mutree = 1 then + begin + if type (p) = 0 then + begin + type (p) := mubyte_prefix + 64; + q := link (p); link (p) := get_avail; p := link (p); + link (p) := q; info (p) := mubyte_stoken; + return; + end; + if type (p) >= 64 then + begin + type (p) := mubyte_prefix + 64; + p := link (p); info (p) := mubyte_stoken; + return; + end; + end; + type (p) := mubyte_prefix; + link (p) := mubyte_stoken; +exit: end; +@# +procedure dispose_munode (p: pointer); { frees a mu subtree recursivelly } +var q: pointer; +begin + if (type (p) > 0) and (type (p) < 64) then free_avail (p) + else begin + if type (p) >= 64 then + begin + q := link (p); free_avail (p); p := q; + end; + q := link (p); free_avail (p); p := q; + while p <> null do + begin + dispose_munode (info (p)); + q := link (p); + free_avail (p); + p := q; + end; + end; +end; +@# +procedure dispose_mutableout (cs: pointer); { frees record from out table } +var p, q, r: pointer; +begin + p := mubyte_cswrite [cs mod 128]; + r := null; + while p <> null do + if info (p) = cs then + begin + if r <> null then link (r) := link (link (p)) + else mubyte_cswrite[cs mod 128] := link (link (p)); + q := link (link(p)); + free_avail (link(p)); free_avail (p); + p := q; + end else begin + r := link (p); p := link (r); + end; +end; + +@ The |print_buffer| procedure prints one character from |buffer|[|i|]. +It also increases |i| to the next character in the buffer. + +@<Basic printing...@>= +{ print one char from |buffer|[|i|]. |i| should have been of type + 0..|buf_size|, but web2c doesn't like that construct in argument lists. } +procedure print_buffer(var i:integer); +var c: ASCII_code; +begin + if mubyte_in = 0 then print (buffer[i]) { normal TeX } + else if mubyte_log > 0 then print_char (buffer[i]) + else begin + c := read_buffer (i); + if mubyte_token > 0 then print_cs (mubyte_token-cs_token_flag) + else print (c); + end; + incr (i); +end; + +@ Additional material to dump for enc\TeX. This includes whether +enc\TeX is enabled, and if it is we also have to dump the \.{\\mubyte} +arrays. + +@<Dump enc\TeX-specific data@>= +dump_int(@"45435458); {enc\TeX's magic constant: "ECTX"} +if not enctex_p then dump_int(0) +else begin + dump_int(1); + dump_things(mubyte_read[0], 256); + dump_things(mubyte_write[0], 256); + dump_things(mubyte_cswrite[0], 128); +end; + +@ Undumping the additional material we dumped for enc\TeX. This includes +conditionally undumping the \.{\\mubyte} arrays. + +@<Undump enc\TeX-specific data@>= +undump_int(x); {check magic constant of enc\TeX} +if x<>@"45435458 then goto bad_fmt; +undump_int(x); {undump |enctex_p| flag into |enctex_enabled_p|} +if x=0 then enctex_enabled_p:=false +else if x<>1 then goto bad_fmt +else begin + enctex_enabled_p:=true; + undump_things(mubyte_read[0], 256); + undump_things(mubyte_write[0], 256); + undump_things(mubyte_cswrite[0], 128); +end; + +@y +@z + +@x l.26984 - pTeX +@* \[54] System-dependent changes. +@y +@* \[55/p\TeX] System-dependent changes for p\TeX. +This section described extended variables, procesures, functions and so on +for pTeX. + +@<Declare procedures that scan font-related stuff@>= +function get_jfm_pos(@!kcode:KANJI_code;@!f:internal_font_number):eight_bits; +var @!jc:KANJI_code; {temporary register for KANJI} +@!sp,@!mp,@!ep:pointer; +begin@/ +jc:=toDVI(kcode); +sp:=1; { start position } +ep:=font_num_ext[f]-1; { end position } +if (kchar_code(f)(sp)<=jc)and(jc<=kchar_code(f)(ep)) then + begin while (sp <= ep) do + begin mp:=sp+((ep-sp) div 2); + if jc<kchar_code(f)(mp) then ep:=mp-1 + else if jc>kchar_code(f)(mp) then sp:=mp+1 + else + begin get_jfm_pos:=kchar_type(f)(mp); return; + end; + end; + end; +get_jfm_pos:=kchar_type(f)(0); +end; + +@ Following codes are used to calcutation a KANJI width and height. + +@<Local variables for dimension calculations@>= +@!t: eight_bits; + +@ @<The KANJI width for |cur_jfont|@>= +if direction=dir_tate then + v:=char_width(cur_tfont)(orig_char_info(cur_tfont)(qi(0))) +else + v:=char_width(cur_jfont)(orig_char_info(cur_jfont)(qi(0))) + +@ @<The KANJI height for |cur_jfont|@>= +if direction=dir_tate then begin + t:=height_depth(orig_char_info(cur_tfont)(qi(0))); + v:=char_height(cur_tfont)(t)+char_depth(cur_tfont)(t); +end else begin + t:=height_depth(orig_char_info(cur_jfont)(qi(0))); + v:=char_height(cur_jfont)(t)+char_depth(cur_jfont)(t); +end + +@ set a kansuji character. + +@ @<Put each...@>= +primitive("kansujichar",set_kansuji_char,0); +@!@:kansujichar_}{\.{\\kansujichar} primitive@> + +@ @<Cases of |print_cmd_chr|...@>= +set_kansuji_char: print_esc("kansujichar"); + +@ @<Assignments@>= +set_kansuji_char: +begin p:=cur_chr; scan_int; n:=cur_val; scan_optional_equals; scan_int; +if not check_kanji(cur_val) then + begin print_err("Invalid KANSUJI char ("); + print_hex(cur_val); print_char(")"); +@.Invalid KANSUJI char@> + help1("I'm skip this control sequences.");@/ + error; return; + end +else if (n<0)or(n>9) then + begin print_err("Invalid KANSUJI number ("); print_int(n); print_char(")"); +@.Invalid KANSUJI number@> + help1("I'm skip this control sequences.");@/ + error; return; + end +else + define(kansuji_base+n,n,tokanji(toDVI(cur_val))); +end; + +@ |print_kansuji| procedure converts a number to KANJI number. + +@ @<Declare procedures needed in |scan_something|@>= +procedure print_kansuji(@!n:integer); +var @!k:0..23; {index to current digit; we assume that $|n|<10^{23}$} +@!cx: KANJI_code; {temporary register for KANJI} +begin k:=0; + if n<0 then return; {nonpositive input produces no output} + repeat dig[k]:=n mod 10; n:=n div 10; incr(k); + until n=0; + begin while k>0 do + begin decr(k); + cx:=kansuji_char(dig[k]); + print_kanji(fromDVI(cx)); + end; + end; +end; + +@ pTeX inserts a glue specified by \.{\\kanjiskip} between 2byte-characters, +automatically, if \.{\\autospacing}. This glue is suppressed by +\.{\\noautospacing}. +\.{\\xkanjiskip}, \.{\\noautoxspacing}, \.{\\autoxspacing}, \.{\\xspcode} is +used to control between 2byte and 1byte characters. + +@d reset_auto_spacing_code=0 +@d set_auto_spacing_code=1 +@d reset_auto_xspacing_code=2 +@d set_auto_xspacing_code=3 + +@<Put each...@>= +primitive("autospacing",set_auto_spacing,set_auto_spacing_code); +@!@:auto_spacing_}{\.{\\autospacing} primitive@> +primitive("noautospacing",set_auto_spacing,reset_auto_spacing_code); +@!@:no_auto_spacing_}{\.{\\noautospacing} primitive@> +primitive("autoxspacing",set_auto_spacing,set_auto_xspacing_code); +@!@:auto_xspacing_}{\.{\\autoxspacing} primitive@> +primitive("noautoxspacing",set_auto_spacing,reset_auto_xspacing_code); +@!@:no_auto_xspacing_}{\.{\\noautoxspacing} primitive@> + +@ @<Cases of |print_cmd_chr|...@>= +set_auto_spacing:begin + if (chr_code mod 2)=0 then print_esc("noauto") else print_esc("auto"); + if chr_code<2 then print("spacing") else print("xspacing"); +end; + +@ @<Assignments@>= +set_auto_spacing:begin + if cur_chr<2 then p:=auto_spacing_code + else begin p:=auto_xspacing_code; cur_chr:=(cur_chr mod 2); end; + define(p,data,cur_chr); +end; + +@ Following codes are used in section 49. + +@<Show the current japanese processing mode@>= +begin print_nl("> "); +if auto_spacing>0 then print("auto spacing mode; ") + else print("no auto spacing mode; "); +print_nl("> "); +if auto_xspacing>0 then print("auto xspacing mode") + else print("no auto xspacing mode"); +goto common_ending; +end + +@ The \.{\\inhibitglue} primitive control to insert a glue specified +JFM (Japanese Font Metic) file. The \.{\\inhibitxspcode} is used to control +inserting a space between 2byte-char and 1byte-char. + +@d inhibit_both=0 {disable to insert space before 2byte-char and after it} +@d inhibit_previous=1 {disable to insert space before 2byte-char} +@d inhibit_after=2 {disable to insert space after 2byte-char} +@d no_entry=1000 +@d new_pos=0 +@d cur_pos=1 + +@<Global...@>= + inhibit_glue_flag:boolean; + +@ @<Set init...@>= + inhibit_glue_flag:=false; + +@ @<Cases of |main_control| that don't...@>= + any_mode(inhibit_glue): inhibit_glue_flag:=true; + +@ @<Put each...@>= +primitive("inhibitglue",inhibit_glue,0); +@!@:inhibit_glue_}{\.{\\inhibitglue} primitive@> +primitive("inhibitxspcode",assign_inhibit_xsp_code,inhibit_xsp_code_base); +@!@:inhibit_xsp_code_}{\.{\\inhibitxspcode} primitive@> + +@ @<Cases of |print_cmd_chr|...@>= +inhibit_glue: print_esc("inhibitglue"); +assign_inhibit_xsp_code: print_esc("inhibitxspcode"); + +@ @<Declare procedures needed in |scan_something|@>= +function get_inhibit_pos(c:KANJI_code; n:small_number):pointer; +label done, done1; +var p,s:pointer; +begin s:=calc_pos(c); p:=s; +if n=new_pos then + begin repeat + if (inhibit_xsp_code(p)=0)or(inhibit_xsp_code(p)=c) then goto done; + incr(p); if p>255 then p:=0; + until s=p; p:=no_entry; + end +else + begin repeat + if inhibit_xsp_code(p)=0 then goto done1; + if inhibit_xsp_code(p)=c then goto done; + incr(p); if p>255 then p:=0; + until s=p; +done1: p:=no_entry; + end; +done: get_inhibit_pos:=p; +end; + +@ @<Assignments@>= +assign_inhibit_xsp_code: +begin p:=cur_chr; scan_int; n:=cur_val; scan_optional_equals; scan_int; +if check_kanji(n) then + begin j:=get_inhibit_pos(tokanji(n),new_pos); + if j=no_entry then + begin print_err("Inhibit table is full!!"); + help1("I'm skip this control sequences.");@/ + error; return; + end; + define(inhibit_xsp_code_base+j,cur_val,n); + end +else + begin print_err("Invalid KANJI code ("); print_hex(n); print_char(")"); +@.Invalid KANJI code@> + help1("I'm skip this control sequences.");@/ + error; return; + end; +end; + +@ @<Fetch inhibit type from some table@>= +begin scan_int; q:=get_inhibit_pos(tokanji(cur_val),cur_pos); +cur_val_level:=int_val; cur_val:=3; +if q<>no_entry then cur_val:=inhibit_xsp_type(q); +end + +@ The \.{\\prebreakpenalty} is used to specified amount of penalties inserted +before the 2byte-char which is first argument of this primitive. +The \.{\\postbreakpenalty} is inserted after the 2byte-char. + +@d pre_break_penalty_code=1 +@d post_break_penalty_code=2 + +@<Put each...@>= +primitive("prebreakpenalty",assign_kinsoku,pre_break_penalty_code); +@!@:pre_break_penalty_}{\.{\\prebreakpenalty} primitive@> +primitive("postbreakpenalty",assign_kinsoku,post_break_penalty_code); +@!@:post_break_penalty_}{\.{\\postbreakpenalty} primitive@> + +@ @<Cases of |print_cmd_chr|...@>= +assign_kinsoku: case chr_code of + pre_break_penalty_code: print_esc("prebreakpenalty"); + post_break_penalty_code: print_esc("postbreakpenalty"); + endcases; + +@ @<Declare procedures needed in |scan_something|@>= +function get_kinsoku_pos(c:KANJI_code; n:small_number):pointer; +label done, done1; +var p,s:pointer; +begin s:=calc_pos(c); p:=s; +@!debug +print_ln; print("c:="); print_int(c); print(", p:="); print_int(s); +if p+kinsoku_base<0 then + begin print("p is negative value"); print_ln; + end; +gubed +if n=new_pos then + begin repeat + if (kinsoku_type(p)=0)or(kinsoku_code(p)=c) then goto done; + incr(p); if p>255 then p:=0; + until s=p; + p:=no_entry; + end +else + begin repeat + if kinsoku_type(p)=0 then goto done1; + if kinsoku_code(p)=c then goto done; + incr(p); if p>255 then p:=0; + until s=p; +done1: p:=no_entry; + end; +done: get_kinsoku_pos:=p; +end; + +@ @<Assignments@>= +assign_kinsoku: +begin p:=cur_chr; scan_int; n:=cur_val; scan_optional_equals; scan_int; +if (is_char_ascii(n) or check_kanji(n)) then + begin j:=get_kinsoku_pos(tokanji(n),new_pos); + if j=no_entry then + begin print_err("KINSOKU table is full!!"); + help1("I'm skip this control sequences.");@/ + error; return; + end; + if (p=pre_break_penalty_code)or(p=post_break_penalty_code) then + begin define(kinsoku_base+j,p,tokanji(n)); + word_define(kinsoku_penalty_base+j,cur_val); + end + else confusion("kinsoku"); +@:this can't happen kinsoku}{\quad kinsoku@> + end +else + begin print_err("Invalid KANJI code for "); + if (p=pre_break_penalty_code) then print("pre") + else if (p=post_break_penalty_code) then print("post") + else print_char("?"); + print("breakpenalty ("); print_hex(n); print_char(")"); +@.Invalid KANJI code@> + help1("I'm skip this control sequences.");@/ + error; return; + end; +end; + +@ @<Fetch breaking penalty from some table@>= +begin scan_int; q:=get_kinsoku_pos(tokanji(cur_val),cur_pos); +cur_val_level:=int_val; cur_val:=0; +if (q<>no_entry)and(m=kinsoku_type(q)) then + scanned_result(kinsoku_penalty(q))(int_val); +end + +@ Following codes are used in |main_control|. + +@<Insert kinsoku penalty@>= +begin kp:=get_kinsoku_pos(cx,cur_pos); +if (kp<>no_entry) then + begin if (kinsoku_type(kp)=pre_break_penalty_code) then + begin if (not is_char_node(cur_q))and(type(cur_q)=penalty_node) then + penalty(cur_q):=penalty(cur_q)+kinsoku_penalty(kp) + else + begin main_p:=link(cur_q); link(cur_q):=new_penalty(kinsoku_penalty(kp)); + subtype(link(cur_q)):=kinsoku_pena; link(link(cur_q)):=main_p; + end; + end + else if (kinsoku_type(kp)=post_break_penalty_code) then + begin tail_append(new_penalty(kinsoku_penalty(kp))); + subtype(tail):=kinsoku_pena; + end; + end; +end; + +@ @<Insert |pre_break_penalty| of |cur_chr|@>= +begin kp:=get_kinsoku_pos(cur_chr,cur_pos); +if (kp<>no_entry) then + begin if (kinsoku_type(kp)=pre_break_penalty_code) then + if (not is_char_node(tail))and(type(tail)=penalty_node) then + penalty(tail):=penalty(tail)+kinsoku_penalty(kp) + else + begin tail_append(new_penalty(kinsoku_penalty(kp))); + subtype(tail):=kinsoku_pena; + end; + end; +end; + +@ @<Insert |post_break_penalty|@>= +begin kp:=get_kinsoku_pos(cx,cur_pos); +if (kp<>no_entry) then + begin if (kinsoku_type(kp)=post_break_penalty_code) then + begin tail_append(new_penalty(kinsoku_penalty(kp))); + subtype(tail):=kinsoku_pena; + end; + end; +end; + +@ This is a part of section 32. + +The procedure |synch_dir| is used in |hlist_out| and |vlist_out|. + +@d dvi_yoko=0 +@d dvi_tate=1 +@d dvi_dtou=3 + +@<Glob...@>= +@!dvi_dir:integer; {a \.{DVI} reader program thinks we direct to} +@!cur_dir:integer; {\TeX\ thinks we direct to} +@!page_dir:eight_bits; + +@ @<Set init...@>= +page_dir:=dir_yoko; + +@ @<Declare procedures needed in |hlist_out|, |vlist_out|@>= +procedure synch_dir; +var tmp:scaled; {temporary resister} +begin + case cur_dir of + dir_yoko: + if dvi_dir<>cur_dir then begin + synch_h; synch_v; dvi_out(dirchg); dvi_out(dvi_yoko); + dir_used:=true; + case dvi_dir of + dir_tate: begin tmp:=cur_h; cur_h:=-cur_v; cur_v:=tmp end; + dir_dtou: begin tmp:=cur_h; cur_h:=cur_v; cur_v:=-tmp end; + endcases; + dvi_h:=cur_h; dvi_v:=cur_v; dvi_dir:=cur_dir; + end; + dir_tate: + if dvi_dir<>cur_dir then begin + synch_h; synch_v; dvi_out(dirchg); dvi_out(dvi_tate); + dir_used:=true; + case dvi_dir of + dir_yoko: begin tmp:=cur_h; cur_h:=cur_v; cur_v:=-tmp end; + dir_dtou: begin cur_v:=-cur_v; cur_h:=-cur_h; end; + endcases; + dvi_h:=cur_h; dvi_v:=cur_v; dvi_dir:=cur_dir; + end; + dir_dtou: + if dvi_dir<>cur_dir then begin + synch_h; synch_v; dvi_out(dirchg); dvi_out(dvi_dtou); + dir_used:=true; + case dvi_dir of + dir_yoko: begin tmp:=cur_h; cur_h:=-cur_v; cur_v:=tmp end; + dir_tate: begin cur_v:=-cur_v; cur_h:=-cur_h; end; + endcases; + dvi_h:=cur_h; dvi_v:=cur_v; dvi_dir:=cur_dir; + end; + othercases + confusion("synch_dir"); + endcases +end; + +@ This function is called from |adjust_hlist| to used to check, whether +a list which pointed |box_p| contain a printing character. +If the list contain such a character, then return `true', otherwise `false'. +If the first matter is a character, |first_char| is stored it. +|last_char| is stored a last character. If no printing characters exist +in the list, |first_char| and |last_char| is null. +@^recursion@> + +@<Glob...@>= +@!first_char:pointer; {first printable character} +@!last_char:pointer; {last printable character} +@!find_first_char:boolean; {find for a first printable character?} + +@ @<Declare procedures needed in |hlist_out|, |vlist_out|@>= +function check_box(box_p:pointer):boolean; +label done; +var @!p:pointer; {run through the current box} +@!flag:boolean; {found any printable character?} +begin flag:=false; p:=box_p; +while p<>null do + begin if is_char_node(p) then + repeat + if find_first_char then + begin first_char:=p; find_first_char:=false + end; + last_char:=p; flag:=true; + if font_dir[font(p)]<>dir_default then p:=link(p); + p:=link(p); + if p=null then goto done; + until not is_char_node(p); + case type(p) of + hlist_node: + begin flag:=true; + if shift_amount(p)=0 then + begin if check_box(list_ptr(p)) then flag:=true; + end + else if find_first_char then find_first_char:=false + else last_char:=null; + end; + ligature_node: if check_box(lig_ptr(p)) then flag:=true; + ins_node,disp_node,mark_node,adjust_node,whatsit_node,penalty_node: + do_nothing; + othercases begin flag:=true; + if find_first_char then find_first_char:=false + else last_char:=null; + end; + endcases; + p:=link(p); + end; +done: check_box:=flag; +end; + +@ Following procedure |adjust_hlist| inserts \.{\\xkanjiskip} between +2byte-char and 1byte-char in hlist which pointed |p|. +Note that the skip is inserted into a place where too difficult to decide +whether inserting or not (i.e, before penalty, after penalty). + +If |pf| is true then insert |jchr_widow_penalty| that is penalty for +creating a widow KANJI character line. + +@d no_skip=0 +@d after_schar=1 {denote after single byte character} +@d after_wchar=2 {denote after double bytes character} + +@<Declare procedures needed in |hlist_out|, |vlist_out|@>= +procedure adjust_hlist(p:pointer;pf:boolean); +label exit; +var q,s,t,u,v,x,z:pointer; + i,k:halfword; + insert_skip:no_skip..after_wchar; + cx:KANJI_code; {temporaly register for KANJI character} + ax:ASCII_code; {temporaly register for ASCII character} + do_ins:boolean; {for inserting |xkanji_skip| into prevous (or after) KANJI} +begin if link(p)=null then goto exit; +if auto_spacing>0 then + begin delete_glue_ref(space_ptr(p)); space_ptr(p):=kanji_skip; + add_glue_ref(kanji_skip); + end; +if auto_xspacing>0 then + begin delete_glue_ref(xspace_ptr(p)); xspace_ptr(p):=xkanji_skip; + add_glue_ref(xkanji_skip); + end; +u:=space_ptr(p); add_glue_ref(u); +s:=xspace_ptr(p); add_glue_ref(s); +if (not is_char_node(link(p))) {p1.0.9d} + and(type(link(p))=glue_node)and(subtype(link(p))=jfm_skip+1) then + begin v:=link(p); link(p):=link(v); + fast_delete_glue_ref(glue_ptr(v)); free_node(v,small_node_size); + end; +i:=0; insert_skip:=no_skip; p:=link(p); v:=p; q:=p; +while p<>null do + begin if is_char_node(p) then + begin repeat @<Insert a space around the character |p|@>; + q:=p; p:=link(p); incr(i); + if (i>5)and(pf) then + begin if is_char_node(v) then + if font_dir[font(v)]<>dir_default then v:=link(v); + v:=link(v); + end; + until not is_char_node(p); + end + else + begin case type(p) of + hlist_node: @<Insert hbox surround spacing@>; + ligature_node: @<Insert ligature surround spacing@>; + penalty_node,disp_node: @<Insert penalty or displace surround spacing@>; + kern_node: if (insert_skip=after_schar)and(subtype(p)<>explicit) then + do_nothing else insert_skip:=no_skip; + math_node: @<Insert math surround spacing@>; + mark_node,adjust_node,ins_node,whatsit_node: + {These nodes are vanished when typeset is done} + do_nothing; + othercases insert_skip:=no_skip; + endcases; + q:=p; p:=link(p); + end; + end; +if (not is_char_node(q))and(type(q)=glue_node)and(subtype(q)=jfm_skip+1) then + begin fast_delete_glue_ref(glue_ptr(q)); + glue_ptr(q):=zero_glue; add_glue_ref(zero_glue); + end; +delete_glue_ref(u); delete_glue_ref(s); +if (v<>null)and(pf)and(i>5) then @<Make |jchr_widow_penalty| node@>; +exit: +end; + +@ @<Insert a space around the character |p|@>= +if font_dir[font(p)]<>dir_default then + begin KANJI(cx):=info(link(p)); + if insert_skip=after_schar then @<Insert ASCII-KANJI spacing@>; + p:=link(p); insert_skip:=after_wchar; + end +else + begin ax:=qo(character(p)); + if insert_skip=after_wchar then @<Insert KANJI-ASCII spacing@>; + if auto_xsp_code(ax)>=2 then + insert_skip:=after_schar else insert_skip:=no_skip; + end + +@ @<Insert hbox surround spacing@>= +begin find_first_char:=true; first_char:=null; last_char:=null; +if (shift_amount(p)=0) then + begin if check_box(list_ptr(p)) then + begin if first_char<>null then @<Insert a space before the |first_char|@>; + if last_char<>null then + begin @<Insert a space after the |last_char|@>; + end else insert_skip:=no_skip; + end else insert_skip:=no_skip; + end else insert_skip:=no_skip; +end + +@ @<Insert a space before the |first_char|@>= +if font_dir[font(first_char)]<>dir_default then + begin KANJI(cx):=info(link(first_char)); + if insert_skip=after_schar then @<Insert ASCII-KANJI spacing@> + else if insert_skip=after_wchar then @<Insert KANJI-KANJI spacing@>; + insert_skip:=after_wchar; + end +else + begin ax:=qo(character(first_char)); + if insert_skip=after_wchar then @<Insert KANJI-ASCII spacing@>; + if auto_xsp_code(ax)>=2 then + insert_skip:=after_schar else insert_skip:=no_skip; + end; + +@ @<Insert a space after the |last_char|@>= +if font_dir[font(last_char)]<>dir_default then + begin insert_skip:=after_wchar; + if (is_char_node(link(p)))and(font_dir[font(link(p))]<>dir_default) then + begin @<Append KANJI-KANJI spacing@>; p:=link(p); + end; + end +else + begin ax:=qo(character(last_char)); + if auto_xsp_code(ax)>=2 then + insert_skip:=after_schar else insert_skip:=no_skip; + end; + +@ @<Insert math surround spacing@>= +begin if (subtype(p)=before)and(insert_skip=after_wchar) then + begin ax:=qo("0"); @<Insert KANJI-ASCII spacing@>; + insert_skip:=no_skip; + end +else if (subtype(p)=after) then + begin ax:=qo("0"); insert_skip:=after_schar; + end +else insert_skip:=no_skip; +end + +@ @<Insert ligature surround spacing@>= +begin t:=lig_ptr(p); +if is_char_node(t) then + begin ax:=qo(character(t)); + if insert_skip=after_wchar then @<Insert KANJI-ASCII spacing@>; + while link(t)<>null do t:=link(t); + if is_char_node(t) then + begin ax:=qo(character(t)); + if auto_xsp_code(ax)>=2 then + insert_skip:=after_schar else insert_skip:=no_skip; + end; + end; +end + +@ @<Insert penalty or displace surround spacing@>= +begin if is_char_node(link(p)) then + begin q:=p; p:=link(p); + if font_dir[font(p)]<>dir_default then + begin KANJI(cx):=info(link(p)); + if insert_skip=after_schar then @<Insert ASCII-KANJI spacing@> + else if insert_skip=after_wchar then @<Insert KANJI-KANJI spacing@>; + p:=link(p); insert_skip:=after_wchar; + end + else + begin ax:=qo(character(p)); + if insert_skip=after_wchar then @<Insert KANJI-ASCII spacing@>; + if auto_xsp_code(ax)>=2 then + insert_skip:=after_schar else insert_skip:=no_skip; + end; + end +end + +@ @<Insert ASCII-KANJI spacing@>= +begin + begin x:=get_inhibit_pos(cx,cur_pos); + if x<>no_entry then + if (inhibit_xsp_type(x)=inhibit_both)or + (inhibit_xsp_type(x)=inhibit_previous) then + do_ins:=false else do_ins:=true + else do_ins:=true; + end; +if do_ins then + begin z:=new_glue(s); subtype(z):=xkanji_skip_code+1; + link(z):=link(q); link(q):=z; q:=z; + end; +end + +@ @<Insert KANJI-ASCII spacing@>= +begin if (auto_xsp_code(ax) mod 2)=1 then + begin x:=get_inhibit_pos(cx,cur_pos); + if x<>no_entry then + if (inhibit_xsp_type(x)=inhibit_both)or + (inhibit_xsp_type(x)=inhibit_after) then + do_ins:=false else do_ins:=true + else do_ins:=true; + end +else do_ins:=false; +if do_ins then + begin z:=new_glue(s); subtype(z):=xkanji_skip_code+1; + link(z):=link(q); link(q):=z; q:=z; + end; +end + +@ @<Insert KANJI-KANJI spacing@>= +begin z:=new_glue(u); subtype(z):=kanji_skip_code+1; +link(z):=link(q); link(q):=z; q:=z; +end + +@ @<Append KANJI-KANJI spacing@>= +begin z:=new_glue(u); subtype(z):=kanji_skip_code+1; +link(z):=link(p); link(p):=z; p:=link(z); q:=z; +end + +@ @<Make |jchr_widow_penalty| node@>= +begin q:=v; p:=link(v); +if (is_char_node(v))and(font_dir[font(v)]<>dir_default) then + begin q:=p; p:=link(p); + end; +t:=q; s:=null; +@<Seek list and make |t| pointing widow penalty position@>; +if (s<>null) then + begin s:=link(t); + if (not is_char_node(s))and(type(s)=penalty_node) then + penalty(s):=penalty(s)+jchr_widow_penalty + else if (jchr_widow_penalty<>0) then + begin s:=new_penalty(jchr_widow_penalty); subtype(s):=widow_pena; + link(s):=link(t); link(t):=s; t:=link(s); + while(not is_char_node(t)) do + begin if (type(t)=glue_node)or(type(t)=kern_node) then goto exit; + t:=link(t); + end; + z:=new_glue(u); subtype(z):=kanji_skip_code+1; + link(z):=link(s); link(s):=z; + end; + end; +end; + +@ @<Seek list and make |t| pointing widow penalty position@>= +while(p<>null) do +begin if is_char_node(p) then + begin if font_dir[font(p)]<>dir_default then + begin KANJI(cx):=info(link(p)); i:=kcat_code(kcatcodekey(cx)); k:=0; + if (i=kanji)or(i=kana) then begin t:=q; s:=p; end; + p:=link(p); q:=p; + end + else begin k:=k+1; + if k>1 then begin q:=p; s:=null; end; + end; + end +else begin case type(p) of + penalty_node,mark_node,adjust_node,whatsit_node, + glue_node,kern_node,math_node,disp_node: + do_nothing; + othercases begin q:=p; s:=null; end; + endcases; + end; +p:=link(p); +end + +@ @<Declare procedures needed in |hlist_out|, |vlist_out|@>= +procedure dir_out; +var @!this_box: pointer; {pointer to containing box} +begin this_box:=temp_ptr; + temp_ptr:=list_ptr(this_box); + if (type(temp_ptr)<>hlist_node)and(type(temp_ptr)<>vlist_node) then + confusion("dir_out"); + case box_dir(this_box) of + dir_yoko: + case box_dir(temp_ptr) of + dir_tate: {Tate in Yoko} + begin cur_v:=cur_v-height(this_box); cur_h:=cur_h+depth(temp_ptr) end; + dir_dtou: {DtoU in Yoko} + begin cur_v:=cur_v+depth(this_box); cur_h:=cur_h+height(temp_ptr) end; + endcases; + dir_tate: + case box_dir(temp_ptr) of + dir_yoko: {Yoko in Tate} + begin cur_v:=cur_v+depth(this_box); cur_h:=cur_h+height(temp_ptr) end; + dir_dtou: {DtoU in Tate} + begin + cur_v:=cur_v+depth(this_box)-height(temp_ptr); + cur_h:=cur_h+width(temp_ptr) + end; + endcases; + dir_dtou: + case box_dir(temp_ptr) of + dir_yoko: {Yoko in DtoU} + begin cur_v:=cur_v-height(this_box); cur_h:=cur_h+depth(temp_ptr) end; + dir_tate: {Tate in DtoU} + begin + cur_v:=cur_v+depth(this_box)-height(temp_ptr); + cur_h:=cur_h+width(temp_ptr) + end; + endcases; + endcases; + cur_dir:=box_dir(temp_ptr); + if type(temp_ptr)=vlist_node then vlist_out@+else hlist_out; +end; + +@ These routines are used to output diagnostic which related direction. + +@ @<Basic printing procedures@>= +procedure print_dir(@!dir:eight_bits); {prints |dir| data} +begin if dir=dir_yoko then print_char("Y") +else if dir=dir_tate then print_char("T") +else if dir=dir_dtou then print_char("D") +end; +@# +procedure print_direction(@!d:integer); {print the direction represented by d} +begin case abs(d) of +dir_yoko: print("yoko"); +dir_tate: print("tate"); +dir_dtou: print("dtou"); +end; +if d<0 then print("(math)"); +print(" direction"); +end; + +@ The procedure |set_math_kchar| is same as |set_math_char| which +written in section 48. + +@<Declare act...@>= +procedure set_math_kchar(@!c:integer); +var p:pointer; {the new noad} +begin p:=new_noad; math_type(nucleus(p)):=math_jchar; +character(nucleus(p)):=qi(0); +math_kcode(p):=c; fam(nucleus(p)):=cur_jfam; +if font_dir[fam_fnt(fam(nucleus(p))+cur_size)]=dir_default then + begin print_err("Not two-byte family"); + help1("IGNORE.");@/ + error; + end; +type(p):=ord_noad; +link(tail):=p; tail:=p; +end; + +@ This section is a part of |main_control|. + +@<Append KANJI-character |cur_chr| ...@>= +if is_char_node(tail) then + begin cx:=qo(character(tail)); @<Insert |post_break_penalty|@>; + end +else if type(tail)=ligature_node then + begin cx:=qo(character(lig_char(tail))); @<Insert |post_break_penalty|@>; + end; +if direction=dir_tate then + begin if font_dir[main_f]=dir_tate then disp:=0 + else if font_dir[main_f]=dir_yoko then disp:=t_baseline_shift-y_baseline_shift + else disp:=t_baseline_shift; + main_f:=cur_tfont; + end +else + begin if font_dir[main_f]=dir_yoko then disp:=0 + else if font_dir[main_f]=dir_tate then disp:=y_baseline_shift-t_baseline_shift + else disp:=y_baseline_shift; + main_f:=cur_jfont; + end; +@<Append |disp_node| at end of displace area@>; +ins_kp:=false; ligature_present:=false; +cur_l:=qi(get_jfm_pos(KANJI(cur_chr),main_f)); +main_i:=orig_char_info(main_f)(qi(0)); +goto main_loop_j+3; +@# +main_loop_j+1: space_factor:=1000; + fast_get_avail(main_p); font(main_p):=main_f; character(main_p):=cur_l; + link(tail):=main_p; tail:=main_p; last_jchr:=tail; + fast_get_avail(main_p); info(main_p):=KANJI(cur_chr); + link(tail):=main_p; tail:=main_p; + cx:=cur_chr; @<Insert kinsoku penalty@>; + ins_kp:=false; +again_2: + get_next; + main_i:=orig_char_info(main_f)(cur_l); + case cur_cmd of + kanji,kana,other_kchar: begin + cur_l:=qi(get_jfm_pos(KANJI(cur_chr),main_f)); goto main_loop_j+3; + end; + letter,other_char: begin ins_kp:=true; cur_l:=qi(0); goto main_loop_j+3; + end; + endcases; + x_token; + case cur_cmd of + kanji,kana,other_kchar: cur_l:=qi(get_jfm_pos(KANJI(cur_chr),main_f)); + letter,other_char: begin ins_kp:=true; cur_l:=qi(0); end; + char_given: begin + if is_char_ascii(cur_chr) then + begin ins_kp:=true; cur_l:=qi(0); + end + else cur_l:=qi(get_jfm_pos(KANJI(cur_chr),main_f)); + end; + char_num: begin scan_char_num; cur_chr:=cur_val; + if is_char_ascii(cur_chr) then + begin ins_kp:=true; cur_l:=qi(0); + end + else cur_l:=qi(get_jfm_pos(KANJI(cur_chr),main_f)); + end; + inhibit_glue: begin inhibit_glue_flag:=true; goto again_2; end; + othercases begin ins_kp:=max_halfword; + cur_l:=qi(0); cur_r:=non_char; lig_stack:=null; + end; + endcases; +@# +main_loop_j+3: + if ins_kp=true then @<Insert |pre_break_penalty| of |cur_chr|@>; + @<Look ahead for glue or kerning@>; + if (ins_kp=false) then begin { Kanji -> Kanji } + goto main_loop_j+1; + end else if (ins_kp=true) then begin { Kanji -> Ascii } + {@<Append |disp_node| at begin of displace area@>;} + ins_kp:=false; goto main_loop; + end else begin { Kanji -> cs } + {@<Append |disp_node| at begin of displace area@>;} + goto reswitch; + end; + +@ @<Append |disp_node| at begin ...@>= +begin if (not is_char_node(tail))and(type(tail)=disp_node) then + begin if prev_disp=disp then + begin free_node(tail,small_node_size); tail:=prev_node; link(tail):=null; + end + else disp_dimen(tail):=disp; + end +else + if disp<>0 then + begin prev_node:=tail; tail_append(get_node(small_node_size)); + type(tail):=disp_node; disp_dimen(tail):=disp; prev_disp:=disp; + end; +end; + +@ @<Append |disp_node| at end ...@>= +if disp<>0 then +begin if (not is_char_node(tail))and(type(tail)=disp_node) then + begin disp_dimen(tail):=0; + end +else + begin prev_node:=tail; tail_append(get_node(small_node_size)); + type(tail):=disp_node; disp_dimen(tail):=0; prev_disp:=disp; + end; +end; + +@ @<Look ahead for glue or kerning@>= +cur_q:=tail; +if inhibit_glue_flag<>true then + begin if char_tag(main_i)=gk_tag then + begin main_k:=glue_kern_start(main_f)(main_i); + repeat main_j:=font_info[main_k].qqqq; + if next_char(main_j)=cur_l then + begin if op_byte(main_j)<kern_flag then + begin gp:=font_glue[main_f]; cur_r:=rem_byte(main_j); + if gp<>null then + begin while((type(gp)<>cur_r)and(link(gp)<>null)) do gp:=link(gp); + gq:=glue_ptr(gp); + end + else + begin gp:=get_node(small_node_size); font_glue[main_f]:=gp; + gq:=null; + end; + if gq=null then + begin type(gp):=cur_r; gq:=new_spec(zero_glue); + glue_ptr(gp):=gq; + main_k:=exten_base[main_f]+qi((qo(cur_r))*3); + width(gq):=font_info[main_k].sc; + stretch(gq):=font_info[main_k+1].sc; + shrink(gq):=font_info[main_k+2].sc; + add_glue_ref(gq); link(gp):=get_node(small_node_size); + gp:=link(gp); glue_ptr(gp):=null; link(gp):=null; + end; + tail_append(new_glue(gq)); subtype(tail):=jfm_skip+1; + goto skip_loop; + end + else begin + tail_append(new_kern(char_kern(main_f)(main_j))); + goto skip_loop; + end; + end; + incr(main_k); + until skip_byte(main_j)>=stop_flag; + end; +end; +skip_loop: inhibit_glue_flag:=false; + +@ @<Basic printing...@>= +procedure print_kanji(@!s:KANJI_code); {prints a single character} +begin +if s>255 then + begin print_char(Hi(s)); print_char(Lo(s)); + end else print_char(s); +end; + +@* \[56] System-dependent changes. +@z diff --git a/Build/source/texk/web2c/ptexdir/ptex-base.ch.orig b/Build/source/texk/web2c/ptexdir/ptex-base.ch.orig new file mode 100644 index 00000000000..3f4236ada93 --- /dev/null +++ b/Build/source/texk/web2c/ptexdir/ptex-base.ch.orig @@ -0,0 +1,7682 @@ +% This is a change file for pTeX 3.1.11 +% By Sadayuki Tanaka and ASCII MEDIA WORKS. +% +% Thanks for : +% Ryoichi Kurasawa (us009185@interramp.com), +% Hisato Hamano, +% Hiroto Kagotani (kagotani@in.it.okayama-u.ac.jp), +% Takashi Kakiuchi (kakiuchi@sy6.isl.mei.co.jp), +% Yoichi Kawabata (kawabata@canon.co.jp), +% Makoto Kobayashi (makoto@lloem.fujidenki.co.jp), +% Yoshihiro Aoki (aoki@tokyo-shoseki-ptg.co.jp), +% Akira Kakuto (kakuto@fsci.fuk.kindai.ac.jp). +% Koich Inoue (inoue@ma.ns.musashi-tech.ac.jp). +% +% (??/??/87) RKS jTeX 2.9 -- j1.0 +% (??/??/89) RKS jTeX 2.93 -- j1.3 +% (12/ 9/89) H_2 pTeX 2.93 j1.3 p1.0.1 +% (12/??/89) RKS jTeX 2.95 -- j1.5 +% (12/??/89) RKS jTeX 2.99 -- j1.5 +% (02/02/90) RKS jTeX 2.99 -- j1.6 +% (04/16/90) H_2 pTeX 2.99 j1.6 p1.0.3 +% (09/14/90) H_2 pTeX 2.99 j1.6 p1.0.9 -- pre-release +% (10/29/90) H_2 Bug fix (p1.0.9a) +% (01/21/92) H_2 jTeX 2.99 - j1.7 +% (01/21/92) H_2 pTeX 2.99 j1.7 p1.0.9F +% (03/09/92) H_2 pTeX 2.99 j1.7 p1.0.9G jflag BUG +% (03/20/95) KN pTeX p2.0 (based on 3.1415) +% (09/08/95) KN pTeX p2.1 +% (09/20/95) KN pTeX p2.1.1 +% (11/21/95) KN pTeX p2.1.4 +% (08/27/97) KN pTeX p2.1.5 (based on 3.14159) +% (02/26/98) KN pTeX p2.1.6 +% (03/19/98) KN pTeX p2.1.7 +% (03/26/98) KN pTeX p2.1.8 (Web2c 7.2) +% (02/21/2000) KN pTeX p2.1.9 (Web2c 7.3.1) +% (11/13/2000) KN pTeX p2.1.10 +% (05/22/2001) KN pTeX p2.1.11 +% (03/10/2001) KN pTeX p3.0 (modified BSD licence) +% (09/02/2004) ST pTeX p3.1.4 +% (11/29/2004) KN pTeX p3.1.5 +% (12/13/2004) KN pTeX p3.1.8 +% (10/17/2005) ST pTeX p3.1.9 +% (07/18/2006) ST pTeX p3.1.10 +% (08/17/2009) ST pTeX p3.1.11 +% +@x [1.2] l.195 - pTeX: +@d TeX_banner_k=='This is TeXk, Version 3.141592' {printed when \TeX\ starts} +@d TeX_banner=='This is TeX, Version 3.141592' {printed when \TeX\ starts} +@y +@d TeX_banner_k=='This is pTeXk, Version 3.141592-p3.1.11' {printed when p\TeX\ starts} +@d TeX_banner=='This is pTeX, Version 3.141592-p3.1.11' {printed when p\TeX\ starts} +@z + +@x [2.??] l.586 - pTeX: +@!ASCII_code=0..255; {eight-bit numbers} +@y +@!ASCII_code=0..255; {eight-bit numbers} +@!KANJI_code=0..65535; {sixteen-bit numbers} +@z + +@x l.632 - pTeX +mubyte_read: array [ASCII_code] of pointer; + { non zero iff character begins the multi byte code } +mubyte_write: array [ASCII_code] of str_number; + { non zero iff character expands to multi bytes in log and write files } +mubyte_cswrite: array [0..127] of pointer; + { non null iff cs mod 128 expands to multi bytes in log and write files } +mubyte_skip: integer; { the number of bytes to skip in |buffer| } +mubyte_keep: integer; { the number of chars we need to keep unchanged } +mubyte_skeep: integer; { saved |mubyte_keep| } +mubyte_prefix: integer; { the type of mubyte prefix } +mubyte_tablein: boolean; { the input side of table will be updated } +mubyte_tableout: boolean; { the output side of table will be updated } +mubyte_relax: boolean; { the relax prefix is used } +mubyte_start: boolean; { we are making the token at the start of the line } +mubyte_sstart: boolean; { saved |mubyte_start| } +mubyte_token: pointer; { the token returned by |read_buffer| } +mubyte_stoken: pointer; { saved first token in mubyte primitive } +mubyte_sout: integer; { saved value of |mubyte_out| } +mubyte_slog: integer; { saved value of |mubyte_log| } +spec_sout: integer; { saved value of |spec_out| } +no_convert: boolean; { conversion supressed by noconvert primitive } +active_noconvert: boolean; { true if noconvert primitive is active } +write_noexpanding: boolean; { true only if we need not write expansion } +cs_converting: boolean; { true only if we need csname converting } +special_printing: boolean; { true only if we need converting in special } +message_printing: boolean; { true if message or errmessage prints to string } +@y +@z + +@x l.803 - pTeX +{Initialize enc\TeX\ data.} +for i:=0 to 255 do mubyte_read[i]:=null; +for i:=0 to 255 do mubyte_write[i]:=0; +for i:=0 to 128 do mubyte_cswrite[i]:=null; +mubyte_keep := 0; mubyte_start := false; +write_noexpanding := false; cs_converting := false; +special_printing := false; message_printing := false; +no_convert := false; active_noconvert := false; +@y +@z + + +@x [4.??] l.870 - pTeX: +@!eight_bits=0..255; {unsigned one-byte quantity} +@y +@!eight_bits=0..255; {unsigned one-byte quantity} +@!sixteen_bits=0..65535; {unsigned two-bytes quantity} +@z + +@x [3.??] l.891 - pTeX: +@ All of the file opening functions are defined in C. +@y +@ All of the file opening functions are defined in C. + +@ Kanji code handling. + +@d jis_enc=0 {denotes JIS X 2022 kanji encoding} +@d euc_enc=1 {denotes EUC kanji encoding} +@d sjis_enc=2 {denotes Shift JIS kanji encoding} + +@<Glob...@>= +@!proc_kanji_code:jis_enc..sjis_enc; +@z + +@x [4.47] l.1325 - pTeX: +@!init function get_strings_started:boolean; {initializes the string pool, + but returns |false| if something goes wrong} +label done,exit; +var k,@!l:0..255; {small indices or counters} +@y +@!init function get_strings_started:boolean; {initializes the string pool, + but returns |false| if something goes wrong} +label done,exit; +var k,@!l:KANJI_code; {small indices or counters} +@z + +@x [4.49] l.1384 - pTeX: +@<Character |k| cannot be printed@>= + (k<" ")or(k>"~") +@y +@<Character |k| cannot be printed@>= + not (iskanji1(k) or iskanji2(k) or xprn[k]) +@z + +@x [5.54] l.1514 - pTeX: Global variables +@!trick_buf:array[0..ssup_error_line] of ASCII_code; {circular buffer for + pseudoprinting} +@y +@!trick_buf:array[0..ssup_error_line] of ASCII_code; {circular buffer for + pseudoprinting} +@!trick_buf2:array[0..ssup_error_line] of 0..2; {pTeX: buffer for KANJI} +@!kcode_pos: 0..2; {pTeX: denotes whether first byte or second byte of KANJI} +@z + +@x [5.55] l.1519 - pTeX: Initialize the kcode_pos +@ @<Initialize the output routines@>= +selector:=term_only; tally:=0; term_offset:=0; file_offset:=0; +@y +@ @<Initialize the output routines@>= +selector:=term_only; tally:=0; term_offset:=0; file_offset:=0; +kcode_pos:=0; +@z + +@x [5.57] l.1538 - pTeX: kcode_pos +procedure print_ln; {prints an end-of-line} +begin case selector of +term_and_log: begin wterm_cr; wlog_cr; + term_offset:=0; file_offset:=0; + end; +log_only: begin wlog_cr; file_offset:=0; + end; +term_only: begin wterm_cr; term_offset:=0; + end; +no_print,pseudo,new_string: do_nothing; +othercases write_ln(write_file[selector]) +endcases;@/ +@y +procedure print_ln; {prints an end-of-line} +begin case selector of +term_and_log: begin + if kcode_pos=1 then begin wterm(' '); wlog(' '); end; + wterm_cr; wlog_cr; term_offset:=0; file_offset:=0; + end; +log_only: begin if kcode_pos=1 then wlog(' '); + wlog_cr; file_offset:=0; + end; +term_only: begin if kcode_pos=1 then wterm(' '); + wterm_cr; term_offset:=0; + end; +no_print,pseudo,new_string: do_nothing; +othercases write_ln(write_file[selector]) +endcases;@/ +kcode_pos:=0; +@z + +@x [5.58] l.1557 - pTeX: kcode_pos, trick_buf2 +procedure print_char(@!s:ASCII_code); {prints a single character} +label exit; +begin if @<Character |s| is the current new-line character@> then + if selector<pseudo then + begin print_ln; return; + end; +case selector of +term_and_log: begin wterm(xchr[s]); wlog(xchr[s]); + incr(term_offset); incr(file_offset); + if term_offset=max_print_line then + begin wterm_cr; term_offset:=0; + end; + if file_offset=max_print_line then + begin wlog_cr; file_offset:=0; + end; + end; +log_only: begin wlog(xchr[s]); incr(file_offset); + if file_offset=max_print_line then print_ln; + end; +term_only: begin wterm(xchr[s]); incr(term_offset); + if term_offset=max_print_line then print_ln; + end; +no_print: do_nothing; +pseudo: if tally<trick_count then trick_buf[tally mod error_line]:=s; +@y +procedure print_char(@!s:ASCII_code); {prints a single character} +label exit; {label is not used but nonetheless kept (for other changes?)} +begin if @<Character |s| is the current new-line character@> then + if selector<pseudo then + begin print_ln; return; + end; +if kcode_pos=1 then kcode_pos:=2 +else if iskanji1(xchr[s]) then + begin kcode_pos:=1; + if (selector=term_and_log)or(selector=log_only) then + if file_offset>=max_print_line-1 then + begin wlog_cr; file_offset:=0; + end; + if (selector=term_and_log)or(selector=term_only) then + if term_offset>=max_print_line-1 then + begin wterm_cr; term_offset:=0; + end; + end +else kcode_pos:=0; +case selector of +term_and_log: begin wterm(xchr[s]); incr(term_offset); + if term_offset=max_print_line then + begin wterm_cr; term_offset:=0; + end; + wlog(xchr[s]); incr(file_offset); + if file_offset=max_print_line then + begin wlog_cr; file_offset:=0; + end; + end; +log_only: begin wlog(xchr[s]); incr(file_offset); + if file_offset=max_print_line then print_ln; + end; +term_only: begin wterm(xchr[s]); incr(term_offset); + if term_offset=max_print_line then print_ln; + end; +no_print: do_nothing; +pseudo: if tally<trick_count then + begin trick_buf[tally mod error_line]:=s; + trick_buf2[tally mod error_line]:=kcode_pos; + end; +@z + +@x l.1603 - pTeX +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) and (not special_printing) + and (not message_printing) then + begin print_char(s); return; {internal strings are not expanded} + end; + if (@<Character |s| is the current new-line character@>) then + if selector<pseudo then + begin print_ln; no_convert := false; return; + end + else if message_printing then + begin print_char(s); no_convert := false; return; + end; + if (mubyte_log>0) and (not no_convert) and (mubyte_write[s]>0) then + s := mubyte_write[s] + else if xprn[s] or special_printing then + begin print_char(s); no_convert := false; return; end; + no_convert := false; + nl:=new_line_char; new_line_char:=-1; + {temporarily disable new-line character} + j:=str_start[s]; + while j<str_start[s+1] do + begin print_char(so(str_pool[j])); incr(j); + end; + new_line_char:=nl; return; + end; +j:=str_start[s]; +while j<str_start[s+1] do + begin print_char(so(str_pool[j])); incr(j); + end; +exit:end; +@y +procedure print(@!s:integer); {prints string |s|} +label exit; +var j:pool_pointer; {current character code position} +@!nl:integer; {new-line character to restore} +begin if s>=str_ptr then s:="???" {this can't happen} +@.???@> +else if s<256 then + if s<0 then s:="???" {can't happen} + else begin if selector>pseudo then + begin print_char(s); return; {internal strings are not expanded} + end; + if (@<Character |s| is the current new-line character@>) then + if selector<pseudo then + begin print_ln; return; + end; + nl:=new_line_char; new_line_char:=-1; + {temporarily disable new-line character} + j:=str_start[s]; + while j<str_start[s+1] do + begin print_char(so(str_pool[j])); incr(j); + end; + new_line_char:=nl; return; + end; +j:=str_start[s]; +while j<str_start[s+1] do + begin print_char(so(str_pool[j])); incr(j); + end; +exit:end; +@z + +@x [5.61] l.1656 - pTeX: +@<Initialize the output...@>= +if src_specials_p or file_line_error_style_p or parse_first_line_p then + wterm(banner_k) +else + wterm(banner); +@y +@<Initialize the output...@>= +if src_specials_p or file_line_error_style_p or parse_first_line_p then + wterm(banner_k) +else + wterm(banner); +wterm(' ('); +case proc_kanji_code of + jis_enc: wterm('jis'); + euc_enc: wterm('euc'); + sjis_enc: wterm('sjis'); + othercases wterm('?'); +endcases; +wterm(')'); +@z + +@x l.1820 - pTeX +k:=first; while k < last do begin print_buffer(k) end; +@y +if last<>first then for k:=first to last-1 do print(buffer[k]); +@z + +@x [8.112] l.2588 - pTeX: +@d ho(#)==# {to take a sixteen-bit item from a halfword} +@y +@d ho(#)==# {to take a sixteen-bit item from a halfword} +@d KANJI(#)==# {pTeX: to output an KANJI code into a halfword} +@d tokanji(#)==# {pTeX: to take an KANJI code into a halfword} +@d tonum(#)==# {pTeX: to put an KANJI code into a halfword} +@z + +@x [10.135] l.3008 - pTeX: box_dir, space_ptr, xspace_ptr +@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 box_dir(#) == subtype(#) {direction mode of a box} +@d dir_default == qi(0) {direction of the box, default Left to Right} +@d dir_dtou == qi(1) {direction of the box, Bottom to Top} +@d dir_tate == qi(3) {direction of the box, Top to Bottom} +@d dir_yoko == qi(4) {direction of the box, equal default} +@d any_dir == dir_yoko,dir_tate,dir_dtou +@# +@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 space_offset = 7 {position of |glue_set| in a box node} +@d space_ptr(#) == link(#+space_offset) +@d xspace_ptr(#) == info(#+space_offset) +@z + +@x [10.136] l.3037 - pTeX: space_ptr, xspace_ptr +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)); +@y +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)); +space_ptr(p):=zero_glue; xspace_ptr(p):=zero_glue; +add_glue_ref(zero_glue); add_glue_ref(zero_glue); +@z + +@x [10.137] l.3045 - pTeX: direction change node +@d vlist_node=1 {|type| of vlist nodes} +@y +@d vlist_node=1 {|type| of vlist nodes} + +@ A |dir_node| stands for direction change. + +@d dir_node=2 {|type| of dir nodes} + +@p function new_dir_node(b:pointer; dir:eight_bits):pointer; +var p:pointer; {the new node} +begin if type(b)>vlist_node then confusion("new_dir_node:not box"); +p:=new_null_box; type(p):=dir_node; box_dir(p):=dir; +case box_dir(b) of + dir_yoko: @<Yoko to other direction@>; + dir_tate: @<Tate to other direction@>; + dir_dtou: @<DtoU to other direction@>; + othercases confusion("new_dir_node:illegal dir"); +endcases; +link(b):=null; list_ptr(p):=b; +new_dir_node:=p; +end; + +@ @<Yoko to other direction@>= + case dir of + dir_tate: begin width(p):=height(b)+depth(b); + depth(p):=width(b)/2; height(p):=width(b)-depth(p); + end; + dir_dtou: begin width(p):=height(b)+depth(b); + depth(p):=0; height(p):=width(b); + end; + othercases confusion("new_dir_node:y->?"); + endcases + +@ @<Tate to other direction@>= + case dir of + dir_yoko: begin width(p):=height(b)+depth(b); + depth(p):=0; height(p):=width(b); + end; + dir_dtou: begin width(p):=width(b); + depth(p):=height(b); height(p):=depth(b); + end; + othercases confusion("new_dir_node:t->?"); + endcases + +@ @<DtoU to other direction@>= + case dir of + dir_yoko: begin width(p):=height(b)+depth(b); + depth(p):=0; height(p):=width(b); + end; + dir_tate: begin width(p):=width(b); + depth(p):=height(b); height(p):=depth(b); + end; + othercases confusion("new_dir_node:d->?"); + endcases +@z + +@x [10.138] l.3054 - pTeX: renumber rule_node +@d rule_node=2 {|type| of rule nodes} +@y +@d rule_node=3 {|type| of rule nodes} +@z + +@x [10.140] l.3083 - pTeX: renumber ins_node, add ins_dir field +@d ins_node=3 {|type| of insertion nodes} +@d ins_node_size=5 {number of words to allocate for an insertion} +@d float_cost(#)==mem[#+1].int {the |floating_penalty| to be used} +@d ins_ptr(#)==info(#+4) {the vertical list to be inserted} +@d split_top_ptr(#)==link(#+4) {the |split_top_skip| to be used} +@y +@d ins_node=4 {|type| of insertion nodes} +@d ins_node_size=6 {number of words to allocate for an insertion} +@d float_cost(#)==mem[#+1].int {the |floating_penalty| to be used} +@d ins_ptr(#)==info(#+4) {the vertical list to be inserted} +@d split_top_ptr(#)==link(#+4) {the |split_top_skip| to be used} +@d ins_dir(#)==subtype(#+5) {direction of |ins_node|} +@z + +@x [10.141] l.3089 - pTeX: disp_node +@ A |mark_node| has a |mark_ptr| field that points to the reference count +@y +@ A |disp_node| has a |disp_dimen| field that points to the displacement +distance of the baselineshift between Latin characters and Kanji chatacters. + +@d disp_node=5 {|type| of a displace node} +@d disp_dimen(#)==mem[#+1].sc + +@ A |mark_node| has a |mark_ptr| field that points to the reference count +@z + +@x [10.140] l.3095 - pTeX: renumber nodes +@d mark_node=4 {|type| of a mark node} +@y +@d mark_node=6 {|type| of a mark node} +@z + +@x [10.141] l.3105 - pTeX: renumber nodes +@d adjust_node=5 {|type| of an adjust node} +@y +@d adjust_node=7 {|type| of an adjust node} +@z + +@x [10.142] l.3122 - pTeX: renumber nodes +@d ligature_node=6 {|type| of a ligature node} +@y +@d ligature_node=8 {|type| of a ligature node} +@z + +@x [10.145] l.3163 - pTeX: renumber nodes +@d disc_node=7 {|type| of a discretionary node} +@y +@d disc_node=9 {|type| of a discretionary node} +@z + +@x [10.146] l.3191 - pTeX: renumber nodes +@d whatsit_node=8 {|type| of special extension nodes} +@y +@d whatsit_node=10 {|type| of special extension nodes} +@z + +@x [10.147] l.3198 - pTeX: renumber nodes +@d math_node=9 {|type| of a math node} +@y +@d math_node=11 {|type| of a math node} +@z + +@x [10.150] l.3244 - pTeX: renumber nodes +@d glue_node=10 {|type| of node that points to a glue specification} +@y +@d glue_node=12 {|type| of node that points to a glue specification} +@z + +@x [10.155] l.3342 - pTeX: renumber nodes +@d kern_node=11 {|type| of a kern node} +@d explicit=1 {|subtype| of kern nodes from \.{\\kern} and \.{\\/}} +@d acc_kern=2 {|subtype| of kern nodes from accents} +@y +@d kern_node=13 {|type| of a kern node} +@d explicit=1 {|subtype| of kern nodes from \.{\\kern}} +@d acc_kern=2 {|subtype| of kern nodes from accents} +@d ita_kern=3 {|subtype| of kern nodes from \.{\\/}} +@z + +@x [10.157] l.3363 - pTeX: renumber nodes +@d penalty_node=12 {|type| of a penalty node} +@y +@d penalty_node=14 {|type| of a penalty node} +@d widow_pena=1 {|subtype| of penalty nodes from \.{\\jchrwidowpenalty}} +@d kinsoku_pena=2 {|subtype| of penalty nodes from kinsoku} +@z + +@x [10.159] l.3392 - pTeX: renumber nodes +@d unset_node=13 {|type| for an unset node} +@y +@d unset_node=15 {|type| for an unset node} +@z + +@x [10.160] l.3397 - pTeX: renumber nodes +@ 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=16|; and a number +of larger type codes will also be defined, for use in math mode only. +@z + +@x [12.174] l.3662 - pTeX: print KANJI + print_ASCII(qo(character(p))); +@y + if font_dir[font(p)]<>dir_default then + begin p:=link(p); print_kanji(info(p)); + end + else print_ASCII(qo(character(p))); +@z + +@x [12.175] l.3672 - pTeX: Print a short indication of dir_nodes. +hlist_node,vlist_node,ins_node,whatsit_node,mark_node,adjust_node, + unset_node: print("[]"); +@y +hlist_node,vlist_node,dir_node,ins_node,whatsit_node, + mark_node,adjust_node,unset_node: print("[]"); +@z + +@x [12.176] l.3698 - pTeX: print KANJI. + print_char(" "); print_ASCII(qo(character(p))); +@y + print_char(" "); + if font_dir[font(p)]<>dir_default then + begin p:=link(p); print_kanji(info(p)); + end + else print_ASCII(qo(character(p))); +@z + +@x [12.183] l.3815 - pTeX: display char_node and disp_node. +if is_char_node(p) then print_font_and_char(p) +else case type(p) of + hlist_node,vlist_node,unset_node: @<Display box |p|@>; + rule_node: @<Display rule |p|@>; + ins_node: @<Display insertion |p|@>; + whatsit_node: @<Display the whatsit node |p|@>; +@y +if is_char_node(p) then + begin print_font_and_char(p); + if font_dir[font(p)]<>dir_default then p:=link(p) + end +else case type(p) of + hlist_node,vlist_node,dir_node,unset_node: @<Display box |p|@>; + rule_node: @<Display rule |p|@>; + ins_node: @<Display insertion |p|@>; + whatsit_node: @<Display the whatsit node |p|@>; + disp_node: begin print_esc("displace "); print_scaled(disp_dimen(p)); + end; +@z + +@x [12.184] l.3833 - pTeX: display dir_node. +@ @<Display box |p|@>= +begin if type(p)=hlist_node then print_esc("h") +else if type(p)=vlist_node then print_esc("v") +else print_esc("unset"); +@y +@ @<Display box |p|@>= +begin case type(p) of + hlist_node: print_esc("h"); + vlist_node: print_esc("v"); + dir_node: print_esc("dir"); + othercases print_esc("unset") + endcases@/; +@z +@x [12.184] l.3842 - pTeX: display dir_node. + if shift_amount(p)<>0 then + begin print(", shifted "); print_scaled(shift_amount(p)); + end; +@y + if shift_amount(p)<>0 then + begin print(", shifted "); print_scaled(shift_amount(p)); + end; + if box_dir(p)<>dir_default then + begin print(", "); print_direction(box_dir(p)); + end; +@z + +@x [12.188] l.3896 - pTeX: Display insertion and ins_dir. +@ @<Display insertion |p|@>= +begin print_esc("insert"); print_int(qo(subtype(p))); +print(", natural size "); print_scaled(height(p)); +@y +@ @<Display insertion |p|@>= +begin print_esc("insert"); print_int(qo(subtype(p))); +print_dir(ins_dir(p)); +print(", natural size "); print_scaled(height(p)); +@z + +@x [12.194] l.3961 - pTeX: Display penalty usage +@ @<Display penalty |p|@>= +begin print_esc("penalty "); print_int(penalty(p)); +end +@y +@ @<Display penalty |p|@>= +begin print_esc("penalty "); print_int(penalty(p)); +if subtype(p)=widow_pena then print("(for \jchrwidowpenalty)") +else if subtype(p)=kinsoku_pena then print("(for kinsoku)"); +end +@z + +@x [13.202] l.4043 - pTeX: dir_node, disp_node + hlist_node,vlist_node,unset_node: begin flush_node_list(list_ptr(p)); + free_node(p,box_node_size); goto done; + end; +@y + hlist_node,vlist_node,dir_node,unset_node: + begin flush_node_list(list_ptr(p)); + fast_delete_glue_ref(space_ptr(p)); + fast_delete_glue_ref(xspace_ptr(p)); + free_node(p,box_node_size); goto done; + end; +@z + +@x [13.202] l.4056 - pTeX: + kern_node,math_node,penalty_node: do_nothing; +@y + kern_node,disp_node,math_node,penalty_node: do_nothing; +@z + +@x [14.206] l.4121 - pTeX: space_ptr, xspace_ptr, dir_node, disp_node +@ @<Case statement to copy...@>= +case type(p) of +hlist_node,vlist_node,unset_node: begin r:=get_node(box_node_size); + mem[r+6]:=mem[p+6]; mem[r+5]:=mem[p+5]; {copy the last two words} + list_ptr(r):=copy_node_list(list_ptr(p)); {this affects |mem[r+5]|} + words:=5; + end; +rule_node: begin r:=get_node(rule_node_size); words:=rule_node_size; + end; +ins_node: begin r:=get_node(ins_node_size); mem[r+4]:=mem[p+4]; + add_glue_ref(split_top_ptr(p)); + ins_ptr(r):=copy_node_list(ins_ptr(p)); {this affects |mem[r+4]|} + words:=ins_node_size-1; + end; +@y +@ @<Case statement to copy...@>= +case type(p) of +hlist_node,vlist_node,dir_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} + add_glue_ref(space_ptr(r)); add_glue_ref(xspace_ptr(r)); + list_ptr(r):=copy_node_list(list_ptr(p)); {this affects |mem[r+5]|} + words:=5; + end; +rule_node: begin r:=get_node(rule_node_size); words:=rule_node_size; + end; +ins_node: begin r:=get_node(ins_node_size); + mem[r+5]:=mem[p+5]; mem[r+4]:=mem[p+4]; + add_glue_ref(split_top_ptr(p)); + ins_ptr(r):=copy_node_list(ins_ptr(p)); {this affects |mem[r+4]|} + words:=ins_node_size-2; + end; +@z + +@x [14.206] l.4140 - pTeX: disp_node +kern_node,math_node,penalty_node: begin r:=get_node(small_node_size); + words:=small_node_size; + end; +@y +kern_node,disp_node,math_node,penalty_node: + begin r:=get_node(small_node_size); words:=small_node_size; + end; +@z + +@x [15.207] l.4201 - pTeX: Add kanji, kana, other_kchar category codes. +@d max_char_code=15 {largest catcode for individual characters} +@y +@d kanji=16 {kanji} +@d kana=17 {hiragana, katakana, alphabet} +@d other_kchar=18 {kanji codes} +@d max_char_code=18 {largest catcode for individual characters} +@z + +@x [15.208] l.4207 - pTeX: Add inhibit_glue, chg_dir. +@d char_num=16 {character specified numerically ( \.{\\char} )} +@d math_char_num=17 {explicit math code ( \.{\\mathchar} )} +@d mark=18 {mark definition ( \.{\\mark} )} +@d xray=19 {peek inside of \TeX\ ( \.{\\show}, \.{\\showbox}, etc.~)} +@d make_box=20 {make a box ( \.{\\box}, \.{\\copy}, \.{\\hbox}, etc.~)} +@d hmove=21 {horizontal motion ( \.{\\moveleft}, \.{\\moveright} )} +@d vmove=22 {vertical motion ( \.{\\raise}, \.{\\lower} )} +@d un_hbox=23 {unglue a box ( \.{\\unhbox}, \.{\\unhcopy} )} +@d un_vbox=24 {unglue a box ( \.{\\unvbox}, \.{\\unvcopy} )} +@d remove_item=25 {nullify last item ( \.{\\unpenalty}, + \.{\\unkern}, \.{\\unskip} )} +@d hskip=26 {horizontal glue ( \.{\\hskip}, \.{\\hfil}, etc.~)} +@d vskip=27 {vertical glue ( \.{\\vskip}, \.{\\vfil}, etc.~)} +@d mskip=28 {math glue ( \.{\\mskip} )} +@d kern=29 {fixed space ( \.{\\kern})} +@d mkern=30 {math kern ( \.{\\mkern} )} +@d leader_ship=31 {use a box ( \.{\\shipout}, \.{\\leaders}, etc.~)} +@d halign=32 {horizontal table alignment ( \.{\\halign} )} +@d valign=33 {vertical table alignment ( \.{\\valign} )} +@d no_align=34 {temporary escape from alignment ( \.{\\noalign} )} +@d vrule=35 {vertical rule ( \.{\\vrule} )} +@d hrule=36 {horizontal rule ( \.{\\hrule} )} +@d insert=37 {vlist inserted in box ( \.{\\insert} )} +@d vadjust=38 {vlist inserted in enclosing paragraph ( \.{\\vadjust} )} +@d ignore_spaces=39 {gobble |spacer| tokens ( \.{\\ignorespaces} )} +@d after_assignment=40 {save till assignment is done ( \.{\\afterassignment} )} +@d after_group=41 {save till group is done ( \.{\\aftergroup} )} +@d break_penalty=42 {additional badness ( \.{\\penalty} )} +@d start_par=43 {begin paragraph ( \.{\\indent}, \.{\\noindent} )} +@d ital_corr=44 {italic correction ( \.{\\/} )} +@d accent=45 {attach accent in text ( \.{\\accent} )} +@d math_accent=46 {attach accent in math ( \.{\\mathaccent} )} +@d discretionary=47 {discretionary texts ( \.{\\-}, \.{\\discretionary} )} +@d eq_no=48 {equation number ( \.{\\eqno}, \.{\\leqno} )} +@d left_right=49 {variable delimiter ( \.{\\left}, \.{\\right} )} +@d math_comp=50 {component of formula ( \.{\\mathbin}, etc.~)} +@d limit_switch=51 {diddle limit conventions ( \.{\\displaylimits}, etc.~)} +@d above=52 {generalized fraction ( \.{\\above}, \.{\\atop}, etc.~)} +@d math_style=53 {style specification ( \.{\\displaystyle}, etc.~)} +@d math_choice=54 {choice specification ( \.{\\mathchoice} )} +@d non_script=55 {conditional math glue ( \.{\\nonscript} )} +@d vcenter=56 {vertically center a vbox ( \.{\\vcenter} )} +@d case_shift=57 {force specific case ( \.{\\lowercase}, \.{\\uppercase}~)} +@d message=58 {send to user ( \.{\\message}, \.{\\errmessage} )} +@d extension=59 {extensions to \TeX\ ( \.{\\write}, \.{\\special}, etc.~)} +@d in_stream=60 {files for reading ( \.{\\openin}, \.{\\closein} )} +@d begin_group=61 {begin local grouping ( \.{\\begingroup} )} +@d end_group=62 {end local grouping ( \.{\\endgroup} )} +@d omit=63 {omit alignment template ( \.{\\omit} )} +@d ex_space=64 {explicit space ( \.{\\\ } )} +@d no_boundary=65 {suppress boundary ligatures ( \.{\\noboundary} )} +@d radical=66 {square root and similar signs ( \.{\\radical} )} +@d end_cs_name=67 {end control sequence ( \.{\\endcsname} )} +@d min_internal=68 {the smallest code that can follow \.{\\the}} +@d char_given=68 {character code defined by \.{\\chardef}} +@d math_given=69 {math code defined by \.{\\mathchardef}} +@d last_item=70 {most recent item ( \.{\\lastpenalty}, + \.{\\lastkern}, \.{\\lastskip} )} +@d max_non_prefixed_command=70 {largest command code that can't be \.{\\global}} +@y +@d char_num=max_char_code+1 {character specified numerically ( \.{\\char} )} +@d math_char_num=char_num+1 {explicit math code ( \.{\\mathchar} )} +@d mark=math_char_num+1 {mark definition ( \.{\\mark} )} +@d xray=mark+1 {peek inside of \TeX\ ( \.{\\show}, \.{\\showbox}, etc.~)} +@d make_box=xray+1 {make a box ( \.{\\box}, \.{\\copy}, \.{\\hbox}, etc.~)} +@d hmove=make_box+1 {horizontal motion ( \.{\\moveleft}, \.{\\moveright} )} +@d vmove=hmove+1 {vertical motion ( \.{\\raise}, \.{\\lower} )} +@d un_hbox=vmove+1 {unglue a box ( \.{\\unhbox}, \.{\\unhcopy} )} +@d un_vbox=un_hbox+1 {unglue a box ( \.{\\unvbox}, \.{\\unvcopy} )} +@d remove_item=un_vbox+1 {nullify last item ( \.{\\unpenalty}, + \.{\\unkern}, \.{\\unskip} )} +@d hskip=remove_item+1 {horizontal glue ( \.{\\hskip}, \.{\\hfil}, etc.~)} +@d vskip=hskip+1 {vertical glue ( \.{\\vskip}, \.{\\vfil}, etc.~)} +@d mskip=vskip+1 {math glue ( \.{\\mskip} )} +@d kern=mskip+1 {fixed space ( \.{\\kern})} +@d mkern=kern+1 {math kern ( \.{\\mkern} )} +@d leader_ship=mkern+1 {use a box ( \.{\\shipout}, \.{\\leaders}, etc.~)} +@d halign=leader_ship+1 {horizontal table alignment ( \.{\\halign} )} +@d valign=halign+1 {vertical table alignment ( \.{\\valign} )} +@d no_align=valign+1 {temporary escape from alignment ( \.{\\noalign} )} +@d vrule=no_align+1 {vertical rule ( \.{\\vrule} )} +@d hrule=vrule+1 {horizontal rule ( \.{\\hrule} )} +@d insert=hrule+1 {vlist inserted in box ( \.{\\insert} )} +@d vadjust=insert+1 {vlist inserted in enclosing paragraph ( \.{\\vadjust} )} +@d ignore_spaces=vadjust+1 {gobble |spacer| tokens ( \.{\\ignorespaces} )} +@d after_assignment=ignore_spaces+1 {save till assignment is done ( \.{\\afterassignment} )} +@d after_group=after_assignment+1 {save till group is done ( \.{\\aftergroup} )} +@d break_penalty=after_group+1 {additional badness ( \.{\\penalty} )} +@d start_par=break_penalty+1 {begin paragraph ( \.{\\indent}, \.{\\noindent} )} +@d ital_corr=start_par+1 {italic correction ( \.{\\/} )} +@d accent=ital_corr+1 {attach accent in text ( \.{\\accent} )} +@d math_accent=accent+1 {attach accent in math ( \.{\\mathaccent} )} +@d discretionary=math_accent+1 {discretionary texts ( \.{\\-}, \.{\\discretionary} )} +@d eq_no=discretionary+1 {equation number ( \.{\\eqno}, \.{\\leqno} )} +@d left_right=eq_no+1 {variable delimiter ( \.{\\left}, \.{\\right} )} +@d math_comp=left_right+1 {component of formula ( \.{\\mathbin}, etc.~)} +@d limit_switch=math_comp+1 {diddle limit conventions ( \.{\\displaylimits}, etc.~)} +@d above=limit_switch+1 {generalized fraction ( \.{\\above}, \.{\\atop}, etc.~)} +@d math_style=above+1 {style specification ( \.{\\displaystyle}, etc.~)} +@d math_choice=math_style+1 {choice specification ( \.{\\mathchoice} )} +@d non_script=math_choice+1 {conditional math glue ( \.{\\nonscript} )} +@d vcenter=non_script+1 {vertically center a vbox ( \.{\\vcenter} )} +@d case_shift=vcenter+1 {force specific case ( \.{\\lowercase}, \.{\\uppercase}~)} +@d message=case_shift+1 {send to user ( \.{\\message}, \.{\\errmessage} )} +@d extension=message+1 {extensions to \TeX\ ( \.{\\write}, \.{\\special}, etc.~)} +@d in_stream=extension+1 {files for reading ( \.{\\openin}, \.{\\closein} )} +@d begin_group=in_stream+1 {begin local grouping ( \.{\\begingroup} )} +@d end_group=begin_group+1 {end local grouping ( \.{\\endgroup} )} +@d omit=end_group+1 {omit alignment template ( \.{\\omit} )} +@d ex_space=omit+1 {explicit space ( \.{\\\ } )} +@d no_boundary=ex_space+1 {suppress boundary ligatures ( \.{\\noboundary} )} +@d radical=no_boundary+1 {square root and similar signs ( \.{\\radical} )} +@d end_cs_name=radical+1 {end control sequence ( \.{\\endcsname} )} +@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 last_item=math_given+1 {most recent item ( \.{\\lastpenalty}, + \.{\\lastkern}, \.{\\lastskip} )} +@d inhibit_glue=last_item+1 {inhibit adjust glue ( \.{\\inhibitglue} )} +@d chg_dir=inhibit_glue+1 {change dir mode by \.{\\tate}, \.{\\yoko}} +@d max_non_prefixed_command=chg_dir {largest command code that can't be \.{\\global}} +@z + +@x [15.209] l.4272 - pTeX: def_jfont, def_tfont, set_auto_spacing +@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.~)} + {or \.{\\charsubdef}} +@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 assign_kinsoku=assign_font_int+1 + {user-defined kinsoku character ( \.{\\prebreakpenalty}, + \.{\\postbreakpenalty} )} +@d assign_inhibit_xsp_code=assign_kinsoku+1 + {user-defined inhibit xsp character ( \.{\\inhibitxspcode} )} +@d set_kansuji_char=assign_inhibit_xsp_code+1 + {user-defined kansuji character ( \.{\\kansujichar} )} +@d set_aux=set_kansuji_char+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 def_jfont=def_font+1 {define a font file ( \.{\\jfont} )} +@d def_tfont=def_jfont+1 {define a font file ( \.{\\tfont} )} +@d register=def_tfont+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 set_auto_spacing=set_interaction+1 {set auto spaceing mode + ( \.{\\autospacing}, \.{\\noautospacing}, ( \.{\\autospacing}, \.{\\noautospacing} )} +@d max_command=set_auto_spacing {the largest command code seen at |big_switch|} +@z + +@x [16.212] l.4437 - pTeX: last_jchr, direction, adjust direction +@<Types...@>= +@!list_state_record=record@!mode_field:-mmode..mmode;@+ + @!head_field,@!tail_field: pointer; +@y +@<Types...@>= +@!list_state_record=record@!mode_field:-mmode..mmode;@+ + @!dir_field,@!adj_dir_field: -dir_dtou..dir_dtou; + @!pdisp_field: scaled; + @!head_field,@!tail_field,@!pnode_field,@!last_jchr_field: pointer; +@z + +@x [16.213] l.4445 - pTeX: last_jchr, direction, adjust_dir, prev_{node,disp} +@d head==cur_list.head_field {header node of current list} +@d tail==cur_list.tail_field {final node on current list} +@y +@d direction==cur_list.dir_field {current direction} +@d adjust_dir==cur_list.adj_dir_field {current adjust direction} +@d head==cur_list.head_field {header node of current list} +@d tail==cur_list.tail_field {final node on current list} +@d prev_node==cur_list.pnode_field {previous to last |disp_node|} +@d prev_disp==cur_list.pdisp_field {displacemant at |prev_node|} +@d last_jchr==cur_list.last_jchr_field {final jchar node on current list} +@z + +@x [16.214] l.4464 - pTeX: prev_append: disp_node +@d tail_append(#)==begin link(tail):=#; tail:=link(tail); + end +@y +@d tail_append(#)==begin link(tail):=#; tail:=link(tail); + end +@d prev_append(#)==begin link(prev_node):=#; + link(link(prev_node)):=tail; prev_node:=link(prev_node); + end +@z + +@x [16.215] l.4477 - pTeX: last_jchar, direction, adjust_dir, prev_node +mode:=vmode; head:=contrib_head; tail:=contrib_head; +@y +mode:=vmode; head:=contrib_head; tail:=contrib_head; prev_node:=tail; +direction:=dir_yoko; adjust_dir:=direction; prev_disp:=0; last_jchr:=null; +@z + +@x [16.216] l.4496 - pTeX: last_jchr, displacement. +incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line; +@y +incr(nest_ptr); head:=new_null_box; tail:=head; prev_node:=tail; +prev_graf:=0; prev_disp:=0; last_jchr:=null; mode_line:=line; +@z + +@x [16.217] l.4504 - pTeX: pop_nest last_jchr +@p procedure pop_nest; {leave a semantic level, re-enter the old} +begin free_avail(head); decr(nest_ptr); cur_list:=nest[nest_ptr]; +end; +@y +@p procedure pop_nest; {leave a semantic level, re-enter the old} +begin +fast_delete_glue_ref(space_ptr(head)); fast_delete_glue_ref(xspace_ptr(head)); +free_node(head,box_node_size); decr(nest_ptr); cur_list:=nest[nest_ptr]; +end; +@z + +@x [16.218] l.4521 - pTeX: show_activities : direction + print_nl("### "); print_mode(m); +@y + print_nl("### "); print_direction(nest[p].dir_field); + print(", "); print_mode(m); +@z + +@x [17.224] l.4711 - pTeX: kanji_skip_code xkanji_skip_code, jfm_skip +@d thin_mu_skip_code=15 {thin space in math formula} +@d med_mu_skip_code=16 {medium space in math formula} +@d thick_mu_skip_code=17 {thick space in math formula} +@d glue_pars=18 {total number of glue parameters} +@y +@d kanji_skip_code=15 {between kanji-kanji space} +@d xkanji_skip_code=16 {between latin-kanji or kanji-latin space} +@d thin_mu_skip_code=17 {thin space in math formula} +@d med_mu_skip_code=18 {medium space in math formula} +@d thick_mu_skip_code=19 {thick space in math formula} +@d jfm_skip=20 {space refer from JFM} +@d glue_pars=21 {total number of glue parameters} +@z + +@x [17.224] l.4739 - kanji_skip, xkanji_skip +@d thick_mu_skip==glue_par(thick_mu_skip_code) +@y +@d thick_mu_skip==glue_par(thick_mu_skip_code) +@d kanji_skip==glue_par(kanji_skip_code) +@d xkanji_skip==glue_par(xkanji_skip_code) +@z + +@x [17.225] l.4767 - pTeX: kanji_skip_code xkanji_skip_code +thick_mu_skip_code: print_esc("thickmuskip"); +othercases print("[unknown glue parameter!]") +@y +thick_mu_skip_code: print_esc("thickmuskip"); +kanji_skip_code: print_esc("kanjiskip"); +xkanji_skip_code: print_esc("xkanjiskip"); +jfm_skip: print("refer from jfm"); +othercases print("[unknown glue parameter!]") +@z + +@x [17.226] l.4813 - pTeX: kanji_skip_code xkanji_skip_code +primitive("thickmuskip",assign_mu_glue,glue_base+thick_mu_skip_code);@/ +@!@:thick_mu_skip_}{\.{\\thickmuskip} primitive@> +@y +primitive("thickmuskip",assign_mu_glue,glue_base+thick_mu_skip_code);@/ +@!@:thick_mu_skip_}{\.{\\thickmuskip} primitive@> +primitive("kanjiskip",assign_glue,glue_base+kanji_skip_code);@/ +@!@:kanji_skip_}{\.{\\kanjiskip} primitive@> +primitive("xkanjiskip",assign_glue,glue_base+xkanji_skip_code);@/ +@!@:xkanji_skip_}{\.{\\xkanjiskip} primitive@> +@z + +@x [17.230] l.4867 - pTeX: cat_code_size, cur_jfont_loc, auto_spacing, auto_xspacing, inhibit_xsp_code, cur_tfont_loc +@d xord_code_base=cur_font_loc+1 +@d xchr_code_base=xord_code_base+1 +@d xprn_code_base=xchr_code_base+1 +@d math_font_base=xprn_code_base+1 +@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} +@y +@d math_font_base=cur_font_loc+1 {table of 48 math font numbers} +@d cur_jfont_loc=math_font_base+48 +@d cur_tfont_loc=cur_jfont_loc+1 +@d auto_spacing_code=cur_tfont_loc+1 +@d auto_xspacing_code=auto_spacing_code+1 +@d cat_code_base=auto_xspacing_code+1 + {table of 256 command codes (the ``catcodes'')} +@d kcat_code_base=cat_code_base+256 + {table of 256 command codes for the wchar's catcodes } +@d auto_xsp_code_base=kcat_code_base+256 {table of 256 auto spacer flag} +@d inhibit_xsp_code_base=auto_xsp_code_base+256 +@d kinsoku_base=inhibit_xsp_code_base+256 {table of 256 kinsoku mappings} +@d kansuji_base=kinsoku_base+256 {table of 10 kansuji mappings} +@d lc_code_base=kansuji_base+10 {table of 256 lowercase mappings} +@z + +@x [17.230] l.4900 - pTeX: +@d char_sub_code(#)==equiv(char_sub_code_base+#) + {Note: |char_sub_code(c)| is the true substitution info plus |min_halfword|} +@y +@d char_sub_code(#)==equiv(char_sub_code_base+#) + {Note: |char_sub_code(c)| is the true substitution info plus |min_halfword|} +@# +@d cur_jfont==equiv(cur_jfont_loc) {pTeX: } +@d cur_tfont==equiv(cur_tfont_loc) +@d auto_spacing==equiv(auto_spacing_code) +@d auto_xspacing==equiv(auto_xspacing_code) +@d kcat_code(#)==equiv(kcat_code_base+#) +@d auto_xsp_code(#)==equiv(auto_xsp_code_base+#) +@d inhibit_xsp_type(#)==eq_type(inhibit_xsp_code_base+#) +@d inhibit_xsp_code(#)==equiv(inhibit_xsp_code_base+#) +@d kinsoku_type(#)==eq_type(kinsoku_base+#) +@d kinsoku_code(#)==equiv(kinsoku_base+#) +@d kansuji_char(#)==equiv(kansuji_base+#) +@z + +@x [17.232] l.4959 - pTeX: initialize cat_code, cur_jfont, cur_tfont +cur_font:=null_font; eq_type(cur_font_loc):=data; +eq_level(cur_font_loc):=level_one;@/ +@y +cur_font:=null_font; eq_type(cur_font_loc):=data; +eq_level(cur_font_loc):=level_one;@/ +cur_jfont:=null_font; eq_type(cur_jfont_loc):=data; +eq_level(cur_jfont_loc):=level_one;@/ +cur_tfont:=null_font; eq_type(cur_tfont_loc):=data; +eq_level(cur_tfont_loc):=level_one;@/ +@z + +@x [17.232] l.4965 - pTeX: initialize cat_code, cur_jfont, cur_tfont +for k:=0 to 255 do + begin cat_code(k):=other_char; math_code(k):=hi(k); sf_code(k):=1000; + end; +@y +eqtb[auto_spacing_code]:=eqtb[cat_code_base]; +eqtb[auto_xspacing_code]:=eqtb[cat_code_base]; +for k:=0 to 255 do + begin cat_code(k):=other_char; kcat_code(k):=other_kchar; + math_code(k):=hi(k); sf_code(k):=1000; + auto_xsp_code(k):=0; inhibit_xsp_code(k):=0; inhibit_xsp_type(k):=0; + kinsoku_code(k):=0; kinsoku_type(k):=0; + end; +@z +@x [17.232] l.4971 - pTeX: initialize cat_code, cur_jfont, cur_tfont +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 +for k:="0" to "9" do + begin math_code(k):=hi(k+var_code); + auto_xsp_code(k):=3; + end; +kansuji_char(0):=@"213B; +kansuji_char(1):=@"306C; +kansuji_char(2):=@"4673; +kansuji_char(3):=@"3B30; +kansuji_char(4):=@"3B4D; +kansuji_char(5):=@"385E; +kansuji_char(6):=@"4F3B; +kansuji_char(7):=@"3C37; +kansuji_char(8):=@"482C; +kansuji_char(9):=@"3665; +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;@/ + auto_xsp_code(k):=3; auto_xsp_code(k+"a"-"A"):=3;@/ + sf_code(k):=999; + end; +if (proc_kanji_code=sjis_enc) then begin + @t\hskip10pt@>kcat_code(129):=other_kchar; + @t\hskip10pt@>kcat_code(130):=kana; + @t\hskip10pt@>kcat_code(131):=kana; + @t\hskip10pt@>kcat_code(132):=other_kchar; + @+@t\1@>for k:=136 to 159 do kcat_code(k):=kanji; + @+@t\1@>for k:=224 to 234 do kcat_code(k):=kanji; +end else begin + @t\hskip10pt@>kcat_code(161):=other_kchar; {1 ku} + @t\hskip10pt@>kcat_code(162):=other_kchar; {2 ku} + @t\hskip10pt@>kcat_code(163):=kana; {3 ku} + @t\hskip10pt@>kcat_code(164):=kana; {4 ku} + @t\hskip10pt@>kcat_code(165):=kana; {5 ku} + @t\hskip10pt@>kcat_code(166):=kana; {6 ku} + @t\hskip10pt@>kcat_code(167):=other_kchar; {7 ku} + @t\hskip10pt@>kcat_code(168):=other_kchar; {8 ku} + @+@t\1@>for k:=176 to 244 do kcat_code(k):=kanji; {16 ku ... 84 ku} +end; +@z + +@x [17.236] l.5092 - pTeX: cur_jfam_code, jchr_widow_penalty +@d cur_fam_code=44 {current family} +@d escape_char_code=45 {escape character for token output} +@d default_hyphen_char_code=46 {value of \.{\\hyphenchar} when a font is loaded} +@d default_skew_char_code=47 {value of \.{\\skewchar} when a font is loaded} +@d end_line_char_code=48 {character placed at the right end of the buffer} +@d new_line_char_code=49 {character that prints as |print_ln|} +@d language_code=50 {current hyphenation table} +@d left_hyphen_min_code=51 {minimum left hyphenation fragment size} +@d right_hyphen_min_code=52 {minimum right hyphenation fragment size} +@d holding_inserts_code=53 {do not remove insertion nodes from \.{\\box255}} +@d error_context_lines_code=54 {maximum intermediate line pairs shown} +@d tex_int_pars=55 {total number of \TeX's integer parameters} +@# +@d web2c_int_base=tex_int_pars {base for web2c's integer parameters} +@d char_sub_def_min_code=web2c_int_base {smallest value in the charsubdef list} +@d char_sub_def_max_code=web2c_int_base+1 {largest value in the charsubdef list} +@d tracing_char_sub_def_code=web2c_int_base+2 {traces changes to a charsubdef def} +@d mubyte_in_code=web2c_int_base+3 {if positive then reading mubytes is active} +@d mubyte_out_code=web2c_int_base+4 {if positive then printing mubytes is active} +@d mubyte_log_code=web2c_int_base+5 {if positive then print mubytes to log and terminal} +@d spec_out_code=web2c_int_base+6 {if positive then print specials by mubytes} +@d web2c_int_pars=web2c_int_base+7 {total number of web2c's integer parameters} +@# +@d int_pars=web2c_int_pars {total number of integer parameters} +@d count_base=int_base+int_pars {256 user \.{\\count} registers} +@y +@d cur_fam_code=44 {current family} +@d cur_jfam_code=45 {current kanji family} +@d escape_char_code=46 {escape character for token output} +@d default_hyphen_char_code=47 {value of \.{\\hyphenchar} when a font is loaded} +@d default_skew_char_code=48 {value of \.{\\skewchar} when a font is loaded} +@d end_line_char_code=49 {character placed at the right end of the buffer} +@d new_line_char_code=50 {character that prints as |print_ln|} +@d language_code=51 {current hyphenation table} +@d left_hyphen_min_code=52 {minimum left hyphenation fragment size} +@d right_hyphen_min_code=53 {minimum right hyphenation fragment size} +@d holding_inserts_code=54 {do not remove insertion nodes from \.{\\box255}} +@d error_context_lines_code=55 {maximum intermediate line pairs shown} +@d jchr_widow_penalty_code=56 + {penalty for creating a widow KANJI character line} +@d char_sub_def_min_code=57 {smallest value in the charsubdef list} +@d char_sub_def_max_code=58 {largest value in the charsubdef list} +@d tracing_char_sub_def_code=59 {traces changes to a charsubdef def} +@d int_pars=60 {total number of integer parameters} +@d count_base=int_base+int_pars {256 user \.{\\count} registers} +@z + +@x [17.236] l.5167 - pTeX: cur_jfam, |jchr_widow_penalty| +@d cur_fam==int_par(cur_fam_code) +@d escape_char==int_par(escape_char_code) +@y +@d cur_fam==int_par(cur_fam_code) +@d cur_jfam==int_par(cur_jfam_code) +@d escape_char==int_par(escape_char_code) +@d jchr_widow_penalty==int_par(jchr_widow_penalty_code) +@z + +@x l.5181 - pTeX +@d tracing_char_sub_def==int_par(tracing_char_sub_def_code) +@d mubyte_in==int_par(mubyte_in_code) +@d mubyte_out==int_par(mubyte_out_code) +@d mubyte_log==int_par(mubyte_log_code) +@d spec_out==int_par(spec_out_code) +@y +@d tracing_char_sub_def==int_par(tracing_char_sub_def_code) +@z + +@x [17.237] l.5244 - pTeX: cur_jfam_code, jchr_window_penalty_code +new_line_char_code:print_esc("newlinechar"); +@y +new_line_char_code:print_esc("newlinechar"); +cur_jfam_code:print_esc("jfam"); +jchr_widow_penalty_code:print_esc("jcharwidowpenalty"); +@z + +@x l.5252 - pTeX +tracing_char_sub_def_code:print_esc("tracingcharsubdef"); +mubyte_in_code:print_esc("mubytein"); +mubyte_out_code:print_esc("mubyteout"); +mubyte_log_code:print_esc("mubytelog"); +spec_out_code:print_esc("specialout"); +@y +tracing_char_sub_def_code:print_esc("tracingcharsubdef"); +@z + +@x [17.238] l.5365 - pTeX: cur_jfam_code, jchr_window_penalty_code +primitive("newlinechar",assign_int,int_base+new_line_char_code);@/ +@!@:new_line_char_}{\.{\\newlinechar} primitive@> +@y +primitive("newlinechar",assign_int,int_base+new_line_char_code);@/ +@!@:new_line_char_}{\.{\\newlinechar} primitive@> +primitive("jfam",assign_int,int_base+cur_jfam_code);@/ +@!@:cur_jfam_}{\.{\\jfam} primitive@> +primitive("jcharwidowpenalty",assign_int,int_base+jchr_widow_penalty_code);@/ +@!@:jchr_widow_penalty}{\.{\\jcharwidowpenalty} primitive@> +@z + +@x l.5387 - pTeX +if enctex_p then + begin enctex_enabled_p:=true; + primitive("mubytein",assign_int,int_base+mubyte_in_code);@/ +@!@:mubyte_in_}{\.{\\mubytein} primitive@> + primitive("mubyteout",assign_int,int_base+mubyte_out_code);@/ +@!@:mubyte_out_}{\.{\\mubyteout} primitive@> + primitive("mubytelog",assign_int,int_base+mubyte_log_code);@/ +@!@:mubyte_log_}{\.{\\mubytelog} primitive@> + primitive("specialout",assign_int,int_base+spec_out_code);@/ +@!@:spec_out_}{\.{\\specialout} primitive@> +end; +@y +@z + +@x [17.247] l.5490 - pTeX: kinsoku, t_baseline_shift, y_baseline_shift +@d h_offset_code=18 {amount of horizontal offset when shipping pages out} +@d v_offset_code=19 {amount of vertical offset when shipping pages out} +@d emergency_stretch_code=20 {reduces badnesses on final pass of line-breaking} +@d dimen_pars=21 {total number of dimension parameters} +@d scaled_base=dimen_base+dimen_pars + {table of 256 user-defined \.{\\dimen} registers} +@d eqtb_size=scaled_base+255 {largest subscript of |eqtb|} +@y +@d h_offset_code=18 {amount of horizontal offset when shipping pages out} +@d v_offset_code=19 {amount of vertical offset when shipping pages out} +@d emergency_stretch_code=20 {reduces badnesses on final pass of line-breaking} +@d t_baseline_shift_code=21 {shift amount when mixing TATE-kumi and Alphabet} +@d y_baseline_shift_code=22 {shift amount when mixing YOKO-kumi and Alphabet} +@d dimen_pars=23 {total number of dimension parameters} +@d scaled_base=dimen_base+dimen_pars + {table of 256 user-defined \.{\\dimen} registers} +@d kinsoku_penalty_base=scaled_base+256 {table of 256 kinsoku registers} +@d eqtb_size=kinsoku_penalty_base+255 {largest subscript of |eqtb|} +@z + +@x l.5498 - pTeX: kinsoku, t_baseline_shift, y_baseline_shift +@d dimen(#)==eqtb[scaled_base+#].sc +@d dimen_par(#)==eqtb[dimen_base+#].sc {a scaled quantity} +@y +@d dimen(#)==eqtb[scaled_base+#].sc +@d dimen_par(#)==eqtb[dimen_base+#].sc {a scaled quantity} +@d kinsoku_penalty(#)==eqtb[kinsoku_penalty_base+#].int +@z + +@x l.5518 - pTeX: +@d h_offset==dimen_par(h_offset_code) +@d v_offset==dimen_par(v_offset_code) +@y +@d h_offset==dimen_par(h_offset_code) +@d v_offset==dimen_par(v_offset_code) +@d t_baseline_shift==dimen_par(t_baseline_shift_code) +@d y_baseline_shift==dimen_par(y_baseline_shift_code) +@z + +@x l.5542 - pTeX: +h_offset_code:print_esc("hoffset"); +v_offset_code:print_esc("voffset"); +emergency_stretch_code:print_esc("emergencystretch"); +othercases print("[unknown dimen parameter!]") +@y +h_offset_code:print_esc("hoffset"); +v_offset_code:print_esc("voffset"); +t_baseline_shift_code:print_esc("tbaselineshift"); +y_baseline_shift_code:print_esc("ybaselineshift"); +emergency_stretch_code:print_esc("emergencystretch"); +othercases print("[unknown dimen parameter!]") +@z + +@x [17.248] l.5588 - pTeX: rotate offset +primitive("hoffset",assign_dimen,dimen_base+h_offset_code);@/ +@!@:h_offset_}{\.{\\hoffset} primitive@> +primitive("voffset",assign_dimen,dimen_base+v_offset_code);@/ +@!@:v_offset_}{\.{\\voffset} primitive@> +@y +primitive("hoffset",assign_dimen,dimen_base+h_offset_code);@/ +@!@:h_offset_}{\.{\\hoffset} primitive@> +primitive("voffset",assign_dimen,dimen_base+v_offset_code);@/ +@!@:v_offset_}{\.{\\voffset} primitive@> +primitive("tbaselineshift",assign_dimen,dimen_base+t_baseline_shift_code);@/ +@!@:t_baseline_shift_}{\.{\\tbaselineshift} primitive@> +primitive("ybaselineshift",assign_dimen,dimen_base+y_baseline_shift_code);@/ +@!@:y_baseline_shift_}{\.{\\ybaselineshift} primitive@> +@z + +@x [17.252] l.5622 - pTeX: show eqtb +else if n<=eqtb_size then @<Show equivalent |n|, in region 6@> +else print_char("?"); {this can't happen either} +end; +tats +@y +else if n<kinsoku_penalty_base then @<Show equivalent |n|, in region 6@> +else if n<=eqtb_size then print("kinsoku") +else print_char("?"); {this can't happen either} +end; +tats +@z + +@x l.5777 - pTeX +The conversion from control sequence to byte sequence for enc\TeX is +implemented here. Of course, the simplest way is to implement an array +of string pointers with |hash_size| length, but we assume that only a +few control sequences will need to be converted. So |mubyte_cswrite|, +an array with only 128 items, is used. The items point to the token +lists. First token includes a csname number and the second points the +string to be output. The third token includes the number of another +csname and fourth token its pointer to the string etc. We need to do +the sequential searching in one of the 128 token lists. + +@y +@z + +@x l.5788 - pTeX +procedure print_cs(@!p:integer); {prints a purported control sequence} +var q: pointer; + s: str_number; +begin + if active_noconvert and (not no_convert) and + (eq_type(p) = let) and (equiv(p) = normal+11) then { noconvert } + begin + no_convert := true; + return; + end; + s := 0; + if cs_converting and (not no_convert) then + begin + q := mubyte_cswrite [p mod 128] ; + while q <> null do + if info (q) = p then + begin + s := info (link(q)); q := null; + end else q := link (link (q)); + end; + no_convert := false; + if s > 0 then print (s) + else if p<hash_base then {single character} +@y +procedure print_cs(@!p:integer); {prints a purported control sequence} +begin if p<hash_base then {single character} +@z + +@x l.5828 - pTeX +exit: end; +@y +end; +@z + +@x l.5893 - pTeX +if enctex_p then +begin + primitive("endmubyte",end_cs_name,10);@/ +@!@:end_mubyte_}{\.{\\endmubyte} primitive@> +end; +@y +@z + +@x [18.265] l.5903 - pTeX: \jfont \tfont +primitive("font",def_font,0);@/ +@!@:font_}{\.{\\font} primitive@> +@y +primitive("font",def_font,0);@/ +@!@:font_}{\.{\\font} primitive@> +primitive("jfont",def_jfont,0);@/ +@!@:jfont_}{\.{\\jfont} primitive@> +primitive("tfont",def_tfont,0);@/ +@!@:tfont_}{\.{\\tfont} primitive@> +@z + +@x [18.266] l.5979 - pTeX: \jfont, \tfont +def_font: print_esc("font"); +@y +def_font: print_esc("font"); +def_jfont: print_esc("jfont"); +def_tfont: print_esc("tfont"); +@z + +@x l.5982 - pTeX +end_cs_name: if chr_code = 10 then print_esc("endmubyte") + else print_esc("endcsname"); +@y +end_cs_name: print_esc("endcsname"); +@z + +@x [20.289] l.6387 - pTeX: cs_token_flag +@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} +@y +@d cs_token_flag==@"FFFF {amount added to the |eqtb| location in a +token that stands for a control sequence; is a multiple of~256, less~1} +@z + +@x [20.293] l.6496 - pTeX: show_token_list +@ @<Display token |p|...@>= +if (p<hi_mem_min) or (p>mem_end) then + begin print_esc("CLOBBERED."); return; +@.CLOBBERED@> + end; +if info(p)>=cs_token_flag then print_cs(info(p)-cs_token_flag) +else begin m:=info(p) div @'400; c:=info(p) mod @'400; + if info(p)<0 then print_esc("BAD.") +@.BAD@> + else @<Display the token $(|m|,|c|)$@>; + end +@y +@ @<Display token |p|...@>= +if (p<hi_mem_min) or (p>mem_end) then + begin print_esc("CLOBBERED."); return; +@.CLOBBERED@> + end; +if info(p)>=cs_token_flag then print_cs(info(p)-cs_token_flag) {wchar_token} +else begin + if check_kanji(info(p)) then {wchar_token} + begin m:=kcat_code(Hi(info(p))); c:=info(p); + end + else begin m:=info(p) div @'400; c:=info(p) mod @'400; + end; + if (m<kanji)and(c>256) then print_esc("BAD.") +@.BAD@> + else @<Display the token $(|m|,|c|)$@>; +end +@z + +@x [20.294] l.6512 - pTeX: show_token_list +@<Display the token ...@>= +case m of +left_brace,right_brace,math_shift,tab_mark,sup_mark,sub_mark,spacer, + letter,other_char: print(c); +@y +@<Display the token ...@>= +case m of +kanji,kana,other_kchar: print_kanji(KANJI(c)); +left_brace,right_brace,math_shift,tab_mark,sup_mark,sub_mark,spacer, + letter,other_char: print(c); +@z + +@x [21.298] l.6632 - pTeX: print KANJI +other_char: chr_cmd("the character "); +@y +other_char: chr_cmd("the character "); +kanji,kana,other_kchar: begin print("kanji character "); + print_kanji(KANJI(chr_code)); end; +@z + +@x [22.303] l.6726 - pTeX: state mid_kanji +1) |state=mid_line| is the normal state.\cr +2) |state=skip_blanks| is like |mid_line|, but blanks are ignored.\cr +3) |state=new_line| is the state at the beginning of a line.\cr}}$$ +@y +1) |state=mid_line| is the normal state.\cr +2) |state=mid_kanji| is like |mid_line|, and internal KANJI string.\cr +3) |state=skip_blanks| is like |mid_line|, but blanks are ignored.\cr +4) |state=new_line| is the state at the beginning of a line.\cr}}$$ +@z + +@x [22.303] l.6736 - pTeX: state mid_kanji +@d mid_line=1 {|state| code when scanning a line of characters} +@d skip_blanks=2+max_char_code {|state| code when ignoring blanks} +@d new_line=3+max_char_code+max_char_code {|state| code at start of line} +@y +@d mid_line=1 {|state| code when scanning a line of characters} +@d mid_kanji=2+max_char_code {|state| code when scanning a line of characters} +@d skip_blanks=3+max_char_code+max_char_code {|state| code when ignoring blanks} +@d new_line=4+max_char_code+max_char_code+max_char_code + {|state| code at start of line} +@z + +@x [22.311] l.6986 - pTeX: label +@p procedure show_context; {prints where the scanner is} +label done; +var old_setting:0..max_selector; {saved |selector| setting} +@y +@p procedure show_context; {prints where the scanner is} +label done, done1; +var old_setting:0..max_selector; {saved |selector| setting} +@!s: pointer; {temporary pointer} +@z + +@x [22.316] l.7110 - pTeX: init kcode_pos +@d begin_pseudoprint== + begin l:=tally; tally:=0; selector:=pseudo; + trick_count:=1000000; + end +@y +@d begin_pseudoprint== + begin l:=tally; tally:=0; selector:=pseudo; kcode_pos:=0; + trick_count:=1000000; + end +@z +@x [22.316] l.7114 - pTeX: kcode_pos +@d set_trick_count== + begin first_count:=tally; + trick_count:=tally+1+error_line-half_error_line; + if trick_count<error_line then trick_count:=error_line; + end +@y +@d set_trick_count== + begin first_count:=tally; + if (first_count>0)and(trick_buf2[(first_count-1)mod error_line]=1) then + incr(first_count); + trick_count:=first_count+1+error_line-half_error_line; + if trick_count<error_line then trick_count:=error_line; + end +@z + +@x [22.317] l.7133 - pTeX: adjust kanji code pos +for q:=p to first_count-1 do print_char(trick_buf[q mod error_line]); +print_ln; +for q:=1 to n do print_char(" "); {print |n| spaces to begin line~2} +if m+n<=error_line then p:=first_count+m else p:=first_count+(error_line-n-3); +@y +if trick_buf2[p mod error_line]=2 then + begin p:=p+1; n:=n-1; + end; +for q:=p to first_count-1 do print_char(trick_buf[q mod error_line]); +print_ln; +for q:=1 to n do print_char(" "); {print |n| spaces to begin line~2} +if m+n<=error_line then p:=first_count+m else p:=first_count+(error_line-n-3); +if trick_buf2[(p-1) mod error_line]=1 then p:=p-1; +@z + +@x l.7148 - pTeX +@<Pseudoprint the line@>= +begin_pseudoprint; +if buffer[limit]=end_line_char then j:=limit +else j:=limit+1; {determine the effective end of the line} +i := start; mubyte_skeep := mubyte_keep; +mubyte_sstart := mubyte_start; mubyte_start := false; +if j>0 then while i < j do +begin + if i=loc then set_trick_count; + print_buffer(i); +end; +mubyte_keep := mubyte_skeep; mubyte_start := mubyte_sstart +@y +@<Pseudoprint the line@>= +begin_pseudoprint; +if buffer[limit]=end_line_char then j:=limit +else j:=limit+1; {determine the effective end of the line} +if j>0 then for i:=start to j-1 do + begin if i=loc then set_trick_count; + print(buffer[i]); + end +@z + +@x [22.319] l.7157 - pTeX: adjust kanji code token +@ @<Pseudoprint the token list@>= +begin_pseudoprint; +if token_type<macro then show_token_list(start,loc,100000) +else show_token_list(link(start),loc,100000) {avoid reference count} +@y +@ @<Pseudoprint the token list@>= +begin_pseudoprint; +if token_type<macro then + begin if (token_type=backed_up)and(loc<>null) then + begin if (link(start)=null)and(check_kanji(info(start))) then {wchar_token} + begin cur_input:=input_stack[base_ptr-1]; + s:=get_avail; info(s):=(buffer[loc] mod @'400); + cur_input:=input_stack[base_ptr]; + link(start):=s; + show_token_list(start,loc,100000); + free_avail(s);link(start):=null; + goto done1; + end; + end; + show_token_list(start,loc,100000); + end +else show_token_list(link(start),loc,100000); {avoid reference count} +done1: +@z + +@x l.7354 - pTeX +Some additional routines used by the enc\TeX extension have to be +declared at this point. + +@p @t\4@>@<Declare additional routines for enc\TeX@>@/ + +@y +@z + +@x l.7476 - pTeX +@!i,@!j: 0..buf_size; {more indexes for encTeX} +@!mubyte_incs: boolean; {control sequence is converted by mubyte} +@!p:pointer; {for encTeX test if noexpanding} +@y +@z + +@x [24.341] l.7479 - pTeX: set last_chr +@!cat:0..15; {|cat_code(cur_chr)|, usually} +@y +@!cat:escape..max_char_code; {|cat_code(cur_chr)|, usually} +@!l:0..buf_size; {temporary index into |buffer|} +@z + +@x [24.343] l.7500 - pTeX: input external file +@ @<Input from external file, |goto restart| if no input found@>= +@^inner loop@> +begin switch: if loc<=limit then {current line not yet finished} + begin + { Use |k| instead of |loc| for type correctness. } + k := loc; + cur_chr := read_buffer (k); + loc := k; incr (loc); + if (mubyte_token > 0) then + begin + state := mid_line; + cur_cs := mubyte_token - cs_token_flag; + goto found; + end; + reswitch: cur_cmd:=cat_code(cur_chr); +@y +@ @<Input from external file, |goto restart| if no input found@>= +@^inner loop@> +begin switch: if loc<=limit then {current line not yet finished} + begin cur_chr:=buffer[loc]; incr(loc); + if (iskanji1(cur_chr))and(loc<=limit)and(iskanji2(buffer[loc])) then + begin cur_cmd:=kcat_code(cur_chr); cur_chr:=cur_chr*@'400+buffer[loc]; + incr(loc); + end + else reswitch: cur_cmd:=cat_code(cur_chr); +@z + +@x [24.344] l.7535 - pTeX: ASCII-KANJI space handling +@d any_state_plus(#) == mid_line+#,skip_blanks+#,new_line+# +@y +@d any_state_plus(#) == mid_line+#,mid_kanji+#,skip_blanks+#,new_line+# +@z + +@x [24.347] l.7569 - pTeX: scaner +@ @d add_delims_to(#)==#+math_shift,#+tab_mark,#+mac_param, + #+sub_mark,#+letter,#+other_char +@y +@ @d add_delims_to(#)==#+math_shift,#+tab_mark,#+mac_param, + #+sub_mark,#+letter,#+other_char +@d all_jcode(#)==#+kanji,#+kana,#+other_kchar +@z + +@x [24.347] l.7573 - pTeX: scaner +mid_line+spacer:@<Enter |skip_blanks| state, emit a space@>; +mid_line+car_ret:@<Finish line, emit a space@>; +skip_blanks+car_ret,any_state_plus(comment): + @<Finish line, |goto switch|@>; +new_line+car_ret:@<Finish line, emit a \.{\\par}@>; +mid_line+left_brace: incr(align_state); +skip_blanks+left_brace,new_line+left_brace: begin + state:=mid_line; incr(align_state); + end; +mid_line+right_brace: decr(align_state); +skip_blanks+right_brace,new_line+right_brace: begin + state:=mid_line; decr(align_state); + end; +add_delims_to(skip_blanks),add_delims_to(new_line): state:=mid_line; +@y +mid_kanji+spacer,mid_line+spacer:@<Enter |skip_blanks| state, emit a space@>; +mid_line+car_ret:@<Finish line, emit a space@>; +mid_kanji+car_ret: if skip_mode then @<Finish line, |goto switch|@> + else @<Finish line, emit a space@>; +skip_blanks+car_ret,any_state_plus(comment): + @<Finish line, |goto switch|@>; +new_line+car_ret:@<Finish line, emit a \.{\\par}@>; +mid_line+left_brace,mid_kanji+left_brace: incr(align_state); +skip_blanks+left_brace,new_line+left_brace: begin + state:=mid_line; incr(align_state); + end; +mid_line+right_brace,mid_kanji+right_brace: decr(align_state); +skip_blanks+right_brace,new_line+right_brace: begin + state:=mid_line; decr(align_state); + end; +add_delims_to(skip_blanks),add_delims_to(new_line),add_delims_to(mid_kanji): + state:=mid_line; +all_jcode(skip_blanks),all_jcode(new_line),all_jcode(mid_line): + state:=mid_kanji; + +@ @<Global...@>= +skip_mode:boolean; + +@ @<Set init...@>= +skip_mode:=true; +@z + +@x [24.354] l.7659 - pTeX: scan control sequence +@<Scan a control...@>= +begin if loc>limit then cur_cs:=null_cs {|state| is irrelevant in this case} +else begin start_cs: + mubyte_incs := false; k := loc; mubyte_skeep := mubyte_keep; + cur_chr := read_buffer (k); cat := cat_code (cur_chr); + if (mubyte_in>0) and (not mubyte_incs) and + ((mubyte_skip>0) or (cur_chr<>buffer[k])) then mubyte_incs := true; + incr (k); + if mubyte_token > 0 then + begin + state := mid_line; + cur_cs := mubyte_token - cs_token_flag; + goto found; + end; + if cat=letter then state:=skip_blanks + else if cat=spacer then state:=skip_blanks + else state:=mid_line; + if (cat=letter)and(k<=limit) then + @<Scan ahead in the buffer until finding a nonletter; + if an expanded code is encountered, reduce it + and |goto start_cs|; otherwise if a multiletter control + sequence is found, adjust |cur_cs| and |loc|, and + |goto found|@> + else @<If an expanded code is present, reduce it and |goto start_cs|@>; + mubyte_keep := mubyte_skeep; + cur_cs:=single_base + read_buffer(loc); incr(loc); + end; +found: cur_cmd:=eq_type(cur_cs); cur_chr:=equiv(cur_cs); +if cur_cmd>=outer_call then check_outer_validity; +if write_noexpanding then +begin + p := mubyte_cswrite [cur_cs mod 128]; + while p <> null do + if info (p) = cur_cs then + begin + cur_cmd := relax; cur_chr := 256; p := null; + end else p := link (link (p)); +end; +end +@y +@<Scan a control...@>= +begin if loc>limit then cur_cs:=null_cs {|state| is irrelevant in this case} +else begin k:=loc; cur_chr:=buffer[k]; incr(k); + if (iskanji1(cur_chr))and(k<=limit)and(iskanji2(buffer[k])) then + begin cat:=kcat_code(cur_chr); incr(k); + end + else cat:=cat_code(cur_chr); +start_cs: + if (cat=letter)or(cat=kanji)or(cat=kana) then state:=skip_blanks + else if cat=spacer then state:=skip_blanks + else state:=mid_line; + if cat=other_kchar then + begin cur_cs:=id_lookup(loc,k-loc); loc:=k; goto found; + end + else if ((cat=letter)or(cat=kanji)or(cat=kana))and(k<=limit) then + @<Scan ahead in the buffer until finding a nonletter; + if an expanded code is encountered, reduce it + and |goto start_cs|; otherwise if a multiletter control + sequence is found, adjust |cur_cs| and |loc|, and + |goto found|@> + else @<If an expanded code is present, reduce it and |goto start_cs|@>; + cur_cs:=single_base+buffer[loc]; incr(loc); + end; +found: cur_cmd:=eq_type(cur_cs); cur_chr:=equiv(cur_cs); +if cur_cmd>=outer_call then check_outer_validity; +end +@z + +@x +@<If an expanded...@>= +begin if buffer[k]=cur_chr then @+if cat=sup_mark then @+if k<limit then + begin c:=buffer[k+1]; @+if c<@'200 then {yes, one is indeed present} + begin d:=2; + if is_hex(c) then @+if k+2<=limit then + begin cc:=buffer[k+2]; @+if is_hex(cc) then incr(d); + end; + if d>2 then + begin hex_to_cur_chr; buffer[k-1]:=cur_chr; + end + else if c<@'100 then buffer[k-1]:=c+@'100 + else buffer[k-1]:=c-@'100; + limit:=limit-d; first:=first-d; + while k<=limit do + begin buffer[k]:=buffer[k+d]; incr(k); + end; + goto start_cs; + end; + end; +end +@y +@<If an expanded...@>= +begin if buffer[k]=cur_chr then @+if cat=sup_mark then @+if k<limit then + begin c:=buffer[k+1]; @+if c<@'200 then {yes, one is indeed present} + begin d:=2; + if is_hex(c) then @+if k+2<=limit then + begin cc:=buffer[k+2]; @+if is_hex(cc) then incr(d); + end; + if d>2 then + begin hex_to_cur_chr; buffer[k-1]:=cur_chr; + end + else if c<@'100 then buffer[k-1]:=c+@'100 + else buffer[k-1]:=c-@'100; + limit:=limit-d; first:=first-d; + l:=k; cur_chr:=buffer[k-1]; cat:=cat_code(cur_chr); + while l<=limit do + begin buffer[l]:=buffer[l+d]; incr(l); + end; + goto start_cs; + end; + end; +end +@z + +@x [24.356] l.7727 - pTeX: scan control sequence (cont) +@ @<Scan ahead in the buffer...@>= +begin + repeat cur_chr := read_buffer (k); cat := cat_code (cur_chr); + if mubyte_token>0 then cat := escape; + if (mubyte_in>0) and (not mubyte_incs) and (cat=letter) and + ((mubyte_skip>0) or (cur_chr<>buffer[k])) then mubyte_incs := true; + incr (k); + until (cat <> letter) or (k > limit); + @<If an expanded...@>; + if cat <> letter then + begin + decr (k); k := k - mubyte_skip; + end; + if k > loc + 1 then { multiletter control sequence has been scanned } + begin + if mubyte_incs then { multibyte in csname occurrs } + begin + i := loc; j := first; mubyte_keep := mubyte_skeep; + if j - loc + k > max_buf_stack then + begin + max_buf_stack := j - loc + k; + if max_buf_stack >= buf_size then + begin + max_buf_stack := buf_size; + overflow ("buffer size", buf_size); + end; + end; + while i < k do + begin + buffer [j] := read_buffer (i); + incr (i); incr (j); + end; + if j = first+1 then + cur_cs := single_base + buffer [first] + else + cur_cs := id_lookup (first, j-first); + end else cur_cs := id_lookup (loc, k-loc) ; + loc := k; + goto found; + end; +end +@y +@ @<Scan ahead in the buffer...@>= +begin repeat cur_chr:=buffer[k]; incr(k); + if (iskanji1(cur_chr))and(k<=limit)and(iskanji2(buffer[k])) then + begin cat:=kcat_code(cur_chr); incr(k); + end + else cat:=cat_code(cur_chr); + while (buffer[k]=cur_chr)and(cat=sup_mark)and(k<limit) do + begin c:=buffer[k+1]; @+if c<@'200 then {yes, one is indeed present} + begin d:=2; + if is_hex(c) then @+if k+2<=limit then + begin cc:=buffer[k+2]; @+if is_hex(cc) then incr(d); + end; + if d>2 then + begin hex_to_cur_chr; + end + else if c<@'100 then cur_chr:=c+@'100 + else cur_chr:=c-@'100; + cat:=cat_code(cur_chr); + if (cat=letter)or(cat=sup_mark) then + begin buffer[k-1]:=cur_chr; + limit:=limit-d; first:=first-d; + l:=k; + while l<=limit do + begin buffer[l]:=buffer[l+d]; incr(l); + end; + end; + end; + end; +until not((cat=letter)or(cat=kanji)or(cat=kana))or(k>limit); +{@@<If an expanded...@@>;} +if not((cat=letter)or(cat=kanji)or(cat=kana)) then decr(k); +if cat=other_kchar then decr(k); {now |k| points to first nonletter} +if k>loc+1 then {multiletter control sequence has been scanned} + begin cur_cs:=id_lookup(loc,k-loc); loc:=k; goto found; + end; +end +@z + +@x [24.357] l.7771 - pTeX: input from token list +@<Input from token list, |goto restart| if end of list or + if a parameter needs to be expanded@>= +if loc<>null then {list not exhausted} +@^inner loop@> + begin t:=info(loc); loc:=link(loc); {move to next} + if t>=cs_token_flag then {a control sequence token} + begin cur_cs:=t-cs_token_flag; + cur_cmd:=eq_type(cur_cs); cur_chr:=equiv(cur_cs); + if cur_cmd>=outer_call then + if cur_cmd=dont_expand then + @<Get the next token, suppressing expansion@> + else check_outer_validity; + if write_noexpanding then + begin + p := mubyte_cswrite [cur_cs mod 128]; + while p <> null do + if info (p) = cur_cs then + begin + cur_cmd := relax; cur_chr := 256; p := null; + end else p := link (link (p)); + end; + end + else begin cur_cmd:=t div @'400; cur_chr:=t mod @'400; + case cur_cmd of + left_brace: incr(align_state); + right_brace: decr(align_state); + out_param: @<Insert macro parameter and |goto restart|@>; + othercases do_nothing + endcases; + end; + end +else begin {we are done with this token list} + end_token_list; goto restart; {resume previous level} + end +@y +@<Input from token list, |goto restart| if end of list or + if a parameter needs to be expanded@>= +if loc<>null then {list not exhausted} +@^inner loop@> + begin t:=info(loc); loc:=link(loc); {move to next} + if t>=cs_token_flag then {a control sequence token} + begin cur_cs:=t-cs_token_flag; + cur_cmd:=eq_type(cur_cs); cur_chr:=equiv(cur_cs); + if cur_cmd>=outer_call then + if cur_cmd=dont_expand then + @<Get the next token, suppressing expansion@> + else check_outer_validity; + end + else if check_kanji(t) then {wchar_token} + begin cur_chr:=t; cur_cmd:=kcat_code(Hi(t)); + end + else + begin cur_cmd:=t div @'400; cur_chr:=t mod @'400; + case cur_cmd of + left_brace: incr(align_state); + right_brace: decr(align_state); + out_param: @<Insert macro parameter and |goto restart|@>; + othercases do_nothing + endcases; + end; + end +else begin {we are done with this token list} + end_token_list; goto restart; {resume previous level} + end +@z + +@x l.7898 - pTeX + k := start; + while k < limit do begin print_buffer(k) end; +@y + if start<limit then for k:=start to limit-1 do print(buffer[k]); +@z + +@x [24.365] l.7935 - pTeX: get_token +@p procedure get_token; {sets |cur_cmd|, |cur_chr|, |cur_tok|} +begin no_new_control_sequence:=false; get_next; no_new_control_sequence:=true; +@^inner loop@> +if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr +else cur_tok:=cs_token_flag+cur_cs; +end; +@y +@p procedure get_token; {sets |cur_cmd|, |cur_chr|, |cur_tok|} +begin no_new_control_sequence:=false; get_next; no_new_control_sequence:=true; +@^inner loop@> +if cur_cs=0 then + if (cur_cmd=kanji)or(cur_cmd=kana)or(cur_cmd=other_kchar) then {wchar_token} + cur_tok:=cur_chr + else cur_tok:=(cur_cmd*@'400)+cur_chr +else cur_tok:=cs_token_flag+cur_cs; +end; +@z + +%@x [25.367] l.8019 - pTeX: expand +%@<Suppress expansion...@>= +%begin save_scanner_status:=scanner_status; scanner_status:=normal; +%get_token; scanner_status:=save_scanner_status; t:=cur_tok; +%back_input; {now |start| and |loc| point to the backed-up token |t|} +%if t>=cs_token_flag then +% begin p:=get_avail; info(p):=cs_token_flag+frozen_dont_expand; +% link(p):=loc; start:=p; loc:=p; +% end; +%end +%@y +%@<Suppress expansion...@>= +%begin save_scanner_status:=scanner_status; scanner_status:=normal; +%get_token; scanner_status:=save_scanner_status; t:=cur_tok; +%back_input; {now |start| and |loc| point to the backed-up token |t|} +%if t>=cs_token_flag then +% begin p:=get_avail; info(p):=cs_token_flag+frozen_dont_expand; +% link(p):=loc; start:=p; loc:=p; +% end; +%end +%@z + +@x [25.374] l.8073 - pTeX: get_chr +@ @<Look up the characters of list |r| in the hash table...@>= +j:=first; p:=link(r); +while p<>null do + begin if j>=max_buf_stack then + begin max_buf_stack:=j+1; + if max_buf_stack=buf_size then + overflow("buffer size",buf_size); +@:TeX capacity exceeded buffer size}{\quad buffer size@> + end; + buffer[j]:=info(p) mod @'400; incr(j); p:=link(p); + end; +@y +@ @<Look up the characters of list |r| in the hash table...@>= +j:=first; p:=link(r); +while p<>null do + begin if j>=max_buf_stack then + begin max_buf_stack:=j+1; + if max_buf_stack=buf_size then + overflow("buffer size",buf_size); +@:TeX capacity exceeded buffer size}{\quad buffer size@> + end; + if check_kanji(info(p)) then {wchar_token} + begin buffer[j]:=Hi(info(p)); incr(j); + buffer[j]:=Lo(info(p)); incr(j); p:=link(p); + end + else + begin buffer[j]:=info(p) mod @'400; incr(j); p:=link(p); + end; + end; +@z + +@x [25.380] l.8221 - pTeX: get_x_token +@p procedure get_x_token; {sets |cur_cmd|, |cur_chr|, |cur_tok|, + and expands macros} +label restart,done; +begin restart: get_next; +@^inner loop@> +if cur_cmd<=max_command then goto done; +if cur_cmd>=call then + if cur_cmd<end_template then macro_call + else begin cur_cs:=frozen_endv; cur_cmd:=endv; + goto done; {|cur_chr=null_list|} + end +else expand; +goto restart; +done: if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr +else cur_tok:=cs_token_flag+cur_cs; +end; +@y +@p procedure get_x_token; {sets |cur_cmd|, |cur_chr|, |cur_tok|, + and expands macros} +label restart,done; +begin restart: get_next; +@^inner loop@> +if cur_cmd<=max_command then goto done; +if cur_cmd>=call then + if cur_cmd<end_template then macro_call + else begin cur_cs:=frozen_endv; cur_cmd:=endv; + goto done; {|cur_chr=null_list|} + end +else expand; +goto restart; +done: if cur_cs=0 then + if (cur_cmd=kanji)or(cur_cmd=kana)or(cur_cmd=other_kchar) then + cur_tok:=cur_chr + else cur_tok:=(cur_cmd*@'400)+cur_chr +else cur_tok:=cs_token_flag+cur_cs; +end; +@z + +@x [25.381] l.8151 - pTeX: x_token +@p procedure x_token; {|get_x_token| without the initial |get_next|} +begin while cur_cmd>max_command do + begin expand; + get_next; + end; +if cur_cs=0 then cur_tok:=(cur_cmd*@'400)+cur_chr +else cur_tok:=cs_token_flag+cur_cs; +@y +@p procedure x_token; {|get_x_token| without the initial |get_next|} +begin while cur_cmd>max_command do + begin expand; + get_next; + end; +if cur_cs=0 then + if (cur_cmd=kanji)or(cur_cmd=kana)or(cur_cmd=other_kchar) then + cur_tok:=cur_chr + else cur_tok:=(cur_cmd*@'400)+cur_chr +else cur_tok:=cs_token_flag+cur_cs; +@z + +@x [26.413] l.8659 - pTeX: scan_somthing_internal +@p procedure scan_something_internal(@!level:small_number;@!negative:boolean); + {fetch an internal parameter} +var m:halfword; {|chr_code| part of the operand token} +@!p:0..nest_size; {index into |nest|} +begin m:=cur_chr; +case cur_cmd of +def_code: @<Fetch a character code from some table@>; +toks_register,assign_toks,def_family,set_font,def_font: @<Fetch a token list or + font identifier, provided that |level=tok_val|@>; +@y +@p @t\4@>@<Declare procedures needed in |scan_something|@>@t@>@/ +procedure scan_something_internal(@!level:small_number;@!negative:boolean); + {fetch an internal parameter} +var m:halfword; {|chr_code| part of the operand token} +@!p:0..nest_size; {index into |nest|} +@!q:pointer; +begin m:=cur_chr; +case cur_cmd of +assign_kinsoku: @<Fetch breaking penalty from some table@>; +assign_inhibit_xsp_code: @<Fetch inhibit type from some table@>; +def_code: @<Fetch a character code from some table@>; +toks_register,assign_toks,def_family,set_font,def_font,def_jfont,def_tfont: + @<Fetch a token list or font identifier, provided that |level=tok_val|@>; +@z + +@x [26.414] l.8693 - pTeX: +if m=xord_code_base then scanned_result(xord[cur_val])(int_val) +else if m=xchr_code_base then scanned_result(xchr[cur_val])(int_val) +else if m=xprn_code_base then scanned_result(xprn[cur_val])(int_val) +else if m=math_code_base then scanned_result(ho(math_code(cur_val)))(int_val) +else if m<math_code_base then scanned_result(equiv(m+cur_val))(int_val) +else scanned_result(eqtb[m+cur_val].int)(int_val); +@y +if m=math_code_base then scanned_result(ho(math_code(cur_val)))(int_val) +else if m=kcat_code_base then scanned_result(equiv(m+Hi(cur_val)))(int_val) +else if m<math_code_base then + begin if check_kanji(cur_val)>0 then + scanned_result(equiv(m+Hi(cur_val)))(int_val) + else scanned_result(equiv(m+cur_val))(int_val) + end +else scanned_result(eqtb[m+cur_val].int)(int_val); +@z + +@x [26.420] l.8799 - pTeX: Fetch a box dimension: dir_node +if box(cur_val)=null then cur_val:=0 @+else cur_val:=mem[box(cur_val)+m].sc; +@y +if box(cur_val)=null then cur_val:=0 +else + begin q:=box(cur_val); + while (q<>null)and(box_dir(q)<>abs(direction)) do q:=link(q); + if q=null then + begin q:=new_dir_node(box(cur_val),abs(direction)); + cur_val:=mem[q+m].sc; + delete_glue_ref(space_ptr(q)); delete_glue_ref(xspace_ptr(q)); + free_node(q,box_node_size); + end + else cur_val:=mem[q+m].sc; + end; +@z + +@x [26.435] l.8940 - pTeX: scan_char_num +procedure scan_char_num; +begin scan_int; +if (cur_val<0)or(cur_val>255) then + begin print_err("Bad character code"); +@.Bad character code@> + help2("A character number must be between 0 and 255.")@/ + ("I changed this one to zero."); int_error(cur_val); cur_val:=0; + end; +end; +@y +procedure scan_char_num; +begin scan_int; +if ((cur_val<0)or(cur_val>255))and(not check_kanji(cur_val)) then {wchar_token} + begin print_err("Bad character code"); +@.Bad character code@> + help2("A character number must be between 0 and 255, or KANJI code.")@/ + ("I changed this one to zero."); int_error(cur_val); cur_val:=0; + end; +end; +@z + +@x [26.442] l.9045 - pTeX: KANJI character scanning +@<Scan an alphabetic character code into |cur_val|@>= +begin get_token; {suppress macro expansion} +if cur_tok<cs_token_flag then + begin cur_val:=cur_chr; + if cur_cmd<=right_brace then + if cur_cmd=right_brace then incr(align_state) + else decr(align_state); + end +else if cur_tok<cs_token_flag+single_base then + cur_val:=cur_tok-cs_token_flag-active_base +else cur_val:=cur_tok-cs_token_flag-single_base; +if cur_val>255 then + begin print_err("Improper alphabetic constant"); +@.Improper alphabetic constant@> + help2("A one-character control sequence belongs after a ` mark.")@/ + ("So I'm essentially inserting \0 here."); + cur_val:="0"; back_error; + end +else @<Scan an optional space@>; +end +@y +@<Scan an alphabetic character code into |cur_val|@>= +begin get_token; {suppress macro expansion} +if cur_tok<cs_token_flag then + if (cur_cmd=kanji)or(cur_cmd=kana)or(cur_cmd=other_kchar) then {wchar_token} + begin skip_mode:=false; cur_val:=tonum(cur_chr); + end + else begin cur_val:=cur_chr; + if cur_cmd<=right_brace then + if cur_cmd=right_brace then incr(align_state) + else decr(align_state); + end +else if cur_tok<cs_token_flag+single_base then + cur_val:=cur_tok-cs_token_flag-active_base +else cur_val:=cur_tok-cs_token_flag-single_base; +if (cur_val>255)and(cur_cmd<kanji) then + begin print_err("Improper alphabetic or KANJI constant"); +@.Improper alphabetic constant@> + help2("A one-character control sequence belongs after a ` mark.")@/ + ("So I'm essentially inserting \0 here."); + cur_val:="0"; back_error; + end +else @<Scan an optional space@>; +skip_mode:=true; +end +@z + +@x [26.455] l.9288 - pTeX: zw, zh: zenkaku width & height +if scan_keyword("em") then v:=(@<The em width for |cur_font|@>) +@.em@> +else if scan_keyword("ex") then v:=(@<The x-height for |cur_font|@>) +@.ex@> +else goto not_found; +@y +if scan_keyword("em") then v:=(@<The em width for |cur_font|@>) +@.em@> +else if scan_keyword("ex") then v:=(@<The x-height for |cur_font|@>) +@.ex@> +else if scan_keyword("zw") then @<The KANJI width for |cur_jfont|@> +@.ze@> +else if scan_keyword("zh") then @<The KANJI height for |cur_jfont|@> +@.zh@> +else goto not_found; +@z + +@x [26.458] l.9345 - pTeX: dimension unit: Q, H (1/4 mm) +else if scan_keyword("sp") then goto done +@.sp@> +@y +else if scan_keyword("H") then set_conversion(7227)(10160) +@.H@> +else if scan_keyword("Q") then set_conversion(7227)(10160) +@.Q@> +else if scan_keyword("sp") then goto done +@.sp@> +@z + +@x [27.464] l.9475 - pTeX: str_toks + if t=" " then t:=space_token + else t:=other_token+t; +@y + if (iskanji1(t))and(k+1<pool_ptr)and(iskanji2(str_pool[k+1])) then + begin t:=t*@'400+str_pool[k+1]; incr(k); + end + else if t=" " then t:=space_token + else t:=other_token+t; +@z + +@x [27.468] l.9531 - pTeX: convert KANJI code +@d number_code=0 {command code for \.{\\number}} +@d roman_numeral_code=1 {command code for \.{\\romannumeral}} +@d string_code=2 {command code for \.{\\string}} +@d meaning_code=3 {command code for \.{\\meaning}} +@d font_name_code=4 {command code for \.{\\fontname}} +@d job_name_code=5 {command code for \.{\\jobname}} +@y +@d number_code=0 {command code for \.{\\number}} +@d roman_numeral_code=1 {command code for \.{\\romannumeral}} +@d kansuji_code=2 {command code for \.{\\kansuji}} +@d string_code=3 {command code for \.{\\string}} +@d meaning_code=4 {command code for \.{\\meaning}} +@d font_name_code=5 {command code for \.{\\fontname}} +@d euc_code=6 {command code for \.{\\euc}} +@d sjis_code=7 {command code for \.{\\sjis}} +@d jis_code=8 {command code for \.{\\jis}} +@d kuten_code=9 {command code for \.{\\kuten}} +@d job_name_code=10 {command code for \.{\\jobname}} +@z + +@x [27.468] l.9547 - pTeX: +primitive("fontname",convert,font_name_code);@/ +@!@:font_name_}{\.{\\fontname} primitive@> +@y +primitive("fontname",convert,font_name_code);@/ +@!@:font_name_}{\.{\\fontname} primitive@> +primitive("kansuji",convert,kansuji_code); +@!@:kansuji_}{\.{\\kansuji} primitive@> +primitive("euc",convert,euc_code); +@!@:euc_}{\.{\\euc} primitive@> +primitive("sjis",convert,sjis_code); +@!@:sjis_}{\.{\\sjis} primitive@> +primitive("jis",convert,jis_code); +@!@:jis_}{\.{\\jis} primitive@> +primitive("kuten",convert,kuten_code); +@!@:kuten_}{\.{\\kuten} primitive@> +@z + +@x [27.469] l.9558 - pTeX: + font_name_code: print_esc("fontname"); +@y + font_name_code: print_esc("fontname"); + kansuji_code: print_esc("kansuji"); + euc_code:print_esc("euc"); + sjis_code:print_esc("sjis"); + jis_code:print_esc("jis"); + kuten_code:print_esc("kuten"); +@z + +@x [27.470] l.9566 - pTeX: convert KANJI code continue +@p procedure conv_toks; +var old_setting:0..max_selector; {holds |selector| setting} +@y +@p procedure conv_toks; +var old_setting:0..max_selector; {holds |selector| setting} +@!cx:KANJI_code; {temporary register for KANJI} +@z + +@x [27.471] l.9577 - pTeX: convert KANJI code continue +@ @<Scan the argument for command |c|@>= +case c of +number_code,roman_numeral_code: scan_int; +string_code, meaning_code: begin save_scanner_status:=scanner_status; + scanner_status:=normal; get_token; scanner_status:=save_scanner_status; + end; +@y +@ @<Scan the argument for command |c|@>= +KANJI(cx):=0; +case c of +number_code,roman_numeral_code, +kansuji_code,euc_code,sjis_code,jis_code,kuten_code: scan_int; +string_code, meaning_code: begin save_scanner_status:=scanner_status; + scanner_status:=normal; get_token; + if (cur_cmd=kanji)or(cur_cmd=kana)or(cur_cmd=other_kchar) then {wchar_token} + KANJI(cx):=cur_tok; + scanner_status:=save_scanner_status; + end; +@z + +@x [27.471] l.9587 - pTeX: convert KANJI code continue +@ @<Print the result of command |c|@>= +case c of +number_code: print_int(cur_val); +roman_numeral_code: print_roman_int(cur_val); +string_code:if cur_cs<>0 then sprint_cs(cur_cs) + else print_char(cur_chr); +@y +@ @<Print the result of command |c|@>= +case c of +number_code: print_int(cur_val); +roman_numeral_code: print_roman_int(cur_val); +jis_code: begin + if (proc_kanji_code=sjis_enc) then cur_val:=JIStoSJIS(cur_val) + else cur_val:=JIStoEUC(cur_val); + print_int(cur_val); end; +euc_code: begin + if (proc_kanji_code=sjis_enc) then cur_val:=EUCtoSJIS(cur_val) + else do_nothing; + print_int(cur_val); end; +sjis_code: begin + if (proc_kanji_code=sjis_enc) then do_nothing + else cur_val:=SJIStoEUC(cur_val); + print_int(cur_val); end; +kuten_code: begin + if (proc_kanji_code=sjis_enc) then cur_val:=KUTENtoSJIS(cur_val) + else cur_val:=KUTENtoEUC(cur_val); + print_int(cur_val); end; +kansuji_code: print_kansuji(cur_val); +string_code:if cur_cs<>0 then sprint_cs(cur_cs) + else if KANJI(cx)=0 then print_char(cur_chr) + else print_kanji(cx); +@z + +@x [28.487] l.9852 - pTeX: iftdir, ifydir, iftbox, ifybox +@d if_case_code=16 { `\.{\\ifcase}' } +@y +@d if_case_code=16 { `\.{\\ifcase}' } +@d if_tdir_code=17 { `\.{\\iftdir}' } +@d if_ydir_code=18 { `\.{\\ifydir}' } +@d if_mdir_code=19 { `\.{\\ifmdir}' } +@d if_tbox_code=20 { `\.{\\iftbox}' } +@d if_ybox_code=21 { `\.{\\ifybox}' } +@z + +@x [28.487] l.9887 - pTeX: iftdir, ifydir, iftbox, ifybox +primitive("ifcase",if_test,if_case_code); +@!@:if_case_}{\.{\\ifcase} primitive@> +@y +primitive("ifcase",if_test,if_case_code); +@!@:if_case_}{\.{\\ifcase} primitive@> +primitive("iftdir",if_test,if_tdir_code); +@!@:if_tdir_}{\.{\\iftdir} primitive@> +primitive("ifydir",if_test,if_ydir_code); +@!@:if_ydir_}{\.{\\ifydir} primitive@> +primitive("ifmdir",if_test,if_mdir_code); +@!@:if_mdir_}{\.{\\ifmdir} primitive@> +primitive("iftbox",if_test,if_tbox_code); +@!@:if_tbox_}{\.{\\iftbox} primitive@> +primitive("ifybox",if_test,if_ybox_code); +@!@:if_ybox_}{\.{\\ifybox} primitive@> +@z + +@x [28.488] l.9907 - pTeX: iftdir, ifydir, iftbox, ifybox + if_case_code:print_esc("ifcase"); +@y + if_case_code:print_esc("ifcase"); + if_tdir_code:print_esc("iftdir"); + if_ydir_code:print_esc("ifydir"); + if_mdir_code:print_esc("ifmdir"); + if_tbox_code:print_esc("iftbox"); + if_ybox_code:print_esc("ifybox"); +@z + +@x [28.501] l.10073 - pTeX: iftdir, ifydir, iftbox, ifybox +if_void_code, if_hbox_code, if_vbox_code: @<Test box register status@>; +@y +if_tdir_code: b:=(abs(direction)=dir_tate); +if_ydir_code: b:=(abs(direction)=dir_yoko); +if_mdir_code: b:=(direction<0); +if_void_code, if_hbox_code, if_vbox_code, if_tbox_code, if_ybox_code: + @<Test box register status@>; +@z + +@x [28.505] l.10118 - pTeX: Test box register status : iftbox, ifybox +if this_if=if_void_code then b:=(p=null) +else if p=null then b:=false +else if this_if=if_hbox_code then b:=(type(p)=hlist_node) +else b:=(type(p)=vlist_node); +@y +if this_if=if_void_code then b:=(p=null) +else if p=null then b:=false +else begin + if type(p)=dir_node then p:=list_ptr(p); + if this_if=if_hbox_code then b:=(type(p)=hlist_node) + else if this_if=if_vbox_code then b:=(type(p)=vlist_node) + else if this_if=if_tbox_code then b:=(box_dir(p)=dir_tate) + else b:=(box_dir(p)=dir_yoko); + end +@z + +@x [28.502] l.10138 - pTeX: ifx : Test character : KANJI character +if (cur_cmd>active_char)or(cur_chr>255) then {not a character} + begin m:=relax; n:=256; + end +else begin m:=cur_cmd; n:=cur_chr; + end; +get_x_token_or_active_char; +if (cur_cmd>active_char)or(cur_chr>255) then + begin cur_cmd:=relax; cur_chr:=256; + end; +@y +if (cur_cmd=kanji)or(cur_cmd=kana)or(cur_cmd=other_kchar) then + begin m:=cur_cmd; n:=cur_chr; + end +else if (cur_cmd>active_char)or(cur_chr>255) then + begin m:=relax; n:=256; + end +else begin m:=cur_cmd; n:=cur_chr; + end; +get_x_token_or_active_char; +if (cur_cmd=kanji)or(cur_cmd=kana)or(cur_cmd=other_kchar) then + begin cur_cmd:=cur_cmd; + end {dummy} +else if (cur_cmd>active_char)or(cur_chr>255) then + begin cur_cmd:=relax; cur_chr:=256; + end; +@z + +@x [29.523] l.10571 - pTeX: xord +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 +if name_of_file then libc_free (name_of_file); +name_of_file := xmalloc (1 + n + (b - a + 1) + format_ext_length + 1); +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]]); +@z + +@x [29.526] l.10668 - pTeX: scan file name +loop@+begin if (cur_cmd>other_char)or(cur_chr>255) then {not a character} + begin back_input; goto done; + end; + {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; + get_x_token; + end; +done: end_name; name_in_progress:=false; +@y +skip_mode:=false; +loop@+begin + if (cur_cmd=kanji)or(cur_cmd=kana)or(cur_cmd=other_kchar) then {is kanji} + begin str_room(2); + append_char(cur_chr div 256); {kanji upper byte} + append_char(cur_chr mod 256); {kanji lower byte} + end + else if (cur_cmd>other_char)or(cur_chr>255) then {not a alphabet} + begin back_input; goto done; + end + {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.} + else if ((cur_chr=" ") and (state<>token_list) and (loc>limit)) or not more_name(cur_chr) then goto done; + get_x_token; + end; +done: end_name; name_in_progress:=false; +skip_mode:=true; +@z + +@x l.10797 - pTeX +if enctex_enabled_p then + begin wlog_cr; wlog(encTeX_banner); wlog(', reencoding enabled'); + if translate_filename then + begin wlog_cr; + wlog(' (\xordcode, \xchrcode, \xprncode overridden by TCX)'); + end; + end; +@y +@z + +@x [29.536] l.10834 - pTeX: +begin +if src_specials_p or file_line_error_style_p or parse_first_line_p +then + wlog(banner_k) +else + wlog(banner); +@y +begin +if src_specials_p or file_line_error_style_p or parse_first_line_p +then + wlog(banner_k) +else + wlog(banner); +wlog(' ('); +case proc_kanji_code of + jis_enc: wlog('jis'); + euc_enc: wlog('euc'); + sjis_enc: wlog('sjis'); + othercases wterm('?'); +endcases; +wlog(')'); +@z + +@x [30.560] l.10968 - pTeX: +This is called BigEndian order. +@!@^BigEndian order@> +@y +This is called BigEndian order. +@!@^BigEndian order@> + +We use to get \TeX\ knowledge about KANJI fonts from \.{JFM} files. +The \.{JFM} format holds more two 16-bit integers ,|id| and |nt|, +at the top of the file. +$$\vbox{\halign{\hfil#&$\null=\null$#\hfil\cr +|id|&identification code of the file;\cr +|nt|&number of words in the |char_type| table;\cr}}$$ +The identification byte, |id| equals~11 or~9. When \TeX read a font file, +the |id| equals~11 or~9 then the font is the \.{JFM}, othercases it is +the \.{TFM} file. The \.{TFM} holds |lf| at the same postion of |id|, +usually it take a larger number than~9 or~11. +The |nt| is nonngative and less than $2^{15}$. + +We must have |ec=0|, +$$\hbox{|lf=7+lh+nt+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np|.}$$ + +@d yoko_jfm_id=11 {for `yoko-kumi' fonts} +@d tate_jfm_id=9 {for `tate-kumi' fonts} +@z + +@x [30.544] l.11085 - pTeX: gk_tag +operation looks for both |list_tag| and |ext_tag|. +@y +operation looks for both |list_tag| and |ext_tag|. + +If the \.{JFM}, the |lig_tag| is called |gk_tag|. The |gk_tag| means that +this character has a glue/kerning program starting at position |remainder| +in the |glue_kern| array. And a \.{JFM} not used |tag=2| and |tag=3|. +@z + +@x [30.544] l.11088 - pTeX: gk_tag +@d lig_tag=1 {character has a ligature/kerning program} +@y +@d lig_tag=1 {character has a ligature/kerning program} +@d gk_tag=1 {character has a glue/kerning program} +@z + +@x [30.549] l.11228 - pTeX: +@<Glob...@>= +@!font_info: ^fmemory_word; +@y +@<Glob...@>= +@!font_info: ^memory_word; {pTeX: use halfword for |char_type| table.} +@!font_dir: ^eight_bits; + {pTeX: direction of fonts, 0 is default, 1 is Yoko, 2 is Tate} +@!font_num_ext: ^integer; + {pTeX: number of the |char_type| table.} +@z + +@x [30.550] l.11270 - pTeX: +@!char_base: ^integer; + {base addresses for |char_info|} +@y +@!char_base: ^integer; + {base addresses for |char_info|} +@!ctype_base: ^integer; + {pTeX: base addresses for KANJI character type parameters} +@z + +@x [30.554] l.11373 - pTeX: +@d orig_char_info_end(#)==#].qqqq +@d orig_char_info(#)==font_info[char_base[#]+orig_char_info_end +@y +@d orig_char_info_end(#)==#].qqqq +@d orig_char_info(#)==font_info[char_base[#]+orig_char_info_end +@# +@d kchar_code_end(#)==#].hh.rh +@d kchar_code(#)==font_info[ctype_base[#]+kchar_code_end +@d kchar_type_end(#)==#].hh.lhfield +@d kchar_type(#)==font_info[ctype_base[#]+kchar_type_end +@z + +@x [30.557] l.11413 - pTeX: glue_kern_start +@d lig_kern_start(#)==lig_kern_base[#]+rem_byte {beginning of lig/kern program} +@y +@d lig_kern_start(#)==lig_kern_base[#]+rem_byte {beginning of lig/kern program} +@d glue_kern_start(#)==lig_kern_base[#]+rem_byte + {beginning of glue/kern program} +@z + +@x [30.560] l.11457 - pTeX: jfm_flag, jfm_id, nt, cx +var k:font_index; {index into |font_info|} +@y +var k:font_index; {index into |font_info|} +@!jfm_flag:dir_default..dir_tate; {direction of the \.{JFM}} +@!nt:halfword; {number of the |char_type| tables} +@!cx:KANJI_code; {kanji code} +@z + +@x [30.565] l.11548 - pTeX: read tfm size +@ @<Read the {\.{TFM}} size fields@>= +begin read_sixteen(lf); +fget; read_sixteen(lh); +fget; read_sixteen(bc); +fget; read_sixteen(ec); +if (bc>ec+1)or(ec>255) then abort; +if bc>255 then {|bc=256| and |ec=255|} + begin bc:=1; ec:=0; + end; +fget; read_sixteen(nw); +fget; read_sixteen(nh); +fget; read_sixteen(nd); +fget; read_sixteen(ni); +fget; read_sixteen(nl); +fget; read_sixteen(nk); +fget; read_sixteen(ne); +fget; read_sixteen(np); +if lf<>6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np then abort; +end +@y +@ @<Read the {\.{TFM}} size fields@>= +begin read_sixteen(lf); +fget; read_sixteen(lh); +if lf=yoko_jfm_id then + begin jfm_flag:=dir_yoko; nt:=lh; + fget; read_sixteen(lf); + fget; read_sixteen(lh); + end +else if lf=tate_jfm_id then + begin jfm_flag:=dir_tate; nt:=lh; + fget; read_sixteen(lf); + fget; read_sixteen(lh); + end +else begin jfm_flag:=dir_default; nt:=0; + end; +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 jfm_flag<>dir_default then + begin if lf<>7+lh+nt+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np then abort + end +else + begin if lf<>6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np then abort + end +end +@z + +@x [30.566] l.11574 - pTeX: set font_dir & font_num_ext +@<Use size fields to allocate font information@>= +lf:=lf-6-lh; {|lf| words should be loaded into |font_info|} +if np<7 then lf:=lf+7-np; {at least seven parameters will appear} +if (font_ptr=font_max)or(fmem_ptr+lf>font_mem_size) then + @<Apologize for not loading the font, |goto done|@>; +f:=font_ptr+1; +char_base[f]:=fmem_ptr-bc; +width_base[f]:=char_base[f]+ec+1; +height_base[f]:=width_base[f]+nw; +depth_base[f]:=height_base[f]+nh; +italic_base[f]:=depth_base[f]+nd; +lig_kern_base[f]:=italic_base[f]+ni; +kern_base[f]:=lig_kern_base[f]+nl-kern_base_offset; +exten_base[f]:=kern_base[f]+kern_base_offset+nk; +param_base[f]:=exten_base[f]+ne +@y +@<Use size fields to allocate font information@>= +if jfm_flag<>dir_default then + lf:=lf-7-lh {If \.{JFM}, |lf| holds more two-16bit records than \.{TFM}} +else + lf:=lf-6-lh; {|lf| words should be loaded into |font_info|} +if np<7 then lf:=lf+7-np; {at least seven parameters will appear} +if (font_ptr=font_max)or(fmem_ptr+lf>font_mem_size) then + @<Apologize for not loading the font, |goto done|@>; +f:=font_ptr+1; +font_dir[f]:=jfm_flag; +font_num_ext[f]:=nt; +ctype_base[f]:=fmem_ptr; +char_base[f]:=ctype_base[f]+nt-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; +@z + +@x [30.569] l.11619 - pTeX: read char_type +@ @<Read character data@>= +for k:=fmem_ptr to width_base[f]-1 do + begin store_four_quarters(font_info[k].qqqq); +@y +@ @<Read character data@>= +if jfm_flag<>dir_default then + for k:=ctype_base[f] to ctype_base[f]+nt-1 do + begin + fget; read_sixteen(cx); font_info[k].hh.rh:=tokanji(cx); {|kchar_code|} + fget; read_sixteen(cx); font_info[k].hh.lhfield:=tonum(cx); {|kchar_type|} + end; +for k:=char_base[f]+bc to width_base[f]-1 do + begin store_four_quarters(font_info[k].qqqq); +@z + +@x [30.570] l.11638 - pTeX: +@d current_character_being_worked_on==k+bc-fmem_ptr +@y +@d current_character_being_worked_on==k-char_base[f] +@z + +@x [30.573] l.11704 - pTeX: jfm + 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; +@y + 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 begin + if jfm_flag<>dir_default then begin if d>=ne then abort; end + else check_existence(d); {check ligature} + end 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; +@z + +@x [30.574] l.11720 - pTeX: read jfm exten +for k:=exten_base[f] to param_base[f]-1 do + begin store_four_quarters(font_info[k].qqqq); +@y +if jfm_flag<>dir_default then + for k:=exten_base[f] to param_base[f]-1 do + store_scaled(font_info[k].sc) {NOTE: this area subst for glue program} +else for k:=exten_base[f] to param_base[f]-1 do + begin store_four_quarters(font_info[k].qqqq); +@z + +@x [30.576] l.11765 - pTeX: adjust ctype_base +adjust(char_base); adjust(width_base); adjust(lig_kern_base); +@y +adjust(ctype_base); +adjust(char_base); adjust(width_base); adjust(lig_kern_base); +@z + +@x [30.577] l.11778 - pTeX: jfont, tfont +if cur_cmd=def_font then f:=cur_font +@y +if cur_cmd=def_jfont then f:=cur_jfont +else if cur_cmd=def_tfont then f:=cur_tfont +else if cur_cmd=def_font then f:=cur_font +@z + +@x +@p procedure char_warning(@!f:internal_font_number;@!c:eight_bits); +begin if tracing_lost_chars>0 then + begin begin_diagnostic; + print_nl("Missing character: There is no "); +@.Missing character@> + print_ASCII(c); print(" in font "); + slow_print(font_name[f]); print_char("!"); end_diagnostic(false); + end; +end; +@y +@d print_lc_hex(#)==l:=#; + if l<10 then print_char(l+"0")@+else print_char(l-10+"a") + +@p procedure char_warning(@!f:internal_font_number;@!c:eight_bits); +var @!l:0..255; {small indices or counters} +begin if tracing_lost_chars>0 then + begin begin_diagnostic; + print_nl("Missing character: There is no "); +@.Missing character@> + if (c<" ")or(c>"~") then + begin print_char("^"); print_char("^"); + if c<64 then print_char(c+64) + else if c<128 then print_char(c-64) + else begin print_lc_hex(c div 16); print_lc_hex(c mod 16); end + end + else print_ASCII(c); + print(" in font "); + slow_print(font_name[f]); print_char("!"); end_diagnostic(false); + end; +end; +@z + +@x [31.586] l.12189 - pTeX: define set2 +@d set1=128 {typeset a character and move right} +@y +@d set1=128 {typeset a character and move right} +@d set2=129 {typeset a character and move right} +@z +@x [31.586] l.12214 - pTeX: define dirchg +@d post_post=249 {postamble ending} +@y +@d post_post=249 {postamble ending} +@d dirchg=255 {direction change} +@z + +@x [31.587] l.12246 - pTeX: ex_id_byte +@d id_byte=2 {identifies the kind of \.{DVI} files described here} +@y +@d id_byte=2 {identifies the kind of \.{DVI} files described here} +@d ex_id_byte=3 {identifies the kind of extended \.{DVI} files} +@z + +@x [32.590] l.12329 - pTeX: ex_id_byte: This dvi is extended! +@ The last part of the postamble, following the |post_post| byte that +signifies the end of the font definitions, contains |q|, a pointer to the +|post| command that started the postamble. An identification byte, |i|, +comes next; this currently equals~2, as in the preamble. +@y +@ The last part of the postamble, following the |post_post| byte that +signifies the end of the font definitions, contains |q|, a pointer to the +|post| command that started the postamble. An identification byte, |i|, +comes next; this equals~2 or~3. If not used p\TeX primitives then the +identification byte equals~2, othercase this is set to~3. +@z + +@x [32.592] l.12405 - pTeX: + {character and font in current |char_node|} +@!c:quarterword; +@!f:internal_font_number; +@y + {character and font in current |char_node|} +@!c:quarterword; +@!f:internal_font_number; +@!dir_used:boolean; {Is this dvi extended?} +@z + +@x [32.593] l.12414 - pTeX: dir_used: Is this dvi extended? +doing_leaders:=false; dead_cycles:=0; cur_s:=-1; +@y +doing_leaders:=false; dead_cycles:=0; cur_s:=-1; dir_used:=false; +@z + +@x [32.617] l.12846 - pTeX: Initialize dvi_dir as shipout begins +dvi_h:=0; dvi_v:=0; cur_h:=h_offset; dvi_f:=null_font; +@y +dvi_h:=0; dvi_v:=0; cur_h:=h_offset; dvi_f:=null_font; +dvi_dir:=dir_yoko; cur_dir:=dvi_dir; +@z + +@x [32.619] l.12892 - pTeX: hlist_out Kanji, disp_node +procedure hlist_out; {output an |hlist_node| box} +label reswitch, move_past, fin_rule, next_p, continue, found; +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, continue, found; +var base_line: scaled; {the baseline coordinate for this box} +@!disp: scaled; {displacement} +@!save_dir:eight_bits; {what |dvi_dir| should pop to} +@!jc:KANJI_code; {temporary register for KANJI codes} +@!ksp_ptr:pointer; {position of |auto_spacing_glue| in the hlist} +@z +@x [32.619] l.12913 - pTeX: hlist_out Kanji, disp_node +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; +@y +ksp_ptr:=space_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; +synch_dir; +base_line:=cur_v; left_edge:=cur_h; disp:=0; +@z + +@x [32.622] l.12945 - pTeX: chain +@<Output node |p| for |hlist_out|...@>= +reswitch: if is_char_node(p) then + begin synch_h; synch_v; + repeat f:=font(p); c:=character(p); + if f<>dvi_f then @<Change font |dvi_f| to |f|@>; + if font_ec[f]>=qo(c) then if font_bc[f]<=qo(c) then + if char_exists(orig_char_info(f)(c)) then {N.B.: not |char_info|} + begin if c>=qi(128) then dvi_out(set1); + dvi_out(qo(c));@/ + cur_h:=cur_h+char_width(f)(orig_char_info(f)(c)); + goto continue; + end; + if mltex_enabled_p then + @<Output a substitution, |goto continue| if not possible@>; +continue: + p:=link(p); + until not is_char_node(p); + dvi_h:=cur_h; + end +else @<Output the non-|char_node| |p| for |hlist_out| + and move to the next node@> +@y +@<Output node |p| for |hlist_out|...@>= +reswitch: if is_char_node(p) then + begin synch_h; synch_v; + chain:=false; + repeat f:=font(p); c:=character(p); + if f<>dvi_f then @<Change font |dvi_f| to |f|@>; + if font_dir[f]=dir_default then + begin chain:=false; + if font_ec[f]>=qo(c) then if font_bc[f]<=qo(c) then + if char_exists(orig_char_info(f)(c)) then {N.B.: not |char_info|} + begin if c>=qi(128) then dvi_out(set1); + dvi_out(qo(c));@/ + cur_h:=cur_h+char_width(f)(orig_char_info(f)(c)); + goto continue; + end; + if mltex_enabled_p then + @<Output a substitution, |goto continue| if not possible@>; +continue: + end + else + begin if chain=false then chain:=true + else begin cur_h:=cur_h+width(ksp_ptr); + if g_sign<>normal then + begin if g_sign=stretching then + begin if stretch_order(ksp_ptr)=g_order then + cur_h:=cur_h+round(float(glue_set(this_box))*stretch(ksp_ptr)); +@^real multiplication@> + end + else + begin if shrink_order(ksp_ptr)=g_order then + cur_h:=cur_h-round(float(glue_set(this_box))*shrink(ksp_ptr)); +@^real multiplication@> + end; + end; + synch_h; + end; + p:=link(p); + if (proc_kanji_code=sjis_enc) then jc:=SJIStoJIS(KANJI(info(p))) + else jc:=EUCtoJIS(KANJI(info(p))); + dvi_out(set2); dvi_out(Hi(jc)); dvi_out(Lo(jc)); + cur_h:=cur_h+char_width(f)(orig_char_info(f)(c)); {not |jc|} + end; + dvi_h:=cur_h; p:=link(p); + until not is_char_node(p); + chain:=false; + end +else @<Output the non-|char_node| |p| for |hlist_out| + and move to the next node@> +@z + +@x [32.623] l.12982 - pTeX: disp_node, dir_node +@ @<Output the non-|char_node| |p| for |hlist_out|...@>= +begin case type(p) of +hlist_node,vlist_node:@<Output a box in an hlist@>; +rule_node: begin rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p); + goto fin_rule; + end; +whatsit_node: @<Output the whatsit node |p| in an hlist@>; +@y +@ @<Output the non-|char_node| |p| for |hlist_out|...@>= +begin case type(p) of +hlist_node,vlist_node,dir_node:@<Output a box in an hlist@>; +rule_node: begin rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p); + goto fin_rule; + end; +whatsit_node: @<Output the whatsit node |p| in an hlist@>; +disp_node: begin disp:=disp_dimen(p); cur_v:=base_line+disp; end; +@z + +@x [32.624] l.13000 - pTeX: output a box(and dir_node) with disp +@ @<Output a box in an hlist@>= +if list_ptr(p)=null then cur_h:=cur_h+width(p) +else begin save_h:=dvi_h; save_v:=dvi_v; + cur_v:=base_line+shift_amount(p); {shift the box down} + temp_ptr:=p; edge:=cur_h; + if type(p)=vlist_node then vlist_out@+else hlist_out; + dvi_h:=save_h; dvi_v:=save_v; + cur_h:=edge+width(p); cur_v:=base_line; + end +@y +@ @<Output a box in an hlist@>= +if list_ptr(p)=null then cur_h:=cur_h+width(p) +else begin save_h:=dvi_h; save_v:=dvi_v; save_dir:=dvi_dir; + cur_v:=base_line+disp+shift_amount(p); {shift the box down} + temp_ptr:=p; edge:=cur_h; + case type(p) of + hlist_node:hlist_out; + vlist_node:vlist_out; + dir_node:dir_out; + endcases; + dvi_h:=save_h; dvi_v:=save_v; dvi_dir:=save_dir; + cur_h:=edge+width(p); cur_v:=base_line+disp; cur_dir:=save_dir; + end +@z + +@x [32.625] l.13010 - pTeX: Output a rule with disp +@ @<Output a rule in an hlist@>= +if is_running(rule_ht) then rule_ht:=height(this_box); +if is_running(rule_dp) then rule_dp:=depth(this_box); +@y +@ @<Output a rule in an hlist@>= +if is_running(rule_ht) then rule_ht:=height(this_box)+disp; +if is_running(rule_dp) then rule_dp:=depth(this_box)-disp; +@z + +@x [32.629] l.13103 - pTeX: Output a leader box(and dir_node) with disp +@<Output a leader box at |cur_h|, ...@>= +begin cur_v:=base_line+shift_amount(leader_box); synch_v; save_v:=dvi_v;@/ +synch_h; save_h:=dvi_h; temp_ptr:=leader_box; +outer_doing_leaders:=doing_leaders; doing_leaders:=true; +if type(leader_box)=vlist_node then vlist_out@+else hlist_out; +doing_leaders:=outer_doing_leaders; +dvi_v:=save_v; dvi_h:=save_h; cur_v:=base_line; +cur_h:=save_h+leader_wd+lx; +end +@y +@<Output a leader box at |cur_h|, ...@>= +begin cur_v:=base_line+disp+shift_amount(leader_box); synch_v; save_v:=dvi_v;@/ +synch_h; save_h:=dvi_h; save_dir:=dvi_dir; temp_ptr:=leader_box; +outer_doing_leaders:=doing_leaders; doing_leaders:=true; +case type(leader_box) of + hlist_node:hlist_out; + vlist_node:vlist_out; + dir_node:dir_out; +endcases; +doing_leaders:=outer_doing_leaders; +dvi_v:=save_v; dvi_h:=save_h; dvi_dir:=save_dir; +cur_v:=base_line; cur_h:=save_h+leader_wd+lx; cur_dir:=save_dir; +end +@z + +@x [32.630] l.13133 - pTeX: vlist_out +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); +@y +@!save_dir:integer; {what |dvi_dir| should pop to} +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; +synch_dir; +left_edge:=cur_h; cur_v:=cur_v-height(this_box); +@z + +@x [32.632] l.13155 - pTeX: output non-char-node +@ @<Output the non-|char_node| |p| for |vlist_out|@>= +begin case type(p) of +hlist_node,vlist_node:@<Output a box in a vlist@>; +rule_node: begin rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p); + goto fin_rule; + end; +@y +@ @<Output the non-|char_node| |p| for |vlist_out|@>= +begin case type(p) of +hlist_node,vlist_node,dir_node: @<Output a box in a vlist@>; +rule_node: begin rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p); + goto fin_rule; + end; +@z + +@x [32.633] l.13175 - pTeX: Output a box in a vlist +@<Output a box in a vlist@>= +if list_ptr(p)=null then cur_v:=cur_v+height(p)+depth(p) +else begin cur_v:=cur_v+height(p); synch_v; + save_h:=dvi_h; save_v:=dvi_v; + cur_h:=left_edge+shift_amount(p); {shift the box right} + temp_ptr:=p; + if type(p)=vlist_node then vlist_out@+else hlist_out; + dvi_h:=save_h; dvi_v:=save_v; + cur_v:=save_v+depth(p); cur_h:=left_edge; + end +@y +@<Output a box in a vlist@>= +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; save_dir:=dvi_dir; + cur_h:=left_edge+shift_amount(p); {shift the box right} + temp_ptr:=p; + case type(p) of + hlist_node:hlist_out; + vlist_node:vlist_out; + dir_node:dir_out; + endcases; + dvi_h:=save_h; dvi_v:=save_v; dvi_dir:=save_dir; + cur_v:=save_v+depth(p); cur_h:=left_edge; cur_dir:=save_dir; + end +@z + +@x [32.637] l.13256 - pTeX: Output a leader in a vlist +@<Output a leader box at |cur_v|, ...@>= +begin cur_h:=left_edge+shift_amount(leader_box); synch_h; save_h:=dvi_h;@/ +cur_v:=cur_v+height(leader_box); synch_v; save_v:=dvi_v; +temp_ptr:=leader_box; +outer_doing_leaders:=doing_leaders; doing_leaders:=true; +if type(leader_box)=vlist_node then vlist_out@+else hlist_out; +doing_leaders:=outer_doing_leaders; +dvi_v:=save_v; dvi_h:=save_h; cur_h:=left_edge; +cur_v:=save_v-height(leader_box)+leader_ht+lx; +end +@y +@<Output a leader box at |cur_v|, ...@>= +begin 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; save_dir:=dvi_dir; +temp_ptr:=leader_box; +outer_doing_leaders:=doing_leaders; doing_leaders:=true; +case type(leader_box) of + hlist_node:hlist_out; + vlist_node:vlist_out; + dir_node:dir_out; +endcases; +doing_leaders:=outer_doing_leaders; +dvi_v:=save_v; dvi_h:=save_h; dvi_dir:=save_dir; +cur_h:=left_edge; cur_v:=save_v-height(leader_box)+leader_ht+lx; +cur_dir:=save_dir; +end +@z + +@x [32.638] l.13270 - pTeX: ship out +@p procedure ship_out(@!p:pointer); {output the box |p|} +label done; +var page_loc:integer; {location of the current |bop|} +@y +@p procedure ship_out(@!p:pointer); {output the box |p|} +label done; +var page_loc:integer; {location of the current |bop|} +@!del_node:pointer; {used when delete the |dir_node| continued box} +@z +@x [32.640] l.13294 - pTeX: ship out +@<Ship box |p| out@>; +@y +if type(p)=dir_node then + begin del_node:=p; p:=list_ptr(p); + delete_glue_ref(space_ptr(del_node)); + delete_glue_ref(xspace_ptr(del_node)); + free_node(del_node,box_node_size); + end; +flush_node_list(link(p)); link(p):=null; +if box_dir(p)<>dir_yoko then p:=new_dir_node(p,dir_yoko); +@<Ship box |p| out@>; +@z + +@x [32.641] l.13327 - pTeX: dir_node +if type(p)=vlist_node then vlist_out@+else hlist_out; +@y +case type(p) of + hlist_node:hlist_out; + vlist_node:vlist_out; + dir_node:dir_out; +endcases; +@z + +@x [33.642] l.13394 - pTeX: postamble's id_byte + @<Output the font definitions for all fonts that were used@>; + dvi_out(post_post); dvi_four(last_bop); dvi_out(id_byte);@/ +@y + @<Output the font definitions for all fonts that were used@>; + dvi_out(post_post); dvi_four(last_bop); + if dir_used then dvi_out(ex_id_byte) else dvi_out(id_byte);@/ +@z + +@x [33.647] l.13515 - pTeX: cur_kanji_skip, cur_xkanji_skip, last_disp +@< Glob...@>= +@!adjust_tail:pointer; {tail of adjustment list} +@y +@< Glob...@>= +@!adjust_tail:pointer; {tail of adjustment list} +@!last_disp:scaled; {displacement at end of list} +@!cur_kanji_skip:pointer; +@!cur_xkanji_skip:pointer; +@z + +@x [33.648] l.13518 - pTeX: cur_kanji_skip, cur_xkanji_skip +@ @<Set init...@>=adjust_tail:=null; last_badness:=0; +@y +@ @<Set init...@>=adjust_tail:=null; last_badness:=0; + cur_kanji_skip:=zero_glue; cur_xkanji_skip:=zero_glue; +{ koko + |incr(glue_ref_count(cur_kanji_skip));| + |incr(glue_ref_count(cur_xkanji_skip));| +} +@z + +@x [33.649] l.13522 - pTeX: hpack +@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} +@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} +@!k:pointer; {points to a |kanji_space| specification} +@!disp:scaled; {displacement} +@z + +@x [33.649] l.13533 - pTeX: hpack +begin last_badness:=0; r:=get_node(box_node_size); type(r):=hlist_node; +subtype(r):=min_quarterword; shift_amount(r):=0; +q:=r+list_offset; link(q):=p;@/ +h:=0; @<Clear dimensions to zero@>; +while p<>null do @<Examine node |p| in the hlist, taking account of its effect + on the dimensions of the new box, or moving it to the adjustment list; + then advance |p| to the next node@>; +if adjust_tail<>null then link(adjust_tail):=null; +height(r):=h; depth(r):=d;@/ +@<Determine the value of |width(r)| and the appropriate glue setting; + then |return| or |goto common_ending|@>; +common_ending: @<Finish issuing a diagnostic message + for an overfull or underfull hbox@>; +exit: hpack:=r; +end; +@y +begin last_badness:=0; r:=get_node(box_node_size); type(r):=hlist_node; +subtype(r):=min_quarterword; shift_amount(r):=0; +space_ptr(r):=cur_kanji_skip; xspace_ptr(r):=cur_xkanji_skip; +add_glue_ref(cur_kanji_skip); add_glue_ref(cur_xkanji_skip); +k:=cur_kanji_skip; +q:=r+list_offset; link(q):=p;@/ +h:=0; @<Clear dimensions to zero@>; +disp:=0; +while p<>null do @<Examine node |p| in the hlist, taking account of its effect + on the dimensions of the new box, or moving it to the adjustment list; + then advance |p| to the next node@>; +if adjust_tail<>null then link(adjust_tail):=null; +height(r):=h; depth(r):=d;@/ +@<Determine the value of |width(r)| and the appropriate glue setting; + then |return| or |goto common_ending|@>; +common_ending: + @<Finish issuing a diagnostic message for an overfull or underfull hbox@>; +exit: last_disp:=disp; hpack:=r; +end; +@z + +@x [33.651] l.13556 - pTeX: dir_node, disp_node, reset chain +@ @<Examine node |p| in the hlist, taking account of its effect...@>= +@^inner loop@> +begin reswitch: while is_char_node(p) do + @<Incorporate character dimensions into the dimensions of + the hbox that will contain~it, then move to the next node@>; +if p<>null then + begin case type(p) of + hlist_node,vlist_node,rule_node,unset_node: + @<Incorporate box dimensions into the dimensions of + the hbox that will contain~it@>; + ins_node,mark_node,adjust_node: if adjust_tail<>null then + @<Transfer node |p| to the adjustment list@>; + whatsit_node:@<Incorporate a whatsit node into an hbox@>; + glue_node:@<Incorporate glue into the horizontal totals@>; + kern_node,math_node: x:=x+width(p); + ligature_node: @<Make node |p| look like a |char_node| + and |goto reswitch|@>; + othercases do_nothing + endcases;@/ + p:=link(p); + end; +end +@y +@ @<Examine node |p| in the hlist, taking account of its effect...@>= +@^inner loop@> +begin reswitch: chain:=false; +while is_char_node(p) do + @<Incorporate character dimensions into the dimensions of + the hbox that will contain~it, then move to the next node@>; +if p<>null then + begin case type(p) of + hlist_node,vlist_node,dir_node,rule_node,unset_node: + @<Incorporate box dimensions into the dimensions of + the hbox that will contain~it@>; + ins_node,mark_node,adjust_node: + if adjust_tail<>null then @<Transfer node |p| to the adjustment list@>; + whatsit_node:@<Incorporate a whatsit node into an hbox@>; + disp_node:disp:=disp_dimen(p); + glue_node:@<Incorporate glue into the horizontal totals@>; + kern_node,math_node:x:=x+width(p); + ligature_node:@<Make node |p| look like a |char_node| and |goto reswitch|@>; + othercases do_nothing + endcases;@/ + p:=link(p); + end; +end +@z + +@x [33.653] l.13589 - pTeX: displacement +@<Incorporate box dimensions into the dimensions of the hbox...@>= +begin x:=x+width(p); +if type(p)>=rule_node then s:=0 @+else s:=shift_amount(p); +if height(p)-s>h then h:=height(p)-s; +if depth(p)+s>d then d:=depth(p)+s; +end +@y +@<Incorporate box dimensions into the dimensions of the hbox...@>= +begin x:=x+width(p); +if type(p)>=rule_node then s:=disp @+else s:=shift_amount(p)+disp; +if height(p)-s>h then h:=height(p)-s; +if depth(p)+s>d then d:=depth(p)+s; +end +@z + +@x [33.654] l.13601 - pTeX: auto spacing, displacement +@<Incorporate character dimensions into the dimensions of the hbox...@>= +begin f:=font(p); i:=char_info(f)(character(p)); hd:=height_depth(i); +x:=x+char_width(f)(i);@/ +s:=char_height(f)(hd);@+if s>h then h:=s; +s:=char_depth(f)(hd);@+if s>d then d:=s; +p:=link(p); +end +@y +@<Incorporate character dimensions into the dimensions of the hbox...@>= +begin f:=font(p); i:=char_info(f)(character(p)); hd:=height_depth(i); +x:=x+char_width(f)(i);@/ +s:=char_height(f)(hd)-disp; if s>h then h:=s; +s:=char_depth(f)(hd)+disp; if s>d then d:=s; +if font_dir[f]<>dir_default then + begin p:=link(p); + if chain then + begin x:=x+width(k);@/ + o:=stretch_order(k); total_stretch[o]:=total_stretch[o]+stretch(k); + o:=shrink_order(k); total_shrink[o]:=total_shrink[o]+shrink(k); + end + else chain:=true; + end +else chain:=false; +p:=link(p); +end +@z + +@x [33.668] l.13779 - pTeX: vpackage +begin last_badness:=0; r:=get_node(box_node_size); type(r):=vlist_node; +subtype(r):=min_quarterword; shift_amount(r):=0; +@y +begin last_badness:=0; r:=get_node(box_node_size); type(r):=vlist_node; +subtype(r):=min_quarterword; shift_amount(r):=0; +space_ptr(r):=zero_glue; xspace_ptr(r):=zero_glue; +add_glue_ref(zero_glue); add_glue_ref(zero_glue); +@z + +@x [33.669] l.13797 - pTeX: dir_node +@ @<Examine node |p| in the vlist, taking account of its effect...@>= +begin if is_char_node(p) then confusion("vpack") +@:this can't happen vpack}{\quad vpack@> +else case type(p) of + hlist_node,vlist_node,rule_node,unset_node: + @<Incorporate box dimensions into the dimensions of + the vbox that will contain~it@>; +@y +@ @<Examine node |p| in the vlist, taking account of its effect...@>= +begin if is_char_node(p) then confusion("vpack") +@:this can't happen vpack}{\quad vpack@> +else case type(p) of + hlist_node,vlist_node,dir_node,rule_node,unset_node: + @<Incorporate box dimensions into the dimensions of + the vbox that will contain~it@>; +@z + +@x [34.681] l.14026 - pTeX: math noad +@d noad_size=4 {number of words in a normal noad} +@d nucleus(#)==#+1 {the |nucleus| field of a noad} +@d supscr(#)==#+2 {the |supscr| field of a noad} +@d subscr(#)==#+3 {the |subscr| field of a noad} +@y +\yskip\hang In Japanese, |math_type(q)=math_jchar| means that |fam(q)| +refers to one of the sixteen kanji font families, and |KANJI(q)| is the +internal kanji code number. +@^Japanese extentions@> + +@d noad_size=5 {number of words in a normal noad} +@d nucleus(#)==#+1 {the |nucleus| field of a noad} +@d supscr(#)==#+2 {the |supscr| field of a noad} +@d subscr(#)==#+3 {the |subscr| field of a noad} +@d kcode_noad(#)==#+4 +@d math_kcode(#)==info(#+4) {the |kanji character| field of a noad} +@d kcode_noad_nucleus(#)==#+3 +@d math_kcode_nucleus(#)==info(#+3) + {the |kanji character| field offset from nucleus} +@# +@d math_jchar=5 +@d math_text_jchar=6 +@z + +@x [34.686] l.14129 - pTeX: new_noad +mem[supscr(p)].hh:=empty_field; +new_noad:=p; +@y +mem[supscr(p)].hh:=empty_field; +mem[kcode_noad(p)].hh:=empty_field; +new_noad:=p; +@z + +@x [34.691] l.14236 - pTeX: print_fam_and_char +procedure print_fam_and_char(@!p:pointer); {prints family and character} +begin print_esc("fam"); print_int(fam(p)); print_char(" "); +print_ASCII(qo(character(p))); +@y +procedure print_fam_and_char(@!p:pointer;@!t:small_number); + {prints family and character} +var @!cx:KANJI_code; {temporary register for KANJI} +begin print_esc("fam"); print_int(fam(p)); print_char(" "); +if t=math_char then print_ASCII(qo(character(p))) +else begin KANJI(cx):=math_kcode_nucleus(p); print_kanji(cx); + end; +@z + +@x [34.692] l.14266 - pTeX: print_subsidiary_data + math_char: begin print_ln; print_current_string; print_fam_and_char(p); +@y + math_char, math_jchar: begin print_ln; print_current_string; + print_fam_and_char(p,math_type(p)); +@z + +@x [34.696] l.14327 - pTeX: print_fam_and_char +accent_noad: begin print_esc("accent"); print_fam_and_char(accent_chr(p)); +@y +accent_noad: begin print_esc("accent"); + print_fam_and_char(accent_chr(p),math_char); +@z + +@x [35.715] l.14687 - pTeX: rebox + begin if type(b)=vlist_node then b:=hpack(b,natural); + p:=list_ptr(b); + if (is_char_node(p))and(link(p)=null) then + begin f:=font(p); v:=char_width(f)(char_info(f)(character(p))); + if v<>width(b) then link(p):=new_kern(width(b)-v); + end; +@y + begin if type(b)<>hlist_node then b:=hpack(b,natural); + p:=list_ptr(b); + if is_char_node(p) then + if font_dir[font(p)]<>dir_default then + begin if link(link(p))=null then + begin f:=font(p); v:=char_width(f)(orig_char_info(f)(character(p))); + if v<>width(b) then link(link(p)):=new_kern(width(b)-v); + end + end + else if link(p)=null then + begin f:=font(p); v:=char_width(f)(orig_char_info(f)(character(p))); + if v<>width(b) then link(p):=new_kern(width(b)-v); + end; + delete_glue_ref(space_ptr(b)); delete_glue_ref(xspace_ptr(b)); +@z + +@x [36.720] l.14783 - pTeX: clean_box +function clean_box(@!p:pointer;@!s:small_number):pointer; +@y +function clean_box(@!p:pointer;@!s:small_number;@!jc:halfword):pointer; +@z + +@x [36.720] l.14790 - pTeX: clean_box +math_char: begin cur_mlist:=new_noad; mem[nucleus(cur_mlist)]:=mem[p]; + end; +@y +math_char: begin cur_mlist:=new_noad; mem[nucleus(cur_mlist)]:=mem[p]; + end; +math_jchar: begin cur_mlist:=new_noad; mem[nucleus(cur_mlist)]:=mem[p]; + math_kcode(cur_mlist):=jc; + end; +@z + +@x [36.720] l.14802 - pTeX: clean_box +found: if is_char_node(q)or(q=null) then x:=hpack(q,natural) + else if (link(q)=null)and(type(q)<=vlist_node)and(shift_amount(q)=0) then + x:=q {it's already clean} + else x:=hpack(q,natural); +@y +found: if is_char_node(q)or(q=null) then x:=hpack(q,natural) + else if (link(q)=null)and(type(q)<=dir_node)and(shift_amount(q)=0) then + x:=q {it's already clean} + else x:=hpack(q,natural); +@z + +@x [36.721] l.14814 - pTeX: skip 2nd kanji node +if is_char_node(q) then + begin r:=link(q); +@y +if is_char_node(q) then + begin if font_dir[font(q)]<>dir_default then q:=link(q); + r:=link(q); +@z + +@x [36.722] l.14833 - pTeX: fetch +else begin if (qo(cur_c)>=font_bc[cur_f])and(qo(cur_c)<=font_ec[cur_f]) then + cur_i:=orig_char_info(cur_f)(cur_c) + else cur_i:=null_character; + if not(char_exists(cur_i)) then + begin char_warning(cur_f,qo(cur_c)); + math_type(a):=empty; + end; + end; +@y +else begin if font_dir[cur_f]<>dir_default then + cur_c:=qi(get_jfm_pos(KANJI(math_kcode_nucleus(a)),cur_f)); + if (qo(cur_c)>=font_bc[cur_f])and(qo(cur_c)<=font_ec[cur_f]) then + cur_i:=orig_char_info(cur_f)(cur_c) + else cur_i:=null_character; + if not(char_exists(cur_i)) then + begin char_warning(cur_f,qo(cur_c)); + math_type(a):=empty; + end; + end; +@z + +@x [36.726] l.14892 - pTeX: mlist_to_hlist +var mlist:pointer; {beginning of the given list} +@!penalties:boolean; {should penalty nodes be inserted?} +@!style:small_number; {the given style} +@y +var mlist:pointer; {beginning of the given list} +@!penalties:boolean; {should penalty nodes be inserted?} +@!style:small_number; {the given style} +@!u:pointer; {temporary register} +@z + +@x [36.726] l.14913 - pTeX: mlist_to_hlist +@<Make a second pass over the mlist, removing all noads and inserting the + proper spacing and penalties@>; +end; +@y +@<Make a second pass over the mlist, removing all noads and inserting the + proper spacing and penalties@>; +p:=new_null_box; link(p):=link(temp_head); +adjust_hlist(p,false); link(temp_head):=link(p); +delete_glue_ref(space_ptr(p)); delete_glue_ref(xspace_ptr(p)); +free_node(p,box_node_size); +end; +@z + +@x [36.727] l.14928 - pTeX: free box +free_node(z,box_node_size); +@y +delete_glue_ref(space_ptr(z)); delete_glue_ref(xspace_ptr(z)); +free_node(z,box_node_size); +@z + +@x [36.730] l.14976 - pTeX: free box: disp_node +kern_node: begin math_kern(q,cur_mu); goto done_with_node; + end; +@y +kern_node: begin math_kern(q,cur_mu); goto done_with_node; + end; +disp_node: goto done_with_node; +@z + +@x [36.734] l.15046 - pTeX: make_over:clean_box + overbar(clean_box(nucleus(q),cramped_style(cur_style)),@| +@y + overbar(clean_box(nucleus(q),cramped_style(cur_style),math_kcode(q)),@| +@z + +@x [36.735] l.15055 - pTeX: make_under:clean_box +begin x:=clean_box(nucleus(q),cur_style); +@y +begin x:=clean_box(nucleus(q),cur_style,math_kcode(q)); +@z + +@x [36.736] l.15069 - pTeX: make_under:clean_box +if type(v)<>vlist_node then confusion("vcenter"); +@y +if type(v)=dir_node then + begin if type(list_ptr(v))<>vlist_node then confusion("dircenter") + end +else begin if type(v)<>vlist_node then confusion("vcenter") + end; +@z + +@x [36.737] l.15089 - pTeX: make_radical:clean_box +begin x:=clean_box(nucleus(q),cramped_style(cur_style)); +@y +begin x:=clean_box(nucleus(q),cramped_style(cur_style),math_kcode(q)); +@z + +@x [36.738] l.15123 - pTeX: make_math_accent:clean_box + x:=clean_box(nucleus(q),cramped_style(cur_style)); w:=width(x); h:=height(x); +@y + x:=clean_box(nucleus(q),cramped_style(cur_style),math_kcode(q)); + w:=width(x); h:=height(x); +@z + +@x [36.742] l.15186 - pTeX: make_math_accent:clean_box +x:=clean_box(nucleus(q),cur_style); delta:=delta+height(x)-h; h:=height(x); +@y +x:=clean_box(nucleus(q),cur_style,math_kcode(q)); +delta:=delta+height(x)-h; h:=height(x); +@z + +@x [36.744] l.15211 - pTeX: make_fraction:clean_box +x:=clean_box(numerator(q),num_style(cur_style)); +z:=clean_box(denominator(q),denom_style(cur_style)); +@y +x:=clean_box(numerator(q),num_style(cur_style),math_kcode(q)); +z:=clean_box(denominator(q),denom_style(cur_style),math_kcode(q)); +@z + +@x [36.749] l.15304 - pTeX: make_op:clean_box + delta:=char_italic(cur_f)(cur_i); x:=clean_box(nucleus(q),cur_style); +@y + delta:=char_italic(cur_f)(cur_i); + x:=clean_box(nucleus(q),cur_style,math_kcode(q)); +@z + +@x [36.750] l.15321 - pTeX: make_op:clean_box +begin x:=clean_box(supscr(q),sup_style(cur_style)); +y:=clean_box(nucleus(q),cur_style); +z:=clean_box(subscr(q),sub_style(cur_style)); +@y +begin x:=clean_box(supscr(q),sup_style(cur_style),math_kcode(q)); +y:=clean_box(nucleus(q),cur_style,math_kcode(q)); +z:=clean_box(subscr(q),sub_style(cur_style),math_kcode(q)); +@z + +@x [36.751] l.15342 - pTeX: free box node + begin free_node(x,box_node_size); list_ptr(v):=y; + end +@y + begin + delete_glue_ref(space_ptr(x)); delete_glue_ref(xspace_ptr(x)); + free_node(x,box_node_size); list_ptr(v):=y; + end +@z + +@x [36.751] l.15350 - pTeX: free box node +if math_type(subscr(q))=empty then free_node(z,box_node_size) +@y +if math_type(subscr(q))=empty then begin + delete_glue_ref(space_ptr(z)); delete_glue_ref(xspace_ptr(z)); + free_node(z,box_node_size) +end +@z + +@x [36.752] l.15369 - pTeX: make_ord +procedure make_ord(@!q:pointer); +label restart,exit; +var a:integer; {address of lig/kern instruction} +@!p,@!r:pointer; {temporary registers for list manipulation} +begin restart:@t@>@;@/ +if math_type(subscr(q))=empty then if math_type(supscr(q))=empty then + if math_type(nucleus(q))=math_char then + begin p:=link(q); + if p<>null then if (type(p)>=ord_noad)and(type(p)<=punct_noad) then + if math_type(nucleus(p))=math_char then + if fam(nucleus(p))=fam(nucleus(q)) then + begin math_type(nucleus(q)):=math_text_char; + fetch(nucleus(q)); + if char_tag(cur_i)=lig_tag then + begin a:=lig_kern_start(cur_f)(cur_i); + cur_c:=character(nucleus(p)); + cur_i:=font_info[a].qqqq; + if skip_byte(cur_i)>stop_flag then + begin a:=lig_kern_restart(cur_f)(cur_i); + cur_i:=font_info[a].qqqq; + end; + loop@+ begin @<If instruction |cur_i| is a kern with |cur_c|, attach + the kern after~|q|; or if it is a ligature with |cur_c|, combine + noads |q| and~|p| appropriately; then |return| if the cursor has + moved past a noad, or |goto restart|@>; + if skip_byte(cur_i)>=stop_flag then return; + a:=a+qo(skip_byte(cur_i))+1; + cur_i:=font_info[a].qqqq; + end; + end; + end; + end; +exit:end; +@y +procedure make_ord(@!q:pointer); +label restart,exit; +var a:integer; {address of lig/kern instruction} +@!gp,@!gq,@!p,@!r:pointer; {temporary registers for list manipulation} +@!rr:halfword; +begin restart:@t@>@;@/ +if (math_type(subscr(q))=empty)and(math_type(supscr(q))=empty)and@| +((math_type(nucleus(q))=math_char)or(math_type(nucleus(q))=math_jchar)) then + begin p:=link(q); + if p<>null then if (type(p)>=ord_noad)and(type(p)<=punct_noad) then + if fam(nucleus(p))=fam(nucleus(q)) then + if math_type(nucleus(p))=math_char then + begin math_type(nucleus(q)):=math_text_char; + fetch(nucleus(q)); + if char_tag(cur_i)=lig_tag then + begin a:=lig_kern_start(cur_f)(cur_i); + cur_c:=character(nucleus(p)); + cur_i:=font_info[a].qqqq; + if skip_byte(cur_i)>stop_flag then + begin a:=lig_kern_restart(cur_f)(cur_i); + cur_i:=font_info[a].qqqq; + end; + loop@+ begin @<If instruction |cur_i| is a kern with |cur_c|, attach + the kern after~|q|; or if it is a ligature with |cur_c|, combine + noads |q| and~|p| appropriately; then |return| if the cursor has + moved past a noad, or |goto restart|@>; + if skip_byte(cur_i)>=stop_flag then return; + a:=a+qo(skip_byte(cur_i))+1; + cur_i:=font_info[a].qqqq; + end; + end; + end + else if math_type(nucleus(p))=math_jchar then + begin math_type(nucleus(q)):=math_text_jchar; + fetch(nucleus(p)); a:=cur_c; fetch(nucleus(q)); + if char_tag(cur_i)=gk_tag then + begin cur_c:=a; a:=glue_kern_start(cur_f)(cur_i); + {|cur_c|:=qi(|get_jfm_pos|(|math_kcode|(p), + |fam_fnt|(fam(nucleus(p))+|cur_size|)));} + repeat + cur_i:=font_info[a].qqqq; + if next_char(cur_i)=cur_c then + if op_byte(cur_i)<kern_flag then + begin gp:=font_glue[cur_f]; rr:=rem_byte(cur_i); + if gp<>null then begin + while((type(gp)<>rr)and(link(gp)<>null)) do begin gp:=link(gp); + end; + gq:=glue_ptr(gp); + end + else begin gp:=get_node(small_node_size); + font_glue[cur_f]:=gp; gq:=null; + end; + if gq=null then + begin type(gp):=rr; gq:=new_spec(zero_glue); glue_ptr(gp):=gq; + a:=exten_base[cur_f]+qi((qo(rr))*3); width(gq):=font_info[a].sc; + stretch(gq):=font_info[a+1].sc; shrink(gq):=font_info[a+2].sc; + add_glue_ref(gq); link(gp):=get_node(small_node_size); + gp:=link(gp); glue_ptr(gp):=null; link(gp):=null; + end; + p:=new_glue(gq); link(p):=link(q); link(q):=p; return; + end + else begin p:=new_kern(char_kern(cur_f)(cur_i)); + link(p):=link(q); link(q):=p; return; + end; + incr(a); + until skip_byte(cur_i)>=stop_flag; + end; + end; + end; +exit:end; +@z + +@x [36.754] l.15452 - pTeX: +math_char, math_text_char: +@y +math_char, math_text_char, math_jchar, math_text_jchar: +@z + +@x [36.755] l.15475 - pTeX: convert math text to KANJI char_node + begin delta:=char_italic(cur_f)(cur_i); p:=new_character(cur_f,qo(cur_c)); + if (math_type(nucleus(q))=math_text_char)and(space(cur_f)<>0) then + delta:=0; {no italic correction in mid-word of text font} + if (math_type(subscr(q))=empty)and(delta<>0) then + begin link(p):=new_kern(delta); delta:=0; +@y + begin delta:=char_italic(cur_f)(cur_i); p:=new_character(cur_f,qo(cur_c)); + u:=p; + if font_dir[cur_f]<>dir_default then begin + link(u):=get_avail; u:=link(u); info(u):=math_kcode(q); + end; + if ((math_type(nucleus(q))=math_text_char)or + (math_type(nucleus(q))=math_text_jchar))and(space(cur_f)<>0) then + delta:=0; {no italic correction in mid-word of text font} + if (math_type(subscr(q))=empty)and(delta<>0) then begin + link(u):=new_kern(delta); delta:=0; +@z + +@x [36.756] l.15505 - pTeX: free box + shift_down:=depth(z)+sub_drop(t); + free_node(z,box_node_size); + end; +@y + shift_down:=depth(z)+sub_drop(t); + delete_glue_ref(space_ptr(z)); delete_glue_ref(xspace_ptr(z)); + free_node(z,box_node_size); + end; +@z + +@x [36.757] l.15526 - pTeX: make_scripts:clean_box +begin x:=clean_box(subscr(q),sub_style(cur_style)); +@y +begin x:=clean_box(subscr(q),sub_style(cur_style),math_kcode(q)); +@z + +@x [36.758] l.15538 - pTeX: make_scripts:clean_box +begin x:=clean_box(supscr(q),sup_style(cur_style)); +@y +begin x:=clean_box(supscr(q),sup_style(cur_style),math_kcode(q)); +@z + +@x [36.758] l.15555 - pTeX: make_scripts:clean_box +begin y:=clean_box(subscr(q),sub_style(cur_style)); +@y +begin y:=clean_box(subscr(q),sub_style(cur_style),math_kcode(q)); +@z + +@x [36.760] l.15616 - pTeX: disp_node +othercases confusion("mlist3") +@y +disp_node: begin link(p):=q; p:=q; q:=link(q); link(p):=null; goto done; + end; +othercases confusion("mlist3") +@z + +@x [37.796] l.16276 - pTeX: call adjust_hlist + begin adjust_tail:=cur_tail; u:=hpack(link(head),natural); w:=width(u); +@y + begin adjust_tail:=cur_tail; adjust_hlist(head,false); + delete_glue_ref(cur_kanji_skip); delete_glue_ref(cur_xkanji_skip); + cur_kanji_skip:=space_ptr(head); cur_xkanji_skip:=xspace_ptr(head); + add_glue_ref(cur_kanji_skip); add_glue_ref(cur_xkanji_skip); + u:=hpack(link(head),natural); w:=width(u); +@z + +@x [37.799] l.16331 - pTeX: call adjust_hlist + begin p:=hpack(link(head),natural); +@y + begin adjust_hlist(head,false); + delete_glue_ref(cur_kanji_skip); delete_glue_ref(cur_xkanji_skip); + cur_kanji_skip:=space_ptr(head); cur_xkanji_skip:=xspace_ptr(head); + add_glue_ref(cur_kanji_skip); add_glue_ref(cur_xkanji_skip); + p:=hpack(link(head),natural); +@z + +@x [37.800] l.16353 - pTeX: call adjust_hlist +var @!p,@!q,@!r,@!s,@!u,@!v: pointer; {registers for the list operations} +@y +var @!p,@!q,@!r,@!s,@!u,@!v,@!z: pointer; {registers for the list operations} +@z + +@x [37.804] l.16456 - pTeX: call adjust_hlist + p:=hpack(preamble,saved(1),saved(0)); overfull_rule:=rule_save; +@y + z:=new_null_box; link(z):=preamble; + adjust_hlist(z,false); + delete_glue_ref(cur_kanji_skip); delete_glue_ref(cur_xkanji_skip); + cur_kanji_skip:=space_ptr(z); cur_xkanji_skip:=xspace_ptr(z); + add_glue_ref(cur_kanji_skip); add_glue_ref(cur_xkanji_skip); + p:=hpack(preamble,saved(1),saved(0)); overfull_rule:=rule_save; + delete_glue_ref(space_ptr(z)); delete_glue_ref(xspace_ptr(z)); + free_node(z,box_node_size); +@z + +@x [37.807] l.16499 - pTeX: unset box -> BOX +glue_order(q):=glue_order(p); glue_sign(q):=glue_sign(p); +glue_set(q):=glue_set(p); shift_amount(q):=o; +r:=link(list_ptr(q)); s:=link(list_ptr(p)); +@y +box_dir(q):=abs(direction); +glue_order(q):=glue_order(p); glue_sign(q):=glue_sign(p); +glue_set(q):=glue_set(p); shift_amount(q):=o; +r:=link(list_ptr(q)); s:=link(list_ptr(p)); +@z + +@x [37.809] l.16541 - pTeX: unset box -> BOX +s:=link(s); link(u):=new_null_box; u:=link(u); t:=t+width(s); +if mode=-vmode then width(u):=width(s)@+else + begin type(u):=vlist_node; height(u):=width(s); + end +@y +s:=link(s); link(u):=new_null_box; u:=link(u); t:=t+width(s); +if mode=-vmode then width(u):=width(s)@+else + begin type(u):=vlist_node; height(u):=width(s); + end; +box_dir(u):=abs(direction) +@z + +@x [37.810] l.16564 - pTeX: unset box -> BOX +width(r):=w; type(r):=hlist_node; +end +@y +width(r):=w; type(r):=hlist_node; +box_dir(r):=abs(direction); +end +@z + +@x [37.811] l.16585 - pTeX: unset box -> BOX +height(r):=w; type(r):=vlist_node; +@y +height(r):=w; type(r):=vlist_node; +box_dir(r):=abs(direction); +@z + +@x [38.816] l.16687 - pTeX: init chain, delete disp_node +link(temp_head):=link(head); +if is_char_node(tail) then tail_append(new_penalty(inf_penalty)) +else if type(tail)<>glue_node then tail_append(new_penalty(inf_penalty)) +@y +first_use:=true; chain:=false; +delete_glue_ref(cur_kanji_skip); delete_glue_ref(cur_xkanji_skip); +cur_kanji_skip:=space_ptr(head); cur_xkanji_skip:=xspace_ptr(head); +add_glue_ref(cur_kanji_skip); add_glue_ref(cur_xkanji_skip); +link(temp_head):=link(head); +if (not is_char_node(tail))and(type(tail)=disp_node) then + begin free_node(tail,small_node_size); tail:=prev_node; link(tail):=null + end; +if is_char_node(tail) then tail_append(new_penalty(inf_penalty)) +else if type(tail)<>glue_node then tail_append(new_penalty(inf_penalty)) +@z + +@x [38.828] l.16946 - pTeX: Global variable |chain| +@!cur_p:pointer; {the current breakpoint under consideration} +@y +@!cur_p:pointer; {the current breakpoint under consideration} +@!chain:boolean; {chain current line and next line?} +@z + +% chain が真の場合、後ろに cur_kanji_skip が挿入されるので、ここで +% break_width から引いておかなければならない。 +@x [38.837] l.17125 - pTeX: add kanji_skip width, ita_kern +begin no_break_yet:=false; do_all_six(set_break_width_to_background); +s:=cur_p; +if break_type>unhyphenated then if cur_p<>null then + @<Compute the discretionary |break_width| values@>; +while s<>null do + begin if is_char_node(s) then goto done; +@y +begin no_break_yet:=false; do_all_six(set_break_width_to_background); +s:=cur_p; +if break_type>unhyphenated then if cur_p<>null then + @<Compute the discretionary |break_width| values@>; +while s<>null do + begin if is_char_node(s) then + begin if chain then + begin break_width[1]:=break_width[1]-width(cur_kanji_skip); + break_width[2+stretch_order(cur_kanji_skip)]:= + break_width[2+stretch_order(cur_kanji_skip)]-stretch(cur_kanji_skip); + break_width[6]:=break_width[6]-shrink(cur_kanji_skip); + end; + goto done end; +@z + +@x [38.837] l.17135 - pTeX: + kern_node: if subtype(s)<>explicit then goto done + else break_width[1]:=break_width[1]-width(s); +@y + kern_node: if (subtype(s)<>explicit)and(subtype(s)<>ita_kern) then + goto done + else break_width[1]:=break_width[1]-width(s); +@z + +@x [38.841] l.17186 - pTeX: +if is_char_node(v) then + begin f:=font(v); + break_width[1]:=break_width[1]-char_width(f)(char_info(f)(character(v))); + end +else case type(v) of + ligature_node: begin f:=font(lig_char(v));@/ + break_width[1]:=@|break_width[1]- + char_width(f)(char_info(f)(character(lig_char(v)))); + end; + hlist_node,vlist_node,rule_node,kern_node: + break_width[1]:=break_width[1]-width(v); + othercases confusion("disc1") +@:this can't happen disc1}{\quad disc1@> + endcases +@y +if is_char_node(v) then + begin f:=font(v); + break_width[1]:=break_width[1]-char_width(f)(orig_char_info(f)(character(v))); + if font_dir[f]<>dir_default then v:=link(v); + end +else case type(v) of + ligature_node: begin f:=font(lig_char(v));@/ + break_width[1]:=@|break_width[1]- + char_width(f)(orig_char_info(f)(character(lig_char(v)))); + end; + hlist_node,vlist_node,dir_node,rule_node,kern_node: + break_width[1]:=break_width[1]-width(v); + disp_node: do_nothing; + othercases confusion("disc1") +@:this can't happen disc1}{\quad disc1@> + endcases +@z + +@x [38.842] l.17204 - pTeX: + 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 + break_width[1]:=@|break_width[1]+char_width(f)(orig_char_info(f)(character(s))); + if font_dir[f]<>dir_default then s:=link(s); + end +else case type(s) of + ligature_node: begin f:=font(lig_char(s)); + break_width[1]:=break_width[1]+ + char_width(f)(orig_char_info(f)(character(lig_char(s)))); + end; + hlist_node,vlist_node,dir_node,rule_node,kern_node: + break_width[1]:=break_width[1]+width(s); + disp_node: do_nothing; +@z + +@x [38.856] l.17467 - pTeX: print symbolic feasibe node +if cur_p=null then print_esc("par") +else if type(cur_p)<>glue_node then + begin if type(cur_p)=penalty_node then print_esc("penalty") + else if type(cur_p)=disc_node then print_esc("discretionary") +@y +if cur_p=null then print_esc("par") +else if (type(cur_p)<>glue_node)and(not is_char_node(cur_p)) then + begin if type(cur_p)=penalty_node then print_esc("penalty") + else if type(cur_p)=disc_node then print_esc("discretionary") +@z + +@x [39.862] l.17584 - pTeX: local valiable for line breaking +@!auto_breaking:boolean; {is node |cur_p| outside a formula?} +@!prev_p:pointer; {helps to determine when glue nodes are breakpoints} +@!q,@!r,@!s,@!prev_s:pointer; {miscellaneous nodes of temporary interest} +@!f:internal_font_number; {used when calculating character widths} +@y +@!auto_breaking:boolean; {is node |cur_p| outside a formula?} +@!prev_p:pointer; {helps to determine when glue nodes are breakpoints} +@!q,@!r,@!s,@!prev_s:pointer; {miscellaneous nodes of temporary interest} +@!f,@!post_f:internal_font_number; {used when calculating character widths} +@!post_p:pointer; +@!cc:ASCII_code; +@!first_use:boolean; +@z + +@x [39.866] l.17677 - pTeX: dir_node, disp_node, ita_kern +case type(cur_p) of +hlist_node,vlist_node,rule_node: act_width:=act_width+width(cur_p); +@y +case type(cur_p) of +hlist_node,vlist_node,dir_node,rule_node: act_width:=act_width+width(cur_p); +@z + +@x [39.866] l.17685 - pTeX: +kern_node: if subtype(cur_p)=explicit then kern_break + else act_width:=act_width+width(cur_p); +@y +kern_node: if (subtype(cur_p)=explicit)or(subtype(cur_p)=ita_kern) then + kern_break + else act_width:=act_width+width(cur_p); +@z + +@x [39.866] l.17694 - pTeX: +mark_node,ins_node,adjust_node: do_nothing; +@y +disp_node,mark_node,ins_node,adjust_node: do_nothing; +@z + +% ここで、連続する漢字コード間に cur_kanji_skip を挿入する。 +% penalty_node や box_node には、adjust_hlist ルーチンによって既に実際の +% glue_node が挿入されているものと仮定している。 +% chain は、try_break で cur_kanji_skip のアジャストのために使われる。 +@x [39.867] l.17708 - pTeX: add kanji char width +@<Advance \(c)|cur_p| to the node following the present string...@>= +begin prev_p:=cur_p; +repeat f:=font(cur_p); +act_width:=act_width+char_width(f)(char_info(f)(character(cur_p))); +cur_p:=link(cur_p); +until not is_char_node(cur_p); +end +@y +@<Advance \(c)|cur_p| to the node following the present string...@>= +begin chain:=false; +if is_char_node(cur_p) then + if font_dir[font(cur_p)]<>dir_default then + begin case type(prev_p) of + hlist_node,vlist_node,dir_node,rule_node, + ligature_node,disc_node,math_node: begin + cur_p:=prev_p; try_break(0,unhyphenated); cur_p:=link(cur_p); + end; + othercases do_nothing; + endcases; + end; + prev_p:=cur_p; post_p:=cur_p; post_f:=font(post_p); + repeat f:=post_f; cc:=character(cur_p); + act_width:=act_width+char_width(f)(orig_char_info(f)(cc)); + post_p:=link(cur_p); + if font_dir[f]<>dir_default then + begin prev_p:=cur_p; cur_p:=post_p; post_p:=link(post_p); + if is_char_node(post_p) then + begin post_f:=font(post_p); + if font_dir[post_f]<>dir_default then chain:=true else chain:=false; + try_break(0,unhyphenated); + end + else + begin chain:=false; + case type(post_p) of + hlist_node,vlist_node,dir_node,rule_node,ligature_node, + disc_node,math_node: try_break(0,unhyphenated); + othercases do_nothing; + endcases; + end; + if chain then + begin if first_use then + begin check_shrinkage(cur_kanji_skip); + first_use:=false; + end; + act_width:=act_width+width(cur_kanji_skip);@| + active_width[2+stretch_order(cur_kanji_skip)]:=@| + active_width[2+stretch_order(cur_kanji_skip)] + +stretch(cur_kanji_skip);@/ + active_width[6]:=active_width[6]+shrink(cur_kanji_skip); + end; + prev_p:=cur_p; + end + else if is_char_node(post_p) then + begin post_f:=font(post_p); chain:=false; + if font_dir[post_f]<>dir_default then try_break(0,unhyphenated); + end; + cur_p:=post_p; + until not is_char_node(cur_p); +chain:=false; +end +@z + +@x [39.868] l.17723 - pTeX: ita_kern + else if (type(prev_p)=kern_node)and(subtype(prev_p)<>explicit) then + try_break(0,unhyphenated); +@y + else if (type(prev_p)=kern_node) then + if (subtype(prev_p)<>explicit)and(subtype(prev_p)<>ita_kern) then + try_break(0,unhyphenated); +@z + +@x [39.871] l.17756 - pTeX: add kanji char width, dir_node width, disp_node + 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 + disc_width:=disc_width+char_width(f)(orig_char_info(f)(character(s))); + if font_dir[f]<>dir_default then s:=link(s) + end +else case type(s) of + ligature_node: begin f:=font(lig_char(s)); + disc_width:=disc_width+ + char_width(f)(orig_char_info(f)(character(lig_char(s)))); + end; + hlist_node,vlist_node,dir_node,rule_node,kern_node: + disc_width:=disc_width+width(s); + disp_node: do_nothing; +@z + +@x [39.872] l.17772 - pTeX: add kanji char width, dir_node width, disp_node + 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 + act_width:=act_width+char_width(f)(orig_char_info(f)(character(s))); + if font_dir[f]<>dir_default then s:=link(s) + end +else case type(s) of + ligature_node: begin f:=font(lig_char(s)); + act_width:=act_width+ + char_width(f)(orig_char_info(f)(character(lig_char(s)))); + end; + hlist_node,vlist_node,dir_node,rule_node,kern_node: + act_width:=act_width+width(s); + disp_node: do_nothing; +@z + +@x [39.877] l.17879 - pTeX: last_disp +cur_line:=prev_graf+1; +@y +cur_line:=prev_graf+1; last_disp:=0; +@z + +@x [39.879] l.17919 - pTeX: ita_kern + if type(q)=kern_node then if subtype(q)<>explicit then goto done1; +@y + if type(q)=kern_node then + if (subtype(q)<>explicit)and(subtype(q)<>ita_kern) then goto done1; +@z + +@x [39.881] l.17950 - pTeX: |q| may be a |char_node| +if q<>null then {|q| cannot be a |char_node|} + if type(q)=glue_node then + begin delete_glue_ref(glue_ptr(q)); + glue_ptr(q):=right_skip; + subtype(q):=right_skip_code+1; add_glue_ref(right_skip); + goto done; + end + else begin if type(q)=disc_node then + @<Change discretionary to compulsory and set + |disc_break:=true|@> + else if (type(q)=math_node)or(type(q)=kern_node) then width(q):=0; + end +@y +if q<>null then {|q| may be a |char_node|} + begin if not is_char_node(q) then + if type(q)=glue_node then + begin delete_glue_ref(glue_ptr(q)); + glue_ptr(q):=right_skip; + subtype(q):=right_skip_code+1; add_glue_ref(right_skip); + goto done; + end + else begin if type(q)=disc_node then + @<Change discretionary to compulsory and set + |disc_break:=true|@> + else if (type(q)=math_node)or(type(q)=kern_node) then width(q):=0; + end + end +@z + +@x [39.887] l.18014 - pTeX: disp_node at begin-of-line +r:=link(q); link(q):=null; q:=link(temp_head); link(temp_head):=r; +@y +r:=link(q); link(q):=null; q:=link(temp_head); link(temp_head):=r; +if last_disp<>0 then begin + r:=get_node(small_node_size); + type(r):=disp_node; disp_dimen(r):=last_disp; + link(r):=q; q:=r; + end; +@z + +@x [40.896] l.18177 - pTeX: hyphenation +loop@+ begin if is_char_node(s) then + begin c:=qo(character(s)); hf:=font(s); + end +@y +loop@+ begin if is_char_node(s) then + begin hf:=font(s); + if font_dir[hf]<>dir_default then + begin prev_s:=s; s:=link(prev_s); c:=info(s); goto continue; + end else c:=qo(character(s)); + end + else if type(s)=disp_node then goto continue + else if (type(s)=penalty_node)and(not subtype(s)=normal) then goto continue +@z + +@x [40.899] l.18248 - pTeX: disp_node + whatsit_node,glue_node,penalty_node,ins_node,adjust_node,mark_node: + goto done4; +@y + disp_node: do_nothing; + whatsit_node,glue_node,penalty_node,ins_node,adjust_node,mark_node: + goto done4; +@z + +@x [44.968] l.19535 - pTeX: dir_node + hlist_node,vlist_node,rule_node:@<Insert glue for |split_top_skip| + and set~|p:=null|@>; +@y + hlist_node,vlist_node,dir_node,rule_node: + @<Insert glue for |split_top_skip| and set~|p:=null|@>; +@z + +@x [44.973] l.19626 - pTeX: dir_node +hlist_node,vlist_node,rule_node: begin@t@>@;@/ + cur_height:=cur_height+prev_dp+height(p); prev_dp:=depth(p); +@y +hlist_node,vlist_node,dir_node,rule_node: begin@t@>@;@/ + cur_height:=cur_height+prev_dp+height(p); prev_dp:=depth(p); +@z + +@x [44.977] l.19710 - pTeX: free box node +var v:pointer; {the box to be split} +@y +var v:pointer; {the box to be split} +w:pointer; {|dir_node|} +@z + +@x [44.977] l.19722 - pTeX: free box node +q:=prune_page_top(q); p:=list_ptr(v); free_node(v,box_node_size); +if q=null then box(n):=null {the |eq_level| of the box stays the same} +else box(n):=vpack(q,natural); +vsplit:=vpackage(p,h,exactly,split_max_depth); +@y +q:=prune_page_top(q); p:=list_ptr(v); +if q=null then box(n):=null {the |eq_level| of the box stays the same} +else begin + box(n):=vpack(q,natural); box_dir(box(n)):=box_dir(v); + end; +q:=vpackage(p,h,exactly,split_max_depth); +box_dir(q):=box_dir(v); +delete_glue_ref(space_ptr(v)); delete_glue_ref(xspace_ptr(v)); +free_node(v,box_node_size); +vsplit:=q; +@z + +@x [44.978] l.19732 - pTeX: bad box for vsplit +if type(v)<>vlist_node then + begin print_err(""); print_esc("vsplit"); print(" needs a "); + print_esc("vbox"); +@:vsplit_}{\.{\\vsplit needs a \\vbox}@> + help2("The box you are trying to split is an \hbox.")@/ + ("I can't split such a box, so I'll leave it alone."); + error; vsplit:=null; return; + end +@y +if type(v)=dir_node then begin + w:=v; v:=list_ptr(v); + delete_glue_ref(space_ptr(w)); + delete_glue_ref(xspace_ptr(w)); + free_node(w,box_node_size); +end; +if type(v)<>vlist_node then begin + print_err(""); print_esc("vsplit"); print(" needs a "); + print_esc("vbox"); +@:vsplit_}{\.{\\vsplit needs a \\vbox}@> + help2("The box you are trying to split is an \hbox.")@/ + ("I can't split such a box, so I'll leave it alone."); + error; vsplit:=null; return; +end; +flush_node_list(link(v)); link(v):=null +@z + +@x [45.993] l.20053 - pTeX: ensure_vbox +begin p:=box(n); +if p<>null then if type(p)=hlist_node then + begin print_err("Insertions can only be added to a vbox"); +@y +begin p:=box(n); +if p<>null then if (type(p)=dir_node) then + begin p:=list_ptr(p); + delete_glue_ref(space_ptr(box(n))); + delete_glue_ref(xspace_ptr(box(n))); + free_node(box(n),box_node_size); + box(n):=p +end; +if p<>null then if type(p)<>vlist_node then begin + print_err("Insertions can only be added to a vbox"); +@z + +@x [45.1000] l.20146 - pTeX: dir_node +hlist_node,vlist_node,rule_node: if page_contents<box_there then + @<Initialize the current page, insert the \.{\\topskip} glue + ahead of |p|, and |goto continue|@> +@y +hlist_node,vlist_node,dir_node,rule_node: if page_contents<box_there then + @<Initialize the current page, insert the \.{\\topskip} glue + ahead of |p|, and |goto continue|@> +@z + +@x [45.1009] l.20291 - pTeX: ins_dir +if box(n)=null then height(r):=0 +else height(r):=height(box(n))+depth(box(n)); +@y +if box(n)=null then height(r):=0 +else + begin if ins_dir(p)<>box_dir(box(n)) then + begin print_err("Insertions can only be added to a same direction vbox"); +@.Insertions can only...@> + help3("Tut tut: You're trying to \insert into a")@/ + ("\box register that now have a different direction.")@/ + ("Proceed, and I'll discard its present contents."); + box_error(n) + end + else + height(r):=height(box(n))+depth(box(n)); + end; +@z + +@x [45.1017] l.20470 - pTeX: page dir +box(255):=vpackage(link(page_head),best_size,exactly,page_max_depth); +@y +box(255):=vpackage(link(page_head),best_size,exactly,page_max_depth); +box_dir(box(255)):=page_dir; +@z + +@x [45.1020] l.20513 - pTeX: check ins_dir +if best_ins_ptr(r)=null then wait:=true +else begin wait:=false; s:=last_ins_ptr(r); link(s):=ins_ptr(p); +@y +if best_ins_ptr(r)=null then wait:=true +else begin wait:=false; + n:=qo(subtype(p)); + case box_dir(box(n)) of + any_dir: + if ins_dir(p)<>box_dir(box(n)) then begin + print_err("Insertions can only be added to a same direction vbox"); +@.Insertions can only...@> + help3("Tut tut: You're trying to \insert into a")@/ + ("\box register that now have a different direction.")@/ + ("Proceed, and I'll discard its present contents."); + box_error(n); + box(n):=new_null_box; last_ins_ptr(r):=box(n)+list_offset; + end; + othercases + box_dir(box(n)):=ins_dir(p); + endcases; + s:=last_ins_ptr(r); link(s):=ins_ptr(p); +@z + +@x [45.1021] l.20537 - pTeX: free box node, ins_dir + free_node(temp_ptr,box_node_size); wait:=true; +@y + delete_glue_ref(space_ptr(temp_ptr)); + delete_glue_ref(xspace_ptr(temp_ptr)); + free_node(temp_ptr,box_node_size); wait:=true; +@z + +@x [45.1021] l.20543 - pTeX: free box node, ins_dir +free_node(box(n),box_node_size); +box(n):=vpack(temp_ptr,natural); +@y +delete_glue_ref(space_ptr(box(n))); +delete_glue_ref(xspace_ptr(box(n))); +flush_node_list(link(box(n))); +free_node(box(n),box_node_size); +box(n):=vpack(temp_ptr,natural); box_dir(box(n)):=ins_dir(p); +@z + +@x [46.1030] l.20687 - pTeX:main_control +@d append_normal_space=120 {go here to append a normal space between words} +@y +@d append_normal_space=120 {go here to append a normal space between words} +@d main_loop_j=130 {like |main_loop|, but |cur_chr| holds a KANJI code} +@d skip_loop=141 +@d again_2=150 +@z + +@x [46.1030] l.20691 - pTeX: main_control +procedure main_control; {governs \TeX's activities} +label big_switch,reswitch,main_loop,main_loop_wrapup, +@y +procedure main_control; {governs \TeX's activities} +label big_switch,reswitch,main_loop,main_loop_wrapup, + main_loop_j,main_loop_j+1,main_loop_j+3,skip_loop,again_2, +@z + +@x [46.1030] l.20697 - pTeX: main_control +var@!t:integer; {general-purpose temporary variable} +@y +var@!t:integer; {general-purpose temporary variable} +@!cx:KANJI_code; {kanji character} +@!kp:pointer; {kinsoku penalty register} +@!gp,gq:pointer; {temporary registers for list manipulation} +@!disp:scaled; {displacement register} +@!ins_kp:boolean; {whether insert kinsoku penalty} +@z + +@x [46.1030] l.20701 - pTeX: main_control +case abs(mode)+cur_cmd of +hmode+letter,hmode+other_char,hmode+char_given: goto main_loop; +hmode+char_num: begin scan_char_num; cur_chr:=cur_val; goto main_loop;@+end; +hmode+no_boundary: begin get_x_token; + if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given)or + (cur_cmd=char_num) then cancel_boundary:=true; + goto reswitch; + end; +@y +ins_kp:=false; +case abs(mode)+cur_cmd of +hmode+letter,hmode+other_char: goto main_loop; +hmode+kanji,hmode+kana,hmode+other_kchar: goto main_loop_j; +hmode+char_given: + if (cur_chr>=0)and(cur_chr<256) then goto main_loop else goto main_loop_j; +hmode+char_num: begin scan_char_num; cur_chr:=cur_val; + if (cur_chr>=0)and(cur_chr<256) then goto main_loop else goto main_loop_j; + end; +hmode+no_boundary: begin get_x_token; + if (cur_cmd=letter)or(cur_cmd=other_char)or + (cur_cmd=kanji)or(cur_cmd=kana)or(cur_cmd=other_kchar)or + (cur_cmd=char_given)or(cur_cmd=char_num) then cancel_boundary:=true; + goto reswitch; + end; +@z + +@x [46.1030] l.20715 - pTeX: main_control +main_loop:@<Append character |cur_chr| and the following characters (if~any) + to the current hlist in the current font; |goto reswitch| when + a non-character has been fetched@>; +@y +main_loop_j:@<Append KANJI-character |cur_chr| + to the current hlist in the current font; |goto reswitch| when + a non-character has been fetched@>; +main_loop:@<Append character |cur_chr| and the following characters (if~any) + to the current hlist in the current font; |goto reswitch| when + a non-character has been fetched@>; +@z + +@x [46.1034] l.20788 - pTeX: disp_node +@<Append character |cur_chr|...@>= +if ((head=tail) and (mode>0)) then begin + if (insert_src_special_auto) then append_src_special; +end; +adjust_space_factor;@/ +@y +@<Append character |cur_chr|...@>= +if ((head=tail) and (mode>0)) then begin + if (insert_src_special_auto) then append_src_special; +end; +adjust_space_factor;@/ +if direction=dir_tate then disp:=t_baseline_shift else disp:=y_baseline_shift; +@<Append |disp_node| at begin of displace area@>; +@z + +%@x [46.1035] l.20850 - pTeX: kinsoku penalty +%@<Make a ligature node, if |ligature_present|;...@>= +%wrapup(rt_hit) +%@y +%@<Make a ligature node, if |ligature_present|;...@>= +%wrapup(rt_hit); +%if ins_kp=true then +% begin cx:=KANJI(cur_l); @<Insert kinsoku penalty@>; +% ins_kp:=false; +% end +%@z + +@x [46.1036] l.20854 - pTeX: disp_node +if lig_stack=null then goto reswitch; +@y +if lig_stack=null then + begin @<Append |disp_node| at end of displace area@>; + goto reswitch; + end; +@z + +@x [46.1037] l.20886 - pTeX: Look ahead for another character +@<Look ahead for another character...@>= +get_next; {set only |cur_cmd| and |cur_chr|, for speed} +if cur_cmd=letter then goto main_loop_lookahead+1; +if cur_cmd=other_char then goto main_loop_lookahead+1; +if cur_cmd=char_given then goto main_loop_lookahead+1; +x_token; {now expand and set |cur_cmd|, |cur_chr|, |cur_tok|} +if cur_cmd=letter then goto main_loop_lookahead+1; +if cur_cmd=other_char then goto main_loop_lookahead+1; +if cur_cmd=char_given then goto main_loop_lookahead+1; +if cur_cmd=char_num then + begin scan_char_num; cur_chr:=cur_val; goto main_loop_lookahead+1; + end; +if cur_cmd=no_boundary then bchar:=non_char; +cur_r:=bchar; lig_stack:=null; goto main_lig_loop; +main_loop_lookahead+1: adjust_space_factor; +fast_get_avail(lig_stack); font(lig_stack):=main_f; +cur_r:=qi(cur_chr); character(lig_stack):=cur_r; +if cur_r=false_bchar then cur_r:=non_char {this prevents spurious ligatures} +@y +@<Look ahead for another character...@>= +get_next; {set only |cur_cmd| and |cur_chr|, for speed} +if cur_cmd=letter then goto main_loop_lookahead+1; +if (cur_cmd=kanji)or(cur_cmd=kana)or(cur_cmd=other_kchar) then + @<goto |main_lig_loop|@>; +if cur_cmd=other_char then goto main_loop_lookahead+1; +if cur_cmd=char_given then + begin if (cur_chr>=0)and(cur_chr<256) then goto main_loop_lookahead+1 + else @<goto |main_lig_loop|@>; + end; +x_token; {now expand and set |cur_cmd|, |cur_chr|, |cur_tok|} +if cur_cmd=letter then goto main_loop_lookahead+1; +if (cur_cmd=kanji)or(cur_cmd=kana)or(cur_cmd=other_kchar) then + @<goto |main_lig_loop|@>; +if cur_cmd=other_char then goto main_loop_lookahead+1; +if cur_cmd=char_given then + begin if (cur_chr>=0)and(cur_chr<256) then goto main_loop_lookahead+1 + else @<goto |main_lig_loop|@>; + end; +if cur_cmd=char_num then + begin scan_char_num; cur_chr:=cur_val; + if (cur_chr>=0)and(cur_chr<256) then goto main_loop_lookahead+1 + else @<goto |main_lig_loop|@>; + end; +if cur_cmd=inhibit_glue then + begin inhibit_glue_flag:=true; goto main_loop_lookahead; + end; +if cur_cmd=no_boundary then bchar:=non_char; +cur_r:=bchar; lig_stack:=null; goto main_lig_loop; +main_loop_lookahead+1: adjust_space_factor; +fast_get_avail(lig_stack); font(lig_stack):=main_f; +cur_r:=qi(cur_chr); character(lig_stack):=cur_r; +if cur_r=false_bchar then cur_r:=non_char {this prevents spurious ligatures} + +@ @<goto |main_lig_loop|@>= +begin bchar:=non_char; cur_r:=bchar; lig_stack:=null; +if ligature_present then pack_lig(rt_hit); +if ins_kp=true then + begin cx:=cur_l; @<Insert kinsoku penalty@>; + end; +ins_kp:=false; +goto main_loop_j; +end +@z + +@x [46.1041] l.20999 - pTeX: disp_node +link(tail):=temp_ptr; tail:=temp_ptr; +@y +if (not is_char_node(tail))and(type(tail)=disp_node) then + begin link(prev_node):=temp_ptr; link(temp_ptr):=tail; prev_node:=temp_ptr; + end +else begin link(tail):=temp_ptr; tail:=temp_ptr; + end; +@z + +@x [46.1043] l.21029 - pTeX: disp_node +link(tail):=q; tail:=q; +@y +if (not is_char_node(tail))and(type(tail)=disp_node) then + begin link(prev_node):=q; link(q):=tail; prev_node:=q; + end +else begin link(tail):=q; tail:=q; + end +@z + +@x [47.1061] l.21277 - pTeX: append kern +begin s:=cur_chr; scan_dimen(s=mu_glue,false,false); +tail_append(new_kern(cur_val)); subtype(tail):=s; +end; +@y +begin s:=cur_chr; scan_dimen(s=mu_glue,false,false); +if (not is_char_node(tail))and(type(tail)=disp_node) then + begin prev_append(new_kern(cur_val)); subtype(prev_node):=s; + end +else + begin tail_append(new_kern(cur_val)); subtype(tail):=s; + end; +end; +@z + +@x [47.1068] l.21377 - pTeX: +var p,@!q:pointer; {for short-term use} +@y +var p,@!q:pointer; {for short-term use} +@!r:pointer; {temporaly} +@z + +@x [47.1071] l.21485 - pTeX: \tate, \yoko, \dtou +primitive("hbox",make_box,vtop_code+hmode);@/ +@!@:hbox_}{\.{\\hbox} primitive@> +@y +primitive("hbox",make_box,vtop_code+hmode);@/ +@!@:hbox_}{\.{\\hbox} primitive@> +primitive("tate",chg_dir,dir_tate);@/ +@!@:tate_}{\.{\\tate} primitive@> +primitive("yoko",chg_dir,dir_yoko);@/ +@!@:yoko_}{\.{\\yoko} primitive@> +primitive("dtou",chg_dir,dir_dtou);@/ +@!@:dtou_}{\.{\\dtou} primitive@> +@z + +@x [47.1072] l.21506 - pTeX: \tate, \yoko, \dtou + othercases print_esc("hbox") + endcases; +leader_ship: if chr_code=a_leaders then print_esc("leaders") +@y + othercases print_esc("hbox") + endcases; +chg_dir: + case chr_code of + dir_yoko: print_esc("yoko"); + dir_tate: print_esc("tate"); + dir_dtou: print_esc("dtou"); + endcases; +leader_ship: if chr_code=a_leaders then print_esc("leaders") +@z + +@x [47.1073] l.21523 - pTeX: \tate, \yoko +any_mode(make_box): begin_box(0); +@y +any_mode(make_box): begin_box(0); +any_mode(chg_dir): + begin if cur_group<>align_group then + if head=tail then + begin direction:=cur_chr; + if mode=vmode then page_dir:=cur_chr; + end + else begin print_err("Use `"); print_cmd_chr(cur_cmd,cur_chr); + print("' at top of list"); + help2("Direction change command is available only while") + ("current list is null."); error; + end + else begin print_err("You can't use `"); print_cmd_chr(cur_cmd,cur_chr); + print("' in an align"); + help2("To change direction in an align,") + ("you shold use \hbox or \vbox with \tate or \yoko."); error; + end + end; +@z + +@x [47.1075] l.21538 - pTeX: box_end +var p:pointer; {|ord_noad| for new box in math mode} +@y +var p:pointer; {|ord_noad| for new box in math mode} +q:pointer; +@z + +@x [47.1076] l.21553 - pTeX: box_dir adjust +begin if cur_box<>null then + begin shift_amount(cur_box):=box_context; + if abs(mode)=vmode then + begin append_to_vlist(cur_box); + if adjust_tail<>null then + begin if adjust_head<>adjust_tail then + begin link(tail):=link(adjust_head); tail:=adjust_tail; + end; + adjust_tail:=null; + end; + if mode>0 then build_page; + end + else begin if abs(mode)=hmode then space_factor:=1000 + else begin p:=new_noad; + math_type(nucleus(p)):=sub_box; + info(nucleus(p)):=cur_box; cur_box:=p; + end; + link(tail):=cur_box; tail:=cur_box; + end; + end; +end +@y +begin if cur_box<>null then + begin p:=link(cur_box); link(cur_box):=null; + while p<>null do begin + q:=p; p:=link(p); + if box_dir(q)=abs(direction) then + begin list_ptr(q):=cur_box; cur_box:=q; link(cur_box):=null; + end + else begin + delete_glue_ref(space_ptr(q)); + delete_glue_ref(xspace_ptr(q)); + free_node(q,box_node_size); + end; + end; + if box_dir(cur_box)<>abs(direction) then + cur_box:=new_dir_node(cur_box,abs(direction)); + shift_amount(cur_box):=box_context; + if abs(mode)=vmode then + begin append_to_vlist(cur_box); + if adjust_tail<>null then + begin if adjust_head<>adjust_tail then + begin link(tail):=link(adjust_head); tail:=adjust_tail; + end; + adjust_tail:=null; + end; + if mode>0 then build_page; + end + else begin + if abs(mode)=hmode then + space_factor:=1000 + else begin p:=new_noad; + math_type(nucleus(p)):=sub_box; + info(nucleus(p)):=cur_box; cur_box:=p; + end; + link(tail):=cur_box; tail:=cur_box; + end; +end; +end +@z + +@x [47.1078] l.21585 - pTeX: box_dir adjust + begin append_glue; subtype(tail):=box_context-(leader_flag-a_leaders); + leader_ptr(tail):=cur_box; + end +@y + begin append_glue; subtype(tail):=box_context-(leader_flag-a_leaders); + if type(cur_box)<=dir_node then + begin p:=link(cur_box); link(cur_box):=null; + while p<>null do + begin q:=p; p:=link(p); + if box_dir(q)=abs(direction) then + begin list_ptr(q):=cur_box; cur_box:=q; link(cur_box):=null; + end + else begin + delete_glue_ref(space_ptr(q)); + delete_glue_ref(xspace_ptr(q)); + free_node(q,box_node_size); + end; + end; + if box_dir(cur_box)<>abs(direction) then + cur_box:=new_dir_node(cur_box,abs(direction)); + end; + leader_ptr(tail):=cur_box; + end +@z + +@x [47.1079] l.21605 - pTeX: disp_node, adjust direction +var @!p,@!q:pointer; {run through the current list} +@!m:quarterword; {the length of a replacement list} +@!k:halfword; {0 or |vmode| or |hmode|} +@!n:eight_bits; {a box number} +@y +var @!p,@!q:pointer; {run through the current list} +@!m:quarterword; {the length of a replacement list} +@!k:halfword; {0 or |vmode| or |hmode|} +@!n:eight_bits; {a box number} +@!a_dir:eight_bits; {adjust direction} +@!d:pointer; {last |disp_node|} +@!disp,@!pdisp:scaled; {displacement} +@!pp,pnode:pointer; +@z + +@x [47.1080] l.21636 - pTeX: disp_node, check head=tail +else begin if not is_char_node(tail) then + if (type(tail)=hlist_node)or(type(tail)=vlist_node) then + @<Remove the last box, unless it's part of a discretionary@>; + end; +@y +else begin + if (not is_char_node(tail))and(type(tail)=disp_node) then + begin d:=tail; tail:=prev_node; + end + else d:=null; + if (not is_char_node(tail))and(head<>tail) then + if (type(tail)=hlist_node)or(type(tail)=vlist_node) + or(type(tail)=dir_node) then + @<Remove the last box, unless it's part of a discretionary@>; + if d<>null then + if (not is_char_node(tail))and(type(tail)=disp_node) then + begin prev_node:=pnode; prev_disp:=pdisp; + if prev_disp=disp_dimen(d) then free_node(tail,small_node_size) + else disp_dimen(tail):=disp_dimen(d); + free_node(d,small_node_size); + end + else tail_append(d); + end; +@z + +@x [47.1081] l.21642 - pTeX: disp_node +@ @<Remove the last box...@>= +begin q:=head; +repeat p:=q; +if not is_char_node(q) then if type(q)=disc_node then + begin for m:=1 to replace_count(q) do p:=link(p); + if p=tail then goto done; + end; +q:=link(p); +until q=tail; +cur_box:=tail; shift_amount(cur_box):=0; +tail:=p; link(p):=null; +done:end +@y +@ @<Remove the last box...@>= +begin q:=head; disp:=0; pdisp:=0; +repeat p:=q; +if not is_char_node(q) then + if type(q)=disc_node then + begin for m:=1 to replace_count(q) do p:=link(p); + if p=tail then goto done; + end + else if type(q)=disp_node then + begin pnode:=pp; pdisp:=disp; disp:=disp_dimen(q); + end; +pp:=q; q:=link(p); +until q=tail; +cur_box:=tail; shift_amount(cur_box):=0; +tail:=p; link(p):=null; +if type(cur_box)=dir_node then + begin link(list_ptr(cur_box)):=cur_box; + cur_box:=list_ptr(cur_box); + list_ptr(link(cur_box)):=null; + end +else + if box_dir(cur_box)=dir_default then box_dir(cur_box):=abs(direction); +done:end +@z + +@x [47.1083] l.21675 - pTeX: adjust_dir +if k=hmode then + if (box_context<box_flag)and(abs(mode)=vmode) then + scan_spec(adjusted_hbox_group,true) + else scan_spec(hbox_group,true) +else begin if k=vmode then scan_spec(vbox_group,true) + else begin scan_spec(vtop_group,true); k:=vmode; + end; + normal_paragraph; + end; +push_nest; mode:=-k; +@y +a_dir:=adjust_dir; +if k=hmode then + if (box_context<box_flag)and(abs(mode)=vmode) then + begin a_dir:=abs(direction); scan_spec(adjusted_hbox_group,true); + end + else scan_spec(hbox_group,true) +else begin if k=vmode then scan_spec(vbox_group,true) + else begin scan_spec(vtop_group,true); k:=vmode; + end; + normal_paragraph; + end; +push_nest; mode:=-k; adjust_dir:=a_dir; +@z + +@x [47.1085] l.21717 - pTeX: end of box, call adjust_hlist +hbox_group: package(0); +adjusted_hbox_group: begin adjust_tail:=adjust_head; package(0); + end; +@y +hbox_group: begin adjust_hlist(head,false); package(0); + end; +adjusted_hbox_group: begin adjust_hlist(head,false); + adjust_tail:=adjust_head; package(0); + end; +@z + +@x [47.1086] l.21730 - pTeX: set cur_kanji_skip, cur_xkanji_skip +begin d:=box_max_depth; unsave; save_ptr:=save_ptr-3; +if mode=-hmode then cur_box:=hpack(link(head),saved(2),saved(1)) +else begin cur_box:=vpackage(link(head),saved(2),saved(1),d); + if c=vtop_code then @<Readjust the height and depth of |cur_box|, + for \.{\\vtop}@>; + end; +pop_nest; box_end(saved(0)); +end; +@y +begin d:=box_max_depth; + delete_glue_ref(cur_kanji_skip); delete_glue_ref(cur_xkanji_skip); + if auto_spacing>0 then cur_kanji_skip:=kanji_skip + else cur_kanji_skip:=zero_glue; + if auto_xspacing>0 then cur_xkanji_skip:=xkanji_skip + else cur_xkanji_skip:=zero_glue; + add_glue_ref(cur_kanji_skip); add_glue_ref(cur_xkanji_skip); + unsave; save_ptr:=save_ptr-3; + if mode=-hmode then begin + cur_box:=hpack(link(head),saved(2),saved(1)); + box_dir(cur_box):=abs(direction); pop_nest; + end else begin + cur_box:=vpackage(link(head),saved(2),saved(1),d); + box_dir(cur_box):=abs(direction); pop_nest; + if c=vtop_code then + @<Readjust the height and depth of |cur_box|, for \.{\\vtop}@>; + end; + box_end(saved(0)); +end; +@z + +@x [47.1090] l.21765 - pTeX: apend vmode case +vmode+letter,vmode+other_char,vmode+char_num,vmode+char_given, + vmode+math_shift,vmode+un_hbox,vmode+vrule, + vmode+accent,vmode+discretionary,vmode+hskip,vmode+valign, + vmode+ex_space,vmode+no_boundary:@t@>@;@/ + begin back_input; new_graf(true); + end; +@y +vmode+letter,vmode+other_char,vmode+char_num,vmode+char_given, + vmode+math_shift,vmode+un_hbox,vmode+vrule, + vmode+accent,vmode+discretionary,vmode+hskip,vmode+valign, + vmode+kanji,vmode+kana,vmode+other_kchar, + vmode+ex_space,vmode+no_boundary:@t@>@;@/ + begin back_input; new_graf(true); + end; +@z + +@x [47.1091] l.21782 - pTeX: new_graf, adjust direction +push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang; +@y +push_nest; adjust_dir:=abs(direction); +mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang; +@z + +@x [47.1096] l.21842 - pTeX: end_graf, call adjust_hlist + begin if head=tail then pop_nest {null paragraphs are ignored} + else line_break(widow_penalty); +@y + begin if head=tail then pop_nest {null paragraphs are ignored} + else begin adjust_hlist(head,true); line_break(widow_penalty) + end; +@z + +@x [47.1099] l.21871 - pTeX: insert and adjust +new_save_level(insert_group); scan_left_brace; normal_paragraph; +push_nest; mode:=-vmode; prev_depth:=ignore_depth; +@y +new_save_level(insert_group); scan_left_brace; normal_paragraph; +push_nest; mode:=-vmode; direction:=adjust_dir; prev_depth:=ignore_depth; +@z + +@x [47.1100] l.21876 - pTeX: free box node, ins_dir +insert_group: begin end_graf; q:=split_top_skip; add_glue_ref(q); + d:=split_max_depth; f:=floating_penalty; unsave; decr(save_ptr); + {now |saved(0)| is the insertion number, or 255 for |vadjust|} + p:=vpack(link(head),natural); pop_nest; + if saved(0)<255 then + begin tail_append(get_node(ins_node_size)); + type(tail):=ins_node; subtype(tail):=qi(saved(0)); + height(tail):=height(p)+depth(p); ins_ptr(tail):=list_ptr(p); + split_top_ptr(tail):=q; depth(tail):=d; float_cost(tail):=f; + end + else begin tail_append(get_node(small_node_size)); + type(tail):=adjust_node;@/ + subtype(tail):=0; {the |subtype| is not used} + adjust_ptr(tail):=list_ptr(p); delete_glue_ref(q); + end; + free_node(p,box_node_size); + if nest_ptr=0 then build_page; + end; +@y +insert_group: begin end_graf; q:=split_top_skip; add_glue_ref(q); + d:=split_max_depth; f:=floating_penalty; unsave; decr(save_ptr); + {now |saved(0)| is the insertion number, or 255 for |vadjust|} + p:=vpack(link(head),natural); box_dir(p):=abs(direction); pop_nest; + if saved(0)<255 then + begin r:=get_node(ins_node_size); + type(r):=ins_node; subtype(r):=qi(saved(0)); + height(r):=height(p)+depth(p); ins_ptr(r):=list_ptr(p); + split_top_ptr(r):=q; depth(r):=d; float_cost(r):=f; + ins_dir(r):=box_dir(p); + if (not is_char_node(tail))and(type(tail)=disp_node) then + prev_append(r) + else tail_append(r); + end + else begin + if box_dir(p)<>adjust_dir then + begin print_err("Direction Incompatible."); + help1("\vadjust's argument and outer vlist must have same direction."); + error; flush_node_list(list_ptr(p)); + end + else begin + r:=get_node(small_node_size); type(r):=adjust_node;@/ + adjust_ptr(r):=list_ptr(p); delete_glue_ref(q); + if (not is_char_node(tail))and(type(tail)=disp_node) then + prev_append(r) + else tail_append(r); + end; + end; + delete_glue_ref(space_ptr(p)); + delete_glue_ref(xspace_ptr(p)); + free_node(p,box_node_size); + if nest_ptr=0 then build_page; + end; +@z + +@x [47.1101] l.21901 - pTeX: mark_node, prev_append +mark_ptr(p):=def_ref; link(tail):=p; tail:=p; +@y +mark_ptr(p):=def_ref; +if (not is_char_node(tail))and(type(tail)=disp_node) then + prev_append(p) +else tail_append(p); +@z + +@x [47.1103] l.21911 - pTeX: penalty, prev_append +procedure append_penalty; +begin scan_int; tail_append(new_penalty(cur_val)); +if mode=vmode then build_page; +end; +@y +procedure append_penalty; +begin scan_int; + if (not is_char_node(tail))and(type(tail)=disp_node) then + prev_append(new_penalty(cur_val)) + else tail_append(new_penalty(cur_val)); + if mode=vmode then build_page; +end; +@z + +@x [47.1105] l.21932 - pTeX: delete_last: disp_node +var @!p,@!q:pointer; {run through the current list} +@!m:quarterword; {the length of a replacement list} +@y +var @!p,@!q:pointer; {run through the current list} +@!m:quarterword; {the length of a replacement list} +@!d:pointer; {last |disp_node|} +@!disp,@!pdisp:scaled; {displacement} +@!pp,pnode:pointer; +@z + +@x [47.1105] l.21937 - pTeX: delete_last: disp_node +else begin if not is_char_node(tail) then if type(tail)=cur_chr then + begin q:=head; + repeat p:=q; + if not is_char_node(q) then if type(q)=disc_node then + begin for m:=1 to replace_count(q) do p:=link(p); + if p=tail then return; + end; + q:=link(p); + until q=tail; + link(p):=null; flush_node_list(tail); tail:=p; + end; + end; +exit:end; +@y +else begin + if (not is_char_node(tail))and(type(tail)=disp_node) then + begin d:=tail; tail:=prev_node; link(tail):=null; + end + else d:=null; + if not is_char_node(tail) then if type(tail)=cur_chr then + begin q:=head; pp:=null; disp:=0; pdisp:=0; + repeat p:=q; + if not is_char_node(q) then + if type(q)=disc_node then + begin for m:=1 to replace_count(q) do p:=link(p); + if p=tail then + begin if d<>null then tail_append(d); + return; + end + end + else if type(q)=disp_node then + begin pnode:=pp; pdisp:=disp; disp:=disp_dimen(q); + end; + pp:=q; q:=link(p); + until q=tail; + link(p):=null; flush_node_list(tail); tail:=p; + end; + prev_node:=pnode; prev_disp:=pdisp; + if d<>null then + if (not is_char_node(tail))and(type(tail)=disp_node) then + begin if prev_disp=disp_dimen(d) then + free_node(tail,small_node_size) + else disp_dimen(tail):=disp_dimen(d); + free_node(d,small_node_size) + end + else + begin prev_node:=tail; prev_disp:=disp; tail_append(d) + end + end; +exit:end; +@z + +@x [47.1110] l.21997 -pTeX: free box node, delete kanji_skip +var p:pointer; {the box} +@!c:box_code..copy_code; {should we copy?} +@y +var p:pointer; {the box} +@!c:box_code..copy_code; {should we copy?} +@!disp:scaled; {displacement} +@z + +@x [47.1110] l.22001 - pTeX: free box node, delete kanji_skip +if (abs(mode)=mmode)or((abs(mode)=vmode)and(type(p)<>vlist_node))or@| + ((abs(mode)=hmode)and(type(p)<>hlist_node)) then + begin print_err("Incompatible list can't be unboxed"); +@.Incompatible list...@> + help3("Sorry, Pandora. (You sneaky devil.)")@/ + ("I refuse to unbox an \hbox in vertical mode or vice versa.")@/ + ("And I can't open any boxes in math mode.");@/ + error; return; + end; +if c=copy_code then link(tail):=copy_node_list(list_ptr(p)) +else begin link(tail):=list_ptr(p); box(cur_val):=null; + free_node(p,box_node_size); + end; +while link(tail)<>null do tail:=link(tail); +@y +if type(p)=dir_node then p:=list_ptr(p); +if (abs(mode)=mmode)or((abs(mode)=vmode)and(type(p)<>vlist_node))or@| + ((abs(mode)=hmode)and(type(p)<>hlist_node)) then + begin print_err("Incompatible list can't be unboxed"); +@.Incompatible list...@> + help3("Sorry, Pandora. (You sneaky devil.)")@/ + ("I refuse to unbox an \hbox in vertical mode or vice versa.")@/ + ("And I can't open any boxes in math mode.");@/ + error; return; +end; +case box_dir(p) of + any_dir: + if abs(direction)<>box_dir(p) then begin + print_err("Incompatible direction list can't be unboxed"); + help2("Sorry, Pandora. (You sneaky devil.)")@/ + ("I refuse to unbox a box in differrent direction.");@/ + error; return; + end; +endcases; +disp:=0; +if c=copy_code then link(tail):=copy_node_list(list_ptr(p)) +else + begin if type(box(cur_val))=dir_node then + begin delete_glue_ref(space_ptr(box(cur_val))); + delete_glue_ref(xspace_ptr(box(cur_val))); + free_node(box(cur_val),box_node_size); + end; + flush_node_list(link(p)); + link(tail):=list_ptr(p); box(cur_val):=null; + delete_glue_ref(space_ptr(p)); + delete_glue_ref(xspace_ptr(p)); + free_node(p,box_node_size); + end; +while link(tail)<>null do + begin p:=tail; tail:=link(tail); + if not is_char_node(tail) then + case type(tail) of + glue_node : + if (subtype(tail)=kanji_skip_code+1) + or(subtype(tail)=xkanji_skip_code+1) then + begin link(p):=link(tail); + delete_glue_ref(glue_ptr(tail)); + free_node(tail,small_node_size); tail:=p; + end; + penalty_node : + if subtype(tail)=widow_pena then + begin link(p):=link(tail); free_node(tail,small_node_size); + tail:=p; + end; + disp_node : + begin prev_disp:=disp; disp:=disp_dimen(tail); prev_node:=p; + end; + endcases; + end; +@z + +@x [47.1113] l.22028 - pTeX: italic correction, ita_kern +procedure append_italic_correction; +label exit; +var p:pointer; {|char_node| at the tail of the current list} +@!f:internal_font_number; {the font in the |char_node|} +begin if tail<>head then + begin if is_char_node(tail) then p:=tail + else if type(tail)=ligature_node then p:=lig_char(tail) + else return; + f:=font(p); + tail_append(new_kern(char_italic(f)(char_info(f)(character(p))))); + subtype(tail):=explicit; + end; +@y +procedure append_italic_correction; +label exit; +var p:pointer; {|char_node| at the tail of the current list} +@!f:internal_font_number; {the font in the |char_node|} +@!d:pointer; {|disp_node|} +begin if tail<>head then + begin + if (not is_char_node(tail))and(type(tail)=disp_node) then + begin d:=tail; tail:=prev_node; + end + else d:=null; + if (last_jchr<>null)and(link(last_jchr)=tail)and(is_char_node(tail)) then + p:=last_jchr + else if is_char_node(tail) then p:=tail + else if type(tail)=ligature_node then p:=lig_char(tail) + else return; + f:=font(p); + tail_append(new_kern(char_italic(f)(char_info(f)(character(p))))); + subtype(tail):=ita_kern; + if d<>null then + begin prev_node:=tail; tail_append(d); + end; + end; +@z + +@x [47.1120] l.22119 - pTeX: discretionary with disp_node +decr(save_ptr); return; +@y +decr(save_ptr); +prev_node:=tail; tail_append(get_node(small_node_size)); +type(tail):=disp_node; disp_dimen(tail):=0; prev_disp:=0; +return; +@z + +@x [47.1121] l.22127 - pTeX: discretionary with disp_node + begin if not is_char_node(p) then if type(p)>rule_node then + if type(p)<>kern_node then if type(p)<>ligature_node then + begin print_err("Improper discretionary list"); +@y + begin if not is_char_node(p) then + if (type(p)>rule_node)and(type(p)<>kern_node)and + (type(p)<>ligature_node)and(type(p)<>disp_node) then + if (type(p)=penalty_node)and(subtype(p)<>normal) then + begin link(q):=link(p); free_node(p,small_node_size); p:=q; + end + else + begin print_err("Improper discretionary list"); +@z + +@x [47.1123] l.22160 - pTeX: make_accent, Kanji, insert disp_node +var s,@!t: real; {amount of slant} +@y +var s,@!t: real; {amount of slant} +@!disp:scaled; {displacement} +@!cx:KANJI_code; {temporary register for KANJI} +@z + +@x [47.1123] l.22165 - pTeX: make_accent, Kanji, insert disp_node +begin scan_char_num; f:=cur_font; p:=new_character(f,cur_val); +@y +begin scan_char_num; +if (cur_val<0)or(cur_val>255) then + begin KANJI(cx):=cur_val; + if direction=dir_tate then f:=cur_tfont else f:=cur_jfont; + p:=new_character(f,get_jfm_pos(KANJI(cx),f)); + {DEBUG if p<>null then ...} + link(p):=get_avail; info(link(p)):=KANJI(cx); + end +else begin f:=cur_font; p:=new_character(f,cur_val); + end; +@z + +@x [47.1123] l.22175 - pTeX: make_accent, Kanji, insert disp_node + link(tail):=p; tail:=p; space_factor:=1000; +@y + link(tail):=p; + if link(p)<>null then tail:=link(p) else tail:=p; + @<Append |disp_node| at end of displace area@>; + space_factor:=1000; +@z + +@x [47.1124] l.22180 - pTeX: make_accent Kanji, insert disp_node +q:=null; f:=cur_font; +if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given) then + q:=new_character(f,cur_chr) +else if cur_cmd=char_num then + begin scan_char_num; q:=new_character(f,cur_val); + end +else back_input +@y +q:=null; f:=cur_font; KANJI(cx):=empty; +if (cur_cmd=letter)or(cur_cmd=other_char) then + q:=new_character(f,cur_chr) +else if (cur_cmd=kanji)or(cur_cmd=kana)or(cur_cmd=other_kchar) then + begin if direction=dir_tate then f:=cur_tfont else f:=cur_jfont; + cx:=cur_chr; + end +else if cur_cmd=char_given then + if (cur_chr>=0)and(cur_chr<256)then q:=new_character(f,cur_chr) + else begin + if direction=dir_tate then f:=cur_tfont else f:=cur_jfont; + KANJI(cx):=cur_chr + end + else if cur_cmd=char_num then + begin scan_char_num; + if (cur_chr>=0)and(cur_chr<256)then q:=new_character(f,cur_val) + else begin + if direction=dir_tate then f:=cur_tfont else f:=cur_jfont; + KANJI(cx):=cur_chr + end + end +else back_input; +if direction=dir_tate then + begin if font_dir[f]=dir_tate then disp:=0 + else if font_dir[f]=dir_yoko then disp:=t_baseline_shift-y_baseline_shift + else disp:=t_baseline_shift + end +else begin if font_dir[f]=dir_yoko then disp:=0 + else if font_dir[f]=dir_tate then disp:=y_baseline_shift-t_baseline_shift + else disp:=y_baseline_shift + end; +@<Append |disp_node| at begin of displace area@>; +if KANJI(cx)<>empty then + begin q:=new_character(f,get_jfm_pos(KANJI(cx),f)); + link(q):=get_avail; info(link(q)):=KANJI(cx); + end; +@z + +@x [47.1125] l.22200 - pTeX: make_accent Kanji +if h<>x then {the accent must be shifted up or down} + begin p:=hpack(p,natural); shift_amount(p):=x-h; + end; +@y +if h<>x then {the accent must be shifted up or down} + begin delete_glue_ref(cur_kanji_skip); delete_glue_ref(cur_xkanji_skip); + cur_kanji_skip:=zero_glue; cur_xkanji_skip:=zero_glue; + add_glue_ref(cur_kanji_skip); add_glue_ref(cur_xkanji_skip); + p:=hpack(p,natural); shift_amount(p):=x-h; + end; +@z + +@x l.22334 - pTeX +procedure cs_error; +begin +if cur_chr = 10 then +begin + print_err("Extra "); print_esc("endmubyte"); +@.Extra \\endmubyte@> + help1("I'm ignoring this, since I wasn't doing a \mubyte."); +end else begin + print_err("Extra "); print_esc("endcsname"); +@.Extra \\endcsname@> + help1("I'm ignoring this, since I wasn't doing a \csname."); +end; +@y +procedure cs_error; +begin print_err("Extra "); print_esc("endcsname"); +@.Extra \\endcsname@> +help1("I'm ignoring this, since I wasn't doing a \csname."); +@z + +@x [48.1138] l.22385 - pTeX: init math : direction < 0 ... math direction +if (cur_cmd=math_shift)and(mode>0) then @<Go into display math mode@> +else begin back_input; @<Go into ordinary math mode@>; + end; +@y +if (cur_cmd=math_shift)and(mode>0) then @<Go into display math mode@> +else begin back_input; @<Go into ordinary math mode@>; + end; +direction:=-abs(direction); +@z + +@x [48.1145] l.22435 - pTeX: Call adjust_hlist at begin of display +else begin line_break(display_widow_penalty);@/ +@y +else begin adjust_hlist(head,true); line_break(display_widow_penalty);@/ +@z + +@x [48.1147] l.22471 - pTeX: Skip kanji 2nd node, dir_node +reswitch: if is_char_node(p) then + begin f:=font(p); d:=char_width(f)(char_info(f)(character(p))); + goto found; + end; +case type(p) of +hlist_node,vlist_node,rule_node: begin d:=width(p); goto found; + end; +@y +reswitch: if is_char_node(p) then + begin f:=font(p); d:=char_width(f)(orig_char_info(f)(character(p))); + if font_dir[f]<>dir_default then p:=link(p); + goto found; + end; +case type(p) of +hlist_node,vlist_node,dir_node,rule_node: begin d:=width(p); goto found; + end; +@z + +@x [48.1150] l.22541 - pTeX: scan_math +mmode+left_brace: begin tail_append(new_noad); + back_input; scan_math(nucleus(tail)); + end; +@y +mmode+left_brace: begin tail_append(new_noad); + back_input; scan_math(nucleus(tail),kcode_noad(tail)); + end; +@z + +@x [48.1151] l.22555 - pTeX: scan_math: use Kanji in math_mode +procedure scan_math(@!p:pointer); +label restart,reswitch,exit; +var c:integer; {math character code} +begin restart:@<Get the next non-blank non-relax...@>; +reswitch:case cur_cmd of +letter,other_char,char_given: begin c:=ho(math_code(cur_chr)); + if c=@'100000 then + begin @<Treat |cur_chr| as an active character@>; + goto restart; + end; + end; +@y +procedure scan_math(@!p,@!q:pointer); +label restart,reswitch,exit; +var c:integer; {math character code} +cx:KANJI_code; {temporary register for KANJI} +begin KANJI(cx):=0; +restart: @<Get the next non-blank non-relax...@>; +reswitch:case cur_cmd of +letter,other_char,char_given: + if (cur_chr>=0)and(cur_chr<=256) then begin + c:=ho(math_code(cur_chr)); + if c=@'100000 then + begin @<Treat |cur_chr| as an active character@>; + goto restart; + end; + end + else + KANJI(cx):=cur_chr; +kanji,kana,other_kchar: cx:=cur_chr; +@z + +@x [48.1151] l.22576 - pTeX: scan_math: use Kanji in math_mode +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; +@y +if KANJI(cx)=0 then + begin 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; + if font_dir[fam_fnt(fam(p)+cur_size)]<>dir_default then + begin print_err("Not one-byte family"); + help1("IGNORE.");@/ + error; + end + end +else begin + if q=null then + begin math_type(p):=sub_mlist; info(p):=new_noad; + p:=nucleus(info(p)); q:=kcode_noad_nucleus(p); + end; + math_type(p):=math_jchar; fam(p):=cur_jfam; character(p):=qi(0); + info(q):=KANJI(cx); + if font_dir[fam_fnt(fam(p)+cur_size)]=dir_default then + begin print_err("Not two-byte family"); + help1("IGNORE.");@/ + error; + end + end; +@z + +@x [48.1154] l.22605 - pTeX: math mode +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; +@y +mmode+letter,mmode+other_char,mmode+char_given: + if (cur_chr>=0)and(cur_chr<256) then + if cur_chr<128 then set_math_char(ho(math_code(cur_chr))) + else set_math_char(cur_chr) + else set_math_kchar(cur_chr); +mmode+kanji,mmode+kana,mmode+other_kchar: begin + cx:=cur_chr; set_math_kchar(KANJI(cx)); + end; +mmode+char_num: begin scan_char_num; cur_chr:=cur_val; + if (cur_chr>=0)and(cur_chr<256) then + if cur_chr<128 then set_math_char(ho(math_code(cur_chr))) + else set_math_char(cur_chr) + else set_math_kchar(cur_chr); + end; +@z + +@x [48.1155] l.22635 - pTeX: set_math_char + link(tail):=p; tail:=p; +@y + link(tail):=p; tail:=p; + if font_dir[fam_fnt(fam(nucleus(p))+cur_size)]<>dir_default then begin + print_err("Not one-byte family"); + help1("IGNORE.");@/ + error; + end +@z + +@x [48.1158] l.22690 - pTeX: scan_math + type(tail):=cur_chr; scan_math(nucleus(tail)); +@y + type(tail):=cur_chr; scan_math(nucleus(tail),kcode_noad(tail)); +@z + +@x [48.1163] l.22750 - pTeX: scan_math +scan_delimiter(left_delimiter(tail),true); scan_math(nucleus(tail)); +@y +scan_delimiter(left_delimiter(tail),true); +scan_math(nucleus(tail),kcode_noad(tail)); +@z + +@x [48.1164] l.22770 - pTeX: scan_math +scan_math(nucleus(tail)); +@y +scan_math(nucleus(tail),kcode_noad(tail)); +@z + +@x [48.1164] l.22790 - pTeX: vcenter : dir +vcenter_group: begin end_graf; unsave; save_ptr:=save_ptr-2; + p:=vpack(link(head),saved(1),saved(0)); pop_nest; + tail_append(new_noad); type(tail):=vcenter_noad; + math_type(nucleus(tail)):=sub_box; info(nucleus(tail)):=p; + end; +@y +vcenter_group: begin end_graf; unsave; save_ptr:=save_ptr-2; + p:=vpack(link(head),saved(1),saved(0)); + box_dir(p):=abs(direction); pop_nest; + if box_dir(p)<>abs(direction) then p:=new_dir_node(p,abs(direction)); + tail_append(new_noad); type(tail):=vcenter_noad; + math_type(nucleus(tail)):=sub_box; info(nucleus(tail)):=p; + end; +@z + +@x [48.1176] l.22864 - pTeX: scan_math +scan_math(p); +@y +scan_math(p,null); +@z + +@x [48.1186] l.23006 - pTeX: copy kanji code + if math_type(supscr(p))=empty then + begin mem[saved(0)].hh:=mem[nucleus(p)].hh; +@y + if ((math_type(supscr(p))=empty)and(math_kcode(p)=null)) then + begin mem[saved(0)].hh:=mem[nucleus(p)].hh; +@z + +@x [48.1194] l.23078 - pTeX: set cur_kanji_skip, cur_xkanji_skip +var l:boolean; {`\.{\\leqno}' instead of `\.{\\eqno}'} +@y +var l:boolean; {`\.{\\leqno}' instead of `\.{\\eqno}'} +@!disp:scaled; {displacement} +@z + +@x [48.1194] l.23087 - pTeX: set cur_kanji_skip, cur_xkanji_skip +m:=mode; l:=false; p:=fin_mlist(null); {this pops the nest} +@y +delete_glue_ref(cur_kanji_skip); delete_glue_ref(cur_xkanji_skip); +if auto_spacing>0 then cur_kanji_skip:=kanji_skip +else cur_kanji_skip:=zero_glue; +if auto_xspacing>0 then cur_xkanji_skip:=xkanji_skip +else cur_xkanji_skip:=zero_glue; +add_glue_ref(cur_kanji_skip); add_glue_ref(cur_xkanji_skip); +m:=mode; l:=false; p:=fin_mlist(null); {this pops the nest} +@z + +@x [48.1196] l.23134 - pTeX: insert disp_node +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 if direction=dir_tate then disp:=t_baseline_shift + else disp:=y_baseline_shift; +@<Append |disp_node| at begin of displace area@>; +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)); +@<Append |disp_node| at end of displace area@>; +space_factor:=1000; unsave; +end +@z + +@x [48.1200] l.23203 - pTeX: adjust direction +push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang; +@y +push_nest; adjust_dir:=abs(direction); +mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang; +@z + +@x [48.1201] l.23217 - pTeX: free box node + begin free_node(b,box_node_size); +@y + begin delete_glue_ref(space_ptr(b)); delete_glue_ref(xspace_ptr(b)); + free_node(b,box_node_size); +@z + +@x [48.1201] l.23222 - pTeX: free box node + begin free_node(b,box_node_size); +@y + begin delete_glue_ref(space_ptr(b)); delete_glue_ref(xspace_ptr(b)); + free_node(b,box_node_size); +@z + +@x [49.1210] l.23361 - pTeX: set_auto_spacing +any_mode(toks_register), +any_mode(assign_toks), +any_mode(assign_int), +@y +any_mode(assign_kinsoku), +any_mode(assign_inhibit_xsp_code), +any_mode(set_auto_spacing), +any_mode(set_kansuji_char), +any_mode(toks_register), +any_mode(assign_toks), +any_mode(assign_int), +any_mode(def_jfont), +any_mode(def_tfont), +@z + +@x [49.1211] l.23397 - pTeX: prefixed_command +procedure prefixed_command; +label done,exit; +var a:small_number; {accumulated prefix codes so far} +@y +procedure prefixed_command; +label done,exit; +var a:small_number; {accumulated prefix codes so far} +@!m:integer; {ditto} +@z + +@x l.23403 - pTeX +@!p,@!q,@!r:pointer; {for temporary short-term use} +@y +@!p,@!q:pointer; {for temporary short-term use} +@z + +@x [49.1217] l.23487 - pTeX: select cur font +set_font: define(cur_font_loc,data,cur_chr); +@y +set_font: begin + if font_dir[cur_chr]=dir_yoko then + define(cur_jfont_loc,data,cur_chr) + else if font_dir[cur_chr]=dir_tate then + define(cur_tfont_loc,data,cur_chr) + else + define(cur_font_loc,data,cur_chr) +end; +@z + +@x l.23504 - pTeX +primitive("futurelet",let,normal+1);@/ +@!@:future_let_}{\.{\\futurelet} primitive@> +if enctex_p then +begin + primitive("mubyte",let,normal+10);@/ +@!@:mubyte_}{\.{\\mubyte} primitive@> + primitive("noconvert",let,normal+11);@/ +@!@:noconvert_}{\.{\\noconvert} primitive@> +end; + +@ @<Cases of |print_cmd_chr|...@>= +let: if chr_code<>normal then + if chr_code = normal+10 then print_esc("mubyte") + else if chr_code = normal+11 then print_esc("noconvert") + else print_esc("futurelet") + else print_esc("let"); + +@ @<Assignments@>= +let: if cur_chr = normal+11 then do_nothing { noconvert primitive } + else if cur_chr = normal+10 then { mubyte primitive } + begin + selector:=term_and_log; + get_token; + mubyte_stoken := cur_tok; + if cur_tok <= cs_token_flag then mubyte_stoken := cur_tok mod 256; + mubyte_prefix := 60; mubyte_relax := false; + mubyte_tablein := true; mubyte_tableout := true; + get_x_token; + if cur_cmd = spacer then get_x_token; + if cur_cmd = sub_mark then + begin + mubyte_tableout := false; get_x_token; + if cur_cmd = sub_mark then + begin + mubyte_tableout := true; mubyte_tablein := false; + get_x_token; + end; + end else if (mubyte_stoken > cs_token_flag) and + (cur_cmd = mac_param) then + begin + mubyte_tableout := false; + scan_int; mubyte_prefix := cur_val; get_x_token; + if mubyte_prefix > 50 then mubyte_prefix := 52; + if mubyte_prefix <= 0 then mubyte_prefix := 51; + end + else if (mubyte_stoken > cs_token_flag) and (cur_cmd = relax) then + begin + mubyte_tableout := true; mubyte_tablein := false; + mubyte_relax := true; get_x_token; + end; + r := get_avail; p := r; + while cur_cs = 0 do begin store_new_token (cur_tok); get_x_token; end; + if (cur_cmd <> end_cs_name) or (cur_chr <> 10) then + begin + print_err("Missing "); print_esc("endmubyte"); print(" inserted"); + help2("The control sequence marked <to be read again> should")@/ +("not appear in <byte sequence> between \mubyte and \endmubyte."); + back_error; + end; + p := link(r); + if (p = null) and mubyte_tablein then + begin + print_err("The empty <byte sequence>, "); + print_esc("mubyte"); print(" ignored"); + help2("The <byte sequence> in")@/ +("\mubyte <token> <byte sequence>\endmubyte should not be empty."); + error; + end else begin + while p <> null do + begin + append_char (info(p) mod 256); + p := link (p); + end; + flush_list (r); + if (str_start [str_ptr] + 1 = pool_ptr) and + (str_pool [pool_ptr-1] = mubyte_stoken) then + begin + if mubyte_read [mubyte_stoken] <> null + and mubyte_tablein then { clearing data } + dispose_munode (mubyte_read [mubyte_stoken]); + if mubyte_tablein then mubyte_read [mubyte_stoken] := null; + if mubyte_tableout then mubyte_write [mubyte_stoken] := 0; + pool_ptr := str_start [str_ptr]; + end else begin + if mubyte_tablein then mubyte_update; { updating input side } + if mubyte_tableout then { updating output side } + begin + if mubyte_stoken > cs_token_flag then { control sequence } + begin + dispose_mutableout (mubyte_stoken-cs_token_flag); + if (str_start [str_ptr] < pool_ptr) or mubyte_relax then + begin { store data } + r := mubyte_cswrite[(mubyte_stoken-cs_token_flag) mod 128]; + p := get_avail; + mubyte_cswrite[(mubyte_stoken-cs_token_flag) mod 128] := p; + info (p) := mubyte_stoken-cs_token_flag; + link (p) := get_avail; + p := link (p); + if mubyte_relax then begin + info (p) := 0; pool_ptr := str_start [str_ptr]; + end else info (p) := slow_make_string; + link (p) := r; + end; + end else begin { single character } + if str_start [str_ptr] = pool_ptr then + mubyte_write [mubyte_stoken] := 0 + else + mubyte_write [mubyte_stoken] := slow_make_string; + end; + end else pool_ptr := str_start [str_ptr]; + end; + end; + end else begin { let primitive } + n:=cur_chr; +@y +primitive("futurelet",let,normal+1);@/ +@!@:future_let_}{\.{\\futurelet} primitive@> + +@ @<Cases of |print_cmd_chr|...@>= +let: if chr_code<>normal then print_esc("futurelet")@+else print_esc("let"); + +@ @<Assignments@>= +let: begin n:=cur_chr; +@z + +@x [49.1228] l.23785 - pTeX: assign jfam +assign_int: begin p:=cur_chr; scan_optional_equals; scan_int; + word_define(p,cur_val); + end; +@y +assign_int: begin p:=cur_chr; scan_optional_equals; scan_int; + if p=int_base+cur_fam_code then + begin if font_dir[fam_fnt(cur_val)]<>dir_default then + word_define(int_base+cur_jfam_code,cur_val) + else word_define(p,cur_val); + end + else word_define(p,cur_val); + end; +@z + +@x [49.1230] l.23812 - pTeX: xspcode, kcatcode +@<Put each...@>= +primitive("catcode",def_code,cat_code_base); +@!@:cat_code_}{\.{\\catcode} primitive@> +@y +@<Put each...@>= +primitive("catcode",def_code,cat_code_base); +@!@:cat_code_}{\.{\\catcode} primitive@> +primitive("kcatcode",def_code,kcat_code_base); +@!@:cat_code_}{\.{\\kcatcode} primitive@> +primitive("xspcode",def_code,auto_xsp_code_base); +@!@:auto_xsp_code_}{\.{\\xspcode} primitive@> +@z + +@x l.23815 - pTeX +if enctex_p then +begin + primitive("xordcode",def_code,xord_code_base); +@!@:xord_code_}{\.{\\xordcode} primitive@> + primitive("xchrcode",def_code,xchr_code_base); +@!@:xchr_code_}{\.{\\xchrcode} primitive@> + primitive("xprncode",def_code,xprn_code_base); +@!@:xprn_code_}{\.{\\xprncode} primitive@> +end; +@y +@z + +@x [49.1231] l.23842 - pTeX: xspcode, kcatcode +def_code: if chr_code=xord_code_base then print_esc("xordcode") + else if chr_code=xchr_code_base then print_esc("xchrcode") + else if chr_code=xprn_code_base then print_esc("xprncode") + else if chr_code=cat_code_base then print_esc("catcode") + else if chr_code=math_code_base then print_esc("mathcode") +@y +def_code: if chr_code=cat_code_base then print_esc("catcode") + else if chr_code=kcat_code_base then print_esc("kcatcode") + else if chr_code=auto_xsp_code_base then print_esc("xspcode") + else if chr_code=math_code_base then print_esc("mathcode") +@z + +@x [49.1232] l.23857 - pTeX: kcatcode +def_code: begin @<Let |n| be the largest legal code value, based on |cur_chr|@>; + p:=cur_chr; scan_char_num; + if p=xord_code_base then p:=cur_val + else if p=xchr_code_base then p:=cur_val+256 + else if p=xprn_code_base then p:=cur_val+512 + else p:=p+cur_val; + scan_optional_equals; + scan_int; + if ((cur_val<0)and(p<del_code_base))or(cur_val>n) then + begin print_err("Invalid code ("); print_int(cur_val); +@.Invalid code@> + if p<del_code_base then print("), should be in the range 0..") + else print("), should be at most "); + print_int(n); + help1("I'm going to use 0 instead of that illegal code value.");@/ + error; cur_val:=0; + end; + if p<256 then xord[p]:=cur_val + else if p<512 then xchr[p-256]:=cur_val + else if p<768 then xprn[p-512]:=cur_val + else if p<math_code_base then define(p,data,cur_val) + else if p<del_code_base then define(p,data,hi(cur_val)) + else word_define(p,cur_val); + end; +@y +def_code: begin + @<Let |m| be the minimal legal code value, based on |cur_chr|@>; + @<Let |n| be the largest legal code value, based on |cur_chr|@>; + p:=cur_chr; scan_char_num; + if p=kcat_code_base then p:=p+Hi(cur_val) else p:=p+cur_val; + scan_optional_equals; scan_int; + if ((cur_val<m)and(p<del_code_base))or(cur_val>n) then + begin print_err("Invalid code ("); print_int(cur_val); +@.Invalid code@> + if p<del_code_base then + begin print("), should be in the range "); print_int(m); print(".."); + end + else print("), should be at most "); + print_int(n); + if m=0 then + begin help1("I'm going to use 0 instead of that illegal code value.");@/ + error; + end + else + begin help1("I'm going to use 16 instead of that illegal code value.");@/ + error; + end; + cur_val:=m; + end; + if p<math_code_base then define(p,data,cur_val) + else if p<del_code_base then define(p,data,hi(cur_val)) + else word_define(p,cur_val); + end; +@z + +@x [49.1233] l.23882 - pTeX: kcatcode +@ @<Let |n| be the largest...@>= +if cur_chr=cat_code_base then n:=max_char_code +@y +@ @<Let |m| be the minimal...@>= +if cur_chr=kcat_code_base then m:=kanji else m:=0 + +@ @<Let |n| be the largest...@>= +if cur_chr=cat_code_base then n:=invalid_char {1byte |max_char_code|} +else if cur_chr=kcat_code_base then n:=max_char_code +@z + +@x [49.1247] l.24083 - pTeX: alter_box_dimen : box_dir +procedure alter_box_dimen; +var c:small_number; {|width_offset| or |height_offset| or |depth_offset|} +@!b:eight_bits; {box number} +begin c:=cur_chr; scan_eight_bit_int; b:=cur_val; scan_optional_equals; +scan_normal_dimen; +if box(b)<>null then mem[box(b)+c].sc:=cur_val; +end; +@y +procedure alter_box_dimen; +var c:small_number; {|width_offset| or |height_offset| or |depth_offset|} +@!b:eight_bits; {box number} +@!p,q:pointer; {temporary registers} +begin c:=cur_chr; scan_eight_bit_int; b:=cur_val; scan_optional_equals; +scan_normal_dimen; +if box(b)<>null then + begin q:=box(b); p:=link(q); + while p<>null do + begin if abs(direction)=box_dir(p) then q:=p; + p:=link(p); + end; + if box_dir(q)<>abs(direction) then + begin q:=new_dir_node(q,abs(direction)); list_ptr(q):=null; + link(q):=link(box(b)); link(box(b)):=q; + end; + mem[q+c].sc:=cur_val; + end; +end; +@z + +@x [49.1256] l.24163 - pTeX: def_tfont +def_font: new_font(a); +@y +def_tfont,def_jfont,def_font: new_font(a); +@z + +@x l.24369 - pTeX +message_printing := true; active_noconvert := true; +token_show(def_ref); +message_printing := false; active_noconvert := false; +selector:=old_setting; +@y +token_show(def_ref); selector:=old_setting; +@z + +@x [49.1292] l.24451 - pTeX: shift_case +@<Change the case of the token in |p|, if a change is appropriate@>= +t:=info(p); +if t<cs_token_flag+single_base then + begin c:=t mod 256; + if equiv(b+c)<>0 then info(p):=t-c+equiv(b+c); + end +@y +@<Change the case of the token in |p|, if a change is appropriate@>= +t:=info(p); +if (t<cs_token_flag+single_base)and(not check_kanji(t)) then + begin c:=t mod 256; + if equiv(b+c)<>0 then info(p):=t-c+equiv(b+c); + end +@z + +@x [49.1291] l.24467 - pTeX: show_mode +@d show_lists=3 { \.{\\showlists} } +@y +@d show_lists=3 { \.{\\showlists} } +@d show_mode=4 { \.{\\showmode} } +@z + +@x [49.1291] l.24476 - pTeX: show_mode +primitive("showlists",xray,show_lists); +@!@:show_lists_}{\.{\\showlists} primitive@> +@y +primitive("showlists",xray,show_lists); +@!@:show_lists_}{\.{\\showlists} primitive@> +primitive("showmode",xray,show_mode); +@!@:show_mode_}{\.{\\showmode} primitive@> +@z + +@x [49.1292] l.24483 - pTeX: show_mode + show_lists:print_esc("showlists"); + othercases print_esc("show") +@y + show_lists:print_esc("showlists"); + show_mode:print_esc("showmode"); + othercases print_esc("show") +@z + +@x [49.1293] l.24495 - pTeX: show_mode +show_code: @<Show the current meaning of a token, then |goto common_ending|@>; +@y +show_code: @<Show the current meaning of a token, then |goto common_ending|@>; +show_mode: @<Show the current japanese processing mode@>; +@z + +@x l.24597 - pTeX +@<Dump ML\TeX-specific data@>; +@<Dump enc\TeX-specific data@>; +@y +@<Dump ML\TeX-specific data@>; +@z + +@x l.24631 - pTeX +@<Undump ML\TeX-specific data@>; +@<Undump enc\TeX-specific data@>; +@y +@<Undump ML\TeX-specific data@>; +@z + +@x l.24982 +font_info:=xmalloc_array(fmemory_word, font_mem_size); +@y +font_info:=xmalloc_array(memory_word, font_mem_size); +@z + +@x [50.1320] l.24988 - pTeX: +@ @<Dump the array info for internal font number |k|@>= +begin +dump_things(font_check[null_font], font_ptr+1-null_font); +@y +@ @<Dump the array info for internal font number |k|@>= +begin +dump_things(font_dir[null_font], font_ptr+1-null_font); +dump_things(font_num_ext[null_font], font_ptr+1-null_font); +dump_things(font_check[null_font], font_ptr+1-null_font); +@z + +@x [50.1321] l.25000 - pTeX: +dump_things(char_base[null_font], font_ptr+1-null_font); +@y +dump_things(ctype_base[null_font], font_ptr+1-null_font); +dump_things(char_base[null_font], font_ptr+1-null_font); +@z + +@x [50.1322] l.25024 - pTeX: +@<Undump the array info for internal font number |k|@>= +begin {Allocate the font arrays} +@y +@<Undump the array info for internal font number |k|@>= +begin {Allocate the font arrays} +font_dir:=xmalloc_array(eight_bits, font_max); +font_num_ext:=xmalloc_array(integer, font_max); +@z + +@x [50.1322] l.25040 - pTeX: +char_base:=xmalloc_array(integer, font_max); +@y +ctype_base:=xmalloc_array(integer, font_max); +char_base:=xmalloc_array(integer, font_max); +@z + +@x [50.1322] l.25050 - pTeX: +undump_things(font_check[null_font], font_ptr+1-null_font); +@y +undump_things(font_dir[null_font], font_ptr+1-null_font); +undump_things(font_num_ext[null_font], font_ptr+1-null_font); +undump_things(font_check[null_font], font_ptr+1-null_font); +@z + +@x [50.1322] l.25064 - pTeX: +undump_things(char_base[null_font], font_ptr+1-null_font); +@y +undump_things(ctype_base[null_font], font_ptr+1-null_font); +undump_things(char_base[null_font], font_ptr+1-null_font); +@z + +@x l.25363 - pTeX + font_info:=xmalloc_array (fmemory_word, font_mem_size); +@y + font_info:=xmalloc_array (memory_word, font_mem_size); +@z + +@x l.25539 - pTeX +if enctex_enabled_p then + begin wterm(encTeX_banner); wterm_ln(', reencoding enabled.'); + if translate_filename then begin + wterm_ln(' (\xordcode, \xchrcode, \xprncode overridden by TCX)'); + end; + end; +@y +@z + +@x [51.1337] l.25563 - pTeX: + font_check:=xmalloc_array(four_quarters, font_max); +@y + font_dir:=xmalloc_array(eight_bits, font_max); + font_num_ext:=xmalloc_array(integer, font_max); + font_check:=xmalloc_array(four_quarters, font_max); +@z + +@x [51.1337] l.25577 - pTeX: + char_base:=xmalloc_array(integer, font_max); +@y + ctype_base:=xmalloc_array(integer, font_max); + char_base:=xmalloc_array(integer, font_max); +@z + +@x [51.1337] l.25587 - pTeX: + font_ptr:=null_font; fmem_ptr:=7; +@y + font_ptr:=null_font; fmem_ptr:=7; + font_dir[null_font]:=dir_default; + font_num_ext[null_font]:=0; +@z + +@x [51.1337] l.25594 - pTeX: + char_base[null_font]:=0; width_base[null_font]:=0; +@y + ctype_base[null_font]:=0; char_base[null_font]:=0; width_base[null_font]:=0; +@z + +@x l.25747 - pTeX +@d write_stream(#) == type(#+1) {stream number (0 to 17)} +@d mubyte_zero == 64 +@d write_mubyte(#) == subtype(#+1) {mubyte value + |mubyte_zero|} +@y +@d write_stream(#) == info(#+1) {stream number (0 to 17)} +@z + +@x l.25849 - pTeX + else if (cur_val>15) and (cur_val <> 18) then cur_val:=16; + end; +write_stream(tail):=cur_val; +if mubyte_out + mubyte_zero < 0 then write_mubyte(tail) := 0 +else if mubyte_out + mubyte_zero >= 2*mubyte_zero then + write_mubyte(tail) := 2*mubyte_zero - 1 + else write_mubyte(tail) := mubyte_out + mubyte_zero; +@y + else if (cur_val>15) and (cur_val <> 18) then cur_val:=16; + end; +write_stream(tail):=cur_val; +@z + +@x l.25881 - pTeX +begin new_whatsit(special_node,write_node_size); +if spec_out + mubyte_zero < 0 then write_stream(tail) := 0 +else if spec_out + mubyte_zero >= 2*mubyte_zero then + write_stream(tail) := 2*mubyte_zero - 1 + else write_stream(tail) := spec_out + mubyte_zero; +if mubyte_out + mubyte_zero < 0 then write_mubyte(tail) := 0 +else if mubyte_out + mubyte_zero >= 2*mubyte_zero then + write_mubyte(tail) := 2*mubyte_zero - 1 + else write_mubyte(tail) := mubyte_out + mubyte_zero; +if (spec_out = 2) or (spec_out = 3) then + if (mubyte_out > 2) or (mubyte_out = -1) or (mubyte_out = -2) then + write_noexpanding := true; +p:=scan_toks(false,true); write_tokens(tail):=def_ref; +write_noexpanding := false; +@y +begin new_whatsit(special_node,write_node_size); write_stream(tail):=null; +p:=scan_toks(false,true); write_tokens(tail):=def_ref; +@z + +@x l.25909 - pTeX +if (s = "write") and (write_mubyte (p) <> mubyte_zero) then +begin + print_char ("<"); print_int (write_mubyte(p)-mubyte_zero); print_char (">"); +end; +@y +@z + +@x l.25925 - pTeX +if write_stream(p) <> mubyte_zero then +begin + print_char ("<"); print_int (write_stream(p)-mubyte_zero); + if (write_stream(p)-mubyte_zero = 2) or + (write_stream(p)-mubyte_zero = 3) then + begin + print_char (":"); print_int (write_mubyte(p)-mubyte_zero); + end; + print_char (">"); +end; +@y +@z + +@x l.26009 - pTeX +spec_sout := spec_out; spec_out := write_stream(p) - mubyte_zero; +mubyte_sout := mubyte_out; mubyte_out := write_mubyte(p) - mubyte_zero; +active_noconvert := true; +mubyte_slog := mubyte_log; +mubyte_log := 0; +if (mubyte_out > 0) or (mubyte_out = -1) then mubyte_log := 1; +if (spec_out = 2) or (spec_out = 3) then +begin + if (mubyte_out > 0) or (mubyte_out = -1) then + begin + special_printing := true; mubyte_log := 1; + end; + if mubyte_out > 1 then cs_converting := true; +end; +@y +@z + +@x l.26031 - pTeX +if (spec_out = 1) or (spec_out = 3) then + for k:=str_start[str_ptr] to pool_ptr-1 do + str_pool[k] := si(xchr[so(str_pool[k])]); +for k:=str_start[str_ptr] to pool_ptr-1 do dvi_out(so(str_pool[k])); +spec_out := spec_sout; mubyte_out := mubyte_sout; mubyte_log := mubyte_slog; +special_printing := false; cs_converting := false; +active_noconvert := false; +@y + for k:=str_start[str_ptr] to pool_ptr-1 do dvi_out(so(str_pool[k])); +@z + +@x l.26062 - pTeX +begin +mubyte_sout := mubyte_out; mubyte_out := write_mubyte(p) - mubyte_zero; +if (mubyte_out > 2) or (mubyte_out = -1) or (mubyte_out = -2) then + write_noexpanding := true; +@<Expand macros in the token list +@y +begin @<Expand macros in the token list +@z + +@x l.26077 - pTeX +active_noconvert := true; +if mubyte_out > 1 then cs_converting := true; +mubyte_slog := mubyte_log; +if (mubyte_out > 0) or (mubyte_out = -1) then mubyte_log := 1 +else mubyte_log := 0; +token_show(def_ref); print_ln; +cs_converting := false; write_noexpanding := false; +active_noconvert := false; +mubyte_out := mubyte_sout; mubyte_log := mubyte_slog; +@y + token_show(def_ref); print_ln; +@z + +@x [53.1376] l.26309 - pTeX: +@<Glob...@> = +@!debug_format_file: boolean; +@y +@<Glob...@> = +@!debug_format_file: boolean; + +@ @<Set init...@>= +@!debug debug_format_file:=true; @+gubed; +@z + +@x l.26685 - pTeX +@* \[54/enc\TeX] System-dependent changes for enc\TeX. + +@d encTeX_banner == ' encTeX v. Jun. 2004' + +@ The boolean variable |enctex_p| is set by web2c according to the given +command line option (or an entry in the configuration file) before any +\TeX{} function is called. + +@<Global...@> = +@!enctex_p: boolean; + + +@ The boolean variable |enctex_enabled_p| is used to enable enc\TeX's +primitives. It is initialised to |false|. When loading a \.{FMT} it +is set to the value of the boolean |enctex_p| saved in the \.{FMT} file. +Additionally it is set to the value of |enctex_p| in Ini\TeX. + +@<Glob...@>= +@!enctex_enabled_p:boolean; {enable encTeX} + + +@ @<Set init...@>= +enctex_enabled_p:=false; + + +@ Auxiliary functions/procedures for enc\TeX{} (by Petr Olsak) follow. +These functions implement the \.{\\mubyte} code to convert +the multibytes in |buffer| to one byte or to one control +sequence. These functions manipulate a mubyte tree: each node of +this tree is token list with n+1 tokens (first token consist the byte +from the byte sequence itself and the other tokens point to the +branches). If you travel from root of the tree to a leaf then you +find exactly one byte sequence which we have to convert to one byte or +control sequence. There are two variants of the leaf: the ``definitive +end'' or the ``middle leaf'' if a longer byte sequence exists and the mubyte +tree continues under this leaf. First variant is implemented as one +memory word where the link part includes the token to +which we have to convert and type part includes the number 60 (normal +conversion) or 1..52 (insert the control sequence). +The second variant of ``middle leaf'' is implemented as two memory words: +first one has a type advanced by 64 and link points to the second +word where info part includes the token to which we have to convert +and link points to the next token list with the branches of +the subtree. + +The inverse: one byte to multi byte (for log printing and \.{\\write} +printing) is implemented via a pool. Each multibyte sequence is stored +in a pool as a string and |mubyte_write|[{\it printed char\/}] points +to this string. + +@d new_mubyte_node == + link (p) := get_avail; p := link (p); info (p) := get_avail; p := info (p) +@d subinfo (#) == subtype (#) + +@<Basic printing...@>= +{ read |buffer|[|i|] and convert multibyte. |i| should have been + of type 0..|buf_size|, but web2c doesn't like that construct in + argument lists. } +function read_buffer(var i:integer):ASCII_code; +var p: pointer; + last_found: integer; + last_type: integer; +begin + mubyte_skip := 0; mubyte_token := 0; + read_buffer := buffer[i]; + if mubyte_in = 0 then + begin + if mubyte_keep > 0 then mubyte_keep := 0; + return ; + end; + last_found := -2; + if (i = start) and (not mubyte_start) then + begin + mubyte_keep := 0; + if (end_line_char >= 0) and (end_line_char < 256) then + if mubyte_read [end_line_char] <> null then + begin + mubyte_start := true; mubyte_skip := -1; + p := mubyte_read [end_line_char]; + goto continue; + end; + end; +restart: + mubyte_start := false; + if (mubyte_read [buffer[i]] = null) or (mubyte_keep > 0) then + begin + if mubyte_keep > 0 then decr (mubyte_keep); + return ; + end; + p := mubyte_read [buffer[i]]; +continue: + if type (p) >= 64 then + begin + last_type := type (p) - 64; + p := link (p); + mubyte_token := info (p); last_found := mubyte_skip; + end else if type (p) > 0 then + begin + last_type := type (p); + mubyte_token := link (p); + goto found; + end; + incr (mubyte_skip); + if i + mubyte_skip > limit then + begin + mubyte_skip := 0; + if mubyte_start then goto restart; + return; + end; + repeat + p := link (p); + if subinfo (info(p)) = buffer [i+mubyte_skip] then + begin + p := info (p); goto continue; + end; + until link (p) = null; + mubyte_skip := 0; + if mubyte_start then goto restart; + if last_found = -2 then return; { no found } + mubyte_skip := last_found; +found: + if mubyte_token < 256 then { multibyte to one byte } + begin + read_buffer := mubyte_token; mubyte_token := 0; + i := i + mubyte_skip; + if mubyte_start and (i >= start) then mubyte_start := false; + return; + end else begin { multibyte to control sequence } + read_buffer := 0; + if last_type = 60 then { normal conversion } + i := i + mubyte_skip + else begin { insert control sequence } + decr (i); mubyte_keep := last_type; + if i < start then mubyte_start := true; + if last_type = 52 then mubyte_keep := 10000; + if last_type = 51 then mubyte_keep := mubyte_skip + 1; + mubyte_skip := -1; + end; + if mubyte_start and (i >= start) then mubyte_start := false; + return; + end; +exit: end; + +@ @<Declare additional routines for enc\TeX@>= +procedure mubyte_update; { saves new string to mubyte tree } +var j: pool_pointer; + p: pointer; + q: pointer; + in_mutree: integer; +begin + j := str_start [str_ptr]; + if mubyte_read [so(str_pool[j])] = null then + begin + in_mutree := 0; + p := get_avail; + mubyte_read [so(str_pool[j])] := p; + subinfo (p) := so(str_pool[j]); type (p) := 0; + end else begin + in_mutree := 1; + p := mubyte_read [so(str_pool[j])]; + end; + incr (j); + while j < pool_ptr do + begin + if in_mutree = 0 then + begin + new_mubyte_node; subinfo (p) := so(str_pool[j]); type (p) := 0; + end else { |in_mutree| = 1 } + if (type (p) > 0) and (type (p) < 64) then + begin + type (p) := type (p) + 64; + q := link (p); link (p) := get_avail; p := link (p); + info (p) := q; + new_mubyte_node; subinfo (p) := so(str_pool[j]); type (p) := 0; + in_mutree := 0; + end else begin + if type (p) >= 64 then p := link (p); + repeat + p := link (p); + if subinfo (info(p)) = so(str_pool[j]) then + begin + p := info (p); + goto continue; + end; + until link (p) = null; + new_mubyte_node; subinfo (p) := so(str_pool[j]); type (p) := 0; + in_mutree := 0; + end; +continue: + incr (j); + end; + if in_mutree = 1 then + begin + if type (p) = 0 then + begin + type (p) := mubyte_prefix + 64; + q := link (p); link (p) := get_avail; p := link (p); + link (p) := q; info (p) := mubyte_stoken; + return; + end; + if type (p) >= 64 then + begin + type (p) := mubyte_prefix + 64; + p := link (p); info (p) := mubyte_stoken; + return; + end; + end; + type (p) := mubyte_prefix; + link (p) := mubyte_stoken; +exit: end; +@# +procedure dispose_munode (p: pointer); { frees a mu subtree recursivelly } +var q: pointer; +begin + if (type (p) > 0) and (type (p) < 64) then free_avail (p) + else begin + if type (p) >= 64 then + begin + q := link (p); free_avail (p); p := q; + end; + q := link (p); free_avail (p); p := q; + while p <> null do + begin + dispose_munode (info (p)); + q := link (p); + free_avail (p); + p := q; + end; + end; +end; +@# +procedure dispose_mutableout (cs: pointer); { frees record from out table } +var p, q, r: pointer; +begin + p := mubyte_cswrite [cs mod 128]; + r := null; + while p <> null do + if info (p) = cs then + begin + if r <> null then link (r) := link (link (p)) + else mubyte_cswrite[cs mod 128] := link (link (p)); + q := link (link(p)); + free_avail (link(p)); free_avail (p); + p := q; + end else begin + r := link (p); p := link (r); + end; +end; + +@ The |print_buffer| procedure prints one character from |buffer|[|i|]. +It also increases |i| to the next character in the buffer. + +@<Basic printing...@>= +{ print one char from |buffer|[|i|]. |i| should have been of type + 0..|buf_size|, but web2c doesn't like that construct in argument lists. } +procedure print_buffer(var i:integer); +var c: ASCII_code; +begin + if mubyte_in = 0 then print (buffer[i]) { normal TeX } + else if mubyte_log > 0 then print_char (buffer[i]) + else begin + c := read_buffer (i); + if mubyte_token > 0 then print_cs (mubyte_token-cs_token_flag) + else print (c); + end; + incr (i); +end; + +@ Additional material to dump for enc\TeX. This includes whether +enc\TeX is enabled, and if it is we also have to dump the \.{\\mubyte} +arrays. + +@<Dump enc\TeX-specific data@>= +dump_int(@"45435458); {enc\TeX's magic constant: "ECTX"} +if not enctex_p then dump_int(0) +else begin + dump_int(1); + dump_things(mubyte_read[0], 256); + dump_things(mubyte_write[0], 256); + dump_things(mubyte_cswrite[0], 128); +end; + +@ Undumping the additional material we dumped for enc\TeX. This includes +conditionally undumping the \.{\\mubyte} arrays. + +@<Undump enc\TeX-specific data@>= +undump_int(x); {check magic constant of enc\TeX} +if x<>@"45435458 then goto bad_fmt; +undump_int(x); {undump |enctex_p| flag into |enctex_enabled_p|} +if x=0 then enctex_enabled_p:=false +else if x<>1 then goto bad_fmt +else begin + enctex_enabled_p:=true; + undump_things(mubyte_read[0], 256); + undump_things(mubyte_write[0], 256); + undump_things(mubyte_cswrite[0], 128); +end; + +@y +@z + +@x l.26984 - pTeX +@* \[54] System-dependent changes. +@y +@* \[55/p\TeX] System-dependent changes for p\TeX. +This section described extended variables, procesures, functions and so on +for pTeX. + +@<Declare procedures that scan font-related stuff@>= +function get_jfm_pos(@!kcode:KANJI_code;@!f:internal_font_number):eight_bits; +var @!jc:KANJI_code; {temporary register for KANJI} +@!sp,@!mp,@!ep:pointer; +begin@/ +if (proc_kanji_code=sjis_enc) then jc:=SJIStoJIS(kcode) +else jc:=EUCtoJIS(kcode); +sp:=1; { start position } +ep:=font_num_ext[f]-1; { end position } +if (kchar_code(f)(sp)<=jc)and(jc<=kchar_code(f)(ep)) then + begin while (sp <= ep) do + begin mp:=sp+((ep-sp) div 2); + if jc<kchar_code(f)(mp) then ep:=mp-1 + else if jc>kchar_code(f)(mp) then sp:=mp+1 + else + begin get_jfm_pos:=kchar_type(f)(mp); return; + end; + end; + end; +get_jfm_pos:=kchar_type(f)(0); +end; + +@ Following codes are used to calcutation a KANJI width and height. + +@<Local variables for dimension calculations@>= +@!t: eight_bits; + +@ @<The KANJI width for |cur_jfont|@>= +if direction=dir_tate then + v:=char_width(cur_tfont)(orig_char_info(cur_tfont)(qi(0))) +else + v:=char_width(cur_jfont)(orig_char_info(cur_jfont)(qi(0))) + +@ @<The KANJI height for |cur_jfont|@>= +if direction=dir_tate then begin + t:=height_depth(orig_char_info(cur_tfont)(qi(0))); + v:=char_height(cur_tfont)(t)+char_depth(cur_tfont)(t); +end else begin + t:=height_depth(orig_char_info(cur_jfont)(qi(0))); + v:=char_height(cur_jfont)(t)+char_depth(cur_jfont)(t); +end + +@ set a kansuji character. + +@ @<Put each...@>= +primitive("kansujichar",set_kansuji_char,0); +@!@:kansujichar_}{\.{\\kansujichar} primitive@> + +@ @<Cases of |print_cmd_chr|...@>= +set_kansuji_char: print_esc("kansujichar"); + +@ @<Assignments@>= +set_kansuji_char: +begin p:=cur_chr; scan_int; n:=cur_val; scan_optional_equals; scan_int; +if not check_kanji(cur_val) then + begin print_err("Invalid KANSUJI char ("); + print_hex(cur_val); print_char(")"); +@.Invalid KANSUJI char@> + help1("I'm skip this control sequences.");@/ + error; return; + end +else if (n<0)or(n>9) then + begin print_err("Invalid KANSUJI number ("); print_int(n); print_char(")"); +@.Invalid KANSUJI number@> + help1("I'm skip this control sequences.");@/ + error; return; + end +else + begin + if (proc_kanji_code=sjis_enc) then + define(kansuji_base+n,n,tokanji(SJIStoJIS(cur_val))) + else if (proc_kanji_code=euc_enc) then + define(kansuji_base+n,n,tokanji(EUCtoJIS(cur_val))) + else if (proc_kanji_code=jis_enc) then + define(kansuji_base+n,n,tokanji(cur_val)); + end; +end; + +@ |print_kansuji| procedure converts a number to KANJI number. + +@ @<Declare procedures needed in |scan_something|@>= +procedure print_kansuji(@!n:integer); +var @!k:0..23; {index to current digit; we assume that $|n|<10^{23}$} +@!cx: KANJI_code; {temporary register for KANJI} +begin k:=0; + if n<0 then return; {nonpositive input produces no output} + repeat dig[k]:=n mod 10; n:=n div 10; incr(k); + until n=0; + begin while k>0 do + begin decr(k); + cx:=kansuji_char(dig[k]); + if (proc_kanji_code=sjis_enc) then cx:=JIStoSJIS(cx) + else if (proc_kanji_code=euc_enc) then cx:=JIStoEUC(cx); + print_kanji(cx); + end; + end; +end; + +@ pTeX inserts a glue specified by \.{\\kanjiskip} between 2byte-characters, +automatically, if \.{\\autospacing}. This glue is suppressed by +\.{\\noautospacing}. +\.{\\xkanjiskip}, \.{\\noautoxspacing}, \.{\\autoxspacing}, \.{\\xspcode} is +used to control between 2byte and 1byte characters. + +@d reset_auto_spacing_code=0 +@d set_auto_spacing_code=1 +@d reset_auto_xspacing_code=2 +@d set_auto_xspacing_code=3 + +@<Put each...@>= +primitive("autospacing",set_auto_spacing,set_auto_spacing_code); +@!@:auto_spacing_}{\.{\\autospacing} primitive@> +primitive("noautospacing",set_auto_spacing,reset_auto_spacing_code); +@!@:no_auto_spacing_}{\.{\\noautospacing} primitive@> +primitive("autoxspacing",set_auto_spacing,set_auto_xspacing_code); +@!@:auto_xspacing_}{\.{\\autoxspacing} primitive@> +primitive("noautoxspacing",set_auto_spacing,reset_auto_xspacing_code); +@!@:no_auto_xspacing_}{\.{\\noautoxspacing} primitive@> + +@ @<Cases of |print_cmd_chr|...@>= +set_auto_spacing:begin + if (chr_code mod 2)=0 then print_esc("noauto") else print_esc("auto"); + if chr_code<2 then print("spacing") else print("xspacing"); +end; + +@ @<Assignments@>= +set_auto_spacing:begin + if cur_chr<2 then p:=auto_spacing_code + else begin p:=auto_xspacing_code; cur_chr:=(cur_chr mod 2); end; + define(p,data,cur_chr); +end; + +@ Following codes are used in section 49. + +@<Show the current japanese processing mode@>= +begin print_nl("> "); +if auto_spacing>0 then print("auto spacing mode; ") + else print("no auto spacing mode; "); +print_nl("> "); +if auto_xspacing>0 then print("auto xspacing mode") + else print("no auto xspacing mode"); +goto common_ending; +end + +@ The \.{\\inhibitglue} primitive control to insert a glue specified +JFM (Japanese Font Metic) file. The \.{\\inhibitxspcode} is used to control +inserting a space between 2byte-char and 1byte-char. + +@d inhibit_both=0 {disable to insert space before 2byte-char and after it} +@d inhibit_previous=1 {disable to insert space before 2byte-char} +@d inhibit_after=2 {disable to insert space after 2byte-char} +@d no_entry=1000 +@d new_pos=0 +@d cur_pos=1 + +@<Global...@>= + inhibit_glue_flag:boolean; + +@ @<Set init...@>= + inhibit_glue_flag:=false; + +@ @<Cases of |main_control| that don't...@>= + any_mode(inhibit_glue): inhibit_glue_flag:=true; + +@ @<Put each...@>= +primitive("inhibitglue",inhibit_glue,0); +@!@:inhibit_glue_}{\.{\\inhibitglue} primitive@> +primitive("inhibitxspcode",assign_inhibit_xsp_code,inhibit_xsp_code_base); +@!@:inhibit_xsp_code_}{\.{\\inhibitxspcode} primitive@> + +@ @<Cases of |print_cmd_chr|...@>= +inhibit_glue: print_esc("inhibitglue"); +assign_inhibit_xsp_code: print_esc("inhibitxspcode"); + +@ @<Declare procedures needed in |scan_something|@>= +function get_inhibit_pos(c:KANJI_code; n:small_number):pointer; +label done, done1; +var p,s:pointer; +begin s:=calc_pos(c); p:=s; +if n=new_pos then + begin repeat + if (inhibit_xsp_code(p)=0)or(inhibit_xsp_code(p)=c) then goto done; + incr(p); if p>255 then p:=0; + until s=p; p:=no_entry; + end +else + begin repeat + if inhibit_xsp_code(p)=0 then goto done1; + if inhibit_xsp_code(p)=c then goto done; + incr(p); if p>255 then p:=0; + until s=p; +done1: p:=no_entry; + end; +done: get_inhibit_pos:=p; +end; + +@ @<Assignments@>= +assign_inhibit_xsp_code: +begin p:=cur_chr; scan_int; n:=cur_val; scan_optional_equals; scan_int; +if check_kanji(n) then + begin j:=get_inhibit_pos(tokanji(n),new_pos); + if j=no_entry then + begin print_err("Inhibit table is full!!"); + help1("I'm skip this control sequences.");@/ + error; return; + end; + define(inhibit_xsp_code_base+j,cur_val,n); + end +else + begin print_err("Invalid KANJI code ("); print_hex(n); print_char(")"); +@.Invalid KANJI code@> + help1("I'm skip this control sequences.");@/ + error; return; + end; +end; + +@ @<Fetch inhibit type from some table@>= +begin scan_int; q:=get_inhibit_pos(tokanji(cur_val),cur_pos); +cur_val_level:=int_val; cur_val:=3; +if q<>no_entry then cur_val:=inhibit_xsp_type(q); +end + +@ The \.{\\prebreakpenalty} is used to specified amount of penalties inserted +before the 2byte-char which is first argument of this primitive. +The \.{\\postbreakpenalty} is inserted after the 2byte-char. + +@d pre_break_penalty_code=1 +@d post_break_penalty_code=2 + +@<Put each...@>= +primitive("prebreakpenalty",assign_kinsoku,pre_break_penalty_code); +@!@:pre_break_penalty_}{\.{\\prebreakpenalty} primitive@> +primitive("postbreakpenalty",assign_kinsoku,post_break_penalty_code); +@!@:post_break_penalty_}{\.{\\postbreakpenalty} primitive@> + +@ @<Cases of |print_cmd_chr|...@>= +assign_kinsoku: case chr_code of + pre_break_penalty_code: print_esc("prebreakpenalty"); + post_break_penalty_code: print_esc("postbreakpenalty"); + endcases; + +@ @<Declare procedures needed in |scan_something|@>= +function get_kinsoku_pos(c:KANJI_code; n:small_number):pointer; +label done, done1; +var p,s:pointer; +begin s:=calc_pos(c); p:=s; +@!debug +print_ln; print("c:="); print_int(c); print(", p:="); print_int(s); +if p+kinsoku_base<0 then + begin print("p is negative value"); print_ln; + end; +gubed +if n=new_pos then + begin repeat + if (kinsoku_type(p)=0)or(kinsoku_code(p)=c) then goto done; + incr(p); if p>255 then p:=0; + until s=p; + p:=no_entry; + end +else + begin repeat + if kinsoku_type(p)=0 then goto done1; + if kinsoku_code(p)=c then goto done; + incr(p); if p>255 then p:=0; + until s=p; +done1: p:=no_entry; + end; +done: get_kinsoku_pos:=p; +end; + +@ @<Assignments@>= +assign_kinsoku: +begin p:=cur_chr; scan_int; n:=cur_val; scan_optional_equals; scan_int; +if check_kanji(n) then + begin j:=get_kinsoku_pos(tokanji(n),new_pos); + if j=no_entry then + begin print_err("KINSOKU table is full!!"); + help1("I'm skip this control sequences.");@/ + error; return; + end; + if (p=pre_break_penalty_code)or(p=post_break_penalty_code) then + begin define(kinsoku_base+j,p,tokanji(n)); + word_define(kinsoku_penalty_base+j,cur_val); + end + else confusion("kinsoku"); +@:this can't happen kinsoku}{\quad kinsoku@> + end +else + begin print_err("Invalid KANJI code for "); + if (p=pre_break_penalty_code) then print("pre") + else if (p=post_break_penalty_code) then print("post") + else print_char("?"); + print("breakpenalty ("); print_hex(n); print_char(")"); +@.Invalid KANJI code@> + help1("I'm skip this control sequences.");@/ + error; return; + end; +end; + +@ @<Fetch breaking penalty from some table@>= +begin scan_int; q:=get_kinsoku_pos(tokanji(cur_val),cur_pos); +cur_val_level:=int_val; cur_val:=0; +if (q<>no_entry)and(m=kinsoku_type(q)) then + scanned_result(kinsoku_penalty(q))(int_val); +end + +@ Following codes are used in |main_control|. + +@<Insert kinsoku penalty@>= +begin kp:=get_kinsoku_pos(cx,cur_pos); +if (kp<>no_entry) then + begin if (kinsoku_type(kp)=pre_break_penalty_code) then + begin if (not is_char_node(cur_q))and(type(cur_q)=penalty_node) then + penalty(cur_q):=penalty(cur_q)+kinsoku_penalty(kp) + else + begin main_p:=link(cur_q); link(cur_q):=new_penalty(kinsoku_penalty(kp)); + subtype(link(cur_q)):=kinsoku_pena; link(link(cur_q)):=main_p; + end; + end + else if (kinsoku_type(kp)=post_break_penalty_code) then + begin tail_append(new_penalty(kinsoku_penalty(kp))); + subtype(tail):=kinsoku_pena; + end; + end; +end; + +@ @<Insert |pre_break_penalty| of |cur_chr|@>= +begin kp:=get_kinsoku_pos(cur_chr,cur_pos); +if (kp<>no_entry) then + begin if (kinsoku_type(kp)=pre_break_penalty_code) then + if (not is_char_node(tail))and(type(tail)=penalty_node) then + penalty(tail):=penalty(tail)+kinsoku_penalty(kp) + else + begin tail_append(new_penalty(kinsoku_penalty(kp))); + subtype(tail):=kinsoku_pena; + end; + end; +end; + +@ @<Insert |post_break_penalty|@>= +begin kp:=get_kinsoku_pos(cx,cur_pos); +if (kp<>no_entry) then + begin if (kinsoku_type(kp)=post_break_penalty_code) then + begin tail_append(new_penalty(kinsoku_penalty(kp))); + subtype(tail):=kinsoku_pena; + end; + end; +end; + +@ This is a part of section 32. + +The procedure |synch_dir| is used in |hlist_out| and |vlist_out|. + +@d dvi_yoko=0 +@d dvi_tate=1 +@d dvi_dtou=3 + +@<Glob...@>= +@!dvi_dir:integer; {a \.{DVI} reader program thinks we direct to} +@!cur_dir:integer; {\TeX\ thinks we direct to} +@!page_dir:eight_bits; + +@ @<Set init...@>= +page_dir:=dir_yoko; + +@ @<Declare procedures needed in |hlist_out|, |vlist_out|@>= +procedure synch_dir; +var tmp:scaled; {temporary resister} +begin + case cur_dir of + dir_yoko: + if dvi_dir<>cur_dir then begin + synch_h; synch_v; dvi_out(dirchg); dvi_out(dvi_yoko); + dir_used:=true; + case dvi_dir of + dir_tate: begin tmp:=cur_h; cur_h:=-cur_v; cur_v:=tmp end; + dir_dtou: begin tmp:=cur_h; cur_h:=cur_v; cur_v:=-tmp end; + endcases; + dvi_h:=cur_h; dvi_v:=cur_v; dvi_dir:=cur_dir; + end; + dir_tate: + if dvi_dir<>cur_dir then begin + synch_h; synch_v; dvi_out(dirchg); dvi_out(dvi_tate); + dir_used:=true; + case dvi_dir of + dir_yoko: begin tmp:=cur_h; cur_h:=cur_v; cur_v:=-tmp end; + dir_dtou: begin cur_v:=-cur_v; cur_h:=-cur_h; end; + endcases; + dvi_h:=cur_h; dvi_v:=cur_v; dvi_dir:=cur_dir; + end; + dir_dtou: + if dvi_dir<>cur_dir then begin + synch_h; synch_v; dvi_out(dirchg); dvi_out(dvi_dtou); + dir_used:=true; + case dvi_dir of + dir_yoko: begin tmp:=cur_h; cur_h:=-cur_v; cur_v:=tmp end; + dir_tate: begin cur_v:=-cur_v; cur_h:=-cur_h; end; + endcases; + dvi_h:=cur_h; dvi_v:=cur_v; dvi_dir:=cur_dir; + end; + othercases + confusion("synch_dir"); + endcases +end; + +@ This function is called from |adjust_hlist| to used to check, whether +a list which pointed |box_p| contain a printing character. +If the list contain such a character, then return `true', otherwise `false'. +If the first matter is a character, |first_char| is stored it. +|last_char| is stored a last character. If no printing characters exist +in the list, |first_char| and |last_char| is null. +@^recursion@> + +@<Glob...@>= +@!first_char:pointer; {first printable character} +@!last_char:pointer; {last printable character} +@!find_first_char:boolean; {find for a first printable character?} + +@ @<Declare procedures needed in |hlist_out|, |vlist_out|@>= +function check_box(box_p:pointer):boolean; +label done; +var @!p:pointer; {run through the current box} +@!flag:boolean; {found any printable character?} +begin flag:=false; p:=box_p; +while p<>null do + begin if is_char_node(p) then + repeat + if find_first_char then + begin first_char:=p; find_first_char:=false + end; + last_char:=p; flag:=true; + if font_dir[font(p)]<>dir_default then p:=link(p); + p:=link(p); + if p=null then goto done; + until not is_char_node(p); + case type(p) of + hlist_node: + begin flag:=true; + if shift_amount(p)=0 then + begin if check_box(list_ptr(p)) then flag:=true; + end + else if find_first_char then find_first_char:=false + else last_char:=null; + end; + ligature_node: if check_box(lig_ptr(p)) then flag:=true; + ins_node,disp_node,mark_node,adjust_node,whatsit_node,penalty_node: + do_nothing; + othercases begin flag:=true; + if find_first_char then find_first_char:=false + else last_char:=null; + end; + endcases; + p:=link(p); + end; +done: check_box:=flag; +end; + +@ Following procedure |adjust_hlist| inserts \.{\\xkanjiskip} between +2byte-char and 1byte-char in hlist which pointed |p|. +Note that the skip is inserted into a place where too difficult to decide +whether inserting or not (i.e, before penalty, after penalty). + +If |pf| is true then insert |jchr_widow_penalty| that is penalty for +creating a widow KANJI character line. + +@d no_skip=0 +@d after_schar=1 {denote after single byte character} +@d after_wchar=2 {denote after double bytes character} + +@<Declare procedures needed in |hlist_out|, |vlist_out|@>= +procedure adjust_hlist(p:pointer;pf:boolean); +label exit; +var q,s,t,u,v,x,z:pointer; + i,k:halfword; + insert_skip:no_skip..after_wchar; + cx:KANJI_code; {temporaly register for KANJI character} + ax:ASCII_code; {temporaly register for ASCII character} + do_ins:boolean; {for inserting |xkanji_skip| into prevous (or after) KANJI} +begin if link(p)=null then goto exit; +if auto_spacing>0 then + begin delete_glue_ref(space_ptr(p)); space_ptr(p):=kanji_skip; + add_glue_ref(kanji_skip); + end; +if auto_xspacing>0 then + begin delete_glue_ref(xspace_ptr(p)); xspace_ptr(p):=xkanji_skip; + add_glue_ref(xkanji_skip); + end; +u:=space_ptr(p); add_glue_ref(u); +s:=xspace_ptr(p); add_glue_ref(s); +if (not is_char_node(link(p))) {p1.0.9d} + and(type(link(p))=glue_node)and(subtype(link(p))=jfm_skip+1) then + begin v:=link(p); link(p):=link(v); + fast_delete_glue_ref(glue_ptr(v)); free_node(v,small_node_size); + end; +i:=0; insert_skip:=no_skip; p:=link(p); v:=p; q:=p; +while p<>null do + begin if is_char_node(p) then + begin repeat @<Insert a space around the character |p|@>; + q:=p; p:=link(p); incr(i); + if (i>5)and(pf) then + begin if is_char_node(v) then + if font_dir[font(v)]<>dir_default then v:=link(v); + v:=link(v); + end; + until not is_char_node(p); + end + else + begin case type(p) of + hlist_node: @<Insert hbox surround spacing@>; + ligature_node: @<Insert ligature surround spacing@>; + penalty_node,disp_node: @<Insert penalty or displace surround spacing@>; + kern_node: if (insert_skip=after_schar)and(subtype(p)<>explicit) then + do_nothing else insert_skip:=no_skip; + math_node: @<Insert math surround spacing@>; + mark_node,adjust_node,ins_node,whatsit_node: + {These nodes are vanished when typeset is done} + do_nothing; + othercases insert_skip:=no_skip; + endcases; + q:=p; p:=link(p); + end; + end; +if (not is_char_node(q))and(type(q)=glue_node)and(subtype(q)=jfm_skip+1) then + begin fast_delete_glue_ref(glue_ptr(q)); + glue_ptr(q):=zero_glue; add_glue_ref(zero_glue); + end; +delete_glue_ref(u); delete_glue_ref(s); +if (v<>null)and(pf)and(i>5) then @<Make |jchr_widow_penalty| node@>; +exit: +end; + +@ @<Insert a space around the character |p|@>= +if font_dir[font(p)]<>dir_default then + begin KANJI(cx):=info(link(p)); + if insert_skip=after_schar then @<Insert ASCII-KANJI spacing@>; + p:=link(p); insert_skip:=after_wchar; + end +else + begin ax:=qo(character(p)); + if insert_skip=after_wchar then @<Insert KANJI-ASCII spacing@>; + if auto_xsp_code(ax)>=2 then + insert_skip:=after_schar else insert_skip:=no_skip; + end + +@ @<Insert hbox surround spacing@>= +begin find_first_char:=true; first_char:=null; last_char:=null; +if (shift_amount(p)=0) then + begin if check_box(list_ptr(p)) then + begin if first_char<>null then @<Insert a space before the |first_char|@>; + if last_char<>null then + begin @<Insert a space after the |last_char|@>; + end else insert_skip:=no_skip; + end else insert_skip:=no_skip; + end else insert_skip:=no_skip; +end + +@ @<Insert a space before the |first_char|@>= +if font_dir[font(first_char)]<>dir_default then + begin KANJI(cx):=info(link(first_char)); + if insert_skip=after_schar then @<Insert ASCII-KANJI spacing@> + else if insert_skip=after_wchar then @<Insert KANJI-KANJI spacing@>; + insert_skip:=after_wchar; + end +else + begin ax:=qo(character(first_char)); + if insert_skip=after_wchar then @<Insert KANJI-ASCII spacing@>; + if auto_xsp_code(ax)>=2 then + insert_skip:=after_schar else insert_skip:=no_skip; + end; + +@ @<Insert a space after the |last_char|@>= +if font_dir[font(last_char)]<>dir_default then + begin insert_skip:=after_wchar; + if (is_char_node(link(p)))and(font_dir[font(link(p))]<>dir_default) then + begin @<Append KANJI-KANJI spacing@>; p:=link(p); + end; + end +else + begin ax:=qo(character(last_char)); + if auto_xsp_code(ax)>=2 then + insert_skip:=after_schar else insert_skip:=no_skip; + end; + +@ @<Insert math surround spacing@>= +begin if (subtype(p)=before)and(insert_skip=after_wchar) then + begin ax:=qo("0"); @<Insert KANJI-ASCII spacing@>; + insert_skip:=no_skip; + end +else if (subtype(p)=after) then + begin ax:=qo("0"); insert_skip:=after_schar; + end +else insert_skip:=no_skip; +end + +@ @<Insert ligature surround spacing@>= +begin t:=lig_ptr(p); +if is_char_node(t) then + begin ax:=qo(character(t)); + if insert_skip=after_wchar then @<Insert KANJI-ASCII spacing@>; + while link(t)<>null do t:=link(t); + if is_char_node(t) then + begin ax:=qo(character(t)); + if auto_xsp_code(ax)>=2 then + insert_skip:=after_schar else insert_skip:=no_skip; + end; + end; +end + +@ @<Insert penalty or displace surround spacing@>= +begin if is_char_node(link(p)) then + begin q:=p; p:=link(p); + if font_dir[font(p)]<>dir_default then + begin KANJI(cx):=info(link(p)); + if insert_skip=after_schar then @<Insert ASCII-KANJI spacing@> + else if insert_skip=after_wchar then @<Insert KANJI-KANJI spacing@>; + p:=link(p); insert_skip:=after_wchar; + end + else + begin ax:=qo(character(p)); + if insert_skip=after_wchar then @<Insert KANJI-ASCII spacing@>; + if auto_xsp_code(ax)>=2 then + insert_skip:=after_schar else insert_skip:=no_skip; + end; + end +end + +@ @<Insert ASCII-KANJI spacing@>= +begin + begin x:=get_inhibit_pos(cx,cur_pos); + if x<>no_entry then + if (inhibit_xsp_type(x)=inhibit_both)or + (inhibit_xsp_type(x)=inhibit_previous) then + do_ins:=false else do_ins:=true + else do_ins:=true; + end; +if do_ins then + begin z:=new_glue(s); subtype(z):=xkanji_skip_code+1; + link(z):=link(q); link(q):=z; q:=z; + end; +end + +@ @<Insert KANJI-ASCII spacing@>= +begin if (auto_xsp_code(ax) mod 2)=1 then + begin x:=get_inhibit_pos(cx,cur_pos); + if x<>no_entry then + if (inhibit_xsp_type(x)=inhibit_both)or + (inhibit_xsp_type(x)=inhibit_after) then + do_ins:=false else do_ins:=true + else do_ins:=true; + end +else do_ins:=false; +if do_ins then + begin z:=new_glue(s); subtype(z):=xkanji_skip_code+1; + link(z):=link(q); link(q):=z; q:=z; + end; +end + +@ @<Insert KANJI-KANJI spacing@>= +begin z:=new_glue(u); subtype(z):=kanji_skip_code+1; +link(z):=link(q); link(q):=z; q:=z; +end + +@ @<Append KANJI-KANJI spacing@>= +begin z:=new_glue(u); subtype(z):=kanji_skip_code+1; +link(z):=link(p); link(p):=z; p:=link(z); q:=z; +end + +@ @<Make |jchr_widow_penalty| node@>= +begin q:=v; p:=link(v); +if (is_char_node(v))and(font_dir[font(v)]<>dir_default) then + begin q:=p; p:=link(p); + end; +t:=q; s:=null; +@<Seek list and make |t| pointing widow penalty position@>; +if (s<>null) then + begin s:=link(t); + if (not is_char_node(s))and(type(s)=penalty_node) then + penalty(s):=penalty(s)+jchr_widow_penalty + else if (jchr_widow_penalty<>0) then + begin s:=new_penalty(jchr_widow_penalty); subtype(s):=widow_pena; + link(s):=link(t); link(t):=s; t:=link(s); + while(not is_char_node(t)) do + begin if (type(t)=glue_node)or(type(t)=kern_node) then goto exit; + t:=link(t); + end; + z:=new_glue(u); subtype(z):=kanji_skip_code+1; + link(z):=link(s); link(s):=z; + end; + end; +end; + +@ @<Seek list and make |t| pointing widow penalty position@>= +while(p<>null) do +begin if is_char_node(p) then + begin if font_dir[font(p)]<>dir_default then + begin KANJI(cx):=info(link(p)); i:=kcat_code(Hi(cx)); k:=0; + if (i=kanji)or(i=kana) then begin t:=q; s:=p; end; + p:=link(p); q:=p; + end + else begin k:=k+1; + if k>1 then begin q:=p; s:=null; end; + end; + end +else begin case type(p) of + penalty_node,mark_node,adjust_node,whatsit_node, + glue_node,kern_node,math_node,disp_node: + do_nothing; + othercases begin q:=p; s:=null; end; + endcases; + end; +p:=link(p); +end + +@ @<Declare procedures needed in |hlist_out|, |vlist_out|@>= +procedure dir_out; +var @!this_box: pointer; {pointer to containing box} +begin this_box:=temp_ptr; + temp_ptr:=list_ptr(this_box); + if (type(temp_ptr)<>hlist_node)and(type(temp_ptr)<>vlist_node) then + confusion("dir_out"); + case box_dir(this_box) of + dir_yoko: + case box_dir(temp_ptr) of + dir_tate: {Tate in Yoko} + begin cur_v:=cur_v-height(this_box); cur_h:=cur_h+depth(temp_ptr) end; + dir_dtou: {DtoU in Yoko} + begin cur_v:=cur_v+depth(this_box); cur_h:=cur_h+height(temp_ptr) end; + endcases; + dir_tate: + case box_dir(temp_ptr) of + dir_yoko: {Yoko in Tate} + begin cur_v:=cur_v+depth(this_box); cur_h:=cur_h+height(temp_ptr) end; + dir_dtou: {DtoU in Tate} + begin + cur_v:=cur_v+depth(this_box)-height(temp_ptr); + cur_h:=cur_h+width(temp_ptr) + end; + endcases; + dir_dtou: + case box_dir(temp_ptr) of + dir_yoko: {Yoko in DtoU} + begin cur_v:=cur_v-height(this_box); cur_h:=cur_h+depth(temp_ptr) end; + dir_tate: {Tate in DtoU} + begin + cur_v:=cur_v+depth(this_box)-height(temp_ptr); + cur_h:=cur_h+width(temp_ptr) + end; + endcases; + endcases; + cur_dir:=box_dir(temp_ptr); + if type(temp_ptr)=vlist_node then vlist_out@+else hlist_out; +end; + +@ These routines are used to output diagnostic which related direction. + +@ @<Basic printing procedures@>= +procedure print_dir(@!dir:eight_bits); {prints |dir| data} +begin if dir=dir_yoko then print_char("Y") +else if dir=dir_tate then print_char("T") +else if dir=dir_dtou then print_char("D") +end; +@# +procedure print_direction(@!d:integer); {print the direction represented by d} +begin case abs(d) of +dir_yoko: print("yoko"); +dir_tate: print("tate"); +dir_dtou: print("dtou"); +end; +if d<0 then print("(math)"); +print(" direction"); +end; + +@ The procedure |set_math_kchar| is same as |set_math_char| which +written in section 48. + +@<Declare act...@>= +procedure set_math_kchar(@!c:integer); +var p:pointer; {the new noad} +begin p:=new_noad; math_type(nucleus(p)):=math_jchar; +character(nucleus(p)):=qi(0); +math_kcode(p):=c; fam(nucleus(p)):=cur_jfam; +if font_dir[fam_fnt(fam(nucleus(p))+cur_size)]=dir_default then + begin print_err("Not two-byte family"); + help1("IGNORE.");@/ + error; + end; +type(p):=ord_noad; +link(tail):=p; tail:=p; +end; + +@ This section is a part of |main_control|. + +@<Append KANJI-character |cur_chr| ...@>= +if is_char_node(tail) then + begin cx:=qo(character(tail)); @<Insert |post_break_penalty|@>; + end +else if type(tail)=ligature_node then + begin cx:=qo(character(lig_char(tail))); @<Insert |post_break_penalty|@>; + end; +if direction=dir_tate then + begin if font_dir[main_f]=dir_tate then disp:=0 + else if font_dir[main_f]=dir_yoko then disp:=t_baseline_shift-y_baseline_shift + else disp:=t_baseline_shift; + main_f:=cur_tfont; + end +else + begin if font_dir[main_f]=dir_yoko then disp:=0 + else if font_dir[main_f]=dir_tate then disp:=y_baseline_shift-t_baseline_shift + else disp:=y_baseline_shift; + main_f:=cur_jfont; + end; +@<Append |disp_node| at end of displace area@>; +ins_kp:=false; ligature_present:=false; +cur_l:=qi(get_jfm_pos(KANJI(cur_chr),main_f)); +main_i:=orig_char_info(main_f)(qi(0)); +goto main_loop_j+3; +@# +main_loop_j+1: space_factor:=1000; + fast_get_avail(main_p); font(main_p):=main_f; character(main_p):=cur_l; + link(tail):=main_p; tail:=main_p; last_jchr:=tail; + fast_get_avail(main_p); info(main_p):=KANJI(cur_chr); + link(tail):=main_p; tail:=main_p; + cx:=cur_chr; @<Insert kinsoku penalty@>; + ins_kp:=false; +again_2: + get_next; + main_i:=orig_char_info(main_f)(cur_l); + case cur_cmd of + kanji,kana,other_kchar: begin + cur_l:=qi(get_jfm_pos(KANJI(cur_chr),main_f)); goto main_loop_j+3; + end; + letter,other_char: begin ins_kp:=true; cur_l:=qi(0); goto main_loop_j+3; + end; + endcases; + x_token; + case cur_cmd of + kanji,kana,other_kchar: cur_l:=qi(get_jfm_pos(KANJI(cur_chr),main_f)); + letter,other_char: begin ins_kp:=true; cur_l:=qi(0); end; + char_given: begin + if (cur_chr>=0)and(cur_chr<256) then + begin ins_kp:=true; cur_l:=qi(0); + end + else cur_l:=qi(get_jfm_pos(KANJI(cur_chr),main_f)); + end; + char_num: begin scan_char_num; cur_chr:=cur_val; + if (cur_chr>=0)and(cur_chr<256) then + begin ins_kp:=true; cur_l:=qi(0); + end + else cur_l:=qi(get_jfm_pos(KANJI(cur_chr),main_f)); + end; + inhibit_glue: begin inhibit_glue_flag:=true; goto again_2; end; + othercases begin ins_kp:=max_halfword; + cur_l:=qi(0); cur_r:=non_char; lig_stack:=null; + end; + endcases; +@# +main_loop_j+3: + if ins_kp=true then @<Insert |pre_break_penalty| of |cur_chr|@>; + @<Look ahead for glue or kerning@>; + if (ins_kp=false) then begin { Kanji -> Kanji } + goto main_loop_j+1; + end else if (ins_kp=true) then begin { Kanji -> Ascii } + {@<Append |disp_node| at begin of displace area@>;} + ins_kp:=false; goto main_loop; + end else begin { Kanji -> cs } + {@<Append |disp_node| at begin of displace area@>;} + goto reswitch; + end; + +@ @<Append |disp_node| at begin ...@>= +begin if (not is_char_node(tail))and(type(tail)=disp_node) then + begin if prev_disp=disp then + begin free_node(tail,small_node_size); tail:=prev_node; link(tail):=null; + end + else disp_dimen(tail):=disp; + end +else + if disp<>0 then + begin prev_node:=tail; tail_append(get_node(small_node_size)); + type(tail):=disp_node; disp_dimen(tail):=disp; prev_disp:=disp; + end; +end; + +@ @<Append |disp_node| at end ...@>= +if disp<>0 then +begin if (not is_char_node(tail))and(type(tail)=disp_node) then + begin disp_dimen(tail):=0; + end +else + begin prev_node:=tail; tail_append(get_node(small_node_size)); + type(tail):=disp_node; disp_dimen(tail):=0; prev_disp:=disp; + end; +end; + +@ @<Look ahead for glue or kerning@>= +cur_q:=tail; +if inhibit_glue_flag<>true then + begin if char_tag(main_i)=gk_tag then + begin main_k:=glue_kern_start(main_f)(main_i); + repeat main_j:=font_info[main_k].qqqq; + if next_char(main_j)=cur_l then + begin if op_byte(main_j)<kern_flag then + begin gp:=font_glue[main_f]; cur_r:=rem_byte(main_j); + if gp<>null then + begin while((type(gp)<>cur_r)and(link(gp)<>null)) do gp:=link(gp); + gq:=glue_ptr(gp); + end + else + begin gp:=get_node(small_node_size); font_glue[main_f]:=gp; + gq:=null; + end; + if gq=null then + begin type(gp):=cur_r; gq:=new_spec(zero_glue); + glue_ptr(gp):=gq; + main_k:=exten_base[main_f]+qi((qo(cur_r))*3); + width(gq):=font_info[main_k].sc; + stretch(gq):=font_info[main_k+1].sc; + shrink(gq):=font_info[main_k+2].sc; + add_glue_ref(gq); link(gp):=get_node(small_node_size); + gp:=link(gp); glue_ptr(gp):=null; link(gp):=null; + end; + tail_append(new_glue(gq)); subtype(tail):=jfm_skip+1; + goto skip_loop; + end + else begin + tail_append(new_kern(char_kern(main_f)(main_j))); + goto skip_loop; + end; + end; + incr(main_k); + until skip_byte(main_j)>=stop_flag; + end; +end; +skip_loop: inhibit_glue_flag:=false; + +@ @<Basic printing...@>= +procedure print_kanji(@!s:KANJI_code); {prints a single character} +begin +if s>255 then + begin print_char(Hi(s)); print_char(Lo(s)); + end else print_char(s); +end; + +@* \[56] System-dependent changes. +@z diff --git a/Build/source/texk/web2c/ptexdir/ptex-include.ch b/Build/source/texk/web2c/ptexdir/ptex-include.ch new file mode 100644 index 00000000000..5d627d1480e --- /dev/null +++ b/Build/source/texk/web2c/ptexdir/ptex-include.ch @@ -0,0 +1,6 @@ +@x [???] l.2600 - pTeX: +@=#include "texmfmem.h";@> +@y +@=#include "texmfmem.h";@> +@=#include "ptexdir/kanji.h";@> +@z diff --git a/Build/source/texk/web2c/ptexdir/ptex.defines b/Build/source/texk/web2c/ptexdir/ptex.defines new file mode 100644 index 00000000000..d358694cd51 --- /dev/null +++ b/Build/source/texk/web2c/ptexdir/ptex.defines @@ -0,0 +1,33 @@ +{ defined at kanji.c, kanji.h, ptexenc/ptexenc.h } +@define function Hi (); +@define function Lo (); + +@define function getencstring; +@define function setencstring (); + +@define function iskanji1 (); +@define function multistrlen (); +@define function fromBUFF (); +@define function toBUFF (); + +@define function fromDVI (); +@define function toDVI (); +@define function putc2 (); +@define function inputline2 (); + +@define function fromJIS (); +@define function fromEUC (); +@define function fromSJIS (); +@define function fromKUTEN (); + +@define function checkkanji (); +@define function iskanji (); +@define function ischarascii (); +@define function iswcharascii (); +@define function ismultiprn (); +@define function calcpos (); +@define function kcatcodekey (); + +@define const PTEXTFTOPLHELP; +@define const PTEXPLTOTFHELP; +@define const PDVITYPEHELP; diff --git a/Build/source/texk/web2c/ptexdir/ptex.mk b/Build/source/texk/web2c/ptexdir/ptex.mk new file mode 100644 index 00000000000..9f49847db6b --- /dev/null +++ b/Build/source/texk/web2c/ptexdir/ptex.mk @@ -0,0 +1,272 @@ +# *ATTENTION* : This file is not used in TeX Live 2009. See am/ptex.am. +# Makefile fragment for pTeX and web2c. -- tutimura(a)nn.iij4u.or.jp. Public domain. +# This fragment contains the parts of the makefile that are most likely to +# differ between releases of pTeX and derived from e-TeX. + +Makefile: $(srcdir)/ptexdir/ptex.mk + +# We build ptex. +ptex = @JPTEX@ ptex pbibtex ptftopl ppltotf pdvitype + +# Extract ptex version +ptexdir/ptex.version: ptexdir/ptex-base.ch + grep "^@d TeX_banner=='This is pTeX" $(srcdir)/ptexdir/ptex-base.ch \ + | sed "s/^.*-//;s/'.*$$//" >ptexdir/ptex.version + +# The C sources. +ptex_c = ptexini.c ptex0.c ptex1.c ptex2.c +ptex_o = ptexini.o ptex0.o ptex1.o ptex2.o ptex-pool.o ptexextra.o ptexdir/kanji.o +plib_o = ptexdir/printversion.o ptexdir/usage.o ptexdir/openclose.o +plib = ptexdir/plib.a + +# Making ptex. +ptex: $(ptex_o) $(plib) $(ptexenc) + $(kpathsea_link) $(ptex_o) $(plib) $(ptexenc) $(socketlibs) $(LOADLIBES) + +# C file dependencies +$(ptex_c) ptexcoerce.h ptexd.h: ptex.p $(web2c_texmf) + $(web2c) ptex +ptexextra.c: ptexdir/ptexextra.h lib/texmfmp.c + sed s/TEX-OR-MF-OR-MP/ptex/ $(srcdir)/lib/texmfmp.c >$@ +ptexdir/ptexextra.h: ptexdir/ptexextra.in ptexdir/ptex.version + test -d ptexdir || mkdir ptexdir + sed s/PTEX-VERSION/`cat ptexdir/ptex.version`/ \ + $(srcdir)/ptexdir/ptexextra.in >$@ + +# Tangling +ptex.p ptex.pool: tangle ptex.web ptex.ch + $(TANGLE) ptex.web ptex.ch + +# Generation of the web and ch file. +# Sources for ptex.web: +ptex_web_srcs = $(srcdir)/tex.web \ + $(srcdir)/tex.ch +# Sources for ptex.ch: +ptex_ch_srcs = ptex.web \ + $(srcdir)/ptexdir/ptex-base.ch \ + $(srcdir)/ptexdir/ptex-include.ch \ + $(srcdir)/tex-binpool.ch +# Rules: +ptex.web: tie $(srcdir)/ptexdir/ptex.mk $(ptex_web_srcs) + $(TIE) -m ptex.web $(ptex_web_srcs) +ptex.ch: $(ptex_ch_srcs) + $(TIE) -c ptex.ch $(ptex_ch_srcs) + +ptex-pool.c: ptex.pool $(makecpool) tmf-pool.h + $(makecpool) ptex.pool $(srcdir)/tmf-pool.h >$@ || rm -f $@ + +$(plib): $(plib_o) + rm -f $@ + $(AR) $(ARFLAGS) $@ $(plib_o) + $(RANLIB) $@ + +### pTFtoPL +ptftopl: ptftopl.o $(plib) $(kpathsea) $(ptexenc) $(proglib) + $(kpathsea_link) ptftopl.o $(plib) $(ptexenc) $(LOADLIBES) +ptftopl.o: ptftopl.c $(srcdir)/ptexdir/kanji.h $(srcdir)/ptexdir/ptexhelp.h +ptftopl.c: ptftopl.p $(web2c_aux) + $(web2c) ptftopl +ptftopl.p: ptftopl.web $(srcdir)/ptexdir/ptftopl.ch + $(tangle) ptftopl.web $(srcdir)/ptexdir/ptftopl.ch +ptftopl.web: $(srcdir)/tftopl.web $(srcdir)/tftopl.ch + $(TIE) -m ptftopl.web $(srcdir)/tftopl.web $(srcdir)/tftopl.ch + + +### pPLtoTF +ppltotf: ppltotf.o $(plib) $(kpathsea) $(ptexenc) $(proglib) + $(kpathsea_link) ppltotf.o $(plib) $(ptexenc) $(LOADLIBES) +ppltotf.o: ppltotf.c $(srcdir)/ptexdir/kanji.h $(srcdir)/ptexdir/ptexhelp.h + $(compile) -DPRESERVE_PUTC -c ppltotf.c +ppltotf.c: ppltotf.p $(web2c_aux) + $(web2c) ppltotf +ppltotf.p: tangle ppltotf.web $(srcdir)/ptexdir/ppltotf.ch + $(tangle) ppltotf.web $(srcdir)/ptexdir/ppltotf.ch +ppltotf.web: $(srcdir)/pltotf.web $(srcdir)/pltotf.ch + $(TIE) -m ppltotf.web $(srcdir)/pltotf.web $(srcdir)/pltotf.ch + +### pDVItype +pdvitype: pdvitype.o $(plib) $(kpathsea) $(ptexenc) $(proglib) + $(kpathsea_link) pdvitype.o $(plib) $(ptexenc) $(LOADLIBES) +pdvitype.o: pdvitype.c $(srcdir)/ptexdir/kanji.h $(srcdir)/ptexdir/ptexhelp.h + $(compile) -DHEX_CHAR_CODE -c pdvitype.c +pdvitype.c: pdvitype.p $(web2c_aux) + $(web2c) pdvitype +pdvitype.p: tangle pdvitype.web $(srcdir)/ptexdir/pdvitype.ch + $(tangle) pdvitype.web $(srcdir)/ptexdir/pdvitype.ch +pdvitype.web: $(srcdir)/dvitype.web + cat $(srcdir)/dvitype.web > $@ + +### pBibTeX +pbibtex: pbibtex.o $(plib_o) $(kpathsea) $(ptexenc) $(proglib) + $(kpathsea_link) pbibtex.o $(plib_o) $(ptexenc) $(LOADLIBES) +pbibtex.o: pbibtex.c $(srcdir)/ptexdir/kanji.h $(srcdir)/ptexdir/ptexhelp.h + +pbibd.h: $(srcdir)/ptexdir/pbibd.sed pbibtex.c + sed -f $(srcdir)/ptexdir/pbibd.sed pbibtex.c > $@ + +pbibtex.c pbibtex.h: $(web2c_common) $(web2c_programs) web2c/cvtbib.sed pbibtex.p + $(web2c) pbibtex +pbibtex.p: tangle bibtex.web $(srcdir)/ptexdir/pbibtex.ch + $(tangle) bibtex.web $(srcdir)/ptexdir/pbibtex.ch +clean:: pbibtex-clean +pbibtex-clean: + $(LIBTOOL) --mode=clean rm -f pbibtex + rm -f pbibtex.o pbibtex.c pbibtex.h pbibtex.p pbibd.h + + +# Additional dependencies for relinking. +$(ptexenc): + cd $(ptexenc_dir) && $(MAKE) libptexenc.la + +# Tests... +check: @JPTEX@ ptex-check +ptex-check: etrip ptex.fmt +# Test truncation (but don't bother showing the warning msg). + ./ptex --progname=ptex --output-comment="`cat $(srcdir)/PROJECTS`" \ + $(srcdir)/tests/hello 2>/dev/null \ + && ./dvitype hello.dvi | grep olaf@infovore.xs4all.nl >/dev/null +# \openout should show up in \write's. + ./ptex --progname=ptex $(srcdir)/tests/openout && grep xfoo openout.log +# one.two.tex -> one.two.log + ./ptex --progname=ptex $(srcdir)/tests/one.two && ls -l one.two.log +# uno.dos -> uno.log + ./ptex --progname=ptex $(srcdir)/tests/uno.dos && ls -l uno.log + ./ptex --progname=ptex $(srcdir)/tests/just.texi && ls -l just.log + -./ptex --progname=ptex $(srcdir)/tests/batch.tex + ./ptex --progname=ptex --shell $(srcdir)/tests/write18 | grep echo +# tcx files are a bad idea. +# ./ptex --translate-file=$(srcdir)/share/isol1-t1.tcx \ +# $(srcdir)/tests/eight && ./dvitype eight.dvi >eigh.typ + TEXMFCNF=../kpathsea \ + ./ptex --mltex --progname=einitex $(srcdir)/tests/mltextst + -./ptex --progname=ptex </dev/null + -PATH=`pwd`:$(kpathsea_dir):$(kpathsea_srcdir):$$PATH \ + WEB2C=$(kpathsea_srcdir) TMPDIR=.. \ + ./ptex --progname=ptex '\nonstopmode\font\foo=nonesuch\end' + +# Cleaning up. +clean:: ptex-clean +ptex-clean: etrip-clean + $(LIBTOOL) --mode=clean $(RM) $(ptex) + rm -f $(ptex_o) $(ptex_c) ptexextra.c ptexcoerce.h ptexd.h + rm -f ptexdir/ptexextra.h ptexdir/ptex.version + rm -f ptexdir/kanji.o $(plib_o) $(plib) + rm -f ptex.p ptex.pool ptex.web ptex.ch ptex-pool.c + rm -f ptftopl.h ptftopl.c ptftopl.o ptftopl.web ptftopl.p + rm -f ppltotf.h ppltotf.c ppltotf.o ppltotf.web ppltotf.p + rm -f pdvitype.h pdvitype.c pdvitype.o pdvitype.web pdvitype.p + rm -f ptex.fmt ptex.log + rm -f hello.dvi hello.log xfoo.out openout.log one.two.log uno.log + rm -f just.log batch.log write18.log mltextst.log texput.log + rm -f missfont.log + rm -rf tfm + +# etrip +ptestdir = $(srcdir)/ptexdir/etrip +ptestenv = TEXMFCNF=$(etestdir) + +triptrap: @JPTEX@ etrip +ptrip: pltotf tftopl ptex dvitype etrip-clean + @echo ">>> See $(etestdir)/etrip.diffs for example of acceptable diffs." >&2 + @echo "*** TRIP test for e-TeX in compatibility mode ***." + ./pltotf $(testdir)/trip.pl trip.tfm + ./tftopl ./trip.tfm trip.pl + -diff $(testdir)/trip.pl trip.pl + $(LN) $(testdir)/trip.tex . # get same filename in log + -$(SHELL) -c '$(etestenv) ./ptex --progname=einitex --ini <$(testdir)/trip1.in >ctripin.fot' + mv trip.log ctripin.log + -diff $(testdir)/tripin.log ctripin.log + -$(SHELL) -c '$(etestenv) ./ptex --progname=ptex <$(testdir)/trip2.in >ctrip.fot' + mv trip.log ctrip.log + -diff $(testdir)/trip.fot ctrip.fot + -$(DIFF) $(DIFFFLAGS) $(testdir)/trip.log ctrip.log + $(SHELL) -c '$(etestenv) ./dvitype $(dvitype_args) trip.dvi >ctrip.typ' + -$(DIFF) $(DIFFFLAGS) $(testdir)/trip.typ ctrip.typ + @echo "*** TRIP test for e-TeX in extended mode ***." + -$(SHELL) -c '$(etestenv) ./ptex --progname=einitex --ini <$(etestdir)/etrip1.in >xtripin.fot' + mv trip.log xtripin.log + -diff ctripin.log xtripin.log + -$(SHELL) -c '$(etestenv) ./ptex --progname=ptex <$(etestdir)/trip2.in >xtrip.fot' + mv trip.log xtrip.log + -diff ctrip.fot xtrip.fot + -$(DIFF) $(DIFFFLAGS) ctrip.log xtrip.log + $(SHELL) -c '$(etestenv) ./dvitype $(dvitype_args) trip.dvi >xtrip.typ' + -$(DIFF) $(DIFFFLAGS) ctrip.typ xtrip.typ + @echo "*** e-TeX specific part of e-TRIP test ***." + ./pltotf $(etestdir)/etrip.pl etrip.tfm + ./tftopl ./etrip.tfm etrip.pl + -diff $(etestdir)/etrip.pl etrip.pl + $(LN) $(etestdir)/etrip.tex . # get same filename in log + -$(SHELL) -c '$(etestenv) ./ptex --progname=einitex --ini <$(etestdir)/etrip2.in >etripin.fot' + mv etrip.log etripin.log + -diff $(etestdir)/etripin.log etripin.log + -$(SHELL) -c '$(etestenv) ./ptex --progname=ptex <$(etestdir)/etrip3.in >etrip.fot' + -diff $(etestdir)/etrip.fot etrip.fot + -$(DIFF) $(DIFFFLAGS) $(etestdir)/etrip.log etrip.log + diff $(etestdir)/etrip.out etrip.out + $(SHELL) -c '$(etestenv) ./dvitype $(dvitype_args) etrip.dvi >etrip.typ' + -$(DIFF) $(DIFFFLAGS) $(etestdir)/etrip.typ etrip.typ + +# Cleaning up for the etrip. +ptrip-clean: + rm -f trip.tfm trip.pl trip.tex trip.fmt ctripin.fot ctripin.log + rm -f ctrip.fot ctrip.log trip.dvi ctrip.typ + rm -f xtripin.fot xtripin.log + rm -f xtrip.fot xtrip.log xtrip.typ + rm -f etrip.tfm etrip.pl etrip.tex etrip.fmt etripin.fot etripin.log + rm -f etrip.fot etrip.log etrip.dvi etrip.out etrip.typ + rm -f tripos.tex 8terminal.tex + rm -rf tfm + +# Distfiles ... +@MAINT@triptrapdiffs: ptexdir/etrip/etrip.diffs +@MAINT@ptexdir/etrip/etrip.diffs: ptex +@MAINT@ $(MAKE) ptrip | tail +1 >ptexdir/etrip/etrip.diffs + + +# Dumps +all_pfmts = ptex.fmt platex.fmt $(pfmts) + +dumps: @JPTEX@ pfmts +pfmts: $(all_pfmts) + +pfmtdir = $(web2cdir)/ptex +$(pfmtdir):: + $(SHELL) $(top_srcdir)/../mkinstalldirs $(pfmtdir) + +ptex.fmt: ptex + $(dumpenv) $(MAKE) progname=ptex files="ptex.src plain.tex cmr10.tfm" prereq-check + $(dumpenv) ./ptex --progname=ptex --jobname=ptex --ini \*\\input ptex.src \\dump </dev/null + +#pelatex.fmt: ptex +# $(dumpenv) $(MAKE) progname=elatex files="latex.ltx" prereq-check +# $(dumpenv) ./ptex --progname=elatex --jobname=elatex --ini \*\\input latex.ltx </dev/null + +platex.fmt: ptex + $(dumpenv) $(MAKE) progname=platex files="platex.ltx" prereq-check + $(dumpenv) ./ptex --progname=platex --jobname=platex --ini \*\\input latex.ltx </dev/null + +#ctex.fmt: ptex +# $(dumpenv) $(MAKE) progname=ctex files="plain.tex cmr10.tfm" prereq-check +# $(dumpenv) ./ptex --progname=ctex --jobname=ctex --ini \\input plain \\dump </dev/null + +#olatex.fmt: ptex +# $(dumpenv) $(MAKE) progname=olatex files="latex.ltx" prereq-check +# $(dumpenv) ./ptex --progname=olatex --progname=olatex --ini \\input latex.ltx </dev/null + +# +# Installation. +install-ptex: install-ptex-exec +install-programs: @JPTEX@ install-ptex-exec +install-ptex-exec: $(ptex) $(bindir) + for p in $(ptex); do $(INSTALL_LIBTOOL_PROG) $$p $(bindir); done + +install-fmts: @JPTEX@ install-ptex-fmts +install-ptex-fmts: pfmts $(pfmtdir) + pfmts="$(all_pfmts)"; \ + for f in $$pfmts; do $(INSTALL_DATA) $$f $(pfmtdir)/$$f; done + pfmts="$(pfmts)"; \ + for f in $$pfmts; do base=`basename $$f .fmt`; \ + (cd $(bindir) && (rm -f $$base; $(LN) ptex $$base)); done + +# end of ptex.mk diff --git a/Build/source/texk/web2c/ptexdir/ptexextra.in b/Build/source/texk/web2c/ptexdir/ptexextra.in new file mode 100644 index 00000000000..2910ac8bad4 --- /dev/null +++ b/Build/source/texk/web2c/ptexdir/ptexextra.in @@ -0,0 +1,61 @@ +/* ptexextra.in: banner etc. for pTeX. + + This is included by pTeX, from ptexextra.c +*/ + +string based_prog_name = "TeX"; +const_string PTEXHELP[] = { + "Usage: ptex [option] texfile", + " : ptex [option] &format texfile", + "", + "-fmt=NAME use NAME instead of program name or %&format.", + "-halt-on-error stop processing at the first error", + "[-no]-file-line-error disable/enable file:line:error style messages", + "-ini be iniptex.", + "-interaction=STRING set interaction mode (STRING=batchmode|nonstopmode|", + " scrollmode|errorstopmode)", +#ifdef IPC + "-ipc send DVI output to a socket as well as the usual", + " output file", + "-ipc-start as -ipc, and also start the server at the other end", +#endif /* IPC */ + "-jobname=STRING set the job name to STRING", + "-kanji=STRING set Japanese encoding (STRING=euc|jis|sjis|utf8)", + "-kpathsea-debug=NUMBER set path searching debugging flags according to", + " the bits of NUMBER", + "[-no]-mktex=FMT disable/enable mktexFMT generation (FMT=tex/tfm)", + "-mltex enable MLTeX extensions such as \\charsubdef", + "-output-comment=STRING use STRING for DVI file comment instead of date", + "-output-directory=DIR use DIR as the directory to write files to", + "[-no]-parse-first-line disable/enable parsing of the first line of the", + " input file", + "-progname=STRING set program (and fmt) name to STRING", + "-recorder enable filename recorder", + "[-no]-shell-escape disable/enable \\write18{SHELL COMMAND}", + "-src-specials insert source specials into the DVI file", + "-src-specials=WHERE insert source specials in certain places of", + " the DVI file. WHERE is a comma-separated value", + " list: cr display hbox math par parend vbox", + "-translate-file=TCXNAME use the TCX file TCXNAME", + "-help print this message and exit.", + "-version print version information and exit.", + NULL +}; + +#define BANNER "This is pTeX, Version 3.1415926-PTEX-VERSION" +#define COPYRIGHT_HOLDER "D.E. Knuth" +#define AUTHOR NULL +#define PROGRAM_HELP PTEXHELP +#define BUG_ADDRESS "ptex-staff@ml.asciimw.jp" +#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 "iniptex" +#define VIR_PROGRAM "virptex" + +#ifdef Xchr +#undef Xchr +#define Xchr(x) (x) +#endif /* Xchr */ diff --git a/Build/source/texk/web2c/ptexdir/ptexhelp.h b/Build/source/texk/web2c/ptexdir/ptexhelp.h new file mode 100644 index 00000000000..01821c7c1ff --- /dev/null +++ b/Build/source/texk/web2c/ptexdir/ptexhelp.h @@ -0,0 +1,69 @@ +/* ptexhelp.h: for the --help option" +*/ +#ifndef PTEXHELP_H +#define PTEXHELP_H +/* block texk/web2c/help.h */ +#define HELP_H + +#ifdef PTFTOPL +string based_prog_name = "TFtoPL"; +const_string PTEXTFTOPLHELP[] = { +"Usage: ptftopl [option] tfmfile [plfile]", +"", +" -verbose output progress reports.", +" -version print version information and exit.", +" -help print this message and exit.", +" -kanji={jis|euc|sjis|utf8}", +" plfile kanji code.", +NULL }; +#endif /* PTFTOPL */ + +#ifdef PPLTOTF +string based_prog_name = "PLtoTF"; +const_string PTEXPLTOTFHELP[] = { +"Usage: ppltotf [option] plfile [tfmfile]", +"", +" -verbose output progress reports.", +" -version print version information and exit.", +" -help print this message and exit.", +" -kanji={jis|euc|sjis|utf8}", +" plfile kanji code.", +NULL }; +#endif /* PPLTOTF */ + +#ifdef PBIBTEX +string based_prog_name = "BibTeX"; +const_string PBIBTEXHELP[] = { +"Usage: pbibtex [option] auxfile", +"", +" -min-crossrefs=INTEGER minimum number of cross-refs required", +" for automatic cite_list inclusion (default 2).", +" -terse do silently.", +" -version print version information and exit.", +" -help print this message and exit.", +" -kanji={jis|euc|sjis|utf8} kanji code for output-file.", +NULL }; +#endif /* PBIBTEX */ + +#ifdef PDVITYPE +string based_prog_name = "DVItype"; +const_string PDVITYPEHELP[] = { +"Usage: pdvitype [option] dvifile", +"", +" -dpi=REAL assumed device resolution in pixels per inch", +" (default 300.0).", +" -magnification=INTEGER overrride the postamble's magnification.", +" -max-pages=INTEGER maximum number of pages (default 1000000).", +" -output-level=1..4 verbosity level.", +" 1: terse, 2: medium-level, 3: verbose,", +" 4: plus check for postamble(default).", +" -page-start=PAGE type, e.g., `1.*.-5' to specify the first page", +" with \\count0=1, \\count2=4.", +" (see the TeX book chapter 15).", +" -show-opcodes show opcodes in dicimal.", +" -kanji={jis|euc|sjis|utf8} kanji code for output-file.", +" -version print version information and exit.", +" -help print this message and exit.", +NULL }; +#endif /* PDVITYPE */ +#endif /* PTEXHELP_H */ diff --git a/Build/source/texk/web2c/ptexdir/ptftopl.ch b/Build/source/texk/web2c/ptexdir/ptftopl.ch new file mode 100644 index 00000000000..76bb02afc48 --- /dev/null +++ b/Build/source/texk/web2c/ptexdir/ptftopl.ch @@ -0,0 +1,549 @@ +% This is a change file for TFtoPL +% +% (07/18/2006) ST TFtoPL p1.7 (3.1, Web2c 7.2) +% (03/27/1998) KN TFtoPL p1.4 (3.1, Web2c 7.2) +% +@x [0] l.45 - pTeX: +\def\title{TF\lowercase{to}PL changes for C} +@y +\def\title{TF\lowercase{to}PL changes for C, and for KANJI} +@z + +@x [2] l.64 - pTeX: +@d banner=='This is TFtoPL, Version 3.2' {printed when the program starts} +@y +@d banner=='This is Nihongo TFtoPL, Version 3.2-p1.7' + {printed when the program starts} +@z + +@x [2] l.91 - pTeX: +procedure initialize; {this procedure gets things started properly} +@y +procedure initialize; {this procedure gets things started properly} +var @!k:integer; {all-purpose initiallization index} +@z + +@x [2] l.97 - pTeX: + tfm_file_array := cast_to_byte_pointer (xmalloc (1003)); +@y + tfm_file_array := cast_to_byte_pointer (xmalloc (1003+4)); +@z + +@x [7] l.149 - pTeX: + print_ln (version_string); +@y + print_ln (version_string); + print ('process kanji code is '); + print (stringcast(get_enc_string)); + print_ln('.'); +@z + +@x [18.20] l.438 - pTeX: +@d index == index_type +@y +@d index == index_type +@d yoko_id_byte = 11 {id byte for YOKO-kumi kanji tfm files} +@d tate_id_byte = 9 {id byte for TATE-kumi kanji tfm files} +@d tfm_format = 1 {normal tfm formated metric files} +@d jfm_format = 2 {jfm formated metric files for YOKO-kumi kanji} +@d vfm_format = 3 {vfm formated metric files for TATE-kumi kanji} +@z + +@x [18.20] l.448 - pTeX: +@!tfm_file_array: pointer_to_byte; {the input data all goes here} +@y +@!tfm_file_array: pointer_to_byte; {the input data all goes here} +@!file_format:tfm_format..vfm_format; {format of tfm file} +@!nt:0..@'77777; {number of words in the character type table} +@!ng:0..@'77777; {number of words in the glue table} +@z + +@x [20] l.434 - pTeX: Read JFM header +read(tfm_file,tfm[1]); lf:=tfm[0]*@'400+tfm[1]; +@y +read(tfm_file,tfm[1]); lf:=tfm[0]*@'400+tfm[1]; +if lf=yoko_id_byte then + begin file_format:=jfm_format; + print_ln('Input file is in YOKO-kumi kanji tfm format.'); + write_ln(pl_file,'(COMMENT THIS IS A KANJI FORMAT FILE)'); + end +else if lf=tate_id_byte then + begin file_format:=vfm_format; + print_ln('Input file is in TATE-kumi kanji tfm format.'); + write_ln(pl_file,'(COMMENT THIS IS A KANJI FORMAT FILE)'); + write_ln(pl_file,'(DIRECTION TATE)'); + end +else begin file_format:=tfm_format; nt:=0; tmp_ptr:=2; + end; +if file_format<>tfm_format then + begin if eof(tfm_file) then abort('The input file is only two bytes long!'); + read(tfm_file,tfm[2]); + if eof(tfm_file) then abort('The input file is only three bytes long!'); + read(tfm_file,tfm[3]); nt:=tfm[2]*@'400+tfm[3]; + if eof(tfm_file) then abort('The input file is only four bytes long!'); + read(tfm_file,tfm[4]); + if eof(tfm_file) then abort('The input file is only five bytes long!'); + read(tfm_file,tfm[5]); lf:=tfm[4]*@'400+tfm[5]; + tmp_ptr:=6; + end; +@z + +@x [20] l.445 - pTeX: put the rest of the file into tfm[6] and after +for tfm_ptr:=2 to 4*lf-1 do +@y +for tfm_ptr:=tmp_ptr to 4*lf-1 do +@z + +@x [21] l.468 - pTeX: the location of subfile sizes is different +begin tfm_ptr:=2;@/ +@y +begin +if file_format<>tfm_format then + begin tfm_ptr:=6; check_sum_value:=28; + end +else + begin tfm_ptr:=2; check_sum_value:=24; + end; +@z + +@x [21] l.485 - pTeX: ng has to be treated specially +if (bc>ec+1)or(ec>255) then abort('The character code range ', +@.The character code range...@> + bc:1,'..',ec:1,'is illegal!'); +if (nw=0)or(nh=0)or(nd=0)or(ni=0) then + abort('Incomplete subfiles for character dimensions!'); +@.Incomplete subfiles...@> +if ne>256 then abort('There are ',ne:1,' extensible recipes!'); +@.There are ... recipes@> +if lf<>6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np then + abort('Subfile sizes don''t add up to the stated total!'); +@.Subfile sizes don't add up...@> +@y +case file_format of +tfm_format: begin + if (bc>ec+1)or(ec>255) then abort('The character code range ', +@.The character code range...@> + bc:1,'..',ec:1,'is illegal!'); + if (nw=0)or(nh=0)or(nd=0)or(ni=0) then + abort('Incomplete subfiles for character dimensions!'); +@.Incomplete subfiles...@> + if ne>256 then abort('There are ',ne:1,' extensible recipes!'); +@.There are ... recipes@> + if lf<>6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np then + abort('Subfile sizes don''t add up to the stated total!'); +@.Subfile sizes don't add up...@> + end; +jfm_format,vfm_format: begin ng:=ne; + if (bc>ec+1)or(ec>255)or(bc<>0) then abort('The character code range ', +@.The character code range...@> + bc:1,'..',ec:1,'is illegal!'); + if (nw=0)or(nh=0)or(nd=0)or(ni=0) then + abort('Incomplete subfiles for character dimensions!'); +@.Incomplete subfiles...@> + if lf<>7+nt+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ng+np then + abort('Sum of subfile sizes (', + 7+nt+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ng+np:1, + ') is not equal to the stated total ', lf:1); +@.Subfile sizes don't add up...@> + end; +end; +@z + +@x [23] l.506 - pTeX: declare type_base. +@!char_base,@!width_base,@!height_base,@!depth_base,@!italic_base, +@!lig_kern_base,@!kern_base,@!exten_base,@!param_base:integer; + {base addresses for the subfiles} +@y +@!char_base,@!width_base,@!height_base,@!depth_base,@!italic_base, +@!lig_kern_base,@!kern_base,@!exten_base,@!param_base:integer; +@!type_base,@!glue_base:integer; {base addresses for the subfiles} +@!check_sum_value:integer; {either 24 (normal case) or 28 (kanji case)} +@z + +@x [24] l.510 - pTeX: define type_base +@ @<Compute the base addresses@>= +begin char_base:=6+lh-bc; +@y +@ @<Compute the base addresses@>= +begin +if file_format<>tfm_format then + begin type_base:=7+lh; + char_base:=type_base+nt-bc; { bc should be zero ...} + end +else char_base:=6+lh-bc; +@z + +@x [24] l.517 - pTeX: define glue_base +kern_base:=lig_kern_base+nl; +exten_base:=kern_base+nk; +param_base:=exten_base+ne-1; +@y +kern_base:=lig_kern_base+nl; +exten_base:=kern_base+nk; +glue_base:=exten_base; +param_base:=exten_base+ne-1; +@z + +@x [25] l.529 - pTeX: must change check_sum from macro (=24) to variable +@d check_sum=24 +@d design_size=check_sum+4 +@d scheme=design_size+4 +@d family=scheme+40 +@d random_word=family+20 +@y +@d check_sum==check_sum_value +@d design_size==check_sum+4 +@d scheme==design_size+4 +@d family==scheme+40 +@d random_word==family+20 +@z + +@x [25] l.549 - pTeX: add definition of glue macro +@d kern(#)==4*(kern_base+#) {here \#\ is an index, not a character} +@y +@d kern(#)==4*(kern_base+#) {here \#\ is an index, not a character} +@d glue(#)==4*(glue_base+#) {likewise} +@z + +@x [63] l.1003 - pTeX: Name of parameter for kanji-font +else if (i<=13)and(font_type=mathex) then + if i=8 then out('DEFAULTRULETHICKNESS') + else out('BIGOPSPACING',i-8:1) +else out('PARAMETER D ',i:1) +@y +else if (i<=13)and(font_type=mathex) then + if i=8 then out('DEFAULTRULETHICKNESS') + else out('BIGOPSPACING',i-8:1) +else if (i<=9)and(file_format<>tfm_format) then + if i=8 then out('EXTRASTRETCH') + else out('EXTRASHRINK') +else out('PARAMETER D ',i:1) +@z + +@x [64] l.1027 - pTeX: Add printing of newline at end of program +if nk>0 then for i:=0 to nk-1 do check_fix(kern(i))('Kern'); +@.Kern n is too big@> +@y +if nk>0 then for i:=0 to nk-1 do check_fix(kern(i))('Kern'); +@.Kern n is too big@> +if file_format<>tfm_format then + begin if ng>0 then for i:=0 to ng-1 do check_fix(glue(i))('Glue'); +@.Glue n is too big@> + end; +@z + +@x [68] l.1068 - pTeX: we print GLUEKERN instead of LIGTABLE + begin left; out('LIGTABLE'); out_ln;@/ +@y + begin left; + if file_format<>tfm_format then out('GLUEKERN') else out('LIGTABLE'); + out_ln;@/ +@z + +@x [69] l.1090 - pTeX: we print Glue/kern instead of Ligature/kern + print('Ligature/kern starting index for character '); print_octal(c); + print_ln(' is too large;'); print_ln('so I removed it.'); reset_tag(c); +@.Ligature/kern starting index...@> +@y + case file_format of + tfm_format: print('Ligature/kern '); +@.Ligature/kern starting index...@> + jfm_format,vfm_format: print('Glue/kern '); +@.Glue/kern index starging index...@> + end; + print('starting index for character '); print_octal(c); + print_ln(' is too large;'); print_ln('so I removed it.'); reset_tag(c); +@z + +@x [76] l.1179 - pTeX: if kanji format, output a glue step not a ligature step +else @<Output a ligature step@>; +@y +else if file_format=tfm_format then @<Output a ligature step@> +else if (file_format=jfm_format)or(file_format=vfm_format) then + @<Output a glue step@>; +@z + +@x [78] l.1238 - pTeX: +for c:=bc to ec do if width_index(c)>0 then +@y +for c:=bc to ec do +if width_index(c)=0 then + begin if file_format<>tfm_format then + bad('width index of type ',c:1,' is zero!!') + end +else if width_index(c)>0 then +@z + +@x [78] l.1246 - pTeX: the 'character' table is really the 'type' table + left; out('CHARACTER'); out_char(c); out_ln; +@y + left; + if file_format<>tfm_format then + begin out('TYPE'); tfm[0]:=c; out_octal(0,1); + end + else + begin out('CHARACTER'); out_char(c); + end; + out_ln; +@z + +@x [78] l.1251 - pTeX: types can only have tags equal to 0 or 1 + case tag(c) of + no_tag: do_nothing; + lig_tag: @<Output the applicable part of the ligature/kern + program as a comment@>; + list_tag: @<Output the character link unless there is a problem@>; + ext_tag: @<Output an extensible character recipe@>; + end; {there are no other cases} + right; + end +@y + case tag(c) of + no_tag: do_nothing; + lig_tag: @<Output the applicable part of the ligature/kern + program as a comment@>; + list_tag: if file_format<>tfm_format then + bad('the tag of type ',c:1,' must be 0 or 1') + else @<Output the character link unless there is a problem@>; + ext_tag: if file_format<>tfm_format then + bad('the tag of type ',c:1,' must be 0 or 1') + else @<Output an extensible character recipe@>; + end; {there are no other cases} + right; + end +@z + +@x [96] l.1539 - pTeX: +var tfm_ptr:index; {an index into |tfm|} +@y +var tfm_ptr,tmp_ptr:index; {an index into |tfm|} +@z + +@x [98] l.1566 - pTeX: declare kanji conversion subroutines and externals +@p begin initialize;@/ +@y +@p +@<declare kanji conversion functions@>; +begin initialize;@/ +@z + +@x [99] l.1570 - pTeX: don't check extensible recipes and list the char_type table +@<Check the extensible recipes@>; +@y +if file_format<>tfm_format then + begin @<list |char_type| table@>; + end +else + begin @<Check the extensible recipes@>; + end; +@z + +@x +const n_options = 4; {Pascal won't count array lengths for us.} +@y +const n_options = 5; {Pascal won't count array lengths for us.} +@z +@x +var @!long_options: array[0..n_options] of getopt_struct; + @!getopt_return_val: integer; + @!option_index: c_int_type; + @!current_option: 0..n_options; +begin + @<Initialize the option variables@>; +@y +var @!long_options: array[0..n_options] of getopt_struct; + @!getopt_return_val: integer; + @!option_index: c_int_type; + @!current_option: 0..n_options; + @!version_switch: boolean; +begin + @<Initialize the option variables@>; + version_switch := false; +@z +@x + usage_help (TFTOPL_HELP, nil); +@y + usage_help (PTEX_TFTOPL_HELP, nil); +@z +@x + end else if argument_is ('version') then begin + print_version_and_exit (banner, nil, 'D.E. Knuth', nil); +@y + end else if argument_is ('version') then begin + version_switch := true; + + end else if argument_is ('kanji') then begin + @<Set process kanji code@>; +@z +@x + end; {Else it was a flag; |getopt| has already done the assignment.} + until getopt_return_val = -1; +@y + end; {Else it was a flag; |getopt| has already done the assignment.} + until getopt_return_val = -1; + if (version_switch) then + print_version_and_exit (banner, nil, 'D.E. Knuth', nil); +@z + +@x +@ An element with all zeros always ends the list. +@y +@ kanji option + +@<Define the option...@> = +long_options[current_option].name := 'kanji'; +long_options[current_option].has_arg := 1; +long_options[current_option].flag := 0; +long_options[current_option].val := 0; +incr(current_option); + +@ An element with all zeros always ends the list. +@z + +@x [99] l.1751 - pTeX: +@* Index. +@y +@* For Japanese Font Metric routines. % pTeX: +We need to include some routines for handling kanji character. + +@d max_kanji=7237 {number of the kanji characters - 1} + +@<Glob...@>= +@!this_code:integer; {to hold jis code of the current kanji character} +@!this_type:integer; {to hold |char_type| of the current kanji character} +@!type_index:integer; {index into |char_type| table} +@!type_num:integer; {index into |char_info| table} +@!type_count:integer; {number of chars with the same type} +@!kanji_index:integer; {index into |kanji_type| array} +@!kanji_type:array[0..max_kanji] of -1..255; {kanji type index} + +@ @<Output a glue step@>= +begin if nonexistent(tfm[k+1]) then + correct_bad_char('Glue step for')(k+1) +@.Glue step for nonexistent...@> +else + begin left; out('GLUE'); out_char(tfm[k+1]); + if tfm[k+3]>=ng then + begin bad('Glue index too large.'); +@.Glue index too large@> + out(' R 0.0 R 0.0 R 0.0'); + end + else begin out_fix(glue(3*tfm[k+3])); + out_fix(glue(3*tfm[k+3]+1)); + out_fix(glue(3*tfm[k+3]+2)); + end; + right; + end; +end; + +@ list the |char_type| table in a similar way to the type table + +@<list |char_type| table@>= +this_code:=tfm[4*type_base+0]*@'400+tfm[4*type_base+1]; +this_type:=tfm[4*type_base+2]*@'400+tfm[4*type_base+3]; +if (this_code<>0)or(this_type<>0) then + begin bad('the first entry in char_type is not zero. I''ll zero it.'); + print_ln('JIS code is ', this_code:1, '. Type is ', this_type:1, '.'); + end; +for kanji_index:=0 to max_kanji do kanji_type[kanji_index]:=-1; +for type_index:=1 to nt-1 do + begin this_code:=tfm[4*type_base + type_index * 4 + 0] * 256 + + tfm[4*type_base + type_index * 4 + 1]; + this_type:=tfm[4*type_base + type_index * 4 + 2] * 256 + + tfm[4*type_base + type_index * 4 + 3]; + if not valid_jis_code(this_code) then + bad('jis code ', this_code:1, + ' in char_type table entry ', type_index:1, + ' is not valid. Ignoring it.') + else if (this_type <= 0) or (this_type > ec) then + bad('type ', this_type:1, ' of jis code ', this_code:1, + ' in char_type table is not valid. Ignoring character.') + else + kanji_type[jis_to_index(this_code)] := this_type; + end; +@# +for type_num:=1 to ec do + begin left; out('CHARSINTYPE'); + tfm[0]:=type_num; out_octal(0,1); out_ln; + type_count:=0; + for kanji_index:=0 to max_kanji do + if kanji_type[kanji_index]=type_num then + begin incr(type_count); + if (type_count mod 14)=0 then out_ln; + out_kanji(index_to_jis(kanji_index)); out(' '); + end; + if type_count=0 then bad('type ', type_num:1, 'has no characters in it!'); + out_ln; right; + end; + +@ Some subroutines to handle kanji codes and i/o + +@<Globals...@>= +@!xchr:array[char] of byte; {specifiles conversion of output charcter} + +@ @<Set init...@>= +for k:=@'0 to @'37 do xchr[k]:='?'; +for k:=@'40 to 255 do xchr[k]:=k; + +@ @<declare kanji conversion functions@>= +procedure out_kanji(jis_code:integer); { prints a kanji character } +var @!cx:integer; {KANJI code} +i:0..4; {index of array} +begin@/ +if charcode_format=charcode_octal then + begin cx:=jis_code; out(' J '); {specify jiscode format} + dig[0]:=Hi(cx) div 16; dig[1]:=Hi(cx) mod 16; + dig[2]:=Lo(cx) div 16; dig[3]:=Lo(cx) mod 16; + for i:=0 to 3 do + if dig[i]<10 then out(dig[i]) else + case dig[i] of + 10: out('A'); 11: out('B'); 12: out('C'); + 13: out('D'); 14: out('E'); 15: out('F'); + end; + end +else begin + cx:=toBUFF(fromDVI(jis_code)); + out(xchr[Hi(cx)]); out(xchr[Lo(cx)]); + end; +end; + +@ @<declare kanji conversion functions@>= +function valid_jis_code(cx:integer):boolean; +var first_byte, second_byte:integer; { jis code bytes } +begin valid_jis_code:=true; +first_byte:=cx div @'400; second_byte:=cx mod @'400; +if (first_byte<@"21) + or((first_byte>@"28)and(first_byte<@"30)) + or(first_byte>@"74) then valid_jis_code:=false; +if (second_byte<@"21)or(second_byte>@"7E) then valid_jis_code:=false; +end; + +@ @<declare kanji conversion functions@>= +function index_to_jis(ix:integer):integer; +begin +if ix<=8*94-1 then + index_to_jis:=(ix div 94 + @"21) * @'400 + (ix mod 94 + @"21) +else + index_to_jis:=((ix+7 * 94) div 94 + @"21) * @'400 + ((ix+7*94) mod 94 + @"21) +end; + +@ @<declare kanji conversion functions@>= +function jis_to_index(cx:integer):integer; +var first_byte,second_byte:integer; { jis code bytes } +begin +first_byte:=cx div @'400 - @"21; +second_byte:=cx mod @'400 - @"21; +if first_byte<8 then + jis_to_index:=first_byte*94+second_byte +else + jis_to_index:=(first_byte-7)*94+second_byte; +end + +@ output kanji code. + +@ @<Set process kanji code@>= + if (not set_enc_string(optarg,optarg)) then + print_ln('Bad kanjicode encoding "', stringcast(optarg), '".'); + +@* Index. +@z diff --git a/Build/source/texk/web2c/ptexdir/reautoconf b/Build/source/texk/web2c/ptexdir/reautoconf new file mode 100755 index 00000000000..0bf54835df3 --- /dev/null +++ b/Build/source/texk/web2c/ptexdir/reautoconf @@ -0,0 +1,7 @@ +#!/bin/sh + +set -x +LANG=C +rm -rf ../autom4te.cache/ + +(cd ../../../; ./reautoconf texk/web2c) |