% This is a change file for PLtoTF
%
% (2024-04-27) TTK Support upTeX new encoding for combining characters
% (2023-09-17) HY Support more than 256 different glue/kern
% (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-p240427'
  {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.
@<Check for infinite ligature loops@>;
@<Doublecheck the lig/kern commands and the extensible recipes@>;
for c:=0 to 255 do
  @<Make sure that |c| is not the largest element of a charlist cycle@>;
@y
if file_format=tfm_format then begin
  @<Check for infinite ligature loops@>;
  @<Doublecheck the lig/kern commands and the extensible recipes@>;
  for c:=0 to 255 do
    @<Make sure that |c| is not the largest element of a charlist cycle@>;
  end;
@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 if lig_exam<>bchar then
      check_existence(lig_exam)('GLUE character examined by');
@.GLUE character examined...@>
  end
@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 (PLTOTF_HELP, nil);
@y
      usage_help (UPPLTOTF_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
      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 [148] l.2620 - pTeX:
@* Index.
@y
@* For Japanese Font Metric routines.
We need to include some routines for handling kanji characters.

@<Constants...@>=
max_kanji=@"2FFFFF; { maximam number of multibyte characters }
max_kanji_code=@"2FFFFF; { 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..15000] of fix_word; {the distinct glue amounts, equals 3 * |max_kerns|}
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 lk_step_ended:=false;
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 call the following
procedure so that an error message is given in case of multiple tags.

@<Declare kanji scanning routines@>=
procedure check_tag_gluekern(c:byte); {print error if |c| already tagged}
begin case char_tag[c] of
no_tag: do_nothing;
lig_tag: err_print('This character already appeared in a 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;
end;

@ @<Read a glue label step@>=
begin while cur_char=" " do get_next;
if cur_char="B" then
  begin bchar_label:=nl; skip_to_paren; {\.{LABEL BOUNDARYCHAR}}
  end
else begin backup; c:=get_byte;
  check_tag_gluekern(c); char_tag[c]:=lig_tag; char_remainder[c]:=nl;
  end;
if min_nl<=nl then min_nl:=nl+1;
lk_step_ended:=false;
end

@ @<Read a (glue) kerning step@>=
begin lig_kern[nl].b0:=0; lig_kern[nl].b1:=get_byte;
kern[nk]:=get_fix; krn_ptr:=0;
while kern[krn_ptr]<>kern[nk] do incr(krn_ptr);
if krn_ptr=nk then
  begin if nk<max_kerns then incr(nk)
  else begin err_print('At most ',max_kerns,' different kerns are allowed');
@.At most 5000 different kerns...@>
    decr(krn_ptr);
    end;
  end;
lig_kern[nl].b2:=kern_flag+(krn_ptr div 256);
lig_kern[nl].b3:=krn_ptr mod 256;
if nl>=max_lig_steps-1 then
  err_print('GLUEKERN table should never exceed ',max_lig_steps,' GLUE/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;
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<max_kerns then incr(ng)
  else begin err_print('At most ',max_kerns,' different glues are allowed');
    decr(krn_ptr);
    end;
  end;
lig_kern[nl].b2:=krn_ptr div 256;
lig_kern[nl].b3:=krn_ptr mod 256;
if nl>=max_lig_steps-1 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;
dig[2]:=(jis_code div 4096) mod 16; dig[3]:=(jis_code div 256) mod 16;
dig[4]:=(jis_code div 16) mod 16; dig[5]:=jis_code mod 16;
for i:=0 to 1 do
  if (dig[i]<>0)or(dig[0]<>0) then begin { if dig[0]<>0, dig[1] should be always printed }
    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;
for i:=2 to 5 do
  if dig[i]<10 then print(dig[i]) else
  case dig[i] of
     10: print('A'); 11: print('B'); 12: print('C');
     13: print('D'); 14: print('E'); 15: print('F');
  end;
end;
@#
function valid_jis_code(cx:integer):boolean;
begin valid_jis_code:=true;
if (cx>max_kanji)or(not is_char_kanji(fromDVI(cx)))
  or(toDVI(fromDVI(cx))<>cx) then valid_jis_code:=false;
end;
@#
function jis_to_index(jis:integer):integer;
begin
jis_to_index:=jis;
end;
@#
function index_to_jis(ix:integer):integer;
begin
index_to_jis:=ix;
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}
  @<Scan a Kanji hexadecimal code@>;
  jis_code:=toDVI(fromUCS(cx)); cur_char:=ch;
  if not valid_jis_code(jis_code) then
    err_print('ucs code ', jis_code:1, ' is invalid');
  end
else if multistrlen(ustringcast(buffer), loc+4, loc)>1 then
  begin cur_char:=" ";
  jis_code:=fromBUFF(ustringcast(buffer), loc+4, loc);
  loc:=loc+multistrlen(ustringcast(buffer), loc+4, loc)-1;
  if (isinternalUPTEX) then
  begin
    cx:=fromBUFF(ustringcast(buffer), loc+5, loc+1);
    if (UVScombinecode(jis_code,cx)>0) then begin
      jis_code:=UVScombinecode(jis_code,cx);
      loc:=loc+multistrlen(ustringcast(buffer), loc+5, loc+1);
      end;
    end
  else begin
    jis_code:=toDVI(jis_code)
    end;
  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