path: root/Build/source/texk/web2c/eptexdir/eptex.ech

% eptexdir/eptex.ech: changefile used to build e-pTeX, see eptexdir/eptex-base.ch for details.
% Public domain. Originally written by Peter Breitenlohner <tex-live@tug.org>.

%% new primitives by e-pTeX
%%
%% \lastnodechar: the (internal) character code of the last node
%%   -1: non-character or null


@x e-pTeX: logo
\def\eTeX{$\varepsilon$-\TeX}
@y
\def\eTeX{$\varepsilon$-\TeX}
\def\epTeX{$\varepsilon$-\pTeX}
@z

@x [1.2] l.190 - epTeX:
@d eTeX_version_string=='-2.6' {current \eTeX\ version}
@y
@d eTeX_version_string=='-2.6' {current \eTeX\ version}
@#
@d epTeX_version_string=='-161114'
@z

@x e-pTeX: banner
  {printed when \pTeX\ starts}
@y
  {printed when \pTeX\ starts}
@#
@d epTeX_version==pTeX_version_string,epTeX_version_string,eTeX_version_string
@d epTeX_banner=='This is e-pTeX, Version 3.14159265',epTeX_version
@d epTeX_banner_k==epTeX_banner
  {printed when \epTeX\ starts}
@z

@x [1.2]
@d banner==pTeX_banner
@d banner_k==pTeX_banner_k
@y
@d banner==epTeX_banner
@d banner_k==epTeX_banner_k
@z

@x
@d max_quarterword=255 {largest allowable value in a |quarterword|}
@y
@d max_quarterword=@"FFFF {largest allowable value in a |quarterword|}
@z

@x [10.135] l.2895 - e-pTeX: box_lr and box_dir
In \eTeX\ the |subtype| field records the box direction mode |box_lr|.
@y
In \eTeX\ the |subtype| field records the box direction mode |box_lr|.
In \epTeX\ the |subtype| field is |qi(16*box_lr+box_dir)|.
@z

