summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorTakuji Tanaka <ttk@t-lab.opal.ne.jp>2022-12-03 12:53:58 +0000
committerTakuji Tanaka <ttk@t-lab.opal.ne.jp>2022-12-03 12:53:58 +0000
commit2ea2abe331e495514be641994f4c90b714753a61 (patch)
tree5abe26bf53e19253a5ae9fb77f7fd99f5b0bd63d
parent6d38426ce998486a0da91a2b10cf69872052e270 (diff)
uptex: Merge change files for pTeX tools into upTeX tools
git-svn-id: svn://tug.org/texlive/trunk@65177 c570f23f-e606-0410-a88d-b1316a301751
-rw-r--r--Build/source/texk/web2c/Makefile.in23
-rwxr-xr-xBuild/source/texk/web2c/ptexdir/nissya.test1
-rwxr-xr-xBuild/source/texk/web2c/ptexdir/pbibtex.test1
-rwxr-xr-xBuild/source/texk/web2c/ptexdir/pdvitype.test1
-rwxr-xr-xBuild/source/texk/web2c/ptexdir/skipjfmp.test1
-rwxr-xr-xBuild/source/texk/web2c/ptexdir/yokotate.test1
-rw-r--r--Build/source/texk/web2c/uptexdir/am/uptex.am26
-rwxr-xr-xBuild/source/texk/web2c/uptexdir/nissya.test1
-rwxr-xr-xBuild/source/texk/web2c/uptexdir/sample.test1
-rwxr-xr-xBuild/source/texk/web2c/uptexdir/skipjfmp.test1
-rwxr-xr-xBuild/source/texk/web2c/uptexdir/upbibtex-mem.test1
-rw-r--r--Build/source/texk/web2c/uptexdir/upbibtex.ch669
-rw-r--r--Build/source/texk/web2c/uptexdir/updvitype.ch472
-rwxr-xr-xBuild/source/texk/web2c/uptexdir/updvitype.test1
-rw-r--r--Build/source/texk/web2c/uptexdir/uppltotf.ch723
-rw-r--r--Build/source/texk/web2c/uptexdir/uptftopl.ch544
-rwxr-xr-xBuild/source/texk/web2c/uptexdir/yokotate.test1
17 files changed, 2193 insertions, 275 deletions
diff --git a/Build/source/texk/web2c/Makefile.in b/Build/source/texk/web2c/Makefile.in
index 3c6d9b5d0a0..c4c7e19f2d1 100644
--- a/Build/source/texk/web2c/Makefile.in
+++ b/Build/source/texk/web2c/Makefile.in
@@ -3303,9 +3303,8 @@ EXTRA_DIST = PROJECTS cftests cpascal.h help.h w2c/config.h \
eptexdir/pdfprimitive.test \
eptexdir/tests/pdfprimitive-test.tex \
eptexdir/tests/pdfprimitive-eptex.log $(uptex_web_srcs) \
- $(uptex_ch_srcs) uptexdir/uptex.defines ptexdir/pbibtex.ch \
- uptexdir/upbibtex.ch ptexdir/pdvitype.ch uptexdir/updvitype.ch \
- ptexdir/ppltotf.ch uptexdir/uppltotf.ch ptexdir/ptftopl.ch \
+ $(uptex_ch_srcs) uptexdir/uptex.defines uptexdir/upbibtex.ch \
+ uptexdir/updvitype.ch uptexdir/uppltotf.ch \
uptexdir/uptftopl.ch uptexdir/COPYRIGHT uptexdir/COPYRIGHT.jis \
uptexdir/ChangeLog $(uptex_tests) $(upweb_tests) \
tests/enc-u.bbl tests/enc-eu.bbl tests/enc-su.bbl \
@@ -22270,32 +22269,32 @@ upbibtex-web2c: upbibtex.p $(web2c_depend) uptexdir/uptex.defines web2c/cvtbib.s
@$(web2c) upbibtex
upbibtex.p: tangle$(EXEEXT) upbibtex.web uptexdir/upbibtex.ch
$(up_tangle) upbibtex upbibtex
-upbibtex.web: tie$(EXEEXT) bibtex.web bibtex.ch ptexdir/pbibtex.ch
- $(tie_m) bibtex.web bibtex.ch ptexdir/pbibtex.ch
+upbibtex.web: tie$(EXEEXT) bibtex.web bibtex.ch
+ $(tie_m) bibtex.web bibtex.ch
updvitype.c updvitype.h: updvitype-web2c
@$(web2c) updvitype
updvitype-web2c: updvitype.p $(web2c_depend) uptexdir/uptex.defines
@$(web2c) updvitype
updvitype.p: tangle$(EXEEXT) updvitype.web uptexdir/updvitype.ch
$(up_tangle) updvitype updvitype
-updvitype.web: tie$(EXEEXT) dvitype.web dvitype.ch ptexdir/pdvitype.ch
- $(tie_m) dvitype.web dvitype.ch ptexdir/pdvitype.ch
+updvitype.web: tie$(EXEEXT) dvitype.web dvitype.ch
+ $(tie_m) dvitype.web dvitype.ch
uppltotf.c uppltotf.h: uppltotf-web2c
@$(web2c) uppltotf
uppltotf-web2c: uppltotf.p $(web2c_depend) uptexdir/uptex.defines
@$(web2c) uppltotf
uppltotf.p: tangle$(EXEEXT) uppltotf.web uptexdir/uppltotf.ch
$(up_tangle) uppltotf uppltotf
-uppltotf.web: tie$(EXEEXT) pltotf.web pltotf.ch ptexdir/ppltotf.ch
- $(tie_m) pltotf.web pltotf.ch ptexdir/ppltotf.ch
+uppltotf.web: tie$(EXEEXT) pltotf.web pltotf.ch
+ $(tie_m) pltotf.web pltotf.ch
uptftopl.c uptftopl.h: uptftopl-web2c
@$(web2c) uptftopl
uptftopl-web2c: uptftopl.p $(web2c_depend) uptexdir/uptex.defines
@$(web2c) uptftopl
uptftopl.p: tangle$(EXEEXT) uptftopl.web uptexdir/uptftopl.ch
$(up_tangle) uptftopl uptftopl
-uptftopl.web: tie$(EXEEXT) tftopl.web tftopl.ch ptexdir/ptftopl.ch
- $(tie_m) tftopl.web tftopl.ch ptexdir/ptftopl.ch
+uptftopl.web: tie$(EXEEXT) tftopl.web tftopl.ch
+ $(tie_m) tftopl.web tftopl.ch
uptexdir/uptriptest.log: uptex$(EXEEXT) dvitype$(EXEEXT) pltotf$(EXEEXT) tftopl$(EXEEXT)
uptexdir/upver.log uptexdir/upkcat.log: uptex$(EXEEXT)
uptexdir/upbibtex.log: upbibtex$(EXEEXT)
@@ -22304,7 +22303,7 @@ uptexdir/uppltotf.log: uppltotf$(EXEEXT)
uptexdir/uptftopl.log: uptftopl$(EXEEXT)
uptexdir/upbibtex-openout-test.log uptexdir/upbibtex-longline-test.log \
uptexdir/upbibtex-mem.log uptexdir/nissya.log: upbibtex$(EXEEXT)
-uptexdir/sample.log: pdvitype$(EXEEXT)
+uptexdir/sample.log: updvitype$(EXEEXT)
uptexdir/yokotate.log uptexdir/skipjfmp.log \
uptexdir/newjfm.log uptexdir/uparse.log uptexdir/gkhuge.log: uppltotf$(EXEEXT) uptftopl$(EXEEXT)
uptrip.diffs: uptex$(EXEEXT) dvitype$(EXEEXT) pltotf$(EXEEXT) tftopl$(EXEEXT)
diff --git a/Build/source/texk/web2c/ptexdir/nissya.test b/Build/source/texk/web2c/ptexdir/nissya.test
index 9c36af75528..cfef230ee18 100755
--- a/Build/source/texk/web2c/ptexdir/nissya.test
+++ b/Build/source/texk/web2c/ptexdir/nissya.test
@@ -1,5 +1,6 @@
#! /bin/sh -vx
# $Id$
+# Copyright 2022 Japanese TeX Development Community <issue@texjp.org>
# Copyright 2017 Karl Berry <tex-live@tug.org>
# Copyright 2010-2013 Peter Breitenlohner <tex-live@tug.org>
# You may freely use, modify and/or distribute this file.
diff --git a/Build/source/texk/web2c/ptexdir/pbibtex.test b/Build/source/texk/web2c/ptexdir/pbibtex.test
index 2df3d8aa5f2..322b021a6d2 100755
--- a/Build/source/texk/web2c/ptexdir/pbibtex.test
+++ b/Build/source/texk/web2c/ptexdir/pbibtex.test
@@ -1,5 +1,6 @@
#! /bin/sh -vx
# $Id$
+# Copyright 2022 Japanese TeX Development Community <issue@texjp.org>
# Copyright 2017 Karl Berry <tex-live@tug.org>
# Copyright 2010-2013 Peter Breitenlohner <tex-live@tug.org>
# You may freely use, modify and/or distribute this file.
diff --git a/Build/source/texk/web2c/ptexdir/pdvitype.test b/Build/source/texk/web2c/ptexdir/pdvitype.test
index 341a290e919..a3a57ac066e 100755
--- a/Build/source/texk/web2c/ptexdir/pdvitype.test
+++ b/Build/source/texk/web2c/ptexdir/pdvitype.test
@@ -1,5 +1,6 @@
#! /bin/sh -vx
# $Id$
+# Copyright 2022 Japanese TeX Development Community <issue@texjp.org>
# Copyright 2017 Karl Berry <tex-live@tug.org>
# Copyright 2010-2013 Peter Breitenlohner <tex-live@tug.org>
# You may freely use, modify and/or distribute this file.
diff --git a/Build/source/texk/web2c/ptexdir/skipjfmp.test b/Build/source/texk/web2c/ptexdir/skipjfmp.test
index 3b2e3ec7e0b..dee7c206db0 100755
--- a/Build/source/texk/web2c/ptexdir/skipjfmp.test
+++ b/Build/source/texk/web2c/ptexdir/skipjfmp.test
@@ -1,5 +1,6 @@
#! /bin/sh -vx
# $Id$
+# Copyright 2018-2022 Japanese TeX Development Community <issue@texjp.org>
# Copyright 2018 Karl Berry <tex-live@tug.org>
# You may freely use, modify and/or distribute this file.
diff --git a/Build/source/texk/web2c/ptexdir/yokotate.test b/Build/source/texk/web2c/ptexdir/yokotate.test
index 4257d076fa0..81fcc415759 100755
--- a/Build/source/texk/web2c/ptexdir/yokotate.test
+++ b/Build/source/texk/web2c/ptexdir/yokotate.test
@@ -1,5 +1,6 @@
#! /bin/sh -vx
# $Id$
+# Copyright 2022 Japanese TeX Development Community <issue@texjp.org>
# Copyright 2017 Karl Berry <tex-live@tug.org>
# Copyright 2010-2013 Peter Breitenlohner <tex-live@tug.org>
# You may freely use, modify and/or distribute this file.
diff --git a/Build/source/texk/web2c/uptexdir/am/uptex.am b/Build/source/texk/web2c/uptexdir/am/uptex.am
index 2d6d0f5bc39..6e5966de44d 100644
--- a/Build/source/texk/web2c/uptexdir/am/uptex.am
+++ b/Build/source/texk/web2c/uptexdir/am/uptex.am
@@ -99,9 +99,9 @@ upbibtex-web2c: upbibtex.p $(web2c_depend) uptexdir/uptex.defines web2c/cvtbib.s
@$(web2c) upbibtex
upbibtex.p: tangle$(EXEEXT) upbibtex.web uptexdir/upbibtex.ch
$(up_tangle) upbibtex upbibtex
-upbibtex.web: tie$(EXEEXT) bibtex.web bibtex.ch ptexdir/pbibtex.ch
- $(tie_m) bibtex.web bibtex.ch ptexdir/pbibtex.ch
-EXTRA_DIST += ptexdir/pbibtex.ch uptexdir/upbibtex.ch
+upbibtex.web: tie$(EXEEXT) bibtex.web bibtex.ch
+ $(tie_m) bibtex.web bibtex.ch
+EXTRA_DIST += uptexdir/upbibtex.ch
## upDVItype
##
@@ -116,9 +116,9 @@ updvitype-web2c: updvitype.p $(web2c_depend) uptexdir/uptex.defines
@$(web2c) updvitype
updvitype.p: tangle$(EXEEXT) updvitype.web uptexdir/updvitype.ch
$(up_tangle) updvitype updvitype
-updvitype.web: tie$(EXEEXT) dvitype.web dvitype.ch ptexdir/pdvitype.ch
- $(tie_m) dvitype.web dvitype.ch ptexdir/pdvitype.ch
-EXTRA_DIST += ptexdir/pdvitype.ch uptexdir/updvitype.ch
+updvitype.web: tie$(EXEEXT) dvitype.web dvitype.ch
+ $(tie_m) dvitype.web dvitype.ch
+EXTRA_DIST += uptexdir/updvitype.ch
## upPLtoTF
##
@@ -133,9 +133,9 @@ uppltotf-web2c: uppltotf.p $(web2c_depend) uptexdir/uptex.defines
@$(web2c) uppltotf
uppltotf.p: tangle$(EXEEXT) uppltotf.web uptexdir/uppltotf.ch
$(up_tangle) uppltotf uppltotf
-uppltotf.web: tie$(EXEEXT) pltotf.web pltotf.ch ptexdir/ppltotf.ch
- $(tie_m) pltotf.web pltotf.ch ptexdir/ppltotf.ch
-EXTRA_DIST += ptexdir/ppltotf.ch uptexdir/uppltotf.ch
+uppltotf.web: tie$(EXEEXT) pltotf.web pltotf.ch
+ $(tie_m) pltotf.web pltotf.ch
+EXTRA_DIST += uptexdir/uppltotf.ch
## upTFtoPL
##
@@ -150,9 +150,9 @@ uptftopl-web2c: uptftopl.p $(web2c_depend) uptexdir/uptex.defines
@$(web2c) uptftopl
uptftopl.p: tangle$(EXEEXT) uptftopl.web uptexdir/uptftopl.ch
$(up_tangle) uptftopl uptftopl
-uptftopl.web: tie$(EXEEXT) tftopl.web tftopl.ch ptexdir/ptftopl.ch
- $(tie_m) tftopl.web tftopl.ch ptexdir/ptftopl.ch
-EXTRA_DIST += ptexdir/ptftopl.ch uptexdir/uptftopl.ch
+uptftopl.web: tie$(EXEEXT) tftopl.web tftopl.ch
+ $(tie_m) tftopl.web tftopl.ch
+EXTRA_DIST += uptexdir/uptftopl.ch
##
EXTRA_DIST += \
@@ -186,7 +186,7 @@ uptexdir/uppltotf.log: uppltotf$(EXEEXT)
uptexdir/uptftopl.log: uptftopl$(EXEEXT)
uptexdir/upbibtex-openout-test.log uptexdir/upbibtex-longline-test.log \
uptexdir/upbibtex-mem.log uptexdir/nissya.log: upbibtex$(EXEEXT)
-uptexdir/sample.log: pdvitype$(EXEEXT)
+uptexdir/sample.log: updvitype$(EXEEXT)
uptexdir/yokotate.log uptexdir/skipjfmp.log \
uptexdir/newjfm.log uptexdir/uparse.log uptexdir/gkhuge.log: uppltotf$(EXEEXT) uptftopl$(EXEEXT)
diff --git a/Build/source/texk/web2c/uptexdir/nissya.test b/Build/source/texk/web2c/uptexdir/nissya.test
index 749450276b3..3c52edcc5ae 100755
--- a/Build/source/texk/web2c/uptexdir/nissya.test
+++ b/Build/source/texk/web2c/uptexdir/nissya.test
@@ -1,5 +1,6 @@
#! /bin/sh -vx
# $Id$
+# Copyright 2022 Japanese TeX Development Community <issue@texjp.org>
# Copyright 2017 Karl Berry <tex-live@tug.org>
# Copyright 2010-2013 Peter Breitenlohner <tex-live@tug.org>
# You may freely use, modify and/or distribute this file.
diff --git a/Build/source/texk/web2c/uptexdir/sample.test b/Build/source/texk/web2c/uptexdir/sample.test
index 295ef8302b4..24db4cc946d 100755
--- a/Build/source/texk/web2c/uptexdir/sample.test
+++ b/Build/source/texk/web2c/uptexdir/sample.test
@@ -1,5 +1,6 @@
#! /bin/sh -vx
# $Id$
+# Copyright 2022 Japanese TeX Development Community <issue@texjp.org>
# Copyright 2017-2020 Karl Berry <tex-live@tug.org>
# Copyright 2010-2013 Peter Breitenlohner <tex-live@tug.org>
# You may freely use, modify and/or distribute this file.
diff --git a/Build/source/texk/web2c/uptexdir/skipjfmp.test b/Build/source/texk/web2c/uptexdir/skipjfmp.test
index 42b11e70aab..11c927c332c 100755
--- a/Build/source/texk/web2c/uptexdir/skipjfmp.test
+++ b/Build/source/texk/web2c/uptexdir/skipjfmp.test
@@ -1,5 +1,6 @@
#! /bin/sh -vx
# $Id$
+# Copyright 2018-2022 Japanese TeX Development Community <issue@texjp.org>
# Copyright 2018 Karl Berry <tex-live@tug.org>
# You may freely use, modify and/or distribute this file.
diff --git a/Build/source/texk/web2c/uptexdir/upbibtex-mem.test b/Build/source/texk/web2c/uptexdir/upbibtex-mem.test
index 70473cd59c9..2aae3431231 100755
--- a/Build/source/texk/web2c/uptexdir/upbibtex-mem.test
+++ b/Build/source/texk/web2c/uptexdir/upbibtex-mem.test
@@ -1,5 +1,6 @@
#! /bin/sh -vx
# $Id$
+# Copyright 2022 Japanese TeX Development Community <issue@texjp.org>
# Copyright 2017 Karl Berry <tex-live@tug.org>
# Copyright 2010-2013 Peter Breitenlohner <tex-live@tug.org>
# You may freely use, modify and/or distribute this file.
diff --git a/Build/source/texk/web2c/uptexdir/upbibtex.ch b/Build/source/texk/web2c/uptexdir/upbibtex.ch
index 40a12c90d04..e244606e6eb 100644
--- a/Build/source/texk/web2c/uptexdir/upbibtex.ch
+++ b/Build/source/texk/web2c/uptexdir/upbibtex.ch
@@ -1,35 +1,103 @@
+% 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
+%
+% 2002 Version 0.33 add kanji option by ASCII Corporation
+%
+% 2009 pTeXenc, pbibtex N. Tsuchimura
+% 2010 Version 0.99d of BibTeX for TeX Live
+%
+% 2022-02-08 Version 0.34 by H. Yamashita
+% * Avoid breaking BBL lines at white space after a Japanese character, to
+% preserve spacing within BIB entry for subsequent pTeX line-end operations.
+% 2022-02-20 Still version 0.34 by H. Yamashita (-> TL'22 version)
+% * Improve substring$ to truncate at least one character when trying to
+% start counting from the middle byte of the first or last Japanese character.
+% 2022-05-15 Version 0.35 by Takuji Tanaka
+% * Accept multibyte characters by int.to.chr$ and chr.to.int$.
+% 2022-12-03 Version 0.36 by Takuji Tanaka (-> TL'23 version)
+% * Merge pBibTeX source/binary into upBibTeX.
+
+@x [0] only print chnages
+\def\title{\BibTeX\ }
+@y
+\let\maybe=\iffalse
+\def\title{J\BibTeX\ 0.36 Changes for C Version \BibTeX\ }
+@z
+
+@x
+ \def\titlepage{F}
+ \centerline{\:\titlefont The {\:\ttitlefont \BibTeX} preprocessor}
+ \vskip 15pt \centerline{(Version 0.99d---\today)} \vfill}
+@y
+ \def\titlepage{F}
+ \centerline{\:\titlefont The {\:\ttitlefont J\BibTeX} preprocessor}
+ \vskip 15pt \centerline{(Version 0.99d-j0.36---\today)} \vfill}
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [1] banner
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
-@d my_name=='pbibtex'
-@d banner=='This is pBibTeX, Version 0.99d-j0.35'
+@d my_name=='bibtex'
+@d banner=='This is BibTeX, Version 0.99d' {printed when the program starts}
@y
@d my_name=='upbibtex'
-@d banner=='This is upBibTeX, Version 0.99d-j0.35-u1.29'
+@d banner=='This is upBibTeX, Version 0.99d-j0.36-u1.29'
+ {printed when the program starts}
@z
@x
-for i:=@'200 to @'237 do xchr[i]:=chr(i-@'200);
-for i:=@'240 to 255 do xchr[i]:=chr(i);
+ print (banner);
@y
+ print (banner);
+ print (' (', conststringcast(get_enc_string), ')');
+@z
+
+@x Changes for JBibTeX by Shouichi Matsui [27]
+for i:=0 to @'37 do xchr[i]:=chr(i);
+for i:=@'177 to @'377 do xchr[i]:=chr(i);
+@y
+for i:=1 to @'37 do xchr[i]:=' ';
+xchr[tab]:=chr(tab);
for i:=@'200 to 255 do xchr[i]:=chr(i);
+xchr[@'33]:=chr(@'33); {escape char}
@z
-@x
-for i:=@'200 to @'237 do xord[i]:= i-@'200;
-for i:=@'240 to 255 do xord[i]:=i;
+@x Changes for JBibTeX by Shouichi Matsui [28]
+for i:=first_text_char to last_text_char do xord[xchr[i]]:=i;
@y
+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 255 do xord[i]:=i;
@z
-@x
-@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}
+
+@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 e_ss3 = @"8F {single shift three in EUC}
@d e_pun_first = @"A1 {Zenkaku punctuation first byte; in EUC}
@d e_space = @"A1A1 {Zenkaku space; in EUC}
@@ -55,21 +123,114 @@ for i:=@'200 to 255 do xord[i]:=i;
@d u_exclam_question = @"2049 {Zenkaku exclamation question mark; in UCS}
@z
-@x
-for i:=@'200 to @'237 do lex_class[i] := illegal;
-for i:=@'240 to 255 do lex_class[i] := alpha;
-lex_class[@'33]:=alpha;
+% [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:=@'200 to @'377 do lex_class[i] := alpha;
+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;
@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;
@z
-@x
-for i:=@'200 to @'237 do id_class[i] := illegal_id_char;
+@x Changes for JBibTeX by Shouichi Matsui [33]
+@<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;
+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;
+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
-for i:=@'240 to 254 do char_width[i]:=514;
+@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;
+@z
+
+@x [48] JBibTeX and dynamic buf_size.
+label loop_exit;
+@y
+label loop_exit;
+var i:c_int_type;
+@z
+@x [still 48] JBibTeX and dynamic buf_size.
+ while (not eoln(f)) do
+ begin
+ if (last >= buf_size) then
+ buffer_overflow;
+ buffer[last] := xord[getc (f)];
+ incr (last);
+ end;
+ vgetc (f); {skip the eol}
+@y
+ last := input_line2(f,ustringcast(buffer),last,buf_size,address_of(i));
+ while (not eof(f)) and (last > 0) and (i <> 10) and (i <> 13) do
+ begin
+ buffer_overflow;
+ last := input_line2(f,ustringcast(buffer),last,buf_size,address_of(i));
+ end;
@z
@x procedure lower_case
@@ -196,11 +357,14 @@ if (len > 0) then
end
@z
-@x procedure get_the_top_level_aux_file_name
+@x
+@<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 (nil,'EUC')) then uexit(1);
@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;
var i:0..last_text_char; {this is the first one declared}
begin
@@ -208,17 +372,96 @@ begin
@z
@x
- 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@>;
+parse_arguments;
+@y
+init_kanji;
+parse_arguments;
+@z
+
+% pBibTeX: do not break at |white_space| after Japanese characters (2022-02-08 j0.34)
+@x "Break that line"
+while ((lex_class[out_buf[out_buf_ptr]] <> white_space) and
+ (out_buf_ptr >= min_print_line)) do
+ decr(out_buf_ptr);
+@y
+while (((lex_class[out_buf[out_buf_ptr]] <> white_space) or
+ (out_buf[out_buf_ptr-1] > 127)) and (out_buf_ptr >= min_print_line)) do
+ decr(out_buf_ptr);
+@z
+@x "Break that unbreakably long line"
+ if (lex_class[out_buf[out_buf_ptr]] <> white_space) then
+ incr(out_buf_ptr)
+@y
+ if (lex_class[out_buf[out_buf_ptr]] <> white_space) or
+ (out_buf[out_buf_ptr-1] > 127) then
+ incr(out_buf_ptr)
+@z
+
+@x Changes for JBibTeX by Shouichi Matsui [332]
+@!b_write : hash_loc; {\.{write\$}}
+@!b_default : hash_loc; {either \.{skip\$} or \.{default.type}}
+@y
+@!b_write : hash_loc; {\.{write\$}}
+@!b_is_kanji_str : hash_loc; {\.{is.kanji.str\$}}
+@!b_default : hash_loc; {either \.{skip\$} or \.{default.type}}
+@z
+
+@x Changes for JBibTeX by Shouichi Matsui [334]
+@d n_write = 36 {\.{write\$}}
+
+@<Constants in the outer block@>=
+@!num_blt_in_fns = 37; {one more than the previous number}
+@y
+@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('write$ ',6,b_write,n_write);
+@y
+build_in('write$ ',6,b_write,n_write);
+build_in('is.kanji.str$',13,b_is_kanji_str,n_is_kanji_str);
+@z
+
+@x Changes for JBibTeX by Shouichi Matsui [342]
+ n_write : x_write;
+ othercases confusion ('Unknown built-in function')
+endcases;
+end
+@y
+ 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|({\.{write\$}})@>@;
+@<|execute_fn| itself@>
+@y
+@<|execute_fn|({\.{write\$}})@>@;
+@<|execute_fn|({\.{is.kanji.str\$}})@>@;
+@<|execute_fn| itself@>
+@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;
othercases
begin
if (is_internalEUC) then
@@ -257,18 +500,41 @@ begin
@z
@x x_chr_to_int
- push_lit_stk(toDVI(fromBUFF(str_pool, str_start[pop_lit1]+2, str_start[pop_lit1])),stk_int)
- { a KANJI char is 2byte long }
+else if (length(pop_lit1) <> 1) then
+ begin
+ print ('"');
+ print_pool_str (pop_lit1);
+ bst_ex_warn ('" isn''t a single character');
+ push_lit_stk (0, stk_int);
+ end
+else
+ push_lit_stk (str_pool[str_start[pop_lit1]], stk_int);
+ {push the (|ASCII_code|) integer}
@y
+else if (length(pop_lit1) = multibytelen(str_pool[str_start[pop_lit1]])) then
+ begin
+ if (length(pop_lit1) = 1) then
+ push_lit_stk(str_pool[str_start[pop_lit1]],stk_int)
+ {push the (|ASCII_code|) integer}
+ else
push_lit_stk(toDVI(fromBUFF(str_pool, str_start[pop_lit1]+length(pop_lit1), str_start[pop_lit1])),stk_int)
{ a KANJI char is |2..4|byte long }
+ end
+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
- 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;
+@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 (is_internalEUC) then
if((fromBUFF(ex_buf, ex_buf_length, ex_buf_ptr-2) = e_comma) or
(fromBUFF(ex_buf, ex_buf_length, ex_buf_ptr-2) = e_toten))
@@ -279,28 +545,41 @@ begin
(fromBUFF(ex_buf, ex_buf_length, ex_buf_ptr-3) = u_toten))
then ex_buf_ptr := ex_buf_ptr - 3
else ex_buf_ptr := ex_buf_ptr - 4;
+ end;
@z
-@x
- zen_pun_first:
+@x Changes for JBibTeX by Shouichi Matsui for Zenkaku comma
+ "a", "A" :
begin
- if((ex_buf[ex_buf_ptr+1]=zen_comma) or
- (ex_buf[ex_buf_ptr+1]=zen_kuten) ) then
+ 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;
e_pun_first:
if (is_internalEUC) then
begin
if ((fromBUFF(ex_buf, ex_buf_length, ex_buf_ptr) = e_comma) or
(fromBUFF(ex_buf, ex_buf_length, ex_buf_ptr) = e_toten)) then
-@z
-@x
- else if(ex_buf[ex_buf_ptr+1]=zen_space) then
-@y
+ begin
+ preceding_white := false;
+ and_found := true
+ end
else if (fromBUFF(ex_buf,ex_buf_length,ex_buf_ptr) = e_space) then
-@z
-@x
- end;
-@y
+ 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 else begin
ex_buf_ptr := ex_buf_ptr + multibytelen(ex_buf[ex_buf_ptr]);
preceding_white := false;
@@ -329,24 +608,48 @@ begin
end;
@z
-@x
- if( ex_buf[ex_buf_ptr] > 127 ) then
- ex_buf_ptr := ex_buf_ptr +2
- else
- incr(ex_buf_ptr);
+@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
ex_buf_ptr := ex_buf_ptr + multibytelen(ex_buf[ex_buf_ptr]);
+ preceding_white := false;
+ end
+ endcases;
+check_brace_level (pop_lit_var);
+end;
@z
-@x
- 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]);
+@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
append_ex_buf_char_and_check (name_buf[name_bf_ptr]);
if multibytelen(name_buf[name_bf_ptr]) > 1 then
append_ex_buf_char_and_check (name_buf[name_bf_ptr+1]);
@@ -355,19 +658,52 @@ begin
if multibytelen(name_buf[name_bf_ptr]) > 3 then
append_ex_buf_char_and_check (name_buf[name_bf_ptr+3]);
name_bf_ptr := name_bf_ptr + multibytelen(name_buf[name_bf_ptr])-1;
+ goto loop_exit;
+ end
+ else if ((name_buf[name_bf_ptr] = left_brace) and
@z
@x x_int_to_chr
- str_room(2);
- if (pop_lit1>127) then begin
- append_char (Hi(k));
- append_char (Lo(k));
+procedure x_int_to_chr;
+begin
+pop_lit_stk (pop_lit1,pop_typ1);
+if (pop_typ1 <> stk_int) then
+ begin
+ print_wrong_stk_lit (pop_lit1,pop_typ1,stk_int);
+ push_lit_stk (s_null, stk_str);
end
- else
- append_char (pop_lit1);
+else if ((pop_lit1 < 0) or (pop_lit1 > 127)) then
+ begin
+ bst_ex_warn (pop_lit1:0,' isn''t valid ASCII');
+ push_lit_stk (s_null, stk_str);
+ end
+else
+ begin
+ str_room(1);
+ append_char (pop_lit1);
push_lit_stk (make_string, stk_str);
end;
+end;
@y
+procedure x_int_to_chr;
+var k:integer;
+begin
+pop_lit_stk (pop_lit1,pop_typ1);
+if (pop_typ1 <> stk_int) then
+ begin
+ print_wrong_stk_lit (pop_lit1,pop_typ1,stk_int);
+ push_lit_stk (s_null, stk_str);
+ end
+else begin
+k:=pop_lit1;
+if (pop_lit1 > 127) then k:=fromDVI(pop_lit1);
+if ((pop_lit1 < 0) or ((pop_lit1 > 127) and (k = 0))) then
+ begin
+ bst_ex_warn (pop_lit1:0,' isn''t valid character code');
+ push_lit_stk (s_null, stk_str);
+ end
+else
+ begin
str_room(4);
k:=toBUFF(k);
if (BYTE1(k)>0) then
@@ -380,40 +716,40 @@ begin
append_char (BYTE4(k));
push_lit_stk (make_string, stk_str);
end;
+end;
+end;
@z
-@x
-@!pop_lit2_saved: integer;
+@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}
@!pop_lit2_saved,@!mbl_tpe: integer;
+begin
@z
@x
-{ 2 bytes Kanji code break check }
-tps:=str_start[pop_lit3];
-tpe:=tps;
-while tpe < str_start[pop_lit3+1] do begin
- if str_pool[tpe] > 127 then begin
- if str_start[pop_lit3+1] < tpe+2 then
- break;
- tpe := tpe + 2;
- end
- else begin
- if str_start[pop_lit3+1] < tpe+1 then
- break;
- tpe := tpe + 1;
- end;
- if tpe<=sp_ptr then
- tps := tpe;
- if sp_end<=tpe then break;
-end;
-if (pop_lit2_saved > 1) and (tps = str_start[pop_lit3])
- then tps := tps + 2; {truncate at least one}
-if (pop_lit2_saved < -1) and (tpe = str_start[pop_lit3+1])
- then tpe := tpe - 2; {truncate at least one}
-if tps > tpe then tpe := tps;
-sp_ptr := tps;
-sp_end := tpe;
+@<Form the appropriate substring@>=
+begin
+@y
+@<Form the appropriate substring@>=
+begin
+pop_lit2_saved := pop_lit2; {save before negate}
+@z
+
+@x Changes for JBibTeX by Shouichi Matsui [438] + fix (2022-02-20 j0.34)
+str_room(sp_end - sp_ptr);
+while (sp_ptr < sp_end) do {shift the substring}
+ begin
+ append_char (str_pool[sp_ptr]);
+ incr(sp_ptr);
+ end;
@y
{ |2..4| bytes Kanji code break check }
tps:=str_start[pop_lit3];
@@ -437,36 +773,48 @@ if (pop_lit2_saved < -1) and (tpe = str_start[pop_lit3+1]) then
if tps > tpe then tpe := tps;
sp_ptr := tps;
sp_end := tpe;
-@z
-@x
- 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;
-@y
+str_room(sp_end - sp_ptr);
+while (sp_ptr < sp_end) do {shift the substring}
+ begin
append_char (str_pool[sp_ptr]);
incr(sp_ptr);
+ end;
@z
-@x
- incr(sp_xptr1); num_text_chars:=num_text_chars+2;
+@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}
num_text_chars := num_text_chars + multibytelen(str_pool[sp_xptr1-1]);
sp_xptr1 := sp_xptr1-1 + multibytelen(str_pool[sp_xptr1-1]);
+ end
+ else
+ incr(num_text_chars);
+ end;
@z
@x
-const n_options = 8; {Pascal won't count array lengths for us.}
+const n_options = 4; {Pascal won't count array lengths for us.}
@y
const n_options = 9; {Pascal won't count array lengths for us.}
@z
@x
- usage_help (PBIBTEX_HELP, 'issue@@texjp.org');
+ usage_help (BIBTEX_HELP, nil);
@y
usage_help (UPBIBTEX_HELP, 'issue@@texjp.org');
@z
@@ -474,6 +822,16 @@ const n_options = 9; {Pascal won't count array lengths for us.}
@x
end; {Else it was a flag; |getopt| has already done the assignment.}
@y
+ end else if argument_is ('kanji') then begin
+ if (not set_enc_string(optarg, nil)) then
+ write_ln('Bad kanji encoding "', stringcast(optarg), '".');
+
+ end else if argument_is ('guess-input-enc') then begin
+ enable_guess_file_enc;
+
+ end else if argument_is ('no-guess-input-enc') then begin
+ disable_guess_file_enc;
+
end else if argument_is ('kanji-internal') then begin
if (not (set_enc_string(nil,optarg) and
(is_internalEUC or is_internalUPTEX))) then
@@ -483,6 +841,40 @@ const n_options = 9; {Pascal won't count array lengths for us.}
@z
@x
+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);
+@y
+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);
+long_options[current_option].name := 'guess-input-enc';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr(current_option);
+long_options[current_option].name := 'no-guess-input-enc';
+long_options[current_option].has_arg := 0;
+long_options[current_option].flag := 0;
+long_options[current_option].val := 0;
+incr(current_option);
+@z
+
+@x
@ An element with all zeros always ends the list.
@y
@ Kanji-internal option.
@@ -499,30 +891,41 @@ incr(current_option);
@z
@x
-begin kpse_set_program_name (argv[0], 'pbibtex');
+begin kpse_set_program_name (argv[0], 'bibtex');
@y
begin kpse_set_program_name (argv[0], 'upbibtex');
@z
-@x procedure x_is_kanji_str
-procedure x_is_kanji_str;
-label exit;
+@x
+ until j_prime;
+ incr (k);
+ hash_prime := j;
+ primes[k] := hash_prime;
+ end;
+end;
+
@y
+ until j_prime;
+ incr (k);
+ hash_prime := j;
+ primes[k] := hash_prime;
+ end;
+end;
+
+@ modules for JBibTeX
+
+@<|execute_fn|({\.{is.kanji.str\$}})@>=
procedure x_is_kanji_str;
label exit;
var ctmp,clen:integer;
-@z
-
-@x procedure x_is_kanji_str (cont.)
- 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;
-@y
+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
clen := multibytelen(str_pool[sp_ptr]);
if sp_ptr+clen<=sp_end then
@@ -539,11 +942,8 @@ var ctmp,clen:integer;
incr(sp_ptr);
end;
end;
-@z
-
-@x
-exit:end;
-@y
+ push_lit_stk(0,stk_int);
+ end;
exit:end;
@ @<Procedures and functions for handling numbers, characters, and strings@>=
@@ -605,4 +1005,3 @@ else
char_width[e_ss3]:=0;
end;
@z
-
diff --git a/Build/source/texk/web2c/uptexdir/updvitype.ch b/Build/source/texk/web2c/uptexdir/updvitype.ch
index de973426e8a..1e5224eb941 100644
--- a/Build/source/texk/web2c/uptexdir/updvitype.ch
+++ b/Build/source/texk/web2c/uptexdir/updvitype.ch
@@ -1,15 +1,25 @@
+% This is a change file for DVItype.
+%
+% 09/27/95 (KA) Supporting ASCII pTeX
+% 2020-08-24 (HY) Support \dtou
+% 2022-12-03 (TTK) Merge pDVItype source/binary into upDVItype
+%
@x
-@d my_name=='pdvitype'
-@d banner=='This is pDVItype, Version 3.6-p0.5'
+@d my_name=='dvitype'
+@d banner=='This is DVItype, Version 3.6' {printed when the program starts}
@y
@d my_name=='updvitype'
-@d banner=='This is upDVItype, Version 3.6-p0.5-u1.29'
+@d banner=='This is upDVItype, Version 3.6-p221203'
+ {printed when the program starts}
@z
@x procedure initialize
+ parse_arguments;
print (banner);
print_ln (version_string);
@y
+ init_kanji;
+ parse_arguments;
print (banner);
print (' (');
print (conststringcast(get_enc_string));
@@ -17,23 +27,467 @@
print_ln (version_string);
@z
-@x procedure out_kanji
- 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);
+@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
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% 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] JFM by K.A.
+read_tfm_word; lh:=b2*256+b3;
+@y
+read_tfm_word; lh:=b0*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*256+b3;
+ read_tfm_word;
+ end
+else
+ begin
+ nt:=0;
+ fnt_jfm_p[nf] := false;
+ end;
+lh:=b2*256+b3;
+@z
+
+@x [35] JFM by K.A.
+ 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*256+b1+b2*65536;
+ jfm_char_type[jfm_char_type_count]:=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
+@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-5 then flush_text;
c:=toBUFF(fromDVI(c));
if BYTE1(c)<>0 then begin incr(text_ptr); text_buf[text_ptr]:=BYTE1(c); end;
if BYTE2(c)<>0 then begin incr(text_ptr); text_buf[text_ptr]:=BYTE2(c); end;
if BYTE3(c)<>0 then begin incr(text_ptr); text_buf[text_ptr]:=BYTE3(c); end;
incr(text_ptr); text_buf[text_ptr]:=BYTE4(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
+@!hhh:integer; {|h|, rounded to the nearest pixel}
+@y
+@!hhh,@!vvv:integer; {|h|,|v| rounded to the nearest pixel}
+@z
+
+@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
+
+@x
+move_right: @<Finish a command that sets |h:=h+q|, then |goto done|@>;
+@y
+move_right:
+ if dd=0 then begin
+ @<Finish a command that sets |h:=h+q|, then |goto done|@>;
+ end else begin
+ if dd=1 then p:=q else {if dd=3 then} p:=-q;
+ @<Finish a command that sets |v:=v+p|, then |goto done|@>;
+ end;
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% pTeX
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+ four_cases(set1): begin major('set',o-set1+1:1,' ',p:1); goto fin_set;
+ end;
+ four_cases(put1): begin major('put',o-put1+1:1,' ',p:1); goto fin_set;
+@y
+ four_cases(set1),four_cases(put1):
+ begin
+ if fnt_jfm_p[cur_font]=true then
+ begin
+ cur_jfm_char_type:=get_jfm_char_type(cur_font,p);
+ out_kanji(p);
+ if o<put1 then
+ begin
+ minor('set',o-set1+1:1,' ',p:1);
+ end
+ else begin
+ minor('put',o-put1+1:1,' ',p:1);
+ end;
+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
+ if o<put1 then
+ begin
+ major('set',o-set1+1:1,' ',p:1);
+ end
+ else begin
+ major('put',o-put1+1:1,' ',p:1);
+ end;
+ifdef('HEX_CHAR_CODE')
+ print('(');
+ print_hex_number(p);
+ print(')');
+endif('HEX_CHAR_CODE')
+ end;
+ goto fin_set;
+@z
+
+@x
+ @t\4@>@<Cases for commands |nop|, |bop|, \dots, |pop|@>@;
+@y
+ dir: begin
+ if not ptex_p and (out_mode=the_works) then
+ bad_dvi('dir command within normal dvi file');
+ major('dir ',p:1); dd:=p; goto done;
+ end;
+ @t\4@>@<Cases for commands |nop|, |bop|, \dots, |pop|@>@;
@z
@x
- usage_help (PDVITYPE_HELP, 'issue@@texjp.org');
+@!vvv:integer; {|v|, rounded to the nearest pixel}
+@y
+@!vvv,hhh:integer; {|v|,|h| rounded to the nearest pixel}
+@z
+
+@x
+move_down: @<Finish a command that sets |v:=v+p|, then |goto done|@>;
+@y
+move_down:
+ if dd=0 then begin
+ @<Finish a command that sets |v:=v+p|, then |goto done|@>;
+ end else begin
+ if dd=1 then q:=-p else {if dd=3 then} q:=p;
+ @<Finish a command that sets |h:=h+q|, then |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 if dd=1 then vv:=pixel_round(v+p)
+ else {if dd=3 then} vv:=pixel_round(v-p);
+ end
+ else if dd=0 then hh:=hh+pixel_round(p)
+ else if dd=1 then vv:=vv+pixel_round(p)
+ else {if dd=3 then} 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 if dd=1 then hh:=pixel_round(h-p)
+ else {if dd=3 then} hh:=pixel_round(h+p);
+ end
+ else if dd=0 then vv:=vv+pixel_round(p)
+ else if dd=1 then hh:=hh-pixel_round(p)
+ else {if dd=3 then} 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 if dd=1 then vv:=vv+char_pixel_width(cur_font)(p)
+ else {if dd=3 then} 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 if dd=1 then vv:=vv+rule_pixels(q)
+else {if dd=3 then} vv:=vv-rule_pixels(q);
+goto move_right
+@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
+const n_options = 8; {Pascal won't count array lengths for us.}
+@y
+const n_options = 10; {Pascal won't count array lengths for us.}
+@z
+
+@x
+ usage_help (DVITYPE_HELP, nil);
@y
usage_help (UPDVITYPE_HELP, 'issue@@texjp.org');
@z
+@x
+ end; {Else it was a flag; |getopt| has already done the assignment.}
+@y
+ end else if argument_is ('kanji') then begin
+ set_prior_file_enc;
+ if (not set_enc_string(optarg,optarg)) then begin
+ write_ln('Bad kanji encoding "', stringcast(optarg), '".');
+ end;
+
+ end; {Else it was a flag; |getopt| has already done the assignment.}
+@z
+
+@x
+@ An element with all zeros always ends the list.
+@y
+@ 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);
+
+@ An element with all zeros always ends the list.
+@z
diff --git a/Build/source/texk/web2c/uptexdir/updvitype.test b/Build/source/texk/web2c/uptexdir/updvitype.test
index 2db8ef4c7e3..515f50f373d 100755
--- a/Build/source/texk/web2c/uptexdir/updvitype.test
+++ b/Build/source/texk/web2c/uptexdir/updvitype.test
@@ -1,5 +1,6 @@
#! /bin/sh -vx
# $Id$
+# Copyright 2022 Japanese TeX Development Community <issue@texjp.org>
# Copyright 2017 Karl Berry <tex-live@tug.org>
# Copyright 2011-2013 Peter Breitenlohner <tex-live@tug.org>
# You may freely use, modify and/or distribute this file.
diff --git a/Build/source/texk/web2c/uptexdir/uppltotf.ch b/Build/source/texk/web2c/uptexdir/uppltotf.ch
index 738b0141bdf..06960c591f1 100644
--- a/Build/source/texk/web2c/uptexdir/uppltotf.ch
+++ b/Build/source/texk/web2c/uptexdir/uppltotf.ch
@@ -1,38 +1,632 @@
-@x
-@d my_name=='ppltotf'
-@d banner=='This is pPLtoTF, Version 3.6-p2.0'
+% This is a change file for PLtoTF
+%
+% (2022-12-03) TTK Merge pPLtoTF source/binary into upPLtoTF
+% (2018-01-27) HY pPLtoTF p2.0 - new JFM spec by texjporg
+% (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 my_name=='pltotf'
+@d banner=='This is PLtoTF, Version 3.6' {printed when the program starts}
@y
@d my_name=='uppltotf'
-@d banner=='This is upPLtoTF, Version 3.6-p2.0-u1.29'
+@d banner=='This is upPLtoTF, Version 3.6-p221203'
+ {printed when the program starts}
+@z
+
+@x
+ parse_arguments;
+@y
+ init_kanji;
+ parse_arguments;
+@z
+
+@x [6] l.140 - pTeX:
+ print_ln (version_string);
+@y
+ print_ln (version_string);
+ print_ln ('process kanji code is ', conststringcast(get_enc_string), '.');
+@z
+
+@x [18] l.495 - pTeX:
+@!xord:array[char] of ASCII_code; {conversion table}
+@y
+@!xord:array[char] of ASCII_code; {conversion table}
+@!xchr:array[char] 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 [28] l.619 - pTeX:
+else begin while (limit<buf_size-2)and(not eoln(pl_file)) do
+ begin incr(limit); read(pl_file,buffer[limit]);
+ end;
+@y
+else begin limit:=input_line2(pl_file,ustringcast(buffer),limit+1,buf_size-1)-1;
+@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 {|GLUEKERN| 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] pTeX:
+@ @d out_size(#)==out((#) div 256); out((#) mod 256)
+@y
+@ @d out_size(#)==out((#) div 256); out((#) mod 256)
+@d out_kanji_code(#)==out_size((#) mod 65536); out((#) div 65536)
+@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 = 5; {Pascal won't count array lengths for us.}
@z
@x
- usage_help (PPLTOTF_HELP, 'issue@@texjp.org');
+ usage_help (PLTOTF_HELP, nil);
@y
usage_help (UPPLTOTF_HELP, 'issue@@texjp.org');
@z
@x
-max_kanji=7237; { maximum number of 2byte characters }
-max_kanji_code=@"7E7E; { maximum jis code }
+ end; {Else it was a flag; |getopt| has already done the assignment.}
@y
-max_kanji=1114111; { maximam number of 2byte characters }
-max_kanji_code=@"10FFFF; { maximum ucs code }
+ end else if argument_is ('kanji') then begin
+ if (not set_enc_string(optarg,optarg)) then
+ print_ln('Bad kanji encoding "', stringcast(optarg), '".');
+
+ end; {Else it was a flag; |getopt| has already done the assignment.}
@z
-@x function get_next_raw
-if multistrlen(ustringcast(buffer),loc+2,loc)=2 then cur_char:=" "
+@x
+@ An element with all zeros always ends the list.
@y
-if multistrlen(ustringcast(buffer),loc+3,loc)>1 then cur_char:=" "
+@ 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.
@z
-@x procedure print_jis_hex
-var dig:array[0..3] 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
+@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=1114111; { maximam number of 2byte characters }
+max_kanji_code=@"10FFFF; { maximum ucs code }
+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@>;
+ skip_code:@<Read a skip 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>max_lig_steps then
+ err_print('GLUEKERN with more than ',max_lig_steps,' commands cannot have further labels')
+@.GLUEKERN with more than...@>
+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<max_kerns then incr(nk)
+ else begin err_print('At most ',max_kerns,' different kerns are allowed');
+@.At most 5000 different kerns...@>
+ krn_ptr:=max_kerns-1;
+ end;
+ end;
+lig_kern[nl].b3:=krn_ptr;
+if nl=max_lig_steps then
+ err_print('GLUEKERN table should never exceed ',max_lig_steps,' 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=max_lig_steps then
+ err_print('GLUEKERN table should never exceed ',max_lig_steps,' 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)or(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 print_ln('This is tatekumi format');
+ file_format:=vfm_format;
+ end
+else if cur_char="Y" then
+ begin if verbose then print_ln('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}.
+In the original JFM spec by ASCII Corporation, |jis_code| and |char_type|
+were packed into upper (2~bytes) and lower (2~bytes) halfword respectively.
+However, |char_type| is allowed only 0..255,
+so the upper byte of lower halfword was always 0.
+
+In the new JFM spec by texjporg, |jis_code| ``XXyyzz'' is packed into
+first 3~bytes in the form ``yy zz XX'', and |char_type| is packed into
+remaining 1~byte. The new spec is effectively upper compatible with
+the original, and it allows |jis_code| larger than 0x10000 (not really
+useful for me \.{pPLtoTF} but necessary for \.{upPLtoTF}).
+
+@<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_kanji_code(index_to_jis(kanji_type_index));
+ out(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(ustringcast(buffer),loc+3,loc)>1 then cur_char:=" "
+else cur_char:=xord[buffer[loc]];
+end;
+@#
+function todig(@!ch:byte):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 begin skip_error('This expression is out of JIS-code encoding.');
+ todig:=0;
+ end;
+end;
+@#
+procedure print_jis_hex(jis_code:integer); {prints jiscode as four digits}
var dig:array[0..5] of byte; {holds jis hex codes}
i:byte; {index of array}
begin dig[0]:=(jis_code div 65536) div 16; dig[1]:=(jis_code div 65536) mod 16;
@@ -47,51 +641,45 @@ for i:=0 to 1 do
end;
end;
for i:=2 to 5 do
-@z
-
-@x function valid_jis_code
-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;
-@y
+ 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(cx:integer):boolean;
begin valid_jis_code:=true;
if (cx>@"10FFFF)or(not is_char_kanji(fromDVI(cx)))
or(toDVI(fromDVI(cx))<>cx) then valid_jis_code:=false;
-@z
-
-@x function jis_to_index
-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;
-@y
+end;
+@#
+function jis_to_index(jis:integer):integer;
begin
jis_to_index:=jis;
-@z
-
-@x function index_to_jis
-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);
-@y
+end;
+@#
+function index_to_jis(ix:integer):integer;
begin
index_to_jis:=ix;
-@z
-
-@x function get_kanji
-else if multistrlen(ustringcast(buffer), loc+2, loc)=2 then
- begin jis_code:=toDVI(fromBUFF(ustringcast(buffer), loc+2, loc));
- incr(loc); cur_char:=" ";
-@y
+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<>' '; {skip the blanks after the type code}
+ @<Scan a Kanji hexadecimal code@>;
+ 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 (ch='U')or(ch='u') then
begin repeat ch:=get_next_raw;
until ch<>' '; {skip the blanks after the type code}
@@ -104,5 +692,26 @@ else if multistrlen(ustringcast(buffer), loc+4, loc)>1 then
begin cur_char:=" ";
jis_code:=toDVI(fromBUFF(ustringcast(buffer), loc+4, loc));
loc:=loc+multistrlen(ustringcast(buffer), loc+4, loc)-1;
-@z
+ 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;
+@ @<Scan a Kanji hex...@>=
+begin cx:=todig(xord[ch]);
+ incr(loc); ch:=xord[buffer[loc]];
+ while ((ch>="0")and(ch<="9"))or((ch>="A")and(ch<="F")) do
+ begin cx:=cx*16+todig(ch); {overflow might happen, but rare...}
+ incr(loc); ch:=xord[buffer[loc]];
+ end;
+ decr(loc); ch:=xord[buffer[loc]];
+ if cx>max_kanji_code then
+ begin skip_error('This value shouldn''t exceed jis code');
+ cx:=0; ch:=" ";
+ end;
+end
+
+@* Index.
+@z
diff --git a/Build/source/texk/web2c/uptexdir/uptftopl.ch b/Build/source/texk/web2c/uptexdir/uptftopl.ch
index 7d406735ca5..5046263cc95 100644
--- a/Build/source/texk/web2c/uptexdir/uptftopl.ch
+++ b/Build/source/texk/web2c/uptexdir/uptftopl.ch
@@ -1,34 +1,492 @@
-@x
-@d my_name=='ptftopl'
-@d banner=='This is pTFtoPL, Version 3.3-p2.0'
+% This is a change file for TFtoPL
+%
+% (2022-12-03) TTK Merge pTFtoPL source/binary into upTFtoPL
+% (2018-01-27) HY pTFtoPL p2.0 - new JFM spec by texjporg
+% (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 my_name=='tftopl'
+@d banner=='This is TFtoPL, Version 3.3' {printed when the program starts}
@y
@d my_name=='uptftopl'
-@d banner=='This is upTFtoPL, Version 3.3-p2.0-u1.29'
+@d banner=='This is upTFtoPL, Version 3.3-p221203'
+ {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 := xmalloc_array (byte, 1002);
+@y
+ tfm_file_array := xmalloc_array (byte, 1002 + 4);
@z
@x
- usage_help (PTFTOPL_HELP, 'issue@@texjp.org');
+ parse_arguments;
@y
- usage_help (UPTFTOPL_HELP, 'issue@@texjp.org');
+ init_kanji;
+ parse_arguments;
+@z
+
+@x [7] l.149 - pTeX:
+ print_ln (version_string);
+@y
+ print_ln (version_string);
+ print_ln ('process kanji code is ', conststringcast(get_enc_string), '.');
+@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: ^byte; {the input data all goes here}
+@y
+@!tfm_file_array: ^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 file_format:=tfm_format;
+if file_format=tfm_format then
+ begin nt:=0; tmp_ptr:=2;
+ end
+else
+ 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!');
+ if tfm[4]>127 then abort('The fifth byte of the input file exceeds 127!');
+ 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 [57] l.982 - pTeX: SEVENBITSAFEFLAG
+if (lh>17) and (tfm[random_word]>127) then
+@y
+if (lh>17) and (tfm[random_word]>127) and (file_format=tfm_format) then
+@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 starting 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 glue step@>
+else @<Output a ligature 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
-@d max_kanji=7237 {number of the kanji characters - 1}
+const n_options = 4; {Pascal won't count array lengths for us.}
@y
-@d max_kanji=1114111 {number of the kanji characters - 1}
+const n_options = 6; {Pascal won't count array lengths for us.}
@z
-@x procedure out_kanji
-i:0..3; {index of array}
+@x
+ usage_help (TFTOPL_HELP, nil);
@y
-i:0..5; {index of array}
+ usage_help (UPTFTOPL_HELP, 'issue@@texjp.org');
@z
+
@x
- 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
+ end; {Else it was a flag; |getopt| has already done the assignment.}
@y
+ end else if argument_is ('kanji') then begin
+ if (not set_enc_string(optarg,optarg)) then
+ print_ln('Bad kanji encoding "', stringcast(optarg), '".');
+
+ end; {Else it was a flag; |getopt| has already done the assignment.}
+@z
+
+@x
+@ An element with all zeros always ends the list.
+@y
+@ 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.
+@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=1114111 {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 3*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.
+The code is based on the new JFM spec by texjporg.
+
+@d char_type(#)==4*(type_base+#) {here \#\ is an index, not a character}
+@d JIS_code(#)==tfm[char_type(#)+0]*@'400+tfm[char_type(#)+1]+tfm[char_type(#)+2]*@'400*@'400 {JIS code from |char_type| table}
+@d JIS_type(#)==tfm[char_type(#)+3] {JIS type from |char_type| table}
+
+@<list |char_type| table@>=
+this_code:=JIS_code(0);
+this_type:=JIS_type(0);
+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:=JIS_code(type_index);
+ this_type:=JIS_type(type_index);
+ 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);
+ type_count:=0;
+ for kanji_index:=0 to max_kanji do
+ if kanji_type[kanji_index]=type_num then
+ begin if (type_count mod 10)=0 then out_ln else out(' ');
+ incr(type_count);
+ out_kanji(index_to_jis(kanji_index));
+ 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..5; {index of array}
+begin@/
+if (charcode_format=charcode_octal)or(jis_code<128) then
begin cx:=jis_code;
if (isinternalUPTEX) then out('U ')
else out('J '); {specify jiscode format}
@@ -44,51 +502,39 @@ i:0..5; {index of array}
end;
end;
for i:=2 to 5 do
-@z
-
-@x
- out(xchr[Hi(cx)]); out(xchr[Lo(cx)]);
-@y
+ 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));
if BYTE1(cx)<>0 then out(xchr[BYTE1(cx)]);
if BYTE2(cx)<>0 then out(xchr[BYTE2(cx)]);
if BYTE3(cx)<>0 then out(xchr[BYTE3(cx)]);
out(xchr[BYTE4(cx)]);
-@z
+ end;
+end;
-@x function valid_jis_code
-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;
-@y
+@ @<declare kanji conversion functions@>=
+function valid_jis_code(cx:integer):boolean;
begin valid_jis_code:=true;
if (cx>@"10FFFF)or(not is_char_kanji(fromDVI(cx)))
or(toDVI(fromDVI(cx))<>cx) then valid_jis_code:=false;
-@z
+end;
-@x function index_to_jis
-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);
-@y
+@ @<declare kanji conversion functions@>=
+function index_to_jis(ix:integer):integer;
+begin
index_to_jis:=ix;
-@z
+end;
-@x function jis_to_index
-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;
-@y
+@ @<declare kanji conversion functions@>=
+function jis_to_index(cx:integer):integer;
begin
jis_to_index:=cx;
-@z
+end
+@* Index.
+@z
diff --git a/Build/source/texk/web2c/uptexdir/yokotate.test b/Build/source/texk/web2c/uptexdir/yokotate.test
index d90ecc1dd88..bb987f0d607 100755
--- a/Build/source/texk/web2c/uptexdir/yokotate.test
+++ b/Build/source/texk/web2c/uptexdir/yokotate.test
@@ -1,5 +1,6 @@
#! /bin/sh -vx
# $Id$
+# Copyright 2022 Japanese TeX Development Community <issue@texjp.org>
# Copyright 2017 Karl Berry <tex-live@tug.org>
# Copyright 2013 Peter Breitenlohner <tex-live@tug.org>
# You may freely use, modify and/or distribute this file.