diff options
Diffstat (limited to 'Build/source/texk/web2c/xetexdir/xetex-noenc.ch')
-rw-r--r-- | Build/source/texk/web2c/xetexdir/xetex-noenc.ch | 1144 |
1 files changed, 1144 insertions, 0 deletions
diff --git a/Build/source/texk/web2c/xetexdir/xetex-noenc.ch b/Build/source/texk/web2c/xetexdir/xetex-noenc.ch new file mode 100644 index 00000000000..71591ca8350 --- /dev/null +++ b/Build/source/texk/web2c/xetexdir/xetex-noenc.ch @@ -0,0 +1,1144 @@ +% /****************************************************************************\ +% Part of the XeTeX typesetting system +% copyright (c) 1994-2006 by SIL International +% written by Jonathan Kew +% +% Permission is hereby granted, free of charge, to any person obtaining +% a copy of this software and associated documentation files (the +% "Software"), to deal in the Software without restriction, including +% without limitation the rights to use, copy, modify, merge, publish, +% distribute, sublicense, and/or sell copies of the Software, and to +% permit persons to whom the Software is furnished to do so, subject to +% the following conditions: +% +% The above copyright notice and this permission notice shall be +% included in all copies or substantial portions of the Software. +% +% THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +% EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +% MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +% NONINFRINGEMENT. IN NO EVENT SHALL SIL INTERNATIONAL BE LIABLE FOR +% ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF +% CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +% WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +% +% Except as contained in this notice, the name of SIL International +% shall not be used in advertising or otherwise to promote the sale, +% use or other dealings in this Software without prior written +% authorization from SIL International. +% \****************************************************************************/ + +% Extra changes to remove the encTeX features from XeTeX +% (and print a warning if --translate-file is used) +% ====================================================== + + +@x +@!xord: array [text_char] of ASCII_code; + {specifies conversion of input characters} +xchr: array [ASCII_code] of text_char; + { specifies conversion of output characters } +xprn: array [ASCII_code] of ASCII_code; + { non zero iff character is printable } +mubyte_read: array [ASCII_code] of pointer; + { non zero iff character begins the multi byte code } +mubyte_write: array [ASCII_code] of str_number; + { non zero iff character expands to multi bytes in log and write files } +mubyte_cswrite: array [0..127] of pointer; + { non null iff cs mod 128 expands to multi bytes in log and write files } +mubyte_skip: integer; { the number of bytes to skip in |buffer| } +mubyte_keep: integer; { the number of chars we need to keep unchanged } +mubyte_skeep: integer; { saved |mubyte_keep| } +mubyte_prefix: integer; { the type of mubyte prefix } +mubyte_tablein: boolean; { the input side of table will be updated } +mubyte_tableout: boolean; { the output side of table will be updated } +mubyte_relax: boolean; { the relax prefix is used } +mubyte_start: boolean; { we are making the token at the start of the line } +mubyte_sstart: boolean; { saved |mubyte_start| } +mubyte_token: pointer; { the token returned by |read_buffer| } +mubyte_stoken: pointer; { saved first token in mubyte primitive } +mubyte_sout: integer; { saved value of |mubyte_out| } +mubyte_slog: integer; { saved value of |mubyte_log| } +spec_sout: integer; { saved value of |spec_out| } +no_convert: boolean; { conversion supressed by noconvert primitive } +active_noconvert: boolean; { true if noconvert primitive is active } +write_noexpanding: boolean; { true only if we need not write expansion } +cs_converting: boolean; { true only if we need csname converting } +special_printing: boolean; { true only if we need converting in special } +message_printing: boolean; { true if message or errmessage prints to string } +@y +@!xchr: ^text_char; + {dummy variable so tangle doesn't complain; not actually used} +@z + +@x +xchr[@'40]:=' '; +xchr[@'41]:='!'; +xchr[@'42]:='"'; +xchr[@'43]:='#'; +xchr[@'44]:='$'; +xchr[@'45]:='%'; +xchr[@'46]:='&'; +xchr[@'47]:='''';@/ +xchr[@'50]:='('; +xchr[@'51]:=')'; +xchr[@'52]:='*'; +xchr[@'53]:='+'; +xchr[@'54]:=','; +xchr[@'55]:='-'; +xchr[@'56]:='.'; +xchr[@'57]:='/';@/ +xchr[@'60]:='0'; +xchr[@'61]:='1'; +xchr[@'62]:='2'; +xchr[@'63]:='3'; +xchr[@'64]:='4'; +xchr[@'65]:='5'; +xchr[@'66]:='6'; +xchr[@'67]:='7';@/ +xchr[@'70]:='8'; +xchr[@'71]:='9'; +xchr[@'72]:=':'; +xchr[@'73]:=';'; +xchr[@'74]:='<'; +xchr[@'75]:='='; +xchr[@'76]:='>'; +xchr[@'77]:='?';@/ +xchr[@'100]:='@@'; +xchr[@'101]:='A'; +xchr[@'102]:='B'; +xchr[@'103]:='C'; +xchr[@'104]:='D'; +xchr[@'105]:='E'; +xchr[@'106]:='F'; +xchr[@'107]:='G';@/ +xchr[@'110]:='H'; +xchr[@'111]:='I'; +xchr[@'112]:='J'; +xchr[@'113]:='K'; +xchr[@'114]:='L'; +xchr[@'115]:='M'; +xchr[@'116]:='N'; +xchr[@'117]:='O';@/ +xchr[@'120]:='P'; +xchr[@'121]:='Q'; +xchr[@'122]:='R'; +xchr[@'123]:='S'; +xchr[@'124]:='T'; +xchr[@'125]:='U'; +xchr[@'126]:='V'; +xchr[@'127]:='W';@/ +xchr[@'130]:='X'; +xchr[@'131]:='Y'; +xchr[@'132]:='Z'; +xchr[@'133]:='['; +xchr[@'134]:='\'; +xchr[@'135]:=']'; +xchr[@'136]:='^'; +xchr[@'137]:='_';@/ +xchr[@'140]:='`'; +xchr[@'141]:='a'; +xchr[@'142]:='b'; +xchr[@'143]:='c'; +xchr[@'144]:='d'; +xchr[@'145]:='e'; +xchr[@'146]:='f'; +xchr[@'147]:='g';@/ +xchr[@'150]:='h'; +xchr[@'151]:='i'; +xchr[@'152]:='j'; +xchr[@'153]:='k'; +xchr[@'154]:='l'; +xchr[@'155]:='m'; +xchr[@'156]:='n'; +xchr[@'157]:='o';@/ +xchr[@'160]:='p'; +xchr[@'161]:='q'; +xchr[@'162]:='r'; +xchr[@'163]:='s'; +xchr[@'164]:='t'; +xchr[@'165]:='u'; +xchr[@'166]:='v'; +xchr[@'167]:='w';@/ +xchr[@'170]:='x'; +xchr[@'171]:='y'; +xchr[@'172]:='z'; +xchr[@'173]:='{'; +xchr[@'174]:='|'; +xchr[@'175]:='}'; +xchr[@'176]:='~';@/ +@y +{ don't need to set up xchr here } +@z + +@x +{Initialize |xchr| to the identity mapping.} +for i:=0 to @'37 do xchr[i]:=i; +for i:=@'177 to @'377 do xchr[i]:=i; +{Initialize enc\TeX\ data.} +for i:=0 to 255 do mubyte_read[i]:=null; +for i:=0 to 255 do mubyte_write[i]:=0; +for i:=0 to 128 do mubyte_cswrite[i]:=null; +mubyte_keep := 0; mubyte_start := false; +write_noexpanding := false; cs_converting := false; +special_printing := false; message_printing := false; +no_convert := false; active_noconvert := false; +@y +@z + +@x +for i:=first_text_char to last_text_char do xord[chr(i)]:=invalid_code; +for i:=@'200 to @'377 do xord[xchr[i]]:=i; +for i:=0 to @'176 do xord[xchr[i]]:=i; +{Set |xprn| for printable ASCII, unless |eight_bit_p| is set.} +for i:=0 to 255 do xprn[i]:=(eight_bit_p or ((i>=" ")and(i<="~"))); + +{The idea for this dynamic translation comes from the patch by + Libor Skarvada \.{<libor@@informatics.muni.cz>} + and Petr Sojka \.{<sojka@@informatics.muni.cz>}. I didn't use any of the + actual code, though, preferring a more general approach.} + +{This updates the |xchr|, |xord|, and |xprn| arrays from the provided + |translate_filename|. See the function definition in \.{texmfmp.c} for + more comments.} +if translate_filename then read_tcx_file; +@y +@z + +@x +if translate_filename then begin + wterm(' ('); + fputs(translate_filename, stdout); + wterm_ln(')'); +end; +@y +if translate_filename then begin + wterm(' (WARNING: translate-file "'); + fputs(translate_filename, stdout); + wterm_ln('" ignored)'); +end; +@z + +@x +@d xord_code_base=cur_font_loc+1 +@d xchr_code_base=xord_code_base+1 +@d xprn_code_base=xchr_code_base+1 +@d math_font_base=xprn_code_base+1 +@y +@d math_font_base=cur_font_loc+1 +@z + +@x +@d mubyte_in_code=web2c_int_base+3 {if positive then reading mubytes is active} +@d mubyte_out_code=web2c_int_base+4 {if positive then printing mubytes is active} +@d mubyte_log_code=web2c_int_base+5 {if positive then print mubytes to log and terminal} +@d spec_out_code=web2c_int_base+6 {if positive then print specials by mubytes} +@d web2c_int_pars=web2c_int_base+7 {total number of web2c's integer parameters} +@y +@d web2c_int_pars=web2c_int_base+3 {total number of web2c's integer parameters} +@z + +@x +@d mubyte_in==int_par(mubyte_in_code) +@d mubyte_out==int_par(mubyte_out_code) +@d mubyte_log==int_par(mubyte_log_code) +@d spec_out==int_par(spec_out_code) +@y +@z + +@x +mubyte_in_code:print_esc("mubytein"); +mubyte_out_code:print_esc("mubyteout"); +mubyte_log_code:print_esc("mubytelog"); +spec_out_code:print_esc("specialout"); +@y +@z + +@x +if enctex_p then + begin enctex_enabled_p:=true; + primitive("mubytein",assign_int,int_base+mubyte_in_code);@/ +@!@:mubyte_in_}{\.{\\mubytein} primitive@> + primitive("mubyteout",assign_int,int_base+mubyte_out_code);@/ +@!@:mubyte_out_}{\.{\\mubyteout} primitive@> + primitive("mubytelog",assign_int,int_base+mubyte_log_code);@/ +@!@:mubyte_log_}{\.{\\mubytelog} primitive@> + primitive("specialout",assign_int,int_base+spec_out_code);@/ +@!@:spec_out_}{\.{\\specialout} primitive@> +end; +@y +@z + +@x +procedure print_cs(@!p:integer); {prints a purported control sequence} +var q: pointer; + s: str_number; +begin + if active_noconvert and (not no_convert) and + (eq_type(p) = let) and (equiv(p) = normal+11) then { noconvert } + begin + no_convert := true; + return; + end; + s := 0; + if cs_converting and (not no_convert) then + begin + q := mubyte_cswrite [p mod 128] ; + while q <> null do + if info (q) = p then + begin + s := info (link(q)); q := null; + end else q := link (link (q)); + end; + no_convert := false; + if s > 0 then print (s) + else if p<hash_base then {single character} +@y +procedure print_cs(@!p:integer); {prints a purported control sequence} +begin if p<hash_base then {single character} +@z + +@x +exit: end; +@y +end; +@z + +@x +if enctex_p then +begin + primitive("endmubyte",end_cs_name,10);@/ +@!@:end_mubyte_}{\.{\\endmubyte} primitive@> +end; +@y +@z + +@x +i := start; mubyte_skeep := mubyte_keep; +mubyte_sstart := mubyte_start; mubyte_start := false; +if j>0 then while i < j do +begin + if i=loc then set_trick_count; + print_buffer(i); +end; +mubyte_keep := mubyte_skeep; mubyte_start := mubyte_sstart +@y +if j>0 then for i:=start to j-1 do + begin if i=loc then set_trick_count; + print(buffer[i]); + end +@z + +@x +Some additional routines used by the enc\TeX extension have to be +declared at this point. + +@p @t\4@>@<Declare additional routines for enc\TeX@>@/ + +@y +@z + +@x +@!i,@!j: 0..buf_size; {more indexes for encTeX} +@!mubyte_incs: boolean; {control sequence is converted by mubyte} +@!p:pointer; {for encTeX test if noexpanding} +@y +@z + +@x + begin + { Use |k| instead of |loc| for type correctness. } + k := loc; + cur_chr := read_buffer (k); + loc := k; incr (loc); + if (mubyte_token > 0) then + begin + state := mid_line; + cur_cs := mubyte_token - cs_token_flag; + goto found; + end; +@y + begin cur_chr:=buffer[loc]; incr(loc); +@z + +@x +else begin start_cs: + mubyte_incs := false; k := loc; mubyte_skeep := mubyte_keep; + cur_chr := read_buffer (k); cat := cat_code (cur_chr); + if (mubyte_in>0) and (not mubyte_incs) and + ((mubyte_skip>0) or (cur_chr<>buffer[k])) then mubyte_incs := true; + incr (k); + if mubyte_token > 0 then + begin + state := mid_line; + cur_cs := mubyte_token - cs_token_flag; + goto found; + end; +@y +else begin start_cs: k:=loc; cur_chr:=buffer[k]; cat:=cat_code(cur_chr); + incr(k); +@z + +@x + mubyte_keep := mubyte_skeep; + cur_cs:=single_base + read_buffer(loc); incr(loc); +@y + cur_cs:=single_base+buffer[loc]; incr(loc); +@z + +@x +if write_noexpanding then +begin + p := mubyte_cswrite [cur_cs mod 128]; + while p <> null do + if info (p) = cur_cs then + begin + cur_cmd := relax; cur_chr := 256; p := null; + end else p := link (link (p)); +end; +@y +@z + +@x +@ @<Scan ahead in the buffer...@>= +begin + repeat cur_chr := read_buffer (k); cat := cat_code (cur_chr); + if mubyte_token>0 then cat := escape; + if (mubyte_in>0) and (not mubyte_incs) and (cat=letter) and + ((mubyte_skip>0) or (cur_chr<>buffer[k])) then mubyte_incs := true; + incr (k); + until (cat <> letter) or (k > limit); + @<If an expanded...@>; + if cat <> letter then + begin + decr (k); k := k - mubyte_skip; + end; + if k > loc + 1 then { multiletter control sequence has been scanned } + begin + if mubyte_incs then { multibyte in csname occurrs } + begin + i := loc; j := first; mubyte_keep := mubyte_skeep; + if j - loc + k > max_buf_stack then + begin + max_buf_stack := j - loc + k; + if max_buf_stack >= buf_size then + begin + max_buf_stack := buf_size; + overflow ("buffer size", buf_size); + end; + end; + while i < k do + begin + buffer [j] := read_buffer (i); + incr (i); incr (j); + end; + if j = first+1 then + cur_cs := single_base + buffer [first] + else + cur_cs := id_lookup (first, j-first); + end else cur_cs := id_lookup (loc, k-loc) ; + loc := k; + goto found; + end; +end +@y +@ @<Scan ahead in the buffer...@>= +begin repeat cur_chr:=buffer[k]; cat:=cat_code(cur_chr); incr(k); +until (cat<>letter)or(k>limit); +@<If an expanded...@>; +if cat<>letter then decr(k); + {now |k| points to first nonletter} +if k>loc+1 then {multiletter control sequence has been scanned} + begin cur_cs:=id_lookup(loc,k-loc); loc:=k; goto found; + end; +end +@z + +@x + if write_noexpanding then + begin + p := mubyte_cswrite [cur_cs mod 128]; + while p <> null do + if info (p) = cur_cs then + begin + cur_cmd := relax; cur_chr := 256; p := null; + end else p := link (link (p)); + end; +@y +@z + +@x +if enctex_enabled_p then + begin wlog_cr; wlog(encTeX_banner); wlog(', reencoding enabled'); + if translate_filename then + begin wlog_cr; + wlog(' (\xordcode, \xchrcode, \xprncode overridden by TCX)'); + end; + end; +@y +@z + +@x +if translate_filename then begin + wlog_cr; + wlog(' ('); + fputs(translate_filename, log_file); + wlog(')'); + end; +@y +if translate_filename then begin + wlog_cr; + wlog(' (WARNING: translate-file "'); + fputs(translate_filename, log_file); + wlog('" ignored)'); + end; +@z + +@x +procedure cs_error; +begin +if cur_chr = 10 then +begin + print_err("Extra "); print_esc("endmubyte"); +@.Extra \\endmubyte@> + help1("I'm ignoring this, since I wasn't doing a \mubyte."); +end else begin + print_err("Extra "); print_esc("endcsname"); +@.Extra \\endcsname@> + help1("I'm ignoring this, since I wasn't doing a \csname."); +end; +error; +end; +@y +procedure cs_error; +begin print_err("Extra "); print_esc("endcsname"); +@.Extra \\endcsname@> +help1("I'm ignoring this, since I wasn't doing a \csname."); +error; +end; +@z + +@x +if enctex_p then +begin + primitive("mubyte",let,normal+10);@/ +@!@:mubyte_}{\.{\\mubyte} primitive@> + primitive("noconvert",let,normal+11);@/ +@!@:noconvert_}{\.{\\noconvert} primitive@> +end; +@y +@z + +@x +let: if chr_code<>normal then + if chr_code = normal+10 then print_esc("mubyte") + else if chr_code = normal+11 then print_esc("noconvert") + else print_esc("futurelet") + else print_esc("let"); +@y +let: if chr_code<>normal then print_esc("futurelet")@+else print_esc("let"); +@z + +@x +let: if cur_chr = normal+11 then do_nothing { noconvert primitive } + else if cur_chr = normal+10 then { mubyte primitive } + begin + selector:=term_and_log; + get_token; + mubyte_stoken := cur_tok; + if cur_tok <= cs_token_flag then mubyte_stoken := cur_tok mod 256; + mubyte_prefix := 60; mubyte_relax := false; + mubyte_tablein := true; mubyte_tableout := true; + get_x_token; + if cur_cmd = spacer then get_x_token; + if cur_cmd = sub_mark then + begin + mubyte_tableout := false; get_x_token; + if cur_cmd = sub_mark then + begin + mubyte_tableout := true; mubyte_tablein := false; + get_x_token; + end; + end else if (mubyte_stoken > cs_token_flag) and + (cur_cmd = mac_param) then + begin + mubyte_tableout := false; + scan_int; mubyte_prefix := cur_val; get_x_token; + if mubyte_prefix > 50 then mubyte_prefix := 52; + if mubyte_prefix <= 0 then mubyte_prefix := 51; + end + else if (mubyte_stoken > cs_token_flag) and (cur_cmd = relax) then + begin + mubyte_tableout := true; mubyte_tablein := false; + mubyte_relax := true; get_x_token; + end; + r := get_avail; p := r; + while cur_cs = 0 do begin store_new_token (cur_tok); get_x_token; end; + if (cur_cmd <> end_cs_name) or (cur_chr <> 10) then + begin + print_err("Missing "); print_esc("endmubyte"); print(" inserted"); + help2("The control sequence marked <to be read again> should")@/ +("not appear in <byte sequence> between \mubyte and \endmubyte."); + back_error; + end; + p := link(r); + if (p = null) and mubyte_tablein then + begin + print_err("The empty <byte sequence>, "); + print_esc("mubyte"); print(" ignored"); + help2("The <byte sequence> in")@/ +("\mubyte <token> <byte sequence>\endmubyte should not be empty."); + error; + end else begin + while p <> null do + begin + append_char (info(p) mod 256); + p := link (p); + end; + flush_list (r); + if (str_start [str_ptr] + 1 = pool_ptr) and + (str_pool [pool_ptr-1] = mubyte_stoken) then + begin + if mubyte_read [mubyte_stoken] <> null + and mubyte_tablein then { clearing data } + dispose_munode (mubyte_read [mubyte_stoken]); + if mubyte_tablein then mubyte_read [mubyte_stoken] := null; + if mubyte_tableout then mubyte_write [mubyte_stoken] := 0; + pool_ptr := str_start [str_ptr]; + end else begin + if mubyte_tablein then mubyte_update; { updating input side } + if mubyte_tableout then { updating output side } + begin + if mubyte_stoken > cs_token_flag then { control sequence } + begin + dispose_mutableout (mubyte_stoken-cs_token_flag); + if (str_start [str_ptr] < pool_ptr) or mubyte_relax then + begin { store data } + r := mubyte_cswrite[(mubyte_stoken-cs_token_flag) mod 128]; + p := get_avail; + mubyte_cswrite[(mubyte_stoken-cs_token_flag) mod 128] := p; + info (p) := mubyte_stoken-cs_token_flag; + link (p) := get_avail; + p := link (p); + if mubyte_relax then begin + info (p) := 0; pool_ptr := str_start [str_ptr]; + end else info (p) := slow_make_string; + link (p) := r; + end; + end else begin { single character } + if str_start [str_ptr] = pool_ptr then + mubyte_write [mubyte_stoken] := 0 + else + mubyte_write [mubyte_stoken] := slow_make_string; + end; + end else pool_ptr := str_start [str_ptr]; + end; + end; + end else begin { let primitive } + n:=cur_chr; +@y +let: begin n:=cur_chr; +@z + +@x +if enctex_p then +begin + primitive("xordcode",def_code,xord_code_base); +@!@:xord_code_}{\.{\\xordcode} primitive@> + primitive("xchrcode",def_code,xchr_code_base); +@!@:xchr_code_}{\.{\\xchrcode} primitive@> + primitive("xprncode",def_code,xprn_code_base); +@!@:xprn_code_}{\.{\\xprncode} primitive@> +end; +@y +@z + +@x +def_code: if chr_code=xord_code_base then print_esc("xordcode") + else if chr_code=xchr_code_base then print_esc("xchrcode") + else if chr_code=xprn_code_base then print_esc("xprncode") + else if chr_code=cat_code_base then print_esc("catcode") +@y +def_code: if chr_code=cat_code_base then print_esc("catcode") +@z + +@x + if p=xord_code_base then p:=cur_val + else if p=xchr_code_base then p:=cur_val+256 + else if p=xprn_code_base then p:=cur_val+512 + else p:=p+cur_val; +@y + p:=p+cur_val; +@z + +@x +message_printing := true; active_noconvert := true; +token_show(def_ref); +message_printing := false; active_noconvert := false; +@y +token_show(def_ref); +@z + +@x +@<Dump enc\TeX-specific data@>; +@y +@z + +@x +@!dummy_xord: ASCII_code; +@!dummy_xchr: text_char; +@!dummy_xprn: ASCII_code; +@y +@z + +@x +@<Undump enc\TeX-specific data@>; +@y +@z + +@x +@<Dump |xord|, |xchr|, and |xprn|@>; +@y +@z + +@x +@<Undump |xord|, |xchr|, and |xprn|@>; +@y +@z + +@x +if enctex_enabled_p then + begin wterm(encTeX_banner); wterm_ln(', reencoding enabled.'); + if translate_filename then begin + wterm_ln(' (\xordcode, \xchrcode, \xprncode overridden by TCX)'); + end; + end; +@y +@z + +@x +if mubyte_out + mubyte_zero < 0 then write_mubyte(tail) := 0 +else if mubyte_out + mubyte_zero >= 2*mubyte_zero then + write_mubyte(tail) := 2*mubyte_zero - 1 + else write_mubyte(tail) := mubyte_out + mubyte_zero; +@y +@z + +@x +@<Implement \.{\\special}@>= +begin new_whatsit(special_node,write_node_size); +if spec_out + mubyte_zero < 0 then write_stream(tail) := 0 +else if spec_out + mubyte_zero >= 2*mubyte_zero then + write_stream(tail) := 2*mubyte_zero - 1 + else write_stream(tail) := spec_out + mubyte_zero; +if mubyte_out + mubyte_zero < 0 then write_mubyte(tail) := 0 +else if mubyte_out + mubyte_zero >= 2*mubyte_zero then + write_mubyte(tail) := 2*mubyte_zero - 1 + else write_mubyte(tail) := mubyte_out + mubyte_zero; +if (spec_out = 2) or (spec_out = 3) then + if (mubyte_out > 2) or (mubyte_out = -1) or (mubyte_out = -2) then + write_noexpanding := true; +p:=scan_toks(false,true); write_tokens(tail):=def_ref; +write_noexpanding := false; +end +@y +@<Implement \.{\\special}@>= +begin new_whatsit(special_node,write_node_size); write_stream(tail):=0; +p:=scan_toks(false,true); write_tokens(tail):=def_ref; +end +@z + +@x +if (s = "write") and (write_mubyte (p) <> mubyte_zero) then +begin + print_char ("<"); print_int (write_mubyte(p)-mubyte_zero); print_char (">"); +end; +@y +@z + +@x +spec_sout := spec_out; spec_out := write_stream(p) - mubyte_zero; +mubyte_sout := mubyte_out; mubyte_out := write_mubyte(p) - mubyte_zero; +active_noconvert := true; +mubyte_slog := mubyte_log; +mubyte_log := 0; +if (mubyte_out > 0) or (mubyte_out = -1) then mubyte_log := 1; +if (spec_out = 2) or (spec_out = 3) then +begin + if (mubyte_out > 0) or (mubyte_out = -1) then + begin + special_printing := true; mubyte_log := 1; + end; + if mubyte_out > 1 then cs_converting := true; +end; +@y +@z + +@x +if (spec_out = 1) or (spec_out = 3) then + for k:=str_start[str_ptr] to pool_ptr-1 do + str_pool[k] := si(xchr[so(str_pool[k])]); +@y +@z + +@x +begin +mubyte_sout := mubyte_out; mubyte_out := write_mubyte(p) - mubyte_zero; +if (mubyte_out > 2) or (mubyte_out = -1) or (mubyte_out = -2) then + write_noexpanding := true; +@<Expand macros in the token list +@y +begin @<Expand macros in the token list +@z + +@x +active_noconvert := true; +if mubyte_out > 1 then cs_converting := true; +mubyte_slog := mubyte_log; +if (mubyte_out > 0) or (mubyte_out = -1) then mubyte_log := 1 +else mubyte_log := 0; +token_show(def_ref); print_ln; +cs_converting := false; write_noexpanding := false; +active_noconvert := false; +mubyte_out := mubyte_sout; mubyte_log := mubyte_slog; +@y +token_show(def_ref); print_ln; +@z + +@x +@ Dumping the |xord|, |xchr|, and |xprn| arrays. We dump these always +in the format, so a TCX file loaded during format creation can set a +default for users of the format. + +@<Dump |xord|, |xchr|, and |xprn|@>= +dump_things(xord[0], 256); +dump_things(xchr[0], 256); +dump_things(xprn[0], 256); + +@ Undumping the |xord|, |xchr|, and |xprn| arrays. This code is more +complicated, because we want to ensure that a TCX file specified on +the command line will override whatever is in the format. Since the +tcx file has already been loaded, that implies throwing away the data +in the format. Also, if no |translate_filename| is given, but +|eight_bit_p| is set we have to make all characters printable. + +@<Undump |xord|, |xchr|, and |xprn|@>= +if translate_filename then begin + for k:=0 to 255 do undump_things(dummy_xord, 1); + for k:=0 to 255 do undump_things(dummy_xchr, 1); + for k:=0 to 255 do undump_things(dummy_xprn, 1); + end +else begin + undump_things(xord[0], 256); + undump_things(xchr[0], 256); + undump_things(xprn[0], 256); + if eight_bit_p then + for k:=0 to 255 do + xprn[k]:=1; +end; + + +@y +@z + +@x +@* \[54/enc\TeX] System-dependent changes for enc\TeX. + +@d encTeX_banner == ' encTeX v. Jun. 2004' + +@ The boolean variable |enctex_p| is set by web2c according to the given +command line option (or an entry in the configuration file) before any +\TeX{} function is called. + +@<Global...@> = +@!enctex_p: boolean; + + +@ The boolean variable |enctex_enabled_p| is used to enable enc\TeX's +primitives. It is initialised to |false|. When loading a \.{FMT} it +is set to the value of the boolean |enctex_p| saved in the \.{FMT} file. +Additionally it is set to the value of |enctex_p| in Ini\TeX. + +@<Glob...@>= +@!enctex_enabled_p:boolean; {enable encTeX} + + +@ @<Set init...@>= +enctex_enabled_p:=false; + + +@ Auxiliary functions/procedures for enc\TeX{} (by Petr Olsak) follow. +These functions implement the \.{\\mubyte} code to convert +the multibytes in |buffer| to one byte or to one control +sequence. These functions manipulate a mubyte tree: each node of +this tree is token list with n+1 tokens (first token consist the byte +from the byte sequence itself and the other tokens point to the +branches). If you travel from root of the tree to a leaf then you +find exactly one byte sequence which we have to convert to one byte or +control sequence. There are two variants of the leaf: the ``definitive +end'' or the ``middle leaf'' if a longer byte sequence exists and the mubyte +tree continues under this leaf. First variant is implemented as one +memory word where the link part includes the token to +which we have to convert and type part includes the number 60 (normal +conversion) or 1..52 (insert the control sequence). +The second variant of ``middle leaf'' is implemented as two memory words: +first one has a type advanced by 64 and link points to the second +word where info part includes the token to which we have to convert +and link points to the next token list with the branches of +the subtree. + +The inverse: one byte to multi byte (for log printing and \.{\\write} +printing) is implemented via a pool. Each multibyte sequence is stored +in a pool as a string and |mubyte_write|[{\it printed char\/}] points +to this string. + +@d new_mubyte_node == + link (p) := get_avail; p := link (p); info (p) := get_avail; p := info (p) +@d subinfo (#) == subtype (#) + +@<Basic printing...@>= +{ read |buffer|[|i|] and convert multibyte. |i| should have been + of type 0..|buf_size|, but web2c doesn't like that construct in + argument lists. } +function read_buffer(var i:integer):ASCII_code; +var p: pointer; + last_found: integer; + last_type: integer; +begin + mubyte_skip := 0; mubyte_token := 0; + read_buffer := buffer[i]; + if mubyte_in = 0 then + begin + if mubyte_keep > 0 then mubyte_keep := 0; + return ; + end; + last_found := -2; + if (i = start) and (not mubyte_start) then + begin + mubyte_keep := 0; + if (end_line_char >= 0) and (end_line_char < 256) then + if mubyte_read [end_line_char] <> null then + begin + mubyte_start := true; mubyte_skip := -1; + p := mubyte_read [end_line_char]; + goto continue; + end; + end; +restart: + mubyte_start := false; + if (mubyte_read [buffer[i]] = null) or (mubyte_keep > 0) then + begin + if mubyte_keep > 0 then decr (mubyte_keep); + return ; + end; + p := mubyte_read [buffer[i]]; +continue: + if type (p) >= 64 then + begin + last_type := type (p) - 64; + p := link (p); + mubyte_token := info (p); last_found := mubyte_skip; + end else if type (p) > 0 then + begin + last_type := type (p); + mubyte_token := link (p); + goto found; + end; + incr (mubyte_skip); + if i + mubyte_skip > limit then + begin + mubyte_skip := 0; + if mubyte_start then goto restart; + return; + end; + repeat + p := link (p); + if subinfo (info(p)) = buffer [i+mubyte_skip] then + begin + p := info (p); goto continue; + end; + until link (p) = null; + mubyte_skip := 0; + if mubyte_start then goto restart; + if last_found = -2 then return; { no found } + mubyte_skip := last_found; +found: + if mubyte_token < 256 then { multibyte to one byte } + begin + read_buffer := mubyte_token; mubyte_token := 0; + i := i + mubyte_skip; + if mubyte_start and (i >= start) then mubyte_start := false; + return; + end else begin { multibyte to control sequence } + read_buffer := 0; + if last_type = 60 then { normal conversion } + i := i + mubyte_skip + else begin { insert control sequence } + decr (i); mubyte_keep := last_type; + if i < start then mubyte_start := true; + if last_type = 52 then mubyte_keep := 10000; + if last_type = 51 then mubyte_keep := mubyte_skip + 1; + mubyte_skip := -1; + end; + if mubyte_start and (i >= start) then mubyte_start := false; + return; + end; +exit: end; + +@ @<Declare additional routines for enc\TeX@>= +procedure mubyte_update; { saves new string to mubyte tree } +var j: pool_pointer; + p: pointer; + q: pointer; + in_mutree: integer; +begin + j := str_start [str_ptr]; + if mubyte_read [so(str_pool[j])] = null then + begin + in_mutree := 0; + p := get_avail; + mubyte_read [so(str_pool[j])] := p; + subinfo (p) := so(str_pool[j]); type (p) := 0; + end else begin + in_mutree := 1; + p := mubyte_read [so(str_pool[j])]; + end; + incr (j); + while j < pool_ptr do + begin + if in_mutree = 0 then + begin + new_mubyte_node; subinfo (p) := so(str_pool[j]); type (p) := 0; + end else { |in_mutree| = 1 } + if (type (p) > 0) and (type (p) < 64) then + begin + type (p) := type (p) + 64; + q := link (p); link (p) := get_avail; p := link (p); + info (p) := q; + new_mubyte_node; subinfo (p) := so(str_pool[j]); type (p) := 0; + in_mutree := 0; + end else begin + if type (p) >= 64 then p := link (p); + repeat + p := link (p); + if subinfo (info(p)) = so(str_pool[j]) then + begin + p := info (p); + goto continue; + end; + until link (p) = null; + new_mubyte_node; subinfo (p) := so(str_pool[j]); type (p) := 0; + in_mutree := 0; + end; +continue: + incr (j); + end; + if in_mutree = 1 then + begin + if type (p) = 0 then + begin + type (p) := mubyte_prefix + 64; + q := link (p); link (p) := get_avail; p := link (p); + link (p) := q; info (p) := mubyte_stoken; + return; + end; + if type (p) >= 64 then + begin + type (p) := mubyte_prefix + 64; + p := link (p); info (p) := mubyte_stoken; + return; + end; + end; + type (p) := mubyte_prefix; + link (p) := mubyte_stoken; +exit: end; +@# +procedure dispose_munode (p: pointer); { frees a mu subtree recursivelly } +var q: pointer; +begin + if (type (p) > 0) and (type (p) < 64) then free_avail (p) + else begin + if type (p) >= 64 then + begin + q := link (p); free_avail (p); p := q; + end; + q := link (p); free_avail (p); p := q; + while p <> null do + begin + dispose_munode (info (p)); + q := link (p); + free_avail (p); + p := q; + end; + end; +end; +@# +procedure dispose_mutableout (cs: pointer); { frees record from out table } +var p, q, r: pointer; +begin + p := mubyte_cswrite [cs mod 128]; + r := null; + while p <> null do + if info (p) = cs then + begin + if r <> null then link (r) := link (link (p)) + else mubyte_cswrite[cs mod 128] := link (link (p)); + q := link (link(p)); + free_avail (link(p)); free_avail (p); + p := q; + end else begin + r := link (p); p := link (r); + end; +end; + +@ The |print_buffer| procedure prints one character from |buffer|[|i|]. +It also increases |i| to the next character in the buffer. + +@<Basic printing...@>= +{ print one char from |buffer|[|i|]. |i| should have been of type + 0..|buf_size|, but web2c doesn't like that construct in argument lists. } +procedure print_buffer(var i:integer); +var c: ASCII_code; +begin + if mubyte_in = 0 then print (buffer[i]) { normal TeX } + else if mubyte_log > 0 then print_char (buffer[i]) + else begin + c := read_buffer (i); + if mubyte_token > 0 then print_cs (mubyte_token-cs_token_flag) + else print (c); + end; + incr (i); +end; + +@ Additional material to dump for enc\TeX. This includes whether +enc\TeX is enabled, and if it is we also have to dump the \.{\\mubyte} +arrays. + +@<Dump enc\TeX-specific data@>= +dump_int(@"45435458); {enc\TeX's magic constant: "ECTX"} +if not enctex_p then dump_int(0) +else begin + dump_int(1); + dump_things(mubyte_read[0], 256); + dump_things(mubyte_write[0], 256); + dump_things(mubyte_cswrite[0], 128); +end; + +@ Undumping the additional material we dumped for enc\TeX. This includes +conditionally undumping the \.{\\mubyte} arrays. + +@<Undump enc\TeX-specific data@>= +undump_int(x); {check magic constant of enc\TeX} +if x<>@"45435458 then goto bad_fmt; +undump_int(x); {undump |enctex_p| flag into |enctex_enabled_p|} +if x=0 then enctex_enabled_p:=false +else if x<>1 then goto bad_fmt +else begin + enctex_enabled_p:=true; + undump_things(mubyte_read[0], 256); + undump_things(mubyte_write[0], 256); + undump_things(mubyte_cswrite[0], 128); +end; + +@y +@z |