@x
@d box_dir(#) == (qo(subtype(#))-dir_max) {direction of a box}
@d set_box_dir(#) == subtype(#):=set_box_dir_end
@y
@d box_dir(#) == ((qo(subtype(#)))mod 16 - dir_max) {direction of a box}
@d set_box_dir(#) == subtype(#):=box_lr(#)*16+set_box_dir_end
@z

@x [26.413] l.8343 - e-pTeX: scan_something_internal
var m:halfword; {|chr_code| part of the operand token}
@y
label exit;
var m:halfword; {|chr_code| part of the operand token}
@z

@x
@d input_line_no_code=glue_val+2 {code for \.{\\inputlineno}}
@y
@d last_node_char_code=glue_val+2 {code for \.{\\lastnodechar}}
@d input_line_no_code=glue_val+3 {code for \.{\\inputlineno}}
@z

@x [26.420] l.8474 - pTeX: Fetch a box dimension: dir_node
begin scan_eight_bit_int; q:=box(cur_val);
@y
begin scan_register_num; fetch_box(q);
@z

@x [26.424] l.8508 - e-pTeX: TeXXeT and disp_node
node of the current list.
@y
node of the current list.
The macro |find_effective_tail_epTeX| sets |tx| to the last non-\.{\\endM}
non-|disp_node| of the current list.
@z

@x [26.424] l.8510 - e-pTeX: last node
@d find_effective_tail==find_effective_tail_pTeX
@y
@d find_effective_tail_epTeX==
tx:=tail;
if not is_char_node(tx) then if type(tx)=disp_node then tx:=prev_node;
if not is_char_node(tx) then
  if (type(tx)=disp_node) {|disp_node| from a discretionary}
    or((type(tx)=math_node)and(subtype(tx)=end_M_code)) then
    begin r:=head; q:=link(head);
    while q<>tx do
      begin if is_char_node(q) then r:=q
      else if (type(q)<>disp_node)and
        ((type(q)<>math_node)or(subtype(q)<>end_M_code)) then r:=q;
      q:=link(q);
      end;
    tx:=r;
    end
@#
@d find_effective_tail==find_effective_tail_epTeX
@#
@d find_last_char==
if font_dir[font(tx)]<>dir_default then cur_val:=KANJI(info(link(tx)))
else cur_val:=qo(character(tx))

@d ignore_font_kerning==
begin if ((type(tx)=glue_node) and (subtype(tx)=jfm_skip+1))
  or ((type(tx)=penalty_node) and (subtype(tx)=kinsoku_pena)) then
  tx:=last_jchr
else if (type(tx)=kern_node) and (subtype(tx)=normal) then
  begin r:=head; q:=link(head);
  while q<>tx do 
    begin r:=q; 
    if is_char_node(q) then if font_dir[font(q)]<>dir_default then q:=link(q);
    q:=link(q);
    end;
  if ((type(r)=penalty_node) and (subtype(r)=kinsoku_pena)) then tx:=last_jchr else tx:=r;
  end;
if not is_char_node(tx) then 
  begin if type(tx)=ligature_node then
    begin r:=lig_ptr(tx);
    while link(r)<>null do r:=link(r);
    cur_val:=qo(character(r));
    end
  end
else find_last_char;
end
@z

@x [26.424] e-pTeX: node char
  if cur_chr=last_node_type_code then
    begin cur_val_level:=int_val;
    if (tx=head)or(mode=0) then cur_val:=-1;
    end
  else cur_val_level:=cur_chr;
@y
  if cur_chr=last_node_type_code then
    begin cur_val_level:=int_val;
    if (tx=head)or(mode=0) then cur_val:=-1;
    end
  else if cur_chr=last_node_char_code then
    begin cur_val_level:=int_val; cur_val:=-1;
    end
  else cur_val_level:=cur_chr;
  if (cur_chr=last_node_char_code)and(is_char_node(tx))and(tx<>head) then 
  { |tx| might be ``second node'' of a KANJI character; so we need to look the node before |tx| }
  begin r:=head; q:=head;
    while q<>tx do begin r:=q; q:=link(q); end; { |r| is the node just before |tx| }
    if (r<>head)and is_char_node(r) then if font_dir[font(r)]<>dir_default then tx:=r;
    find_last_char; 
    end;
@z

@x [26.424] e-pTeX: node types
    last_node_type_code: if type(tx)<=unset_node then cur_val:=type(tx)+1
      else cur_val:=unset_node+2;
@y
    last_node_type_code: if type(tx)<=unset_node then
        begin if type(tx)=dir_node then tx:=list_ptr(tx);
        cur_val:=type(tx);
        if cur_val<dir_node then cur_val:=cur_val+1
        else if cur_val>disp_node then cur_val:=cur_val-1;
        end
      else cur_val:=unset_node; {\epTeX's |unset_node| is \eTeX's |unset_node+2|}
    last_node_char_code: ignore_font_kerning;
@z

@x e-pTeX: if primitives - leave room for three e-TeX codes
@d if_tdir_code=if_case_code+1 { `\.{\\iftdir}' }
@y
@d if_tdir_code=if_case_code+4 { `\.{\\iftdir}' }
@z

@x
@d box_lr(#) == (qo(subtype(#))) {direction mode of a box}
@d set_box_lr(#) ==  subtype(#):=set_box_lr_end
@d set_box_lr_end(#) == qi(#)
@y
@d box_lr(#) == ((qo(subtype(#)))div 16) {direction mode of a box}
@d set_box_lr(#) == subtype(#):=box_dir(#)+dir_max+set_box_lr_end
@d set_box_lr_end(#) == qi(16*(#))
@z

@x [45.996] l.19420
last_node_type:=type(p)+1;
@y
if type(p)<dir_node then last_node_type:=type(p)+1
else if type(p)=dir_node then last_node_type:=type(list_ptr(p))+1
else if type(p)<disp_node then last_node_type:=type(p)
else last_node_type:=type(p)-1; {no |disp_node| in a vertical list}
@z

@x [47.1079] l.20920
@!fd:boolean; {a final |disp_node| pair?}
@y
@!s:pointer; {running behind |r|}
@!t:pointer;
@!fm:integer; {1: if |r|, 2: if |p| is a \.{\\beginM} node}
@!gm:integer; {1: if |link(q)|, 2: if |q| is an  \.{\\endM} node}
@!fd,@!gd:integer; {same for |disp_node|}
@z

@x [47.1080] l.20940
@d check_effective_tail==check_effective_tail_pTeX
@d fetch_effective_tail==fetch_effective_tail_pTeX
@y
@d fetch_effective_tail_epTeX(#)== {extract |tx|,
  drop \.{\\beginM} \.{\\endM} pair and\slash or merge |disp_node| pair}
q:=head; p:=null; r:=null; fm:=0; fd:=0; disp:=0; pdisp:=0;
repeat s:=r; r:=p; p:=q; fm:=fm div 2; fd:=fd div 2;
if not is_char_node(q) then
  if type(q)=disc_node then
    begin for m:=1 to replace_count(q) do
      begin p:=link(p); if p=tx then #; end
      { |tx| might be a part of discretionary; in this case, nothing will be removed}
    end
  else if (type(q)=math_node)and(subtype(q)=begin_M_code) then fm:=2
  else if type(q)=disp_node then
    begin pdisp:=disp; disp:=disp_dimen(q); fd:=2;@+end;
q:=link(p);
until q=tx; {found |s|$\to$|r|$\to$|p|$\to$|q=tx|}
q:=link(tx); link(p):=q; link(tx):=null;
if q=null then  begin tail:=p; gm:=0; gd:=0;@+end
else  begin if type(q)=math_node then
    begin gm:=2;
    if link(q)=null then gd:=0
    else if type(link(q))=disp_node then gd:=1
    else confusion("tail3");
@:this can't happen tail3}{\quad tail3@>
    end
  else if type(q)=disp_node then
    begin prev_node:=p; gd:=2;
    if link(q)=null then gm:=0
    else if type(link(q))=math_node then gm:=1
    else confusion("tail4");
@:this can't happen tail4}{\quad tail4@>
    end
  else confusion("tail5");
@:this can't happen tail5}{\quad tail5@>
  end;
if gm=0 then if fm=2 then confusion("tail1")
@:this can't happen tail1}{\quad tail1@>
  else if fm=1 then confusion("tail2");
@:this can't happen tail2}{\quad tail2@>
if (fm+fd)=1 then begin fm:=0; fd:=0;@+end;
if gm=0 then fm:=0;
if gd=0 then fd:=0;
@#
if fd>0 then {merge a |disp_node| pair}
  begin if gm=0 then {|p|$\to$|q=disp_node|$to$|null|}
    begin t:=q; q:=null; link(p):=q; tail:=p;@+end
  else if gm=1 then {|p|$\to$|q=disp_node|$to$|end_M|$to$|null|}
    begin t:=q; q:=link(q); link(p):=q; gm:=2;@+end
  else {|p|$\to$|q=end_M|$\to$|disp_node|$to$|null|}
    begin t:=link(q); link(q):=null; tail:=q;@+end;
@#
  if fd=1 then {|s|$\to$|r=disp_node|}
    begin prev_node:=s; disp_dimen(r):=disp_dimen(t);@+end
  else {|r|$\to$|p=disp_node|}
    begin prev_node:=r; disp_dimen(p):=disp_dimen(t);@+end;
  prev_disp:=pdisp; free_node(t,small_node_size); gd:=0;
  end;
@#
if fm>0 then {drop \.{\\beginM} \.{\\endM} pair}
  begin if gd=0 then {|p|$\to$|q=end_M|$to$|null|}
    begin t:=q; q:=null; link(p):=q; tail:=p;@+end
  else if gd=1 then {|p|$\to$|q=end_M|$to$|disp_node|$to$|null|}
    begin t:=q; q:=link(q); link(p):=q; prev_node:=p; link(t):=null
    end
  else {|p|$\to$|q=disp_node|$\to$|end_M|$to$|null|}
    begin t:=link(q); link(q):=null; tail:=q;@+end;
@#
  if fm=1 then {|s|$\to$|r=begin_M|$\to$|p=disp_node|}
    begin link(s):=p; link(r):=t; t:=r; prev_node:=s;@+end
  else {|r|$\to$|p=begin_M|$\to$|q|}
    begin link(r):=q; link(p):=t; t:=p;
    if q=null then tail:=r@+else prev_node:=r;
    end;
  flush_node_list(t);
  end
@#
@d check_effective_tail(#)==find_effective_tail_epTeX
@d fetch_effective_tail==fetch_effective_tail_epTeX
@z

@x [47.1105] l.21246
@!fd:boolean; {a final |disp_node| pair?}
@y
@!s:pointer; {running behind |r|}
@!t:pointer;
@!fm:integer; {1: if |r|, 2: if |p| is a \.{\\beginM} node}
@!gm:integer; {1: if |link(q)|, 2: if |q| is an  \.{\\endM} node}
@!fd,@!gd:integer; {same for |disp_node|}
@z

@x
@d set_language_code=5 {command modifier for \.{\\setlanguage}}
@y
@d set_language_code=5 {command modifier for \.{\\setlanguage}}
@d epTeX_input_encoding_code=6 {command modifier for \.{\\epTeXinputencoding}}
@z

@x
primitive("setlanguage",extension,set_language_code);@/
@!@:set_language_}{\.{\\setlanguage} primitive@>
@y
primitive("setlanguage",extension,set_language_code);@/
@!@:set_language_}{\.{\\setlanguage} primitive@>
primitive("epTeXinputencoding",extension,epTeX_input_encoding_code);@/
@!@:epTeX_input_encoding_}{\.{\\epTeXinputencoding} primitive@>
@z

@x
  set_language_code:print_esc("setlanguage");
@y
  set_language_code:print_esc("setlanguage");
  epTeX_input_encoding_code:print_esc("epTeXinputencoding");
@z

@x
set_language_code:@<Implement \.{\\setlanguage}@>;
@y
set_language_code:@<Implement \.{\\setlanguage}@>;
epTeX_input_encoding_code:@<Implement \.{\\epTeXinputencoding}@>;
@z

@x
@ @<Finish the extensions@>=
@y
@ @<Implement \.{\\epTeXinputencoding}@>=
  begin
    scan_file_name;
    pack_cur_name;
    if setinfileenc(cur_file,stringcast(name_of_file+1)) = false then
    begin
      wlog_cr;
      wlog('Unknown encoding `');
      fputs(stringcast(name_of_file + 1), log_file);
      wlog('''');
    end
  end

@ @<Finish the extensions@>=
@z

@x
primitive("lastnodetype",last_item,last_node_type_code);
@!@:last_node_type_}{\.{\\lastnodetype} primitive@>
@y
primitive("lastnodetype",last_item,last_node_type_code);
@!@:last_node_type_}{\.{\\lastnodetype} primitive@>
primitive("lastnodechar",last_item,last_node_char_code);
@!@:last_node_char_}{\.{\\lastnodechar} primitive@>
@z

@x
last_node_type_code: print_esc("lastnodetype");
@y
last_node_type_code: print_esc("lastnodetype");
last_node_char_code: print_esc("lastnodechar");
@z
@x e-pTeX: font_char_{wd,ht,dp,ic}_code l.27306
  if (font_bc[q]<=cur_val)and(font_ec[q]>=cur_val) then
    begin i:=char_info(q)(qi(cur_val));
    case m of
    font_char_wd_code: cur_val:=char_width(q)(i);
    font_char_ht_code: cur_val:=char_height(q)(height_depth(i));
    font_char_dp_code: cur_val:=char_depth(q)(height_depth(i));
    font_char_ic_code: cur_val:=char_italic(q)(i);
    end; {there are no other cases}
    end
  else cur_val:=0;
  end;
@y
  if font_dir[q]<>dir_default then {Japanese font}
    begin if cur_val>=256 then {Japanese Character}
      begin cur_val:=get_jfm_pos(KANJI(cur_val),q);
      i:=orig_char_info(q)(qi(cur_val));
      case m of
      font_char_wd_code: cur_val:=char_width(q)(i);
      font_char_ht_code: cur_val:=char_height(q)(height_depth(i));
      font_char_dp_code: cur_val:=char_depth(q)(height_depth(i));
      font_char_ic_code: cur_val:=char_italic(q)(i);
      end; {there are no other cases}
      end
    else cur_val:=0;
    end
  else if (font_bc[q]<=cur_val)and(font_ec[q]>=cur_val) then
    begin i:=orig_char_info(q)(qi(cur_val));
    case m of
    font_char_wd_code: cur_val:=char_width(q)(i);
    font_char_ht_code: cur_val:=char_height(q)(height_depth(i));
    font_char_dp_code: cur_val:=char_depth(q)(height_depth(i));
    font_char_ic_code: cur_val:=char_italic(q)(i);
    end; {there are no other cases}
    end
  else cur_val:=0;
  end;
@z

@x e-pTeX: displacement value when typesetting right-to-left l.27798
@!LR_ptr:pointer; {stack of LR codes for |hpack|, |ship_out|, and |init_math|}
@y
@!revdisp:scaled; {temporary value of displacement}
@!LR_ptr:pointer; {stack of LR codes for |hpack|, |ship_out|, and |init_math|}
@z

@x e-pTeX: reverse nodes of an hlist l.28010
var l:pointer; {the new list}
@y
var l,la:pointer; {the new list}
disp,disp2: scaled; { displacement } disped: boolean;
@z
@x e-pTeX: reverse nodes of an hlist l.28010
begin g_order:=glue_order(this_box); g_sign:=glue_sign(this_box);
@y
begin g_order:=glue_order(this_box); g_sign:=glue_sign(this_box);
disp:=revdisp; disped:=false;
@z
@x e-pTeX: reverse nodes of an hlist l.28010
done:reverse:=l;
@y
done: {if the beginning node of the new list isn't |disp_node|,
       we insert |disp_node| to fix.}
if (l<>null)and(type(l)<>disp_node) then begin
  p:=get_node(small_node_size); type(p):=disp_node;
  disp_dimen(p):=disp; link(p):=l; reverse:=p;
  end
else reverse:=l;
@z
@x e-pTeX: reverse nodes of an hlist l.28010
  q:=link(p); link(p):=l; l:=p; p:=q;
@y
  if font_dir[f]<>dir_default then begin
    q:=link(p); la:=l; l:=p; p:=link(q); link(q):=la;
    end
  else begin q:=link(p); link(p):=l; l:=p; p:=q; end;
@z
@x e-pTeX: reverse nodes of an hlist l.28010
othercases goto next_p
@y
disp_node: begin
  disp2:=disp_dimen(p); disp_dimen(p):=disp; disp:=disp2;
  if not disped then disped:=true; end;
othercases goto next_p
@z

@x e-pTeX: just_copy
  hlist_node,vlist_node: begin r:=get_node(box_node_size);
@y
  dir_node,
  hlist_node,vlist_node: begin r:=get_node(box_node_size);
@z
@x e-pTeX: just_copy
    mem[r+6]:=mem[p+6]; mem[r+5]:=mem[p+5]; {copy the last two words}
@y
    mem[r+7]:=mem[p+7];
    mem[r+6]:=mem[p+6]; mem[r+5]:=mem[p+5]; {copy the last three words}
    add_glue_ref(space_ptr(r)); add_glue_ref(xspace_ptr(r));
@z

@x e-pTeX: ifcsname l.28620
  buffer[m]:=info(p) mod @'400; incr(m); p:=link(p);
@y
  if check_kanji(info(p)) then {|wchar_token|}
    begin buffer[m]:=Hi(info(p)); incr(m);
    end;
  buffer[m]:=Lo(info(p)); incr(m); p:=link(p);
@z

@x e-pTeX: if_font_char_code l.28633
    b:=char_exists(char_info(n)(qi(cur_val)))
@y
    b:=char_exists(orig_char_info(n)(qi(cur_val)))
@z

@x
procedure print_direction(@!d:integer); {print the direction represented by d}
@y
procedure print_direction_alt(@!d:integer);
var x: boolean;
begin x:=false;
case abs(d) of
dir_yoko: begin print(", yoko"); x:=true; end;
dir_tate: begin print(", tate"); x:=true; end;
dir_dtou: begin print(", dtou"); x:=true; end;
end;
if x then begin if d<0 then print("(math)");
print(" direction"); end;
end;
@#
procedure print_direction(@!d:integer); {print the direction represented by d}
@z