/****************************************************************************\ Part of the XeTeX typesetting system copyright (c) 1994-2008 by SIL International copyright (c) 2009-2011 by Jonathan Kew 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 THE COPYRIGHT HOLDERS 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 the copyright holders shall not be used in advertising or otherwise to promote the sale, use or other dealings in this Software without prior written authorization from the copyright holders. \****************************************************************************/ @x \def\section{\mathhexbox278} @y \def\section{\mathhexbox278} \def\XeTeX{Xe\TeX} @z @x \def\title{\eTeX} @y \def\title{\XeTeX} @z @x \let\maybe=\iffalse % print only changed modules @y @z @x \let\maybe=\iffalse @y \let\maybe=\iftrue @z @x @* \[1] Introduction. @y @* \[1] Introduction. @z @x @d TeX_banner=='This is TeX, Version 3.1415926' {printed when \TeX\ starts} @y @d TeX_banner=='This is TeX, Version 3.1415926' {printed when \TeX\ starts} @# @d XeTeX_version=0 @d XeTeX_revision==".9997" @d XeTeX_version_string=='-0.9997.5' {current \XeTeX\ version} @# @d XeTeX_banner=='This is XeTeX, Version 3.1415926',eTeX_version_string,XeTeX_version_string {printed when \XeTeX\ starts} @d XeTeX_banner_k==XeTeX_banner @z @x @d banner==eTeX_banner @d banner_k==eTeX_banner_k @y @d banner==XeTeX_banner @d banner_k==XeTeX_banner_k @z @x @d TEX==ETEX {change program name into |ETEX|} @y @d TEX==XETEX {change program name into |XETEX|} @z @x @d TeXXeT_code=0 {the \TeXXeT\ feature is optional} @# @d eTeX_states=1 {number of \eTeX\ state variables in |eqtb|} @y @d TeXXeT_code=0 {the \TeXXeT\ feature is optional} @# @d XeTeX_dash_break_code = 1 {non-zero to enable breaks after en- and em-dashes} @# @d XeTeX_upwards_code = 2 {non-zero if the main vertical list is being built upwards} @d XeTeX_use_glyph_metrics_code = 3 {non-zero to use exact glyph height/depth} @d XeTeX_inter_char_tokens_code = 4 {non-zero to enable \\XeTeXinterchartokens insertion} @# @d XeTeX_input_normalization_code = 5 {normalization mode: 1 = NFC, 2 = NFD, else none} @# @d XeTeX_default_input_mode_code = 6 {input mode for newly opened files} @d XeTeX_input_mode_auto = 0 @d XeTeX_input_mode_utf8 = 1 @d XeTeX_input_mode_utf16be = 2 @d XeTeX_input_mode_utf16le = 3 @d XeTeX_input_mode_raw = 4 @d XeTeX_input_mode_icu_mapping = 5 @# @d XeTeX_default_input_encoding_code = 7 {|str_number| of encoding name if mode = ICU} @# @d XeTeX_tracing_fonts_code = 8 {non-zero to log native fonts used} @d eTeX_states=9 {number of \eTeX\ state variables in |eqtb|} @z @x @d hyph_prime=607 {another prime for hashing \.{\\hyphenation} exceptions; if you change this, you should also change |iinf_hyphen_size|.} @y @d hyph_prime=607 {another prime for hashing \.{\\hyphenation} exceptions; if you change this, you should also change |iinf_hyphen_size|.} {NB: |biggest_char| here refers to UTF16 codepoints that we store in strings, etc; actual character codes can exceed this range, up to |biggest_usv|.} @d biggest_char=65535 {the largest allowed character number; must be |<=max_quarterword|} @d biggest_usv=@"10FFFF {the largest Unicode Scalar Value} @d too_big_char=65536 {|biggest_char+1|} @d special_char=65537 {|biggest_char+2|} @d number_chars=65536 {|biggest_char+1|} @d too_big_usv=@"110000 @d number_usvs=@"110000 @d biggest_reg=255 {the largest allowed register number; must be |<=max_quarterword|} @d number_regs=256 {|biggest_reg+1|} @d font_biggest=255 {the real biggest font} @d number_fonts=font_biggest-font_base+2 @d number_math_families=256 @d number_math_fonts=number_math_families+number_math_families+number_math_families @d math_font_biggest=number_math_fonts-1 @d text_size=0 {size code for the largest size in a family} @d script_size=number_math_families {size code for the medium size in a family} @d script_script_size=number_math_families+number_math_families {size code for the smallest size in a family} @d biggest_lang=255 @d too_big_lang=256 @z @x @* \[2] The character set. @y @* \[2] The character set. @z @x @ Characters of text that have been converted to \TeX's internal form are said to be of type |ASCII_code|, which is a subrange of the integers. @= @!ASCII_code=0..255; {eight-bit numbers} @y @ Characters of text that have been converted to \TeX's internal form are said to be of type |ASCII_code|, which is a subrange of the integers. For xetex, we rename |ASCII_code| as |UTF16_code|. But we also have a new type |UTF8_code|, used when we construct filenames to pass to the system libraries. @d ASCII_code==UTF16_code @d packed_ASCII_code==packed_UTF16_code @= @!ASCII_code=0..biggest_char; {16-bit numbers} @!UTF8_code=0..255; {8-bit numbers} @!UnicodeScalar=0..@"10FFFF; {Unicode scalars} @z @x @d last_text_char=255 {ordinal number of the largest element of |text_char|} @y @d last_text_char=biggest_char {ordinal number of the largest element of |text_char|} @z @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 \.{} and Petr Sojka \.{}. 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 @* \[3] Input and output. @y @* \[3] Input and output. @z @x @!name_of_file:^text_char; @!name_length:0..file_name_size;@/{this many characters are actually relevant in |name_of_file| (the rest are blank)} @y @!name_of_file:^UTF8_code; {we build filenames in utf8 to pass to the OS} @!name_of_file16:^UTF16_code; {but sometimes we need a utf16 version of the name} @!name_length:0..file_name_size;@/{this many characters are actually relevant in |name_of_file| (the rest are blank)} @!name_length16:0..file_name_size; @z @x @!buffer:^ASCII_code; {lines of characters being read} @y @!buffer:^UnicodeScalar; {lines of characters being read} @z @x @d term_in==stdin {the terminal as an input file} @y @z @x @!bound_default:integer; {temporary for setup} @y @!term_in:unicode_file; @# @!bound_default:integer; {temporary for setup} @z @x @* \[4] String handling. @y @* \[4] String handling. @z @x |str_start[s]<=j=@"10000) then length:=str_start_macro(s+1)-str_start_macro(s) else if (s>=@"20) and (s<@"7F) then length:=1 else if (s<=@"7F) then length:=3 else if (s<@"100) then length:=4 else length:=8 end; @z @x @d cur_length == (pool_ptr - str_start[str_ptr]) @y @d cur_length == (pool_ptr - str_start_macro(str_ptr)) @z @x incr(str_ptr); str_start[str_ptr]:=pool_ptr; @y incr(str_ptr); str_start_macro(str_ptr):=pool_ptr; @z @x @d flush_string==begin decr(str_ptr); pool_ptr:=str_start[str_ptr]; end @y @d flush_string==begin decr(str_ptr); pool_ptr:=str_start_macro(str_ptr); end @p procedure append_str(@!s:str_number); { append an existing string to the current string } var i: integer; j: pool_pointer; begin i:=length(s); str_room(i); j:=str_start_macro(s); while (i > 0) do begin append_char(str_pool[j]); incr(j); decr(i); end; end; @z @x begin j:=str_start[s]; while jbuffer[k] then @y begin j:=str_start_macro(s); while j=@"10000 then if so(str_pool[j])<>@"D800+(buffer[k]-@"10000)div@"400 then begin result:=false; goto not_found; end else if so(str_pool[j+1])<>@"DC00+(buffer[k]-@"10000)mod@"400 then begin result:=false; goto not_found; end else incr(j) else if so(str_pool[j])<>buffer[k] then @z @x j:=str_start[s]; k:=str_start[t]; while jstr_pool[k] then goto not_found; incr(j); incr(k); @y if (length(s)=1) then begin if s<65536 then begin if t<65536 then begin if s<>t then goto not_found; end else begin if s<>str_pool[str_start_macro(t)] then goto not_found; end; end else begin if t<65536 then begin if str_pool[str_start_macro(s)]<>t then goto not_found; end else begin if str_pool[str_start_macro(s)]<>str_pool[str_start_macro(t)] then goto not_found; end; end; end else begin j:=str_start_macro(s); k:=str_start_macro(t); while jstr_pool[k] then goto not_found; incr(j); incr(k); end; @z @x @!init function get_strings_started:boolean; {initializes the string pool, but returns |false| if something goes wrong} label done,exit; var k,@!l:0..255; {small indices or counters} @!m,@!n:text_char; {characters input from |pool_file|} @!g:str_number; {garbage} @!a:integer; {accumulator for check sum} @!c:boolean; {check sum has been checked} begin pool_ptr:=0; str_ptr:=0; str_start[0]:=0; @y @!init function get_strings_started:boolean; {initializes the string pool, but returns |false| if something goes wrong} begin pool_ptr:=0; str_ptr:=0; @z @x @ @d app_lc_hex(#)==l:=#; if l<10 then append_char(l+"0")@+else append_char(l-10+"a") @y @ The first 65536 strings will consist of a single character only. But we don't actually make them; they're simulated on the fly. @z @x for k:=0 to 255 do begin if (@) then begin append_char("^"); append_char("^"); if k<@'100 then append_char(k+@'100) else if k<@'200 then append_char(k-@'100) else begin app_lc_hex(k div 16); app_lc_hex(k mod 16); end; end else append_char(k); g:=make_string; end @y begin str_ptr:=too_big_char; str_start_macro(str_ptr):=pool_ptr; end @z @x @= (k<" ")or(k>"~") @y @= { this module is not used } @z @x @ When the \.{WEB} system program called \.{TANGLE} processes the \.{TEX.WEB} description that you are now reading, it outputs the \PASCAL\ program \.{TEX.PAS} and also a string pool file called \.{TEX.POOL}. The \.{INITEX} @.WEB@>@.INITEX@> program reads the latter file, where each string appears as a two-digit decimal length followed by the string itself, and the information is recorded in \TeX's string memory. @= @!init @!pool_file:alpha_file; {the string-pool file output by \.{TANGLE}} tini @ @d bad_pool(#)==begin wake_up_terminal; write_ln(term_out,#); a_close(pool_file); get_strings_started:=false; return; end @= name_length := strlen (pool_name); name_of_file := xmalloc_array (ASCII_code, name_length + 1); strcpy (stringcast(name_of_file+1), pool_name); {copy the string} if a_open_in (pool_file, kpse_texpool_format) then begin c:=false; repeat @; until c; a_close(pool_file); get_strings_started:=true; end else bad_pool('! I can''t read ', pool_name, '; bad path?') @.I can't read TEX.POOL@> @ @= begin if eof(pool_file) then bad_pool('! ', pool_name, ' has no check sum.'); @.TEX.POOL has no check sum@> read(pool_file,m); read(pool_file,n); {read two digits of string length} if m='*' then @ else begin if (xord[m]<"0")or(xord[m]>"9")or@| (xord[n]<"0")or(xord[n]>"9") then bad_pool('! ', pool_name, ' line doesn''t begin with two digits.'); @.TEX.POOL line doesn't...@> l:=xord[m]*10+xord[n]-"0"*11; {compute the length} if pool_ptr+l+string_vacancies>pool_size then bad_pool('! You have to increase POOLSIZE.'); @.You have to increase POOLSIZE@> for k:=1 to l do begin if eoln(pool_file) then m:=' '@+else read(pool_file,m); append_char(xord[m]); end; read_ln(pool_file); g:=make_string; end; end @ The \.{WEB} operation \.{@@\$} denotes the value that should be at the end of this \.{TEX.POOL} file; any other value means that the wrong pool file has been loaded. @^check sum@> @= begin a:=0; k:=1; loop@+ begin if (xord[n]<"0")or(xord[n]>"9") then bad_pool('! ', pool_name, ' check sum doesn''t have nine digits.'); @.TEX.POOL check sum...@> a:=10*a+xord[n]-"0"; if k=9 then goto done; incr(k); read(pool_file,n); end; done: if a<>@$ then bad_pool('! ', pool_name, ' doesn''t match; tangle me again (or fix the path).'); @.TEX.POOL doesn't match@> c:=true; end @y @ @d bad_pool(#)==begin wake_up_terminal; write_ln(term_out,#); get_strings_started:=false; return; end @= if init_pool(pool_size-string_vacancies) = 0 then begin bad_pool('! You have to increase POOLSIZE.'); end else get_strings_started := true; @z @x @* \[5] On-line and off-line printing. @y @* \[5] On-line and off-line printing. @z @x procedure print_char(@!s:ASCII_code); {prints a single character} label exit; begin if @ then if selector= procedure print_char(@!s:integer); {prints a single character} label exit; var l: small_number; begin if (selector>pseudo) and (not doing_special) then {"printing" to a new string, encode as UTF-16 rather than UTF-8} begin if s>=@"10000 then begin print_visible_char(@"D800 + (s - @"10000) div @"400); print_visible_char(@"DC00 + (s - @"10000) mod @"400); end else print_visible_char(s); return; end; if @ then if selector= 128: encode as UTF8 } if s<@"800 then begin print_visible_char(@"C0 + s div @"40); print_visible_char(@"80 + s mod @"40); end else if s<@"10000 then begin print_visible_char(@"E0 + (s div @"1000)); print_visible_char(@"80 + (s mod @"1000) div @"40); print_visible_char(@"80 + (s mod @"40)); end else begin print_visible_char(@"F0 + (s div @"40000)); print_visible_char(@"80 + (s mod @"40000) div @"1000); print_visible_char(@"80 + (s mod @"1000) div @"40); print_visible_char(@"80 + (s mod @"40)); end end; exit:end; @ @d native_room(#)==while native_text_size <= native_len+# do begin native_text_size:=native_text_size+128; native_text:=xrealloc(native_text, native_text_size * sizeof(UTF16_code)); end @d append_native(#)==begin native_text[native_len]:=#; incr(native_len); end @ @= @!doing_special: boolean; @!native_text: ^UTF16_code; { buffer for collecting native-font strings } @!native_text_size: integer; { size of buffer } @!native_len: integer; @!save_native_len: integer; @ @= doing_special:=false; native_text_size:=128; native_text:=xmalloc(native_text_size * sizeof(UTF16_code)); @z @x procedure print(@!s:integer); {prints string |s|} label exit; var j:pool_pointer; {current character code position} @!nl:integer; {new-line character to restore} begin if s>=str_ptr then s:="???" {this can't happen} @.???@> else if s<256 then if s<0 then s:="???" {can't happen} else begin if (selector>pseudo) and (not special_printing) and (not message_printing) then begin print_char(s); return; {internal strings are not expanded} end; if (@) then if selector0) and (not no_convert) and (mubyte_write[s]>0) then s := mubyte_write[s] else if xprn[s] or special_printing then begin print_char(s); no_convert := false; return; end; no_convert := false; nl:=new_line_char; new_line_char:=-1; {temporarily disable new-line character} j:=str_start[s]; while j=str_ptr then s:="???" {this can't happen} @.???@> else if spseudo then begin print_char(s); return; {internal strings are not expanded} end; if (@) then if selector=@"D800) and (so(str_pool[j])<=@"DFFF) then begin if (so(str_pool[j])<=@"DBFF) and (j+1=@"DC00) and (so(str_pool[j+1])<=@"DFFF) then begin print_char(@"10000 + (so(str_pool[j])-@"D800) * @"400 + so(str_pool[j+1])-@"DC00); j:=j+2; end end else begin print_char(so(str_pool[j])); incr(j); end; exit:end; @z @x @ Control sequence names, file names, and strings constructed with \.{\\string} might contain |ASCII_code| values that can't be printed using |print_char|. Therefore we use |slow_print| for them: @= procedure slow_print(@!s:integer); {prints string |s|} var j:pool_pointer; {current character code position} begin if (s>=str_ptr) or (s<256) then print(s) else begin j:=str_start[s]; while j; if c>=0 then if c<256 then print(c); @y begin @; if c>=0 then if c<=biggest_usv then print_char(c); @z @x begin j:=str_start["m2d5c2l5x2v5i"]; v:=1000; @y begin j:=str_start_macro("m2d5c2l5x2v5i"); v:=1000; @z @x @p procedure print_current_string; {prints a yet-unmade string} var j:pool_pointer; {points to current character code} begin j:=str_start[str_ptr]; @y @p procedure print_current_string; {prints a yet-unmade string} var j:pool_pointer; {points to current character code} begin j:=str_start_macro(str_ptr); @z @x k:=first; while k < last do begin print_buffer(k) end; @y if last<>first then for k:=first to last-1 do print(buffer[k]); @z @x @* \[6] Reporting errors. @y @* \[6] Reporting errors. @z @x begin edit_name_start:=str_start[edit_file.name_field]; edit_name_length:=str_start[edit_file.name_field+1] - str_start[edit_file.name_field]; @y begin edit_name_start:=str_start_macro(edit_file.name_field); edit_name_length:=str_start_macro(edit_file.name_field+1) - str_start_macro(edit_file.name_field); @z @x @* \[7] Arithmetic with scaled dimensions. @y @* \[7] Arithmetic with scaled dimensions. @z @x @* \[8] Packed data. @y @* \[8] Packed data. @z @x @d min_quarterword=0 {smallest allowable value in a |quarterword|} @d max_quarterword=255 {largest allowable value in a |quarterword|} @d min_halfword==-@"FFFFFFF {smallest allowable value in a |halfword|} @d max_halfword==@"FFFFFFF {largest allowable value in a |halfword|} @y @d min_quarterword=0 {smallest allowable value in a |quarterword|} @d max_quarterword=@"FFFF {largest allowable value in a |quarterword|} @d min_halfword==-@"FFFFFFF {smallest allowable value in a |halfword|} @d max_halfword==@"3FFFFFFF {largest allowable value in a |halfword|} @z @x if (min_quarterword>0)or(max_quarterword<127) then bad:=11; if (min_halfword>0)or(max_halfword<32767) then bad:=12; @y if (min_quarterword>0)or(max_quarterword<@"7FFF) then bad:=11; if (min_halfword>0)or(max_halfword<@"3FFFFFFF) then bad:=12; @z @x if max_quarterword-min_quarterword<255 then bad:=19; @y if max_quarterword-min_quarterword<@"FFFF then bad:=19; @z @x @!word_file = file of memory_word; @y @!word_file = gzFile; @z @x @* \[9] Dynamic memory allocation. @y @* \[9] Dynamic memory allocation. @z @x @* \[10] Data structures for boxes and their friends. @y @* \[10] Data structures for boxes and their friends. @z @x @d whatsit_node=8 {|type| of special extension nodes} @y @d whatsit_node=8 {|type| of special extension nodes} { added stuff here for |native_word| and picture nodes } @d native_word_node=40 {|subtype| in whatsits that hold |native_font| words (0-3 are used for open, write, close, special; 4 is language; pdfTeX uses up through 30-something) To support ``native'' fonts, we build |native_word_nodes|, which are variable size whatsits. These have the same |width|, |depth|, and |height| fields as a |box_node|, at offsets 1-3, and then a word containing a size field for the node, a font number, a length, and a glyph count. Then there is a field containing a C pointer to a glyph info array; this and the glyph count are set by |set_native_metrics|. Copying and freeing of these nodes needs to take account of this! This is followed by |2*length| bytes, for the actual characters of the string (in UTF-16). So |native_node_size|, which does not include any space for the actual text, is 6.} @d native_node_size=6 {size of a |native_word| node (plus the actual chars) -- see also xetex.h} @d native_size(#)==mem[#+4].qqqq.b0 @d native_font(#)==mem[#+4].qqqq.b1 @d native_length(#)==mem[#+4].qqqq.b2 @d native_glyph_count(#)==mem[#+4].qqqq.b3 @d native_glyph_info_ptr(#)==mem[#+5].ptr @d native_glyph_info_size=10 { number of bytes of info per glyph: 16-bit glyph ID, 32-bit x and y coords } @d free_native_glyph_info(#) == begin if native_glyph_info_ptr(#) <> null_ptr then begin libc_free(native_glyph_info_ptr(#)); native_glyph_info_ptr(#) := null_ptr; native_glyph_count(#) := 0; end end @p procedure copy_native_glyph_info(src:pointer; dest:pointer); var glyph_count:integer; begin if native_glyph_info_ptr(src) <> null_ptr then begin glyph_count := native_glyph_count(src); native_glyph_info_ptr(dest) := xmalloc_array(char, glyph_count * native_glyph_info_size); memcpy(native_glyph_info_ptr(dest), native_glyph_info_ptr(src), glyph_count * native_glyph_info_size); native_glyph_count(dest) := glyph_count; end end; @ There are also |glyph_nodes|; these are like |native_word_nodes| in having |width|, |depth|, and |height| fields, but then they contain a glyph ID rather than size and length fields, and there's no subsidiary C pointer. @d glyph_node_size=5 @d native_glyph==native_length {in |glyph_node|s, we store the glyph number here} @d pic_node=42 {|subtype| in whatsits that hold picture file references} @d pdf_node=43 {|subtype| in whatsits that hold PDF page references} @d glyph_node=44 {|subtype| in whatsits that hold glyph numbers} @d pdfbox_crop = 1 { |pic_box_type| values in PDF nodes } @d pdfbox_media = 2 @d pdfbox_bleed = 3 @d pdfbox_trim = 4 @d pdfbox_art = 5 {Picture files are handled with nodes that include fields for the transform associated with the picture, and a pathname for the picture file itself. They also have the |width|, |depth|, and |height| fields of a |box_node| at offsets 1-3. (|depth| will always be zero, as it happens.) So |pic_node_size|, which does not include any space for the picture file pathname, is 7. |pdf_nodes| are just like |pic_nodes|, but generate a different xdv file code.} @d pic_node_size=8 { must sync with xetex.h } @d pic_path_length(#)==mem[#+4].hh.b0 @d pic_page(#)==mem[#+4].hh.b1 @d pic_box_type(#)==mem[#+4].hh.rh { for PDF, unused in picfile } @d pic_transform1(#)==mem[#+5].hh.lh @d pic_transform2(#)==mem[#+5].hh.rh @d pic_transform3(#)==mem[#+6].hh.lh @d pic_transform4(#)==mem[#+6].hh.rh @d pic_transform5(#)==mem[#+7].hh.lh @d pic_transform6(#)==mem[#+7].hh.rh @z @x @* \[11] Memory layout. @y @* \[11] Memory layout. @z @x @* \[12] Displaying boxes. @y @* \[12] Displaying boxes. @z @x @ @= case type(p) of hlist_node,vlist_node,ins_node,whatsit_node,mark_node,adjust_node, unset_node: print("[]"); @y @ @= case type(p) of hlist_node,vlist_node,ins_node,mark_node,adjust_node, unset_node: print("[]"); whatsit_node: case subtype(p) of native_word_node: begin if native_font(p)<>font_in_short_display then begin print_esc(font_id_text(native_font(p))); print_char(" "); font_in_short_display:=native_font(p); end; print_native_word(p); end; othercases print("[]") endcases; @z @x @p procedure show_node_list(@!p:integer); {prints a node list symbolically} label exit; var n:integer; {the number of items already printed at this level} @y @p procedure show_node_list(@!p:integer); {prints a node list symbolically} label exit; var n:integer; {the number of items already printed at this level} i:integer; {temp index for printing chars of picfile paths} @z @x @* \[15] The command codes. @y @* \[15] The command codes. @z @x @d math_given=69 {math code defined by \.{\\mathchardef}} @d last_item=70 {most recent item ( \.{\\lastpenalty}, \.{\\lastkern}, \.{\\lastskip} )} @d max_non_prefixed_command=70 {largest command code that can't be \.{\\global}} @ The next codes are special; they all relate to mode-independent assignment of values to \TeX's internal registers or tables. Codes that are |max_internal| or less represent internal quantities that might be expanded by `\.{\\the}'. @d toks_register=71 {token list register ( \.{\\toks} )} @d assign_toks=72 {special token list ( \.{\\output}, \.{\\everypar}, etc.~)} @d assign_int=73 {user-defined integer ( \.{\\tolerance}, \.{\\day}, etc.~)} @d assign_dimen=74 {user-defined length ( \.{\\hsize}, etc.~)} @d assign_glue=75 {user-defined glue ( \.{\\baselineskip}, etc.~)} @d assign_mu_glue=76 {user-defined muglue ( \.{\\thinmuskip}, etc.~)} @d assign_font_dimen=77 {user-defined font dimension ( \.{\\fontdimen} )} @d assign_font_int=78 {user-defined font integer ( \.{\\hyphenchar}, \.{\\skewchar} )} @d set_aux=79 {specify state info ( \.{\\spacefactor}, \.{\\prevdepth} )} @d set_prev_graf=80 {specify state info ( \.{\\prevgraf} )} @d set_page_dimen=81 {specify state info ( \.{\\pagegoal}, etc.~)} @d set_page_int=82 {specify state info ( \.{\\deadcycles}, \.{\\insertpenalties} )} {( or \.{\\interactionmode} )} @d set_box_dimen=83 {change dimension of box ( \.{\\wd}, \.{\\ht}, \.{\\dp} )} @d set_shape=84 {specify fancy paragraph shape ( \.{\\parshape} )} {(or \.{\\interlinepenalties}, etc.~)} @d def_code=85 {define a character code ( \.{\\catcode}, etc.~)} @d def_family=86 {declare math fonts ( \.{\\textfont}, etc.~)} @d set_font=87 {set current font ( font identifiers )} @d def_font=88 {define a font file ( \.{\\font} )} @d register=89 {internal register ( \.{\\count}, \.{\\dimen}, etc.~)} @d max_internal=89 {the largest code that can follow \.{\\the}} @d advance=90 {advance a register or parameter ( \.{\\advance} )} @d multiply=91 {multiply a register or parameter ( \.{\\multiply} )} @d divide=92 {divide a register or parameter ( \.{\\divide} )} @d prefix=93 {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )} {( or \.{\\protected} )} @d let=94 {assign a command code ( \.{\\let}, \.{\\futurelet} )} @d shorthand_def=95 {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)} {or \.{\\charsubdef}} @d read_to_cs=96 {read into a control sequence ( \.{\\read} )} {( or \.{\\readline} )} @d def=97 {macro definition ( \.{\\def}, \.{\\gdef}, \.{\\xdef}, \.{\\edef} )} @d set_box=98 {set a box ( \.{\\setbox} )} @d hyph_data=99 {hyphenation data ( \.{\\hyphenation}, \.{\\patterns} )} @d set_interaction=100 {define level of interaction ( \.{\\batchmode}, etc.~)} @d max_command=100 {the largest command code seen at |big_switch|} @y @d math_given=69 {math code defined by \.{\\mathchardef}} @d XeTeX_math_given=70 @d last_item=71 {most recent item ( \.{\\lastpenalty}, \.{\\lastkern}, \.{\\lastskip} )} @d max_non_prefixed_command=71 {largest command code that can't be \.{\\global}} @ The next codes are special; they all relate to mode-independent assignment of values to \TeX's internal registers or tables. Codes that are |max_internal| or less represent internal quantities that might be expanded by `\.{\\the}'. @d toks_register=72 {token list register ( \.{\\toks} )} @d assign_toks=73 {special token list ( \.{\\output}, \.{\\everypar}, etc.~)} @d assign_int=74 {user-defined integer ( \.{\\tolerance}, \.{\\day}, etc.~)} @d assign_dimen=75 {user-defined length ( \.{\\hsize}, etc.~)} @d assign_glue=76 {user-defined glue ( \.{\\baselineskip}, etc.~)} @d assign_mu_glue=77 {user-defined muglue ( \.{\\thinmuskip}, etc.~)} @d assign_font_dimen=78 {user-defined font dimension ( \.{\\fontdimen} )} @d assign_font_int=79 {user-defined font integer ( \.{\\hyphenchar}, \.{\\skewchar} )} @d set_aux=80 {specify state info ( \.{\\spacefactor}, \.{\\prevdepth} )} @d set_prev_graf=81 {specify state info ( \.{\\prevgraf} )} @d set_page_dimen=82 {specify state info ( \.{\\pagegoal}, etc.~)} @d set_page_int=83 {specify state info ( \.{\\deadcycles}, \.{\\insertpenalties} )} {( or \.{\\interactionmode} )} @d set_box_dimen=84 {change dimension of box ( \.{\\wd}, \.{\\ht}, \.{\\dp} )} @d set_shape=85 {specify fancy paragraph shape ( \.{\\parshape} )} {(or \.{\\interlinepenalties}, etc.~)} @d def_code=86 {define a character code ( \.{\\catcode}, etc.~)} @d XeTeX_def_code=87 {\.{\\XeTeXmathcode}, \.{\\XeTeXdelcode}} @d def_family=88 {declare math fonts ( \.{\\textfont}, etc.~)} @d set_font=89 {set current font ( font identifiers )} @d def_font=90 {define a font file ( \.{\\font} )} @d register=91 {internal register ( \.{\\count}, \.{\\dimen}, etc.~)} @d max_internal=91 {the largest code that can follow \.{\\the}} @d advance=92 {advance a register or parameter ( \.{\\advance} )} @d multiply=93 {multiply a register or parameter ( \.{\\multiply} )} @d divide=94 {divide a register or parameter ( \.{\\divide} )} @d prefix=95 {qualify a definition ( \.{\\global}, \.{\\long}, \.{\\outer} )} {( or \.{\\protected} )} @d let=96 {assign a command code ( \.{\\let}, \.{\\futurelet} )} @d shorthand_def=97 {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)} {or \.{\\charsubdef}} @d read_to_cs=98 {read into a control sequence ( \.{\\read} )} {( or \.{\\readline} )} @d def=99 {macro definition ( \.{\\def}, \.{\\gdef}, \.{\\xdef}, \.{\\edef} )} @d set_box=100 {set a box ( \.{\\setbox} )} @d hyph_data=101 {hyphenation data ( \.{\\hyphenation}, \.{\\patterns} )} @d set_interaction=102 {define level of interaction ( \.{\\batchmode}, etc.~)} @d max_command=102 {the largest command code seen at |big_switch|} @z @x @* \[17] The table of equivalents. @y @* \[17] The table of equivalents. @z @x In the first region we have 256 equivalents for ``active characters'' that act as control sequences, followed by 256 equivalents for single-character control sequences. @y In the first region we have |number_chars| equivalents for ``active characters'' that act as control sequences, followed by |number_chars| equivalents for single-character control sequences. @z @x @d single_base=active_base+256 {equivalents of one-character control sequences} @d null_cs=single_base+256 {equivalent of \.{\\csname\\endcsname}} @y @d single_base=active_base+number_usvs {equivalents of one-character control sequences} @d null_cs=single_base+number_usvs {equivalent of \.{\\csname\\endcsname}} @z @x @ Region 3 of |eqtb| contains the 256 \.{\\skip} registers, as well as the glue parameters defined here. It is important that the ``muskip'' parameters have larger numbers than the others. @y @ Region 3 of |eqtb| contains the |number_regs| \.{\\skip} registers, as well as the glue parameters defined here. It is important that the ``muskip'' parameters have larger numbers than the others. @z @x @d par_fill_skip_code=14 {glue on last line of paragraph} @d thin_mu_skip_code=15 {thin space in math formula} @d med_mu_skip_code=16 {medium space in math formula} @d thick_mu_skip_code=17 {thick space in math formula} @d glue_pars=18 {total number of glue parameters} @y @d par_fill_skip_code=14 {glue on last line of paragraph} @d XeTeX_linebreak_skip_code=15 {glue introduced at potential linebreak location} @d thin_mu_skip_code=16 {thin space in math formula} @d med_mu_skip_code=17 {medium space in math formula} @d thick_mu_skip_code=18 {thick space in math formula} @d glue_pars=19 {total number of glue parameters} @z @x @d skip_base=glue_base+glue_pars {table of 256 ``skip'' registers} @d mu_skip_base=skip_base+256 {table of 256 ``muskip'' registers} @d local_base=mu_skip_base+256 {beginning of region 4} @y @d skip_base=glue_base+glue_pars {table of |number_regs| ``skip'' registers} @d mu_skip_base=skip_base+number_regs {table of |number_regs| ``muskip'' registers} @d local_base=mu_skip_base+number_regs {beginning of region 4} @z @x @d par_fill_skip==glue_par(par_fill_skip_code) @y @d par_fill_skip==glue_par(par_fill_skip_code) @d XeTeX_linebreak_skip==glue_par(XeTeX_linebreak_skip_code) @z @x par_fill_skip_code: print_esc("parfillskip"); @y par_fill_skip_code: print_esc("parfillskip"); XeTeX_linebreak_skip_code: print_esc("XeTeXlinebreakskip"); @z @x primitive("parfillskip",assign_glue,glue_base+par_fill_skip_code);@/ @!@:par_fill_skip_}{\.{\\parfillskip} primitive@> @y primitive("parfillskip",assign_glue,glue_base+par_fill_skip_code);@/ @!@:par_fill_skip_}{\.{\\parfillskip} primitive@> primitive("XeTeXlinebreakskip",assign_glue,glue_base+XeTeX_linebreak_skip_code);@/ @z @x @d etex_toks=etex_toks_base+1 {end of \eTeX's token list parameters} @y @d XeTeX_inter_char_loc=every_eof_loc+1 {not really used, but serves as a flag} @d etex_toks=XeTeX_inter_char_loc+1 {end of \eTeX's token list parameters} @z @x @d toks_base=etex_toks {table of 256 token list registers} @# @d etex_pen_base=toks_base+256 {start of table of \eTeX's penalties} @d inter_line_penalties_loc=etex_pen_base {additional penalties between lines} @d club_penalties_loc=etex_pen_base+1 {penalties for creating club lines} @d widow_penalties_loc=etex_pen_base+2 {penalties for creating widow lines} @d display_widow_penalties_loc=etex_pen_base+3 {ditto, just before a display} @d etex_pens=etex_pen_base+4 {end of table of \eTeX's penalties} @# @d box_base=etex_pens {table of 256 box registers} @d cur_font_loc=box_base+256 {internal font number outside math mode} @d xord_code_base=cur_font_loc+1 @d xchr_code_base=xord_code_base+1 @d xprn_code_base=xchr_code_base+1 @d math_font_base=xprn_code_base+1 @d cat_code_base=math_font_base+48 {table of 256 command codes (the ``catcodes'')} @d lc_code_base=cat_code_base+256 {table of 256 lowercase mappings} @d uc_code_base=lc_code_base+256 {table of 256 uppercase mappings} @d sf_code_base=uc_code_base+256 {table of 256 spacefactor mappings} @d math_code_base=sf_code_base+256 {table of 256 math mode mappings} @d char_sub_code_base=math_code_base+256 {table of character substitutions} @d int_base=char_sub_code_base+256 {beginning of region 5} @y @d toks_base=etex_toks {table of |number_regs| token list registers} @# @d etex_pen_base=toks_base+number_regs {start of table of \eTeX's penalties} @d inter_line_penalties_loc=etex_pen_base {additional penalties between lines} @d club_penalties_loc=etex_pen_base+1 {penalties for creating club lines} @d widow_penalties_loc=etex_pen_base+2 {penalties for creating widow lines} @d display_widow_penalties_loc=etex_pen_base+3 {ditto, just before a display} @d etex_pens=etex_pen_base+4 {end of table of \eTeX's penalties} @# @d box_base=etex_pens {table of |number_regs| box registers} @d cur_font_loc=box_base+number_regs {internal font number outside math mode} @d math_font_base=cur_font_loc+1 @d cat_code_base=math_font_base+number_math_fonts {table of |number_usvs| command codes (the ``catcodes'')} @d lc_code_base=cat_code_base+number_usvs {table of |number_usvs| lowercase mappings} @d uc_code_base=lc_code_base+number_usvs {table of |number_usvs| uppercase mappings} @d sf_code_base=uc_code_base+number_usvs {table of |number_usvs| spacefactor mappings} @d math_code_base=sf_code_base+number_usvs {table of |number_usvs| math mode mappings} @d char_sub_code_base=math_code_base+number_usvs {table of character substitutions} @d int_base=char_sub_code_base+number_usvs {beginning of region 5} @z @x @d var_code==@'70000 {math code meaning ``use the current family''} @y @d var_fam_class = 7 @d active_math_char = @"1FFFFF @d is_active_math_char(#) == math_char_field(#) = active_math_char @d is_var_family(#) == math_class_field(#) = 7 @z @x for k:=output_routine_loc to toks_base+255 do @y for k:=output_routine_loc to toks_base+number_regs-1 do @z @x for k:=box_base+1 to box_base+255 do eqtb[k]:=eqtb[box_base]; @y for k:=box_base+1 to box_base+number_regs-1 do eqtb[k]:=eqtb[box_base]; @z @x for k:=math_font_base to math_font_base+47 do eqtb[k]:=eqtb[cur_font_loc]; @y for k:=math_font_base to math_font_base+number_math_fonts-1 do eqtb[k]:=eqtb[cur_font_loc]; @z @x for k:=0 to 255 do @y for k:=0 to number_usvs-1 do @z @x for k:="0" to "9" do math_code(k):=hi(k+var_code); @y for k:="0" to "9" do math_code(k):=hi(k + set_class_field(var_fam_class)); @z @x math_code(k):=hi(k+var_code+@"100); math_code(k+"a"-"A"):=hi(k+"a"-"A"+var_code+@"100);@/ @y math_code(k) := hi(k + set_family_field(1) + set_class_field(var_fam_class)); math_code(k+"a"-"A") := hi(k+"a"-"A" + set_family_field(1) + set_class_field(var_fam_class));@/ @z @x begin if n=cur_font_loc then print("current font") else if n @y primitive("errorcontextlines",assign_int,int_base+error_context_lines_code);@/ @!@:error_context_lines_}{\.{\\errorcontextlines} primitive@> primitive("XeTeXlinebreakpenalty",assign_int,int_base+XeTeX_linebreak_penalty_code);@/ @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 for k:=0 to 255 do del_code(k):=-1; del_code("."):=0; {this null delimiter is used in error recovery} @y for k:=0 to number_chars-1 do del_code(k):=-1; del_code("."):=0; {this null delimiter is used in error recovery} @z @x @ The final region of |eqtb| contains the dimension parameters defined here, and the 256 \.{\\dimen} registers. @y @ The final region of |eqtb| contains the dimension parameters defined here, and the |number_regs| \.{\\dimen} registers. @z @x @d emergency_stretch_code=20 {reduces badnesses on final pass of line-breaking} @d dimen_pars=21 {total number of dimension parameters} @y @d emergency_stretch_code=20 {reduces badnesses on final pass of line-breaking} @d pdf_page_width_code=21 {page width of the PDF output} @d pdf_page_height_code=22 {page height of the PDF output} @d dimen_pars=23 {total number of dimension parameters} @z @x @d scaled_base=dimen_base+dimen_pars {table of 256 user-defined \.{\\dimen} registers} @d eqtb_size=scaled_base+255 {largest subscript of |eqtb|} @y @d scaled_base=dimen_base+dimen_pars {table of |number_regs| user-defined \.{\\dimen} registers} @d eqtb_size=scaled_base+biggest_reg {largest subscript of |eqtb|} @z @x @d emergency_stretch==dimen_par(emergency_stretch_code) @y @d emergency_stretch==dimen_par(emergency_stretch_code) @d pdf_page_width == dimen_par(pdf_page_width_code) @d pdf_page_height == dimen_par(pdf_page_height_code) @z @x emergency_stretch_code:print_esc("emergencystretch"); @y emergency_stretch_code:print_esc("emergencystretch"); pdf_page_width_code: print_esc("pdfpagewidth"); pdf_page_height_code: print_esc("pdfpageheight"); @z @x primitive("emergencystretch",assign_dimen,dimen_base+emergency_stretch_code);@/ @!@:emergency_stretch_}{\.{\\emergencystretch} primitive@> @y primitive("emergencystretch",assign_dimen,dimen_base+emergency_stretch_code);@/ @!@:emergency_stretch_}{\.{\\emergencystretch} primitive@> primitive("pdfpagewidth",assign_dimen,dimen_base+pdf_page_width_code);@/ @!@:pdf_page_width_}{\.{\\pdfpagewidth} primitive@> primitive("pdfpageheight",assign_dimen,dimen_base+pdf_page_height_code);@/ @!@:pdf_page_height_}{\.{\\pdfpageheight} primitive@> @z @x for q:=active_base to box_base+255 do @y for q:=active_base to box_base+biggest_reg do @z @x @* \[18] The hash table. @y @* \[18] The hash table. @z @x begin @; p:=h+hash_base; {we start searching here; note that |0<=h0 then if length(text(p))=l then @y @!ll:integer; {length in utf16 code units} begin @; p:=h+hash_base; {we start searching here; note that |0<=h=@"10000 then incr(ll); loop@+begin if text(p)>0 then if length(text(p))=ll then @z @x str_room(l); d:=cur_length; while pool_ptr>str_start[str_ptr] do @y str_room(ll); d:=cur_length; while pool_ptr>str_start_macro(str_ptr) do @z @x for k:=j to j+l-1 do append_char(buffer[k]); @y for k:=j to j+l-1 do begin if buffer[k]<@"10000 then append_char(buffer[k]) else begin append_char(@"D800+(buffer[k]-@"10000)div@"400); append_char(@"DC00+(buffer[k]-@"10000)mod@"400); end end; @z @x The conversion from control sequence to byte sequence for enc\TeX is implemented here. Of course, the simplest way is to implement an array of string pointers with |hash_size| length, but we assume that only a few control sequences will need to be converted. So |mubyte_cswrite|, an array with only 128 items, is used. The items point to the token lists. First token includes a csname number and the second points the string to be output. The third token includes the number of another csname and fourth token its pointer to the string etc. We need to do the sequential searching in one of the 128 token lists. @y @z @x 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 end; @y @z @x primitive("mathaccent",math_accent,0);@/ @y primitive("mathaccent",math_accent,0);@/ primitive("XeTeXmathaccent",math_accent,1);@/ @z @x primitive("mathchar",math_char_num,0);@/ @!@:math_char_}{\.{\\mathchar} primitive@> @y primitive("mathchar",math_char_num,0);@/ primitive("XeTeXmathcharnum",math_char_num,1);@/ primitive("XeTeXmathchar",math_char_num,2);@/ @!@:math_char_}{\.{\\mathchar} primitive@> @z @x primitive("radical",radical,0);@/ @y primitive("radical",radical,0);@/ primitive("XeTeXradical",radical,1);@/ @z @x primitive("relax",relax,256); {cf.\ |scan_file_name|} @y primitive("relax",relax,too_big_usv); {cf.\ |scan_file_name|} @z @x delim_num: print_esc("delimiter"); @y delim_num: if chr_code=1 then print_esc("XeTeXdelimiter") else print_esc("delimiter"); @z @x end_cs_name: if chr_code = 10 then print_esc("endmubyte") else print_esc("endcsname"); @y end_cs_name: print_esc("endcsname"); @z @x math_accent: print_esc("mathaccent"); @y math_accent: if chr_code=1 then print_esc("XeTeXmathaccent") else print_esc("mathaccent"); @z @x math_char_num: print_esc("mathchar"); @y math_char_num: if chr_code=2 then print_esc("XeTeXmathchar") else if chr_code=1 then print_esc("XeTeXmathcharnum") else print_esc("mathchar"); @z @x radical: print_esc("radical"); @y radical: if chr_code=1 then print_esc("XeTeXradical") else print_esc("radical"); @z @x @* \[19] Saving and restoring equivalents. @y @* \[19] Saving and restoring equivalents. @z @x @* \[20] Token lists. @y @* \[20] Token lists. @z @x A \TeX\ token is either a character or a control sequence, and it is @^token@> represented internally in one of two ways: (1)~A character whose ASCII code number is |c| and whose command code is |m| is represented as the number $2^8m+c$; the command code is in the range |1<=m<=14|. (2)~A control sequence whose |eqtb| address is |p| is represented as the number |cs_token_flag+p|. Here |cs_token_flag=@t$2^{12}-1$@>| is larger than $2^8m+c$, yet it is small enough that |cs_token_flag+p< max_halfword|; thus, a token fits comfortably in a halfword. @y A \TeX\ token is either a character or a control sequence, and it is @^token@> represented internally in one of two ways: (1)~A character whose ASCII code number is |c| and whose command code is |m| is represented as the number $2^16m+c$; the command code is in the range |1<=m<=14|. (2)~A control sequence whose |eqtb| address is |p| is represented as the number |cs_token_flag+p|. Here |cs_token_flag=@t$2^{20}-1$@>| is larger than $2^8m+c$, yet it is small enough that |cs_token_flag+p< max_halfword|; thus, a token fits comfortably in a halfword. @z @x @d cs_token_flag==@'7777 {amount added to the |eqtb| location in a token that stands for a control sequence; is a multiple of~256, less~1} @d left_brace_token=@'0400 {$2^8\cdot|left_brace|$} @d left_brace_limit=@'1000 {$2^8\cdot(|left_brace|+1)$} @d right_brace_token=@'1000 {$2^8\cdot|right_brace|$} @d right_brace_limit=@'1400 {$2^8\cdot(|right_brace|+1)$} @d math_shift_token=@'1400 {$2^8\cdot|math_shift|$} @d tab_token=@'2000 {$2^8\cdot|tab_mark|$} @d out_param_token=@'2400 {$2^8\cdot|out_param|$} @d space_token=@'5040 {$2^8\cdot|spacer|+|" "|$} @d letter_token=@'5400 {$2^8\cdot|letter|$} @d other_token=@'6000 {$2^8\cdot|other_char|$} @d match_token=@'6400 {$2^8\cdot|match|$} @d end_match_token=@'7000 {$2^8\cdot|end_match|$} @d protected_token=@'7001 {$2^8\cdot|end_match|+1$} @y @d cs_token_flag= @"1FFFFFF {was @@"FFFFF: amount added to the |eqtb| location in a token that stands for a control sequence; is a multiple of~65536, less~1} @d max_char_val= @"200000 {@@"10000 to separate char and command code} @d left_brace_token= @"200000 {@@"10000 $2^16\cdot|left_brace|$} @d left_brace_limit= @"400000 {@@"20000 $2^16\cdot(|left_brace|+1)$} @d right_brace_token= @"400000 {@@"20000 $2^16\cdot|right_brace|$} @d right_brace_limit= @"600000 {@@"30000 $2^16\cdot(|right_brace|+1)$} @d math_shift_token= @"600000 {@@"30000 $2^16\cdot|math_shift|$} @d tab_token= @"800000 {@@"40000 $2^16\cdot|tab_mark|$} @d out_param_token= @"A00000 {@@"50000 $2^16\cdot|out_param|$} @d space_token= @"1400020 {@@"A0020 $2^16\cdot|spacer|+|" "|$} @d letter_token= @"1600000 {@@"B0000 $2^16\cdot|letter|$} @d other_token= @"1800000 {@@"C0000 $2^16\cdot|other_char|$} @d match_token= @"1A00000 {@@"D0000 $2^16\cdot|match|$} @d end_match_token= @"1C00000 {@@"E0000 $2^16\cdot|end_match|$} @d protected_token=end_match_token+1 {$2^8\cdot|end_match|+1$} @z @x procedure show_token_list(@!p,@!q:integer;@!l:integer); label exit; var m,@!c:integer; {pieces of a token} @!match_chr:ASCII_code; {character used in a `|match|'} @y procedure show_token_list(@!p,@!q:integer;@!l:integer); label exit; var m,@!c:integer; {pieces of a token} @!match_chr:integer; {character used in a `|match|'} @z @x else begin m:=info(p) div @'400; c:=info(p) mod @'400; @y else begin m:=info(p) div max_char_val; c:=info(p) mod max_char_val; @z @x @= case m of left_brace,right_brace,math_shift,tab_mark,sup_mark,sub_mark,spacer, letter,other_char: print(c); mac_param: begin print(c); print(c); end; out_param: begin print(match_chr); if c<=9 then print_char(c+"0") else begin print_char("!"); return; end; end; match: begin match_chr:=c; print(c); incr(n); print_char(n); @y @= case m of left_brace,right_brace,math_shift,tab_mark,sup_mark,sub_mark,spacer, letter,other_char: print_char(c); mac_param: begin print_char(c); print_char(c); end; out_param: begin print_char(match_chr); if c<=9 then print_char(c+"0") else begin print_char("!"); return; end; end; match: begin match_chr:=c; print_char(c); incr(n); print_char(n); @z @x @* \[21] Introduction to the syntactic routines. @y @* \[21] Introduction to the syntactic routines. @z @x procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword); var n:integer; {temp variable} @y procedure print_cmd_chr(@!cmd:quarterword;@!chr_code:halfword); var n:integer; {temp variable} @!font_name_str:str_number; {local vars for \.{\\fontname} quoting extension} @!quote_char:UTF16_code; @z @x @* \[22] Input stacks and states. @y @* \[22] Input stacks and states. @z @x @!input_file : ^alpha_file; @y @!input_file : ^unicode_file; @z @x @d inserted=4 {|token_type| code for inserted texts} @d macro=5 {|token_type| code for defined control sequences} @d output_text=6 {|token_type| code for output routines} @d every_par_text=7 {|token_type| code for \.{\\everypar}} @d every_math_text=8 {|token_type| code for \.{\\everymath}} @d every_display_text=9 {|token_type| code for \.{\\everydisplay}} @d every_hbox_text=10 {|token_type| code for \.{\\everyhbox}} @d every_vbox_text=11 {|token_type| code for \.{\\everyvbox}} @d every_job_text=12 {|token_type| code for \.{\\everyjob}} @d every_cr_text=13 {|token_type| code for \.{\\everycr}} @d mark_text=14 {|token_type| code for \.{\\topmark}, etc.} @# @d eTeX_text_offset=output_routine_loc-output_text @y @d backed_up_char=4 {special code for backed-up char from \\XeTeXinterchartoks hook} @d inserted=5 {|token_type| code for inserted texts} @d macro=6 {|token_type| code for defined control sequences} @d output_text=7 {|token_type| code for output routines} @d every_par_text=8 {|token_type| code for \.{\\everypar}} @d every_math_text=9 {|token_type| code for \.{\\everymath}} @d every_display_text=10 {|token_type| code for \.{\\everydisplay}} @d every_hbox_text=11 {|token_type| code for \.{\\everyhbox}} @d every_vbox_text=12 {|token_type| code for \.{\\everyvbox}} @d every_job_text=13 {|token_type| code for \.{\\everyjob}} @d every_cr_text=14 {|token_type| code for \.{\\everycr}} @d mark_text=15 {|token_type| code for \.{\\topmark}, etc.} @d inter_char_text=16 {text from \\XeTeXinterchartoks} @# @d eTeX_text_offset=output_routine_loc-output_text-1 {1 more to make space for the |inter_char_text|} @z @x backed_up: if loc=null then print_nl(" ") @y backed_up_char,backed_up: if loc=null then print_nl(" ") @z @x every_eof_text: print_nl(" "); @y inter_char_text: print_nl(" "); every_eof_text: print_nl(" "); @z @x for q:=p to first_count-1 do print_char(trick_buf[q mod error_line]); print_ln; for q:=1 to n do print_char(" "); {print |n| spaces to begin line~2} if m+n<=error_line then p:=first_count+m else p:=first_count+(error_line-n-3); for q:=first_count to p-1 do print_char(trick_buf[q mod error_line]); @y for q:=p to first_count-1 do print_visible_char(trick_buf[q mod error_line]); print_ln; for q:=1 to n do print_visible_char(" "); {print |n| spaces to begin line~2} if m+n<=error_line then p:=first_count+m else p:=first_count+(error_line-n-3); for q:=first_count to p-1 do print_visible_char(trick_buf[q mod error_line]); @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_char(buffer[i]); end @z @x @* \[23] Maintaining the input stacks. @y @* \[23] Maintaining the input stacks. @z @x othercases print_cmd_chr(assign_toks,t-output_text+output_routine_loc) @y othercases print_cmd_chr(assign_toks,t-output_text+output_routine_loc+1) @z @x if name>17 then a_close(cur_file); {forget it} @y if name>17 then u_close(cur_file); {forget it} @z @x @* \[24] Getting the next token. @y @* \[24] Getting the next token. @z @x Some additional routines used by the enc\TeX extension have to be declared at this point. @p @t\4@>@@/ @y @z @x primitive("par",par_end,256); {cf.\ |scan_file_name|} @y primitive("par",par_end,too_big_usv); {cf.\ |scan_file_name|} @z @x @d start_cs=26 {another} @y @d start_cs=26 {another} @d not_exp=27 @z @x exit; {go here when the next input token has been got} @y not_exp, {go here when ^^ turned out not to start an expanded code} exit; {go here when the next input token has been got} @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 @!c,@!cc:ASCII_code; {constituents of a possible expanded code} @!d:2..3; {number of excess characters in an expanded code} @y @!c:UnicodeScalar; {constituent of a possible expanded code} @!d:small_number; {number of excess characters in an expanded code} @!sup_count:small_number; {number of identical |sup_mark| characters} @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 @d hex_to_cur_chr== if c<="9" then cur_chr:=c-"0" @+else cur_chr:=c-"a"+10; if cc<="9" then cur_chr:=16*cur_chr+cc-"0" else cur_chr:=16*cur_chr+cc-"a"+10 @y @d hex_to_cur_chr== if c<="9" then cur_chr:=c-"0" @+else cur_chr:=c-"a"+10; if cc<="9" then cur_chr:=16*cur_chr+cc-"0" else cur_chr:=16*cur_chr+cc-"a"+10 @d long_hex_to_cur_chr== if c<="9" then cur_chr:=c-"0" @+else cur_chr:=c-"a"+10; if cc<="9" then cur_chr:=16*cur_chr+cc-"0" else cur_chr:=16*cur_chr+cc-"a"+10; if ccc<="9" then cur_chr:=16*cur_chr+ccc-"0" else cur_chr:=16*cur_chr+ccc-"a"+10; if cccc<="9" then cur_chr:=16*cur_chr+cccc-"0" else cur_chr:=16*cur_chr+cccc-"a"+10 @z @x @= begin if cur_chr=buffer[loc] then if loc= begin if cur_chr=buffer[loc] then if locbiggest_usv then begin cur_chr:=buffer[loc]; goto not_exp; end; loc:=loc+2*sup_count-1; goto reswitch; end; not_exp: state:=mid_line; end @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 @= begin if buffer[k]=cur_chr then @+if cat=sup_mark then @+if k2 then begin hex_to_cur_chr; buffer[k-1]:=cur_chr; end else if c<@'100 then buffer[k-1]:=c+@'100 else buffer[k-1]:=c-@'100; limit:=limit-d; first:=first-d; while k<=limit do begin buffer[k]:=buffer[k+d]; incr(k); end; goto start_cs; end; end; end @y @= begin if (cat=sup_mark) and (buffer[k]=cur_chr) and (k0 then {there were the right number of hex chars, so convert them} begin cur_chr:=0; for d:=1 to sup_count do begin c:=buffer[k+sup_count-2+d]; if c<="9" then cur_chr:=16*cur_chr+c-"0" else cur_chr:=16*cur_chr+c-"a"+10; end; {check the resulting value is within the valid range} if cur_chr>biggest_usv then cur_chr:=buffer[k] else begin buffer[k-1]:=cur_chr; d:=2*sup_count-1; {shift the rest of the buffer left by |d| chars} limit:=limit-d; while k<=limit do begin buffer[k]:=buffer[k+d]; incr(k); end; goto start_cs; end end end end @z @x @ @= 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 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 @ @= begin repeat cur_chr:=buffer[k]; cat:=cat_code(cur_chr); incr(k); until (cat<>letter)or(k>limit); @; 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 else begin cur_cmd:=t div @'400; cur_chr:=t mod @'400; @y else begin cur_cmd:=t div max_char_val; cur_chr:=t mod max_char_val; @z @x @d no_expand_flag=257 {this characterizes a special variant of |relax|} @y @d no_expand_flag=special_char {this characterizes a special variant of |relax|} @z @x k := start; while k < limit do begin print_buffer(k) end; @y if startmatch_token+255)or(info(r)=end_match_token)or(info(r) if (cur_cs=0)and@| ((cur_chr=s)or(cur_chr=s-"a"+"A")) then begin store_new_token(cur_tok); flush_list(link(backup_head)); scan_keyword:=true; return; end else if (cur_cmd<>spacer)or(p<>backup_head) then begin back_input; if p<>backup_head then back_list(link(backup_head)); scan_keyword:=false; return; end; end; end; k:=str_start_macro(s); while k; @y def_code: @; XeTeX_def_code: begin scan_usv_num; if m=sf_code_base then begin scanned_result(ho(sf_code(cur_val) div @"10000))(int_val) end else if m=math_code_base then begin scanned_result(ho(math_code(cur_val)))(int_val) end else if m=math_code_base+1 then begin print_err("Can't use \XeTeXmathcode as a number (try \XeTeXmathcodenum)"); help2("\XeTeXmathcode is for setting a mathcode from separate values;")@/ ("use \XeTeXmathcodenum to access them as single values."); error; scanned_result(0)(int_val) end else if m=del_code_base then begin scanned_result(ho(del_code(cur_val)))(int_val) end else begin print_err("Can't use \XeTeXdelcode as a number (try \XeTeXdelcodenum)"); help2("\XeTeXdelcode is for setting a delcode from separate values;")@/ ("use \XeTeXdelcodenum to access them as single values."); error; scanned_result(0)(int_val); end; end; @z @x @ @= begin scan_char_num; @y @ @= begin scan_usv_num; @z @x if m=xord_code_base then scanned_result(xord[cur_val])(int_val) else if m=xchr_code_base then scanned_result(xchr[cur_val])(int_val) else if m=xprn_code_base then scanned_result(xprn[cur_val])(int_val) else if m=math_code_base then scanned_result(ho(math_code(cur_val)))(int_val) @y if m=math_code_base then begin cur_val1:=ho(math_code(cur_val)); if is_active_math_char(cur_val1) then cur_val1:=@"8000 else if (math_class_field(cur_val1)>7) or (math_fam_field(cur_val1)>15) or (math_char_field(cur_val1)>255) then begin print_err("Extended mathchar used as mathchar"); @.Bad mathchar@> help2("A mathchar number must be between 0 and ""7FFF.")@/ ("I changed this one to zero."); int_error(cur_val1); cur_val1:=0; end; cur_val1:=(math_class_field(cur_val1)*@"1000) + (math_fam_field(cur_val1)*@"100) + math_char_field(cur_val1); scanned_result(cur_val1)(int_val) end else if m=del_code_base then begin cur_val1:=del_code(cur_val); if cur_val1>=@"40000000 then begin print_err("Extended delcode used as delcode"); @.Bad delcode@> help2("A delimiter code must be between 0 and ""7FFFFFF.")@/ ("I changed this one to zero."); error; scanned_result(0)(int_val); end else begin scanned_result(cur_val1)(int_val); end end @z @x else if m= if m>=input_line_no_code then if m>=eTeX_glue then @@; else if m>=eTeX_dim then @y @= if m>=input_line_no_code then if m>=eTeX_glue then @@; else if m>=XeTeX_dim then @z @x procedure scan_eight_bit_int; begin scan_int; if (cur_val<0)or(cur_val>255) then begin print_err("Bad register code"); @.Bad register code@> help2("A register number must be between 0 and 255.")@/ @y procedure scan_char_class; begin scan_int; if (cur_val<0)or(cur_val>256) then begin print_err("Bad character class"); @.Bad character code@> help2("A character class must be between 0 and 256.")@/ ("I changed this one to zero."); int_error(cur_val); cur_val:=0; end; end; procedure scan_eight_bit_int; begin scan_int; if (cur_val<0)or(cur_val>255) then begin print_err("Bad register code"); @.Bad register code@> help2("A register code or char class must be between 0 and 255.")@/ @z @x procedure scan_char_num; begin scan_int; if (cur_val<0)or(cur_val>255) then @y procedure scan_usv_num; begin scan_int; if (cur_val<0)or(cur_val>@"10FFFF) then begin print_err("Bad USV code"); @.Bad character code@> help2("A Unicode Scalar Value must be between 0 and ""10FFFF.")@/ ("I changed this one to zero."); int_error(cur_val); cur_val:=0; end; end; procedure scan_char_num; begin scan_int; if (cur_val<0)or(cur_val>biggest_char) then @z @x help2("A character number must be between 0 and 255.")@/ @y help2("A character number must be between 0 and 65535.")@/ @z @x procedure scan_four_bit_int; @y procedure scan_xetex_math_char_int; begin scan_int; if is_active_math_char(cur_val) then begin if cur_val <> active_math_char then begin print_err("Bad active XeTeX math code"); help2("Since I ignore class and family for active math chars,")@/ ("I changed this one to ""1FFFFF."); int_error(cur_val); cur_val := active_math_char; end end else if math_char_field(cur_val) > @"10FFFF then begin print_err("Bad XeTeX math character code"); help2("Since I expected a character number between 0 and ""10FFFF,")@/ ("I changed this one to zero."); int_error(cur_val); cur_val:=0; end; end; procedure scan_math_class_int; begin scan_int; if (cur_val<0)or(cur_val>7) then begin print_err("Bad math class"); @.Bad number@> help2("Since I expected to read a number between 0 and 7,")@/ ("I changed this one to zero."); int_error(cur_val); cur_val:=0; end; end; procedure scan_math_fam_int; begin scan_int; if (cur_val<0)or(cur_val>number_math_families-1) then begin print_err("Bad math family"); @.Bad number@> help2("Since I expected to read a number between 0 and 255,")@/ ("I changed this one to zero."); int_error(cur_val); cur_val:=0; end; end; procedure scan_four_bit_int; @z @x procedure scan_twenty_seven_bit_int; begin scan_int; if (cur_val<0)or(cur_val>@'777777777) then begin print_err("Bad delimiter code"); @.Bad delimiter code@> help2("A numeric delimiter code must be between 0 and 2^{27}-1.")@/ ("I changed this one to zero."); int_error(cur_val); cur_val:=0; end; end; @y procedure scan_delimiter_int; begin scan_int; if (cur_val<0)or(cur_val>@'777777777) then begin print_err("Bad delimiter code"); @.Bad delimiter code@> help2("A numeric delimiter code must be between 0 and 2^{27}-1.")@/ ("I changed this one to zero."); int_error(cur_val); cur_val:=0; end; end; @z @x if cur_val>255 then @y if cur_val>biggest_usv then @z @x @p procedure scan_dimen(@!mu,@!inf,@!shortcut:boolean); @y @p procedure xetex_scan_dimen(@!mu,@!inf,@!shortcut,@!requires_units:boolean); @z @x @; @; @y if requires_units then begin @; @; end else begin if cur_val>=@'40000 then arith_error:=true else cur_val:=cur_val*unity+f; end; @z @x @ @= @y procedure scan_dimen(@!mu,@!inf,@!shortcut:boolean); begin xetex_scan_dimen(mu,inf,shortcut,true); end; @ For XeTeX, we have an additional version |scan_decimal|, like |scan_dimen| but without any scanning of units. @p procedure scan_decimal; {sets |cur_val| to a quantity expressed as a decimal fraction} begin xetex_scan_dimen(false, false, false, false); end; @ @= @z @x @d etex_convert_base=5 {base for \eTeX's command codes} @d eTeX_revision_code=etex_convert_base {command code for \.{\\eTeXrevision}} @d etex_convert_codes=etex_convert_base+1 {end of \eTeX's command codes} @y @d etex_convert_base=5 {base for \eTeX's command codes} @d eTeX_revision_code=etex_convert_base {command code for \.{\\eTeXrevision}} @d XeTeX_revision_code=6 @d XeTeX_variation_name_code=7 { must match codes in xetexmac.c } @d XeTeX_feature_name_code=8 @d XeTeX_selector_name_code=9 @d XeTeX_glyph_name_code=10 @d etex_convert_codes=XeTeX_glyph_name_code+1 {end of \eTeX's command codes} @z @x eTeX_revision_code: print_esc("eTeXrevision"); @y @/@@/ @z @x @!c:number_code..job_name_code; {desired type of conversion} @y @!c:small_number; {desired type of conversion} @z @x @!b:pool_pointer; {base of temporary string} @y @!b:pool_pointer; {base of temporary string} @!fnt,@!arg1,@!arg2:integer; {args for \XeTeX\ extensions} @!font_name_str:str_number; {local vars for \.{\\fontname} quoting extension} @!i:small_number; @!quote_char:UTF16_code; @z @x eTeX_revision_code: do_nothing; @y @/@@/ @z @x font_name_code: begin print(font_name[cur_val]); @y font_name_code: begin font_name_str:=font_name[cur_val]; if is_native_font(cur_val) then begin quote_char:=""""; for i:=0 to length(font_name_str) - 1 do if str_pool[str_start_macro(font_name_str) + i] = """" then quote_char:="'"; print_char(quote_char); print(font_name_str); print_char(quote_char); end else print(font_name_str); @z @x eTeX_revision_code: print(eTeX_revision); @y @/@@/ @z @x job_name_code: print(job_name); @y job_name_code: print_file_name(job_name, 0, 0); @z @x @!read_file:array[0..15] of alpha_file; {used for \.{\\read}} @y @!read_file:array[0..15] of unicode_file; {used for \.{\\read}} @z @x else begin a_close(read_file[m]); read_open[m]:=closed; @y else begin u_close(read_file[m]); read_open[m]:=closed; @z @x begin a_close(read_file[m]); read_open[m]:=closed; @y begin u_close(read_file[m]); read_open[m]:=closed; @z @x if (cur_cmd>active_char)or(cur_chr>255) then {not a character} begin m:=relax; n:=256; @y if (cur_cmd>active_char)or(cur_chr>biggest_usv) then {not a character} begin m:=relax; n:=too_big_usv; @z @x if (cur_cmd>active_char)or(cur_chr>255) then begin cur_cmd:=relax; cur_chr:=256; @y if (cur_cmd>active_char)or(cur_chr>biggest_usv) then begin cur_cmd:=relax; cur_chr:=too_big_usv; @z @x @* \[29] File names. @y @* \[29] File names. @z @x The following procedures don't allow spaces to be part of file names; but some users seem to like names that are spaced-out. System-dependent changes to allow such things should probably be made with reluctance, and only when an entire file name that includes spaces is ``quoted'' somehow. @y @z @x @!ext_delimiter:pool_pointer; {the most recent `\..', if any} @y @!ext_delimiter:pool_pointer; {the most recent `\..', if any} @!file_name_quote_char:UTF16_code; @z @x begin area_delimiter:=0; ext_delimiter:=0; quoted_filename:=false; @y begin area_delimiter:=0; ext_delimiter:=0; quoted_filename:=false; file_name_quote_char:=0; @z @x @p function more_name(@!c:ASCII_code):boolean; begin if (c=" ") and stop_at_space and (not quoted_filename) then more_name:=false else if c="""" then begin quoted_filename:=not quoted_filename; more_name:=true; end @y @p function more_name(@!c:ASCII_code):boolean; begin if stop_at_space and (c=" ") and (file_name_quote_char=0) then more_name:=false else if stop_at_space and (file_name_quote_char<>0) and (c=file_name_quote_char) then begin file_name_quote_char:=0; more_name:=true; end else if stop_at_space and (file_name_quote_char=0) and ((c="""") or (c="'") or (c="(")) then begin if c="(" then file_name_quote_char:=")" else file_name_quote_char:=c; quoted_filename:=true; more_name:=true; end @z @x @p procedure end_name; var temp_str: str_number; {result of file name cache lookups} @!j,@!s,@!t: pool_pointer; {running indices} @!must_quote:boolean; {whether we need to quote a string} begin if str_ptr+3>max_strings then overflow("number of strings",max_strings-init_str_ptr); @:TeX capacity exceeded number of strings}{\quad number of strings@> str_room(6); {Room for quotes, if needed.} {add quotes if needed} if area_delimiter<>0 then begin {maybe quote |cur_area|} must_quote:=false; s:=str_start[str_ptr]; t:=str_start[str_ptr]+area_delimiter; j:=s; while (not must_quote) and (j0 then ext_delimiter:=ext_delimiter+2; area_delimiter:=area_delimiter+2; pool_ptr:=pool_ptr+2; end; end; {maybe quote |cur_name|} s:=str_start[str_ptr]+area_delimiter; if ext_delimiter=0 then t:=pool_ptr else t:=str_start[str_ptr]+ext_delimiter-1; must_quote:=false; j:=s; while (not must_quote) and (j0 then ext_delimiter:=ext_delimiter+2; pool_ptr:=pool_ptr+2; end; if ext_delimiter<>0 then begin {maybe quote |cur_ext|} s:=str_start[str_ptr]+ext_delimiter-1; t:=pool_ptr; must_quote:=false; j:=s; while (not must_quote) and (jmax_strings then overflow("number of strings",max_strings-init_str_ptr); @:TeX capacity exceeded number of strings}{\quad number of strings@> @z @x str_start[str_ptr+1]:=str_start[str_ptr]+area_delimiter; incr(str_ptr); @y str_start_macro(str_ptr+1):=str_start_macro(str_ptr)+area_delimiter; incr(str_ptr); @z @x for j:=str_start[str_ptr+1] to pool_ptr-1 do @y for j:=str_start_macro(str_ptr+1) to pool_ptr-1 do @z @x str_start[str_ptr+1]:=str_start[str_ptr]+ext_delimiter-area_delimiter-1; @y str_start_macro(str_ptr+1):=str_start_macro(str_ptr)+ext_delimiter-area_delimiter-1; @z @x for j:=str_start[str_ptr+1] to pool_ptr-1 do @y for j:=str_start_macro(str_ptr+1) to pool_ptr-1 do @z @x procedure print_file_name(@!n,@!a,@!e:integer); var must_quote: boolean; {whether to quote the filename} @!j:pool_pointer; {index into |str_pool|} begin must_quote:=false; if a<>0 then begin j:=str_start[a]; while (not must_quote) and (j0 then begin j:=str_start[n]; while (not must_quote) and (j0 then begin j:=str_start[e]; while (not must_quote) and (j0)and(|str_pool|[|str_start|[|a|]]=""""))or ((|n|<>0)and(|str_pool|[|str_start|[|n|]]=""""))or ((|e|<>0)and(|str_pool|[|str_start|[|e|]]=""""));} if must_quote then print_char(""""); if a<>0 then for j:=str_start[a] to str_start[a+1]-1 do if so(str_pool[j])<>"""" then print(so(str_pool[j])); if n<>0 then for j:=str_start[n] to str_start[n+1]-1 do if so(str_pool[j])<>"""" then print(so(str_pool[j])); if e<>0 then for j:=str_start[e] to str_start[e+1]-1 do if so(str_pool[j])<>"""" then print(so(str_pool[j])); if must_quote then print_char(""""); end; @y procedure print_file_name(@!n,@!a,@!e:integer); var @!must_quote: boolean; {whether to quote the filename} @!quote_char: integer; {current quote char (single or double)} @!j:pool_pointer; {index into |str_pool|} begin must_quote:=false; quote_char:=0; if a<>0 then begin j:=str_start_macro(a); while ((not must_quote) or (quote_char=0)) and (j0 then begin j:=str_start_macro(n); while ((not must_quote) or (quote_char=0)) and (j0 then begin j:=str_start_macro(e); while ((not must_quote) or (quote_char=0)) and (j0 then for j:=str_start_macro(a) to str_start_macro(a+1)-1 do begin if str_pool[j]=quote_char then begin print(quote_char); quote_char:="""" + "'" - quote_char; print(quote_char); end; print(str_pool[j]); end; if n<>0 then for j:=str_start_macro(n) to str_start_macro(n+1)-1 do begin if str_pool[j]=quote_char then begin print(quote_char); quote_char:="""" + "'" - quote_char; print(quote_char); end; print(str_pool[j]); end; if e<>0 then for j:=str_start_macro(e) to str_start_macro(e+1)-1 do begin if str_pool[j]=quote_char then begin print(quote_char); quote_char:="""" + "'" - quote_char; print(quote_char); end; print(str_pool[j]); end; if quote_char<>0 then print_char(quote_char); end; @z @x @d append_to_name(#)==begin c:=#; if not (c="""") then begin incr(k); if k<=file_name_size then name_of_file[k]:=xchr[c]; end end @y @d append_to_name(#)==begin c:=#; incr(k); if k<=file_name_size then begin if (c < 128) then name_of_file[k]:=c else if (c < @"800) then begin name_of_file[k]:=@"C0 + c div @"40; incr(k); name_of_file[k]:=@"80 + c mod @"40; end else begin name_of_file[k]:=@"E0 + c div @"1000; incr(k); name_of_file[k]:=@"80 + (c mod @"1000) div @"40; incr(k); name_of_file[k]:=@"80 + (c mod @"1000) mod @"40; end end end @z @x name_of_file:= xmalloc_array (ASCII_code, length(a)+length(n)+length(e)+1); for j:=str_start[a] to str_start[a+1]-1 do append_to_name(so(str_pool[j])); for j:=str_start[n] to str_start[n+1]-1 do append_to_name(so(str_pool[j])); for j:=str_start[e] to str_start[e+1]-1 do append_to_name(so(str_pool[j])); @y name_of_file:= xmalloc_array (UTF8_code, (length(a)+length(n)+length(e))*3+1); for j:=str_start_macro(a) to str_start_macro(a+1)-1 do append_to_name(so(str_pool[j])); for j:=str_start_macro(n) to str_start_macro(n+1)-1 do append_to_name(so(str_pool[j])); for j:=str_start_macro(e) to str_start_macro(e+1)-1 do append_to_name(so(str_pool[j])); @z @x name_of_file := xmalloc_array (ASCII_code, n+(b-a+1)+format_ext_length+1); for j:=1 to n do append_to_name(xord[ucharcast(TEX_format_default[j])]); @y name_of_file := xmalloc_array (UTF8_code, n+(b-a+1)+format_ext_length+1); for j:=1 to n do append_to_name(TEX_format_default[j]); @z @x append_to_name(xord[ucharcast(TEX_format_default[j])]); @y append_to_name(TEX_format_default[j]); @z @x @p function make_name_string:str_number; var k:1..file_name_size; {index into |name_of_file|} save_area_delimiter, save_ext_delimiter: pool_pointer; save_name_in_progress, save_stop_at_space: boolean; begin if (pool_ptr+name_length>pool_size)or(str_ptr=max_strings)or (cur_length>0) then make_name_string:="?" else begin for k:=1 to name_length do append_char(xord[name_of_file[k]]); make_name_string:=make_string; {At this point we also set |cur_name|, |cur_ext|, and |cur_area| to match the contents of |name_of_file|.} save_area_delimiter:=area_delimiter; save_ext_delimiter:=ext_delimiter; save_name_in_progress:=name_in_progress; save_stop_at_space:=stop_at_space; name_in_progress:=true; begin_name; stop_at_space:=false; k:=1; while (k<=name_length)and(more_name(name_of_file[k])) do incr(k); stop_at_space:=save_stop_at_space; end_name; name_in_progress:=save_name_in_progress; area_delimiter:=save_area_delimiter; ext_delimiter:=save_ext_delimiter; end; end; @y @p function make_name_string:str_number; var k:0..file_name_size; {index into |name_of_file|} save_area_delimiter, save_ext_delimiter: pool_pointer; save_name_in_progress, save_stop_at_space: boolean; begin if (pool_ptr+name_length>pool_size)or(str_ptr=max_strings)or (cur_length>0) then make_name_string:="?" else begin make_utf16_name; for k:=0 to name_length16-1 do append_char(name_of_file16[k]); make_name_string:=make_string; {At this point we also set |cur_name|, |cur_ext|, and |cur_area| to match the contents of |name_of_file|.} save_area_delimiter:=area_delimiter; save_ext_delimiter:=ext_delimiter; save_name_in_progress:=name_in_progress; save_stop_at_space:=stop_at_space; name_in_progress:=true; begin_name; stop_at_space:=false; k:=0; while (kother_char)or(cur_chr>255) then {not a character} @y loop@+begin if (cur_cmd>other_char)or(cur_chr>biggest_char) then {not a character} @z @x {If |cur_chr| is a space and we're not scanning a token list, check whether we're at the end of the buffer. Otherwise we end up adding spurious spaces to file names in some cases.} if (cur_chr=" ") and (state<>token_list) and (loc>limit) then goto done; @y @z @x pack_job_name(".dvi"); while not b_open_out(dvi_file) do prompt_file_name("file name for output",".dvi"); @y pack_job_name(output_file_extension); while not dvi_open_out(dvi_file) do prompt_file_name("file name for output",output_file_extension); @z @x @!dvi_file: byte_file; {the device-independent output goes here} @y @!output_file_extension: str_number; @!no_pdf_output: boolean; @!dvi_file: byte_file; {the device-independent output goes here} @z @x @ @=output_file_name:=0; @y @ @= output_file_name:=0; if no_pdf_output then output_file_extension:=".xdv" else output_file_extension:=".pdf"; @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 if kpse_in_name_ok(stringcast(name_of_file+1)) and a_open_in(cur_file, kpse_tex_format) then goto done; @y if kpse_in_name_ok(stringcast(name_of_file+1)) and u_open_in(cur_file, kpse_tex_format, XeTeX_default_input_mode, XeTeX_default_input_encoding) then {At this point |name_of_file| contains the actual name found, as a UTF8 string. We convert to UTF16, then extract the |cur_area|, |cur_name|, and |cur_ext| from it.} begin make_utf16_name; name_in_progress:=true; begin_name; stop_at_space:=false; k:=0; while (k0 then begin begin_diagnostic; print_nl("Requested font """); print_c_string(stringcast(name_of_file+1)); print('"'); if s < 0 then begin print(" scaled "); print_int(-s); end else begin print(" at "); print_scaled(s); print("pt"); end; end_diagnostic(false); end; if quoted_filename then begin { quoted name, so try for a native font } g:=load_native_font(u,nom,aire,s); if g<>null_font then goto done; end; { it was an unquoted name, or not found as an installed font, so try for a TFM file } @; @y if g<>null_font then goto done; if not quoted_filename then begin { we failed to find a TFM file, so try for a native font } g:=load_native_font(u,nom,aire,s); if g<>null_font then goto done end; bad_tfm: if suppress_fontnotfound_error=0 then begin @; end; @z @x done: if file_opened then b_close(tfm_file); @y done: if file_opened then b_close(tfm_file); if XeTeX_tracing_fonts_state>0 then begin if g=null_font then begin begin_diagnostic; print_nl(" -> font not found, using ""nullfont"""); end_diagnostic(false); end else if file_opened then begin begin_diagnostic; print_nl(" -> "); print_c_string(stringcast(name_of_file+1)); end_diagnostic(false); end; end; @z @x @d start_font_error_message==print_err("Font "); sprint_cs(u); print_char("="); print_file_name(nom,aire,""); @y @d start_font_error_message==print_err("Font "); sprint_cs(u); print_char("="); if file_name_quote_char=")" then print_char("(") else if file_name_quote_char<>0 then print_char(file_name_quote_char); print_file_name(nom,aire,cur_ext); if file_name_quote_char<>0 then print_char(file_name_quote_char); @z @x else print(" not loadable: Metric (TFM) file not found"); @y else print(" not loadable: Metric (TFM) file or installed font not found"); @z @x @ @= @; @y @ @= @; @z @x @ @y @; end @z @x @ @= file_opened:=false; @y @ @= @z @x if not b_open_in(tfm_file) then abort; file_opened:=true @y check_for_tfm_font_mapping; if b_open_in(tfm_file) then begin file_opened:=true @z @x fmem_ptr:=fmem_ptr+lf; font_ptr:=f; g:=f; goto done @y fmem_ptr:=fmem_ptr+lf; font_ptr:=f; g:=f; font_mapping[f]:=load_tfm_font_mapping; goto done @z @x @ When \TeX\ wants to typeset a character that doesn't exist, the character node is not created; thus the output routine can assume that characters exist when it sees them. The following procedure prints a warning message unless the user has suppressed it. @p procedure char_warning(@!f:internal_font_number;@!c:eight_bits); var old_setting: integer; {saved value of |tracing_online|} begin if tracing_lost_chars>0 then begin old_setting:=tracing_online; if eTeX_ex and(tracing_lost_chars>1) then tracing_online:=1; begin begin_diagnostic; print_nl("Missing character: There is no "); @.Missing character@> print_ASCII(c); print(" in font "); slow_print(font_name[f]); print_char("!"); end_diagnostic(false); end; tracing_online:=old_setting; end; end; @y @ Procedure |char_warning| has been moved in the source. @z @x @p function new_character(@!f:internal_font_number;@!c:eight_bits):pointer; @y @p function new_character(@!f:internal_font_number;@!c:ASCII_code):pointer; @z @x begin ec:=effective_char(false,f,qi(c)); @y begin if is_native_font(f) then begin new_character:=new_native_character(f,c); return; end; ec:=effective_char(false,f,qi(c)); @z @x @* \[31] Device-independent file format. @y @* \[31] Device-independent file format. @z @x \yskip\noindent Commands 250--255 are undefined at the present time. @y \yskip\hang|set_glyph_string| 254 w[4] k[2] x[4k] g[2k]. \yskip\hang|set_glyph_array| 253 w[4] k[2] xy[8k] g[2k] \yskip\hang|define_native_font| 252 k[4] s[4] flags[2] lenps[1] lenfam[1] lensty[1] ps[lenps] fam[lenfam] sty[lensty] if (flags AND COLORED): rgba[4] if (flags AND VARIATIONS): numvars[2] axes[4nv] values[4nv] if (flags AND MATRIX): ta[4] tb[4] tc[4] td[4] tx[4] ty[4] \yskip\hang|pic_file| 251 flags[1] t[4][6] p[2] len[2] path[l] flags = 0 for raster image, 1 for PDF t is transform matrix p is page \# from the graphic file (0-based) len is length of pathname path is pathname of graphic file \yskip\noindent Commands 250 and 255 are undefined at the present time (but 255 is used by pTeX). @z @x @d post_post=249 {postamble ending} @y @d post_post=249 {postamble ending} @d set_glyph_string=254 {sequence of glyphs, all at the current y-position} @d set_glyph_array=253 {sequence of glyphs with individual x-y coordinates} @d define_native_font=252 {define native font} @d pic_file=251 {embed picture or PDF} @z @x @d id_byte=2 {identifies the kind of \.{DVI} files described here} @y XeTeX changes the DVI version to 5, as we have new DVI opcodes like |set_glyph_array| for native font text; I used version 3 in an earlier extension of TeX, and 4 in pre-1.0 XeTeX releases using Mac OS-specific data types. @d id_byte=5 {identifies the kind of \.{DVI} files described here} @z @x @* \[32] Shipping pages out. @y @* \[32] Shipping pages out. @z @x @ A mild optimization of the output is performed by the |dvi_pop| @y procedure dvi_two(s: UTF16_code); begin dvi_out(s div @'400); dvi_out(s mod @'400); end; @ A mild optimization of the output is performed by the |dvi_pop| @z @x @p procedure dvi_font_def(@!f:internal_font_number); @y @p procedure dvi_native_font_def(@!f:internal_font_number); var font_def_length, i: integer; begin dvi_out(define_native_font); dvi_four(f-font_base-1); font_def_length := make_font_def(f); for i := 0 to font_def_length - 1 do dvi_out(xdv_buffer[i]); end; procedure dvi_font_def(@!f:internal_font_number); @z @x var k:pool_pointer; {index into |str_pool|} @y var k:pool_pointer; {index into |str_pool|} l:integer; {length of name without mapping option} @z @x begin if f<=256+font_base then @y begin if is_native_font(f) then dvi_native_font_def(f) else begin if f<=256+font_base then @z @x dvi_out(length(font_name[f])); @; @y l:=0; k:=str_start_macro(font_name[f]); {search for colon; we will truncate the name there} while (l=0) and (k= for k:=str_start[font_area[f]] to str_start[font_area[f]+1]-1 do dvi_out(so(str_pool[k])); for k:=str_start[font_name[f]] to str_start[font_name[f]+1]-1 do dvi_out(so(str_pool[k])) @y @ @= for k:=str_start_macro(font_area[f]) to str_start_macro(font_area[f]+1)-1 do dvi_out(so(str_pool[k])); for k:=str_start_macro(font_name[f]) to str_start_macro(font_name[f]+1)-1 do dvi_out(so(str_pool[k])) @z @x @ @= dvi_h:=0; dvi_v:=0; cur_h:=h_offset; dvi_f:=null_font; @y @ @= dvi_h:=0; dvi_v:=0; cur_h:=h_offset; dvi_f:=null_font; @; @z @x print(" TeX output "); print_int(year); print_char("."); @y print(" XeTeX output "); print_int(year); print_char("."); @z @x for s:=str_start[str_ptr] to pool_ptr-1 do dvi_out(so(str_pool[s])); pool_ptr:=str_start[str_ptr]; {flush the current string} @y for s:=str_start_macro(str_ptr) to pool_ptr-1 do dvi_out(so(str_pool[s])); pool_ptr:=str_start_macro(str_ptr); {flush the current string} @z @x @d next_p=15 {go to this label when finished with node |p|} @y @d next_p=15 {go to this label when finished with node |p|} @d check_next=1236 @d end_node_run=1237 @z @x label reswitch, move_past, fin_rule, next_p, continue, found; @y label reswitch, move_past, fin_rule, next_p, continue, found, check_next, end_node_run; @z @x @!prev_p:pointer; {one step behind |p|} @y @!prev_p:pointer; {one step behind |p|} @!len: integer; { length of scratch string for native word output } @!q,@!r: pointer; @!k,@!j: integer; @z @x g_sign:=glue_sign(this_box); p:=list_ptr(this_box); @y g_sign:=glue_sign(this_box); @; p:=list_ptr(this_box); @z @x @ We ought to give special care to the efficiency of one part of |hlist_out|, @y @ Extra stuff for justifiable AAT text; need to merge runs of words and normal spaces. @d is_native_word_node(#) == ((not is_char_node(#)) and (type(#) = whatsit_node) and (subtype(#) = native_word_node)) @= p := list_ptr(this_box); prev_p := this_box+list_offset; while p<>null do begin if link(p) <> null then begin {not worth looking ahead at the end} if is_native_word_node(p) and (font_area[native_font(p)] = aat_font_flag) and (font_letter_space[native_font(p)] = 0) then begin {got a word in an AAT font, might be the start of a run} r := p; {|r| is start of possible run} k := native_length(r); q := link(p); check_next: @; if (q <> null) and not is_char_node(q) then begin if (type(q) = glue_node) and (subtype(q) = normal) and (glue_ptr(q) = font_glue[native_font(r)]) then begin {found a normal space; if the next node is another word in the same font, we'll merge} q := link(q); @; if (q <> null) and is_native_word_node(q) and (native_font(q) = native_font(r)) then begin p := q; {record new tail of run in |p|} k := k + 1 + native_length(q); q := link(q); goto check_next; end; goto end_node_run; end; {@@;} if (q <> null) and is_native_word_node(q) and (native_font(q) = native_font(r)) then begin p := q; {record new tail of run in |p|} q := link(q); goto check_next; end end; end_node_run: {now |r| points to first |native_word_node| of the run, and |p| to the last} if p <> r then begin {merge nodes from |r| to |p| inclusive; total text length is |k|} str_room(k); k := 0; {now we'll use this as accumulator for total width} q := r; loop begin if type(q) = whatsit_node then begin if subtype(q) = native_word_node then begin for j := 0 to native_length(q)-1 do append_char(get_native_char(q, j)); k := k + width(q); end end else if type(q) = glue_node then begin append_char(" "); g := glue_ptr(q); k := k + width(g); if g_sign <> normal then begin if g_sign = stretching then begin if stretch_order(g) = g_order then begin k := k + round(float(glue_set(this_box)) * stretch(g)) end end else begin if shrink_order(g) = g_order then begin k := k - round(float(glue_set(this_box)) * shrink(g)) end end end end; {discretionary and deleted nodes can be discarded here} if q = p then break else q := link(q); end; done: q := new_native_word_node(native_font(r), cur_length); link(prev_p) := q; for j := 0 to cur_length - 1 do set_native_char(q, j, str_pool[str_start_macro(str_ptr) + j]); link(q) := link(p); link(p) := null; flush_node_list(r); width(q) := k; set_justified_native_glyphs(q); p := q; pool_ptr := str_start_macro(str_ptr); {flush the temporary string data} end end; prev_p := p; end; p := link(p); end @ @= while (q <> null) and (not is_char_node(q)) and (type(q) = disc_node) do q := link(q) @ We ought to give special care to the efficiency of one part of |hlist_out|, @z @x repeat f:=font(p); c:=character(p); @y repeat f:=font(p); c:=character(p); if (p<>lig_trick) and (font_mapping[f]<>nil) then c:=apply_tfm_font_mapping(font_mapping[f],c); @z @x @p procedure vlist_out; {output a |vlist_node| box} @y @p procedure vlist_out; {output a |vlist_node| box} @z @x @!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio} begin cur_g:=0; cur_glue:=float_constant(0); this_box:=temp_ptr; g_order:=glue_order(this_box); g_sign:=glue_sign(this_box); p:=list_ptr(this_box); incr(cur_s); if cur_s>0 then dvi_out(push); if cur_s>max_push then max_push:=cur_s; save_loc:=dvi_offset+dvi_ptr; left_edge:=cur_h; cur_v:=cur_v-height(this_box); @y @!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio} @!upwards:boolean; {whether we're stacking upwards} begin cur_g:=0; cur_glue:=float_constant(0); this_box:=temp_ptr; g_order:=glue_order(this_box); g_sign:=glue_sign(this_box); p:=list_ptr(this_box); upwards:=(subtype(this_box)=min_quarterword+1); incr(cur_s); if cur_s>0 then dvi_out(push); if cur_s>max_push then max_push:=cur_s; save_loc:=dvi_offset+dvi_ptr; left_edge:=cur_h; if upwards then cur_v:=cur_v+depth(this_box) else cur_v:=cur_v-height(this_box); @z @x kern_node:cur_v:=cur_v+width(p); @y kern_node:if upwards then cur_v:=cur_v-width(p) else cur_v:=cur_v+width(p); @z @x move_past: cur_v:=cur_v+rule_ht; @y move_past: if upwards then cur_v:=cur_v-rule_ht else cur_v:=cur_v+rule_ht; @z @x @= if list_ptr(p)=null then cur_v:=cur_v+height(p)+depth(p) @y @= if list_ptr(p)=null then begin if upwards then cur_v:=cur_v-depth(p)-height(p) else cur_v:=cur_v+height(p)+depth(p); end @z @x else begin cur_v:=cur_v+height(p); synch_v; save_h:=dvi_h; save_v:=dvi_v; if cur_dir=right_to_left then cur_h:=left_edge-shift_amount(p) else cur_h:=left_edge+shift_amount(p); {shift the box right} temp_ptr:=p; if type(p)=vlist_node then vlist_out@+else hlist_out; dvi_h:=save_h; dvi_v:=save_v; cur_v:=save_v+depth(p); cur_h:=left_edge; end @y else begin if upwards then cur_v:=cur_v-depth(p) else cur_v:=cur_v+height(p); synch_v; save_h:=dvi_h; save_v:=dvi_v; if cur_dir=right_to_left then cur_h:=left_edge-shift_amount(p) else cur_h:=left_edge+shift_amount(p); {shift the box right} temp_ptr:=p; if type(p)=vlist_node then vlist_out@+else hlist_out; dvi_h:=save_h; dvi_v:=save_v; if upwards then cur_v:=save_v-height(p) else cur_v:=save_v+depth(p); cur_h:=left_edge; end @z @x cur_v:=cur_v+rule_ht; @y if upwards then cur_v:=cur_v-rule_ht else cur_v:=cur_v+rule_ht; @z @x begin if tracing_output>0 then @y begin if job_name=0 then open_log_file; if tracing_output>0 then @z @x dvi_four(last_bop); last_bop:=page_loc; @y dvi_four(last_bop); last_bop:=page_loc; { generate a pagesize special at start of page } old_setting:=selector; selector:=new_string; print("pdf:pagesize "); if (pdf_page_width > 0) and (pdf_page_height > 0) then begin print("width"); print(" "); print_scaled(pdf_page_width); print("pt"); print(" "); print("height"); print(" "); print_scaled(pdf_page_height); print("pt"); end else print("default"); selector:=old_setting; dvi_out(xxx1); dvi_out(cur_length); for s:=str_start_macro(str_ptr) to pool_ptr-1 do dvi_out(so(str_pool[s])); pool_ptr:=str_start_macro(str_ptr); {erase the string} @z @x cur_v:=height(p)+v_offset; temp_ptr:=p; @y cur_v:=height(p)+v_offset; { does this need changing for upwards mode ???? } temp_ptr:=p; @z @x dvi_out(eop); incr(total_pages); cur_s:=-1; @y dvi_out(eop); incr(total_pages); cur_s:=-1; if not no_pdf_output then fflush(dvi_file); @z @x print_nl("Output written on "); print_file_name(0, output_file_name, 0); @.Output written on x@> print(" ("); print_int(total_pages); if total_pages<>1 then print(" pages") else print(" page"); print(", "); print_int(dvi_offset+dvi_ptr); print(" bytes)."); b_close(dvi_file); @y k:=dvi_close(dvi_file); if k=0 then begin print_nl("Output written on "); print(output_file_name); @.Output written on x@> print(" ("); print_int(total_pages); if total_pages<>1 then print(" pages") else print(" page"); if no_pdf_output then begin print(", "); print_int(dvi_offset+dvi_ptr); print(" bytes)."); end else print(")."); end else begin print_nl("Error "); print_int(k); print(" ("); if no_pdf_output then print_c_string(strerror(k)) else print("driver return code"); print(") generating output;"); print_nl("file "); print(output_file_name); print(" may not be valid."); end; @z @x @* \[33] Packaging. @y @* \[33] Packaging. @z @x @p function hpack(@!p:pointer;@!w:scaled;@!m:small_number):pointer; label reswitch, common_ending, exit; @y @p function hpack(@!p:pointer;@!w:scaled;@!m:small_number):pointer; label reswitch, common_ending, exit, restart; @z @x @!hd:eight_bits; {height and depth indices for a character} @y @!hd:eight_bits; {height and depth indices for a character} @!pp,@!ppp: pointer; @!total_chars, @!k: integer; @z @x p:=lig_trick; goto reswitch; @y p:=lig_trick; xtx_ligature_present:=true; goto reswitch; @z @x @d vpack(#)==vpackage(#,max_dimen) {special case of unconstrained depth} @y @d vpack(#)==vpackage(#,max_dimen) {special case of unconstrained depth} @z @x subtype(r):=min_quarterword; shift_amount(r):=0; @y if XeTeX_upwards then subtype(r):=min_quarterword+1 else subtype(r):=min_quarterword; shift_amount(r):=0; @z @x @p procedure append_to_vlist(@!b:pointer); var d:scaled; {deficiency of space between baselines} @!p:pointer; {a new glue node} begin if prev_depth>ignore_depth then begin d:=width(baseline_skip)-prev_depth-height(b); if dignore_depth then begin if upwards then d:=width(baseline_skip)-prev_depth-depth(b) else d:=width(baseline_skip)-prev_depth-height(b); if d=h) or no_extenders; {assemble box using |n| copies of each extender, with appropriate glue wherever an overlap occurs} prev_o:=0; for i:=0 to ot_part_count(a)-1 do begin if ot_part_is_extender(a, i) then begin for j:=1 to n do begin o:=ot_part_start_connector(f, a, i); if prev_o0 then stack_glue_into_box(b, -oo, -o); g:=ot_part_glyph(a, i); stack_glyph_into_box(b, f, g); prev_o:=ot_part_end_connector(f, a, i); end end else begin o:=ot_part_start_connector(f, a, i); if prev_o0 then stack_glue_into_box(b, -oo, -o); g:=ot_part_glyph(a, i); stack_glyph_into_box(b, f, g); prev_o:=ot_part_end_connector(f, a, i); end; end; {find natural height and total stretch of the box} p:=list_ptr(b); nat:=0; str:=0; while p<>null do begin if type(p)=whatsit_node then nat:=nat+height(p)+depth(p) else if type(p)=glue_node then begin nat:=nat+width(glue_ptr(p)); str:=str+stretch(glue_ptr(p)); end; p:=link(p); end; {set glue so as to stretch the connections if needed} depth(b):=0; if (h>nat) and (str>0) then begin glue_order(b):=normal; glue_sign(b):=stretching; glue_set(b):=unfloat((h-nat)/str); height(b):=nat+round(str*float(glue_set(b))); end else height(b):=nat; build_opentype_assembly:=b; end; function var_delimiter(@!d:pointer;@!s:integer;@!v:scaled):pointer; label found,continue; var b:pointer; {the box that will be constructed} ot_assembly_ptr:void_pointer; @z @x @!z: small_number; {runs through font family members} @y @!z: integer; {runs through font family members} @z @x loop@+ begin @; if large_attempt then goto found; {there were none large enough} large_attempt:=true; z:=large_fam(d); x:=large_char(d); end; found: if f<>null_font then @ else begin b:=new_null_box; width(b):=null_delimiter_space; {use this width if no delimiter was found} end; @y ot_assembly_ptr:=nil; loop@+ begin @; if large_attempt then goto found; {there were none large enough} large_attempt:=true; z:=large_fam(d); x:=large_char(d); end; found: if f<>null_font then begin if not is_ot_font(f) then @ else begin {for OT fonts, c is the glyph ID to use} if ot_assembly_ptr<>nil then b:=build_opentype_assembly(f, ot_assembly_ptr, v) else begin b:=new_null_box; type(b):=vlist_node; list_ptr(b):=get_node(glyph_node_size); type(list_ptr(b)):=whatsit_node; subtype(list_ptr(b)):=glyph_node; native_font(list_ptr(b)):=f; native_glyph(list_ptr(b)):=c; set_native_glyph_metrics(list_ptr(b), 1); width(b):=width(list_ptr(b)); height(b):=height(list_ptr(b)); depth(b):=depth(list_ptr(b)); end end end else begin b:=new_null_box; width(b):=null_delimiter_space; {use this width if no delimiter was found} end; @z @x begin z:=z+s+16; repeat z:=z-16; g:=fam_fnt(z); @y begin z:=z+s+script_size; repeat z:=z-script_size; g:=fam_fnt(z); @z @x until z<16; @y until z= @y @ @= if is_ot_font(g) then begin b:=new_native_character(g, x); x:=get_native_glyph(b, 0); free_node(b, native_size(b)); f:=g; c:=x; w:=0; n:=0; repeat y:=get_ot_math_variant(g, x, n, addressof(u), 0); if u>w then begin c:=y; w:=u; if u>=v then goto found; end; n:=n+1; until u<0; {if we get here, then we didn't find a big enough glyph; check if the char is extensible} ot_assembly_ptr:=get_ot_assembly_ptr(g, x, 0); if ot_assembly_ptr<>nil then goto found; end else @z @x function char_box(@!f:internal_font_number;@!c:quarterword):pointer; var q:four_quarters; @!hd:eight_bits; {|height_depth| byte} @!b,@!p:pointer; {the new box and its character node} begin q:=char_info(f)(c); hd:=height_depth(q); b:=new_null_box; width(b):=char_width(f)(q)+char_italic(f)(q); height(b):=char_height(f)(hd); depth(b):=char_depth(f)(hd); p:=get_avail; character(p):=c; font(p):=f; list_ptr(b):=p; char_box:=b; end; @y function char_box(@!f:internal_font_number;@!c:integer):pointer; var q:four_quarters; @!hd:eight_bits; {|height_depth| byte} @!b,@!p:pointer; {the new box and its character node} begin if is_native_font(f) then begin b:=new_null_box; p:=new_native_character(f, c); list_ptr(b):=p; height(b):=height(p); width(b):=width(p); if depth(p)<0 then depth(b):=0 else depth(b):=depth(p); end else begin q:=char_info(f)(c); hd:=height_depth(q); b:=new_null_box; width(b):=char_width(f)(q)+char_italic(f)(q); height(b):=char_height(f)(hd); depth(b):=char_depth(f)(hd); p:=get_avail; character(p):=c; font(p):=f; end; list_ptr(b):=p; char_box:=b; end; @z @x @* \[36] Typesetting math formulas. @y @* \[36] Typesetting math formulas. @z @x @!cur_size:small_number; {size code corresponding to |cur_style|} @y @!cur_size:integer; {size code corresponding to |cur_style|} @z @x @p procedure fetch(@!a:pointer); {unpack the |math_char| field |a|} begin cur_c:=character(a); cur_f:=fam_fnt(fam(a)+cur_size); if cur_f=null_font then @ else begin if (qo(cur_c)>=font_bc[cur_f])and(qo(cur_c)<=font_ec[cur_f]) then cur_i:=orig_char_info(cur_f)(cur_c) @y @p procedure fetch(@!a:pointer); {unpack the |math_char| field |a|} begin cur_c:=cast_to_ushort(character(a)); cur_f:=fam_fnt(fam(a)+cur_size); cur_c:=cur_c + (plane_and_fam_field(a) div @"100) * @"10000; if cur_f=null_font then @ else if is_native_font(cur_f) then begin cur_i:=null_character; end else begin if (qo(cur_c)>=font_bc[cur_f])and(qo(cur_c)<=font_ec[cur_f]) then cur_i:=orig_char_info(cur_f)(cur_c) @z @x @!cur_c:quarterword; {the |character| field of a |math_char|} @y @!cur_c:integer; {the |character| field of a |math_char|} @z @x procedure make_radical(@!q:pointer); var x,@!y:pointer; {temporary registers for box construction} @!delta,@!clr:scaled; {dimensions involved in the calculation} begin x:=clean_box(nucleus(q),cramped_style(cur_style)); if cur_style; x:=clean_box(nucleus(q),cramped_style(cur_style)); w:=width(x); h:=height(x); @; @y procedure make_math_accent(@!q:pointer); label done,done1; var p,@!x,@!y:pointer; {temporary registers for box construction} @!a:integer; {address of lig/kern instruction} @!c,@!g:integer; {accent character} @!f:internal_font_number; {its font} @!i:four_quarters; {its |char_info|} @!s:scaled; {amount to skew the accent to the right} @!h:scaled; {height of character being accented} @!delta:scaled; {space to remove between accent and accentee} @!w,@!wa,@!w2:scaled; {width of the accentee, not including sub/superscripts} begin fetch(accent_chr(q)); x:=null; if is_native_font(cur_f) then begin c:=cur_c; f:=cur_f; s:=0; {@@;} x:=clean_box(nucleus(q),cramped_style(cur_style)); w:=width(x); h:=height(x); end else if char_exists(cur_i) then begin i:=cur_i; c:=cur_c; f:=cur_f;@/ @; x:=clean_box(nucleus(q),cramped_style(cur_style)); w:=width(x); h:=height(x); @; end; if x<>null then begin @z @x y:=char_box(f,c); shift_amount(y):=s+half(w-width(y)); @y y:=char_box(f,c); if is_native_font(f) then begin {turn the |native_word| node into a |native_glyph| one} p:=get_node(glyph_node_size); type(p):=whatsit_node; subtype(p):=glyph_node; native_font(p):=f; native_glyph(p):=get_native_glyph(list_ptr(y), 0); set_native_glyph_metrics(p, 1); free_node(list_ptr(y), native_size(list_ptr(y))); list_ptr(y):=p; @; {determine horiz positioning} wa:=get_ot_math_accent_pos(f,native_glyph(p)); if wa=@"7FFFFFFF then wa:=half(width(y)); p:=list_ptr(x); if (p<>null) and (type(p)=whatsit_node) and (subtype(p)=glyph_node) and (link(p)=null) then begin w2:=get_ot_math_accent_pos(native_font(p), native_glyph(p)); if w2=@"7FFFFFFF then w:=half(w) else w:=w2; end else w:=half(w); shift_amount(y):=s+w-wa; end else shift_amount(y):=s+half(w-width(y)); @z @x @ @= @y @ @= wa:=width(x); c:=native_glyph(p); a:=0; repeat g:=get_ot_math_variant(f, c, a, addressof(w2), 1); if (w2>0) and (w2<=wa) then begin native_glyph(p):=g; set_native_glyph_metrics(p, 1); incr(a); end; until (w2<0) or (w2>=wa); { |if (w2<0) then begin ot_assembly_ptr:=get_ot_assembly_ptr(f, c, 1); if ot_assembly_ptr<>nil then begin free_node(p,glyph_node_size); p:=build_opentype_assembly(cur_f, ot_assembly_ptr, w1); list_ptr(y):=p; goto found; end; end else| } set_native_glyph_metrics(p, 1); {found:} width(y):=width(p); height(y):=height(p); depth(y):=depth(p); if depth(y)<0 then depth(y):=0; @ @= @z @x @= begin if cur_style= begin if is_ot_font(fam_fnt(3+cur_size)) then begin if cur_style= begin if cur_style= begin if is_ot_font(fam_fnt(3+cur_size)) then begin delta:=half(thickness(q)); if cur_styleempty)and(subtype(q)<>limits) then width(x):=width(x)-delta; {remove italic correction} shift_amount(x):=half(height(x)-depth(x)) - axis_height(cur_size); {center vertically} math_type(nucleus(q)):=sub_box; info(nucleus(q)):=x; end else delta:=0; if subtype(q)=limits then @; make_op:=delta; end; @y function make_op(@!q:pointer):scaled; label found; var delta:scaled; {offset between subscript and superscript} @!p,@!v,@!x,@!y,@!z:pointer; {temporary registers for box construction} @!c:quarterword;@+@!i:four_quarters; {registers for character examination} @!shift_up,@!shift_down:scaled; {dimensions for box calculation} @!h1,@!h2:scaled; {height of original text-style symbol and possible replacement} @!n,@!g:integer; {potential variant index and glyph code} @!ot_assembly_ptr:void_pointer; begin if (subtype(q)=normal)and(cur_style0 then native_glyph(p):=g; incr(n); until (h2<0) or (h2>=h1); if (h2<0) then begin {if we get here, then we didn't find a big enough glyph; check if the char is extensible} ot_assembly_ptr:=get_ot_assembly_ptr(cur_f, c, 0); if ot_assembly_ptr<>nil then begin free_node(p,glyph_node_size); p:=build_opentype_assembly(cur_f, ot_assembly_ptr, h1); list_ptr(x):=p; delta:=0; goto found; end; end else set_native_glyph_metrics(p, 1); end; delta:=get_ot_math_ital_corr(cur_f, native_glyph(p)); found: width(x):=width(p); height(x):=height(p); depth(x):=depth(p); end end; if (math_type(subscr(q))<>empty)and(subtype(q)<>limits) then width(x):=width(x)-delta; {remove italic correction} shift_amount(x):=half(height(x)-depth(x)) - axis_height(cur_size); {center vertically} math_type(nucleus(q)):=sub_box; info(nucleus(q)):=x; end; if subtype(q)=limits then @; make_op:=delta; end; @z @x character(nucleus(r)):=rem_byte(cur_i); fam(nucleus(r)):=fam(nucleus(q));@/ @y character(nucleus(r)):=rem_byte(cur_i); plane_and_fam_field(nucleus(r)):=fam(nucleus(q));@/ @z @x @ @= begin fetch(nucleus(q)); if char_exists(cur_i) then @y @ @= begin fetch(nucleus(q)); if is_native_font(cur_f) then begin z:=new_native_character(cur_f, qo(cur_c)); p:=get_node(glyph_node_size); type(p):=whatsit_node; subtype(p):=glyph_node; native_font(p):=cur_f; native_glyph(p):=get_native_glyph(z, 0); set_native_glyph_metrics(p, 1); free_node(z, native_size(z)); delta:=get_ot_math_ital_corr(cur_f, native_glyph(p)); if (math_type(nucleus(q))=math_text_char)and(space(cur_f)<>0) then delta:=0; {no italic correction in mid-word of text font} if (math_type(subscr(q))=empty)and(delta<>0) then begin link(p):=new_kern(delta); delta:=0; end; end else if char_exists(cur_i) then @z @x @ The purpose of |make_scripts(q,delta)| is to attach the subscript and/or superscript of noad |q| to the list that starts at |new_hlist(q)|, given that subscript and superscript aren't both empty. The superscript will appear to the right of the subscript by a given distance |delta|. We set |shift_down| and |shift_up| to the minimum amounts to shift the baseline of subscripts and superscripts based on the given nucleus. @= procedure make_scripts(@!q:pointer;@!delta:scaled); var p,@!x,@!y,@!z:pointer; {temporary registers for box construction} @!shift_up,@!shift_down,@!clr:scaled; {dimensions in the calculation} @!t:small_number; {subsidiary size code} begin p:=new_hlist(q); if is_char_node(p) then @y @ The purpose of |make_scripts(q,delta)| is to attach the subscript and/or superscript of noad |q| to the list that starts at |new_hlist(q)|, given that subscript and superscript aren't both empty. The superscript will appear to the right of the subscript by a given distance |delta|. We set |shift_down| and |shift_up| to the minimum amounts to shift the baseline of subscripts and superscripts based on the given nucleus. @= procedure make_scripts(@!q:pointer;@!delta:scaled); var p,@!x,@!y,@!z:pointer; {temporary registers for box construction} @!shift_up,@!shift_down,@!clr:scaled; {dimensions in the calculation} @!t:integer; {subsidiary size code} begin p:=new_hlist(q); if is_char_node(p) or (p<>null and is_native_word_node(p)) then @z @x magic_offset:=str_start[math_spacing]-9*ord_noad @y magic_offset:=str_start_macro(math_spacing)-9*ord_noad @z @x @* \[37] Alignment. @y @* \[37] Alignment. @z @x @d span_code=256 {distinct from any character} @d cr_code=257 {distinct from |span_code| and from any character} @y @d span_code=special_char {distinct from any character} @d cr_code=span_code+1 {distinct from |span_code| and from any character} @z @x if n>max_quarterword then confusion("256 spans"); {this can happen, but won't} @^system dependencies@> @:this can't happen 256 spans}{\quad 256 spans@> @y if n>max_quarterword then confusion("too many spans"); {this can happen, but won't} @^system dependencies@> @:this can't happen too many spans}{\quad too many spans@> @z @x @* \[38] Breaking paragraphs into lines. @y @* \[38] Breaking paragraphs into lines. @z @x label done,done1,done2,done3,done4,done5,continue; @y label done,done1,done2,done3,done4,done5,done6,continue, restart; @z @x ligature_node: begin f:=font(lig_char(v));@/ @y ligature_node: begin f:=font(lig_char(v));@/ xtx_ligature_present:=true; @z @x othercases confusion("disc1") @y whatsit_node: if (subtype(v)=native_word_node) or (subtype(v)=glyph_node) or (subtype(v)=pic_node) or (subtype(v)=pdf_node) then break_width[1]:=break_width[1]-width(v) else confusion("disc1a"); othercases confusion("disc1") @z @x ligature_node: begin f:=font(lig_char(s)); @y ligature_node: begin f:=font(lig_char(s)); xtx_ligature_present:=true; @z @x othercases confusion("disc2") @y whatsit_node: if (subtype(s)=native_word_node) or (subtype(s)=glyph_node) or (subtype(s)=pic_node) or (subtype(s)=pdf_node) then break_width[1]:=break_width[1]+width(s) else confusion("disc2a"); othercases confusion("disc2") @z @x @* \[39] Breaking paragraphs into lines, continued. @y @* \[39] Breaking paragraphs into lines, continued. @z @x ligature_node: begin f:=font(lig_char(cur_p)); @y ligature_node: begin f:=font(lig_char(cur_p)); xtx_ligature_present:=true; @z @x ligature_node: begin f:=font(lig_char(s)); @y ligature_node: begin f:=font(lig_char(s)); xtx_ligature_present:=true; @z @x othercases confusion("disc3") @y whatsit_node: if (subtype(s)=native_word_node) or (subtype(s)=glyph_node) or (subtype(s)=pic_node) or (subtype(s)=pdf_node) then disc_width:=disc_width+width(s) else confusion("disc3a"); othercases confusion("disc3") @z @x ligature_node: begin f:=font(lig_char(s)); @y ligature_node: begin f:=font(lig_char(s)); xtx_ligature_present:=true; @z @x othercases confusion("disc4") @y whatsit_node: if (subtype(s)=native_word_node) or (subtype(s)=glyph_node) or (subtype(s)=pic_node) or (subtype(s)=pdf_node) then act_width:=act_width+width(s) else confusion("disc4a"); othercases confusion("disc4") @z @x @* \[40] Pre-hyphenation. @y @* \[40] Pre-hyphenation. @z @x @!hc:array[0..65] of 0..256; {word to be hyphenated} @y @!hc:array[0..66] of 0..number_usvs; {word to be hyphenated} { note that element 0 needs to be a full UnicodeScalar, even though we basically work in utf16 } @z @x @!hu:array[0..63] of 0..256; {like |hc|, before conversion to lowercase} @y @!hu:array[0..64] of 0..too_big_char; {like |hc|, before conversion to lowercase} @z @x @!cur_lang,@!init_cur_lang:ASCII_code; {current hyphenation table of interest} @y @!cur_lang,@!init_cur_lang:0..biggest_lang; {current hyphenation table of interest} @z @x @!hyf_bchar:halfword; {boundary character after $c_n$} @y @!hyf_bchar:halfword; {boundary character after $c_n$} @!max_hyph_char:integer; @ @= max_hyph_char:=too_big_lang; @z @x @!c:0..255; {character being considered for hyphenation} @y @!c:UnicodeScalar; {character being considered for hyphenation} @z @x @; @y if (not is_char_node(ha)) and (type(ha) = whatsit_node) and (subtype(ha) = native_word_node) then begin @; @; end else begin @; end; @z @x @ The first thing we need to do is find the node |ha| just before the first letter. @y @ @= s := link(ha); loop@+ begin if not(is_char_node(s)) then case type(s) of ligature_node: do_nothing; kern_node: if subtype(s)<>normal then goto done6; whatsit_node,glue_node,penalty_node,ins_node,adjust_node,mark_node: goto done6; othercases goto done1 endcases; s:=link(s); end; done6: @ @= { note that if there are chars with |lccode = 0|, we split them out into separate |native_word| nodes } hn := 0; restart: for l := 0 to native_length(ha)-1 do begin c := get_native_usv(ha, l); set_lc_code(c); if (hc[0] = 0) then begin if (hn > 0) then begin { we've got some letters, and now found a non-letter, so break off the tail of the |native_word| and link it after this node, and goto done3 } @; goto done3; end end else if (hn = 0) and (l > 0) then begin { we've found the first letter after some non-letters, so break off the head of the |native_word| and restart } @; ha := link(ha); goto restart; end else if (hn = 63) then { reached max hyphenatable length } goto done3 else begin { found a letter that is part of a potentially hyphenatable sequence } incr(hn); if c<@"10000 then begin hu[hn] := c; hc[hn] := hc[0]; end else begin hu[hn] := (c - @"10000) div @"400 + @"D800; hc[hn] := (hc[0] - @"10000) div @"400 + @"D800; incr(hn); hu[hn] := c mod @"400 + @"DC00; hc[hn] := hc[0] mod @"400 + @"DC00; incr(l); end; hyf_bchar := non_char; end end; @ @= q := new_native_word_node(hf, native_length(ha) - l); for i := l to native_length(ha) - 1 do set_native_char(q, i - l, get_native_char(ha, i)); set_native_metrics(q, XeTeX_use_glyph_metrics); link(q) := link(ha); link(ha) := q; { truncate text in node |ha| } native_length(ha) := l; set_native_metrics(ha, XeTeX_use_glyph_metrics); @ @= l: integer; i: integer; @ The first thing we need to do is find the node |ha| just before the first letter. @z @x begin @; goto continue; @y begin if subtype(s) = native_word_node then begin { we only consider the node if it contains at least one letter, otherwise we'll skip it } for l:=0 to native_length(s) - 1 do begin c := get_native_usv(s, l); if lc_code(c) <> 0 then begin hf := native_font(s); prev_s := s; goto done2; end; if c>=@"10000 then incr(l); end end; @; goto continue @z @x if hyf_char>255 then goto done1; @y if hyf_char>biggest_char then goto done1; @z @x if hc[0]=0 then goto done3; @y if hc[0]=0 then goto done3; if hc[0]>max_hyph_char then goto done3; @z @x if hc[0]=0 then goto done3; @y if hc[0]=0 then goto done3; if hc[0]>max_hyph_char then goto done3; @z @x @* \[41] Post-hyphenation. @y @* \[41] Post-hyphenation. @z @x @= @y @= if (not is_char_node(ha)) and (type(ha) = whatsit_node) and (subtype(ha) = native_word_node) then begin @; end else begin @z @x begin hu[0]:=256; init_lig:=false; @y begin hu[0]:=max_hyph_char; init_lig:=false; @z @x found2: s:=ha; j:=0; hu[0]:=256; init_lig:=false; init_list:=null; @y found2: s:=ha; j:=0; hu[0]:=max_hyph_char; init_lig:=false; init_list:=null; @z @x flush_list(init_list) @y flush_list(init_list); end @ @= { find the node immediately before the word to be hyphenated } s := cur_p; {we have |cur_p<>ha| because |type(cur_p)=glue_node|} while link(s) <> ha do s := link(s); { for each hyphen position, create a |native_word_node| fragment for the text before this point, and a |disc_node| for the break, with the |hyf_char| in the |pre_break| text } hyphen_passed := 0; { location of last hyphen we saw } for j := l_hyf to hn - r_hyf do begin { if this is a valid break.... } if odd(hyf[j]) then begin { make a |native_word_node| for the fragment before the hyphen } q := new_native_word_node(hf, j - hyphen_passed); for i := 0 to j - hyphen_passed - 1 do set_native_char(q, i, get_native_char(ha, i + hyphen_passed)); set_native_metrics(q, XeTeX_use_glyph_metrics); link(s) := q; { append the new node } s := q; { make the |disc_node| for the hyphenation point } q := new_disc; pre_break(q) := new_native_character(hf, hyf_char); link(s) := q; s := q; hyphen_passed := j; end end; { make a |native_word_node| for the last fragment of the word } hn := native_length(ha); { ensure trailing punctuation is not lost! } q := new_native_word_node(hf, hn - hyphen_passed); for i := 0 to hn - hyphen_passed - 1 do set_native_char(q, i, get_native_char(ha, i + hyphen_passed)); set_native_metrics(q, XeTeX_use_glyph_metrics); link(s) := q; { append the new node } s := q; q := link(ha); link(s) := q; link(ha) := null; flush_node_list(ha); @z @x @!c:ASCII_code; {character temporarily replaced by a hyphen} @y @!c:UnicodeScalar; {character temporarily replaced by a hyphen} @z @x begin decr(l); c:=hu[l]; c_loc:=l; hu[l]:=256; @y begin decr(l); c:=hu[l]; c_loc:=l; hu[l]:=max_hyph_char; @z @x @* \[42] Hyphenation. @y @* \[42] Hyphenation. @z @x @!op_start:array[ASCII_code] of 0..trie_op_size; {offset for current language} @y @!op_start:array[0..biggest_lang] of 0..trie_op_size; {offset for current language} @z @x hc[0]:=0; hc[hn+1]:=0; hc[hn+2]:=256; {insert delimiters} @y hc[0]:=0; hc[hn+1]:=0; hc[hn+2]:=max_hyph_char; {insert delimiters} @z @x begin j:=1; u:=str_start[k]; @y begin j:=1; u:=str_start_macro(k); @z @x else if language>255 then cur_lang:=0 @y else if language>biggest_lang then cur_lang:=0 @z @x else if n<63 then begin incr(n); hc[n]:=hc[0]; end; @y else if n<63 then begin incr(n); if hc[0]<@"10000 then hc[n]:=hc[0] else begin hc[n] := (hc[0] - @"10000) div @"400 + @"D800; incr(n); hc[n] := hc[0] mod @"400 + @"DC00; end; end; @z @x u:=str_start[k]; v:=str_start[s]; @y u:=str_start_macro(k); v:=str_start_macro(s); @z @x until u=str_start[k+1]; @y until u=str_start_macro(k+1); @z @x @* \[43] Initializing the hyphenation tables. @y @* \[43] Initializing the hyphenation tables. @z @x @!trie_used:array[ASCII_code] of trie_opcode; @y @!trie_used:array[0..biggest_lang] of trie_opcode; @z @x @!trie_op_lang:array[1..trie_op_size] of ASCII_code; @y @!trie_op_lang:array[1..trie_op_size] of 0..biggest_lang; @z @x for j:=1 to 255 do op_start[j]:=op_start[j-1]+qo(trie_used[j-1]); @y for j:=1 to biggest_lang do op_start[j]:=op_start[j-1]+qo(trie_used[j-1]); @z @x for k:=0 to 255 do trie_used[k]:=min_trie_op; @y for k:=0 to biggest_lang do trie_used[k]:=min_trie_op; @z @x for p:=0 to 255 do trie_min[p]:=p+1; @y for p:=0 to biggest_char do trie_min[p]:=p+1; @z @x @!ll:1..256; {upper limit of |trie_min| updating} @y @!ll:1..too_big_char; {upper limit of |trie_min| updating} @z @x @=h+256|@>; @y @=h+max_hyph_char|@>; @z @x @ By making sure that |trie_max| is at least |h+256|, we can be sure that @y @ By making sure that |trie_max| is at least |h+max_hyph_char|, we can be sure that @z @x @=h+256|@>= if trie_max=h+max_hyph_char|@>= if trie_maxmax_hyph_char then max_hyph_char:=cur_chr; if k<63 then @z @x begin @; @y begin incr(max_hyph_char); @; @z @x @* \[44] Breaking vertical lists into pages. @y @* \[44] Breaking vertical lists into pages. @z @x @* \[45] The page builder. @y @* \[45] The page builder. @z @x @!n:min_quarterword..255; {insertion box number} @y @!n:min_quarterword..biggest_reg; {insertion box number} @z @x @!n:min_quarterword..255; {insertion box number} @y @!n:min_quarterword..biggest_reg; {insertion box number} @z @x @* \[46] The chief executive. @y @* \[46] The chief executive. @z @x @d main_loop=70 {go here to typeset a string of consecutive characters} @y @d main_loop=70 {go here to typeset a string of consecutive characters} @d collect_native=71 {go here to collect characters in a "native" font string} @d collected=72 @z @x append_normal_space,exit; @y collect_native,collected, append_normal_space,exit; @z @x hmode+char_num: begin scan_char_num; cur_chr:=cur_val; goto main_loop;@+end; @y hmode+char_num: begin scan_usv_num; cur_chr:=cur_val; goto main_loop;@+end; @z @x hmode+spacer: if space_factor=1000 then goto append_normal_space else app_space; hmode+ex_space,mmode+ex_space: goto append_normal_space; @t\4@>@@; end; {of the big |case| statement} @y othercases begin if abs(mode)=hmode then check_for_post_char_toks(big_switch); case abs(mode)+cur_cmd of hmode+spacer: if space_factor=1000 then goto append_normal_space else app_space; hmode+ex_space,mmode+ex_space: goto append_normal_space; @t\4@>@ end end endcases; {of the big |case| statement} @z @x append_normal_space:@@;@/ main_s:=sf_code(cur_chr); @y @d adjust_space_factor==@t@>@;@/ main_s:=sf_code(cur_chr) mod @"10000; @z @x @= if ((head=tail) and (mode>0)) then begin if (insert_src_special_auto) then append_src_special; end; adjust_space_factor;@/ @y @d check_for_inter_char_toks(#)=={check for a spacing token list, goto |#| if found, or |big_switch| in case of the initial letter of a run} cur_ptr:=null; space_class:=sf_code(cur_chr) div @"10000; if XeTeX_inter_char_tokens_en and space_class <> 256 then begin {class 256 = ignored (for combining marks etc)} if prev_class = 255 then begin {boundary} if (state<>token_list) or (token_type<>backed_up_char) then begin find_sa_element(inter_char_val, 255*@"100 + space_class, false); if cur_ptr<>null then begin if cur_cmd<>letter then cur_cmd:=other_char; cur_tok:=(cur_cmd*max_char_val)+cur_chr; back_input; token_type:=backed_up_char; begin_token_list(sa_ptr(cur_ptr), inter_char_text); goto big_switch; end end end else begin find_sa_element(inter_char_val, prev_class*@"100 + space_class, false); if cur_ptr<>null then begin if cur_cmd<>letter then cur_cmd:=other_char; cur_tok:=(cur_cmd*max_char_val)+cur_chr; back_input; token_type:=backed_up_char; begin_token_list(sa_ptr(cur_ptr), inter_char_text); prev_class:=255; goto #; end; end; prev_class:=space_class; end @d check_for_post_char_toks(#)== if XeTeX_inter_char_tokens_en and (space_class<>256) and (prev_class<>255) then begin prev_class:=255; find_sa_element(inter_char_val, space_class*@"100 + 255, false); {boundary} if cur_ptr<>null then begin if cur_cs=0 then begin if cur_cmd=char_num then cur_cmd:=other_char; cur_tok:=(cur_cmd*max_char_val)+cur_chr; end else cur_tok:=cs_token_flag+cur_cs; back_input; begin_token_list(sa_ptr(cur_ptr), inter_char_text); goto #; end; end @= if ((head=tail) and (mode>0)) then begin if (insert_src_special_auto) then append_src_special; end; prev_class := 255; {boundary} { added code for native font support } if is_native_font(cur_font) then begin if mode>0 then if language<>clang then fix_language; main_h := 0; main_f := cur_font; native_len := 0; collect_native: adjust_space_factor; check_for_inter_char_toks(collected); if (cur_chr > @"FFFF) then begin native_room(2); append_native((cur_chr - @"10000) div 1024 + @"D800); append_native((cur_chr - @"10000) mod 1024 + @"DC00); end else begin native_room(1); append_native(cur_chr); end; is_hyph := (cur_chr = hyphen_char[main_f]) or (XeTeX_dash_break_en and ((cur_chr = @"2014) or (cur_chr = @"2013))); if (main_h = 0) and is_hyph then main_h := native_len; {try to collect as many chars as possible in the same font} get_next; if (cur_cmd=letter) or (cur_cmd=other_char) or (cur_cmd=char_given) then goto collect_native; x_token; if (cur_cmd=letter) or (cur_cmd=other_char) or (cur_cmd=char_given) then goto collect_native; if cur_cmd=char_num then begin scan_usv_num; cur_chr:=cur_val; goto collect_native; end; check_for_post_char_toks(collected); collected: if (font_mapping[main_f] <> 0) then begin main_k := apply_mapping(font_mapping[main_f], native_text, native_len); native_len := 0; native_room(main_k); main_h := 0; for main_p := 0 to main_k - 1 do begin append_native(mapped_text[main_p]); if (main_h = 0) and ((mapped_text[main_p] = hyphen_char[main_f]) or (XeTeX_dash_break_en and ((mapped_text[main_p] = @"2014) or (mapped_text[main_p] = @"2013)) ) ) then main_h := native_len; end end; if tracing_lost_chars > 0 then begin temp_ptr := 0; while (temp_ptr < native_len) do begin main_k := native_text[temp_ptr]; incr(temp_ptr); if (main_k >= @"D800) and (main_k < @"DC00) then begin main_k := @"10000 + (main_k - @"D800) * 1024; main_k := main_k + native_text[temp_ptr] - @"DC00; incr(temp_ptr); end; if map_char_to_glyph(main_f, main_k) = 0 then char_warning(main_f, main_k); end end; main_k := native_len; main_pp := tail; if mode=hmode then begin main_ppp := head; if main_ppp<>main_pp then { find node preceding tail, skipping discretionaries } while (link(main_ppp)<>main_pp) do begin if (not is_char_node(main_ppp)) and (type(main_ppp=disc_node)) then begin temp_ptr:=main_ppp; for main_p:=1 to replace_count(temp_ptr) do main_ppp:=link(main_ppp); end; if main_ppp<>main_pp then main_ppp:=link(main_ppp); end; temp_ptr := 0; repeat if main_h = 0 then main_h := main_k; if (not is_char_node(main_pp)) and (type(main_pp)=whatsit_node) and (subtype(main_pp)=native_word_node) and (native_font(main_pp)=main_f) and (main_ppp<>main_pp) and (not is_char_node(main_ppp)) and (type(main_ppp)<>disc_node) then begin { make a new temp string that contains the concatenated text of |tail| + the current word/fragment } main_k := main_h + native_length(main_pp); native_room(main_k); save_native_len := native_len; for main_p := 0 to native_length(main_pp) - 1 do append_native(get_native_char(main_pp, main_p)); for main_p := 0 to main_h - 1 do append_native(native_text[temp_ptr + main_p]); do_locale_linebreaks(save_native_len, main_k); native_len := save_native_len; { discard the temp string } main_k := native_len - main_h - temp_ptr; { and set |main_k| to remaining length of new word } temp_ptr := main_h; { pointer to remaining fragment } main_h := 0; while (main_h < main_k) and (native_text[temp_ptr + main_h] <> hyphen_char[main_f]) and ( (not XeTeX_dash_break_en) or ((native_text[temp_ptr + main_h] <> @"2014) and (native_text[temp_ptr + main_h] <> @"2013)) ) do incr(main_h); { look for next hyphen or end of text } if (main_h < main_k) then incr(main_h); { remove the preceding node from the list } link(main_ppp) := link(main_pp); link(main_pp) := null; flush_node_list(main_pp); main_pp := tail; while (link(main_ppp)<>main_pp) do main_ppp:=link(main_ppp); end else begin do_locale_linebreaks(temp_ptr, main_h); { append fragment of current word } temp_ptr := temp_ptr + main_h; { advance ptr to remaining fragment } main_k := main_k - main_h; { decrement remaining length } main_h := 0; while (main_h < main_k) and (native_text[temp_ptr + main_h] <> hyphen_char[main_f]) and ( (not XeTeX_dash_break_en) or ((native_text[temp_ptr + main_h] <> @"2014) and (native_text[temp_ptr + main_h] <> @"2013)) ) do incr(main_h); { look for next hyphen or end of text } if (main_h < main_k) then incr(main_h); end; if (main_k > 0) or is_hyph then begin tail_append(new_disc); { add a break if we aren't at end of text (must be a hyphen), or if last char in original text was a hyphen } main_pp:=tail; end; until main_k = 0; end else begin { must be restricted hmode, so no need for line-breaking or discretionaries } { but there might already be explicit |disc_node|s in the list } main_ppp := head; if main_ppp<>main_pp then { find node preceding tail, skipping discretionaries } while (link(main_ppp)<>main_pp) do begin if (not is_char_node(main_ppp)) and (type(main_ppp=disc_node)) then begin temp_ptr:=main_ppp; for main_p:=1 to replace_count(temp_ptr) do main_ppp:=link(main_ppp); end; if main_ppp<>main_pp then main_ppp:=link(main_ppp); end; if (not is_char_node(main_pp)) and (type(main_pp)=whatsit_node) and (subtype(main_pp)=native_word_node) and (native_font(main_pp)=main_f) and (main_ppp<>main_pp) and (not is_char_node(main_ppp)) and (type(main_ppp)<>disc_node) then begin { total string length for the new merged whatsit } link(main_pp) := new_native_word_node(main_f, main_k + native_length(main_pp)); tail := link(main_pp); { copy text from the old one into the new } for main_p := 0 to native_length(main_pp) - 1 do set_native_char(tail, main_p, get_native_char(main_pp, main_p)); { append the new text } for main_p := 0 to main_k - 1 do set_native_char(tail, main_p + native_length(main_pp), native_text[main_p]); set_native_metrics(tail, XeTeX_use_glyph_metrics); { remove the preceding node from the list } main_p := head; if main_p<>main_pp then while link(main_p)<>main_pp do main_p := link(main_p); link(main_p) := link(main_pp); link(main_pp) := null; flush_node_list(main_pp); end else begin { package the current string into a |native_word| whatsit } link(main_pp) := new_native_word_node(main_f, main_k); tail := link(main_pp); for main_p := 0 to main_k - 1 do set_native_char(tail, main_p, native_text[main_p]); set_native_metrics(tail, XeTeX_use_glyph_metrics); end end; if cur_ptr<>null then goto big_switch else goto reswitch; end; { End of added code for native fonts } adjust_space_factor;@/ check_for_inter_char_toks(big_switch); @z @x main_loop_lookahead+1: adjust_space_factor; @y main_loop_lookahead+1: adjust_space_factor; check_for_inter_char_toks(big_switch); @z @x non_math(math_given), non_math(math_comp), non_math(delim_num), @y non_math(math_given), non_math(XeTeX_math_given), non_math(math_comp), non_math(delim_num), @z @x begin d:=box_max_depth; unsave; save_ptr:=save_ptr-3; if mode=-hmode then cur_box:=hpack(link(head),saved(2),saved(1)) else begin cur_box:=vpackage(link(head),saved(2),saved(1),d); if c=vtop_code then @; end; pop_nest; box_end(saved(0)); @y @!u,v:integer; {saved values for upwards mode flag} begin d:=box_max_depth; u:=XeTeX_upwards_state; unsave; save_ptr:=save_ptr-3; v:=XeTeX_upwards_state; XeTeX_upwards_state:=u; if mode=-hmode then cur_box:=hpack(link(head),saved(2),saved(1)) else begin cur_box:=vpackage(link(head),saved(2),saved(1),d); if c=vtop_code then @; end; XeTeX_upwards_state:=v; pop_nest; box_end(saved(0)); @z @x procedure append_italic_correction; label exit; var p:pointer; {|char_node| at the tail of the current list} @!f:internal_font_number; {the font in the |char_node|} begin if tail<>head then begin if is_char_node(tail) then p:=tail else if type(tail)=ligature_node then p:=lig_char(tail) else return; @y procedure append_italic_correction; label exit; var p:pointer; {|char_node| at the tail of the current list} @!f:internal_font_number; {the font in the |char_node|} begin if tail<>head then begin if is_char_node(tail) then p:=tail else if type(tail)=ligature_node then p:=lig_char(tail) else if (type(tail)=whatsit_node) then begin if (subtype(tail)=native_word_node) then begin tail_append(new_kern(get_native_italic_correction(tail))); subtype(tail):=explicit; end else if (subtype(tail)=glyph_node) then begin tail_append(new_kern(get_native_glyph_italic_correction(tail))); subtype(tail):=explicit; end; return; end else return; @z @x if c>=0 then if c<256 then pre_break(tail):=new_character(cur_font,c); @y if c>=0 then if c<=biggest_char then pre_break(tail):=new_character(cur_font,c); @z @x if type(p)<>kern_node then if type(p)<>ligature_node then begin print_err("Improper discretionary list"); @y if type(p)<>kern_node then if type(p)<>ligature_node then if (type(p)<>whatsit_node) or ((subtype(p)<>native_word_node) and (subtype(p)<>glyph_node)) then begin print_err("Improper discretionary list"); @z @x @!a,@!h,@!x,@!w,@!delta:scaled; {heights and widths, as explained above} @y @!a,@!h,@!x,@!w,@!delta,@!lsb,@!rsb:scaled; {heights and widths, as explained above} @z @x a:=char_width(f)(char_info(f)(character(p)));@/ @y if is_native_font(f) then begin a:=width(p); if a=0 then get_native_char_sidebearings(f, cur_val, addressof(lsb), addressof(rsb)) end else a:=char_width(f)(char_info(f)(character(p)));@/ @z @x if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given) then q:=new_character(f,cur_chr) @y if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given) then begin q:=new_character(f,cur_chr); cur_val:=cur_chr end @z @x i:=char_info(f)(character(q)); w:=char_width(f)(i); h:=char_height(f)(height_depth(i)); @y if is_native_font(f) then begin w:=width(q); get_native_char_height_depth(f, cur_val, addressof(h), addressof(delta)) {using delta as scratch space for the unneeded depth value} end else begin i:=char_info(f)(character(q)); w:=char_width(f)(i); h:=char_height(f)(height_depth(i)) end; @z @x delta:=round((w-a)/float_constant(2)+h*t-x*s); @y if is_native_font(f) and (a=0) then { special case for non-spacing marks } delta:=round((w-lsb+rsb)/float_constant(2)+h*t-x*s) else delta:=round((w-a)/float_constant(2)+h*t-x*s); @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 whatsit_node: @; @y whatsit_node: @; @z @x letter,other_char,char_given: begin c:=ho(math_code(cur_chr)); if c=@'100000 then @y letter,other_char,char_given: begin c:=ho(math_code(cur_chr)); if is_active_math_char(c) then @z @x math_char_num: begin scan_fifteen_bit_int; c:=cur_val; end; @y math_char_num: if cur_chr = 2 then begin { XeTeXmathchar } scan_math_class_int; c := set_class_field(cur_val); scan_math_fam_int; c := c + set_family_field(cur_val); scan_usv_num; c := c + cur_val; end else if cur_chr = 1 then begin { XeTeXmathcharnum } scan_xetex_math_char_int; c := cur_val; end else begin scan_fifteen_bit_int; c := set_class_field(cur_val div @"1000) + set_family_field((cur_val mod @"1000) div @"100) + (cur_val mod @"100); end; @z @x math_given: c:=cur_chr; delim_num: begin scan_twenty_seven_bit_int; c:=cur_val div @'10000; @y math_given: begin c := set_class_field(cur_chr div @"1000) + set_family_field((cur_chr mod @"1000) div @"100) + (cur_chr mod @"100); end; XeTeX_math_given: c:=cur_chr; delim_num: begin if cur_chr=1 then begin {XeTeXdelimiter } scan_math_class_int; c := set_class_field(cur_val); scan_math_fam_int; c := c + set_family_field(cur_val); scan_usv_num; c := c + cur_val; end else begin {delimiter <27-bit delcode>} scan_delimiter_int; c := cur_val div @'10000; {get the 'small' delimiter field} c := set_class_field(c div @"1000) + set_family_field((c mod @"1000) div @"100) + (c mod @"100); {and convert it to a xetex mathchar code} end; @z @x math_type(p):=math_char; character(p):=qi(c mod 256); if (c>=var_code)and fam_in_range then fam(p):=cur_fam else fam(p):=(c div 256) mod 16; @y math_type(p):=math_char; character(p):=qi(c mod @"10000); if (is_var_family(c)) and fam_in_range then plane_and_fam_field(p):=cur_fam else plane_and_fam_field(p):=(math_fam_field(c)); plane_and_fam_field(p) := plane_and_fam_field(p) + (math_char_field(c) div @"10000) * @"100; @z @x mmode+math_char_num: begin scan_fifteen_bit_int; set_math_char(cur_val); end; @y mmode+math_char_num: if cur_chr = 2 then begin { XeTeXmathchar } scan_math_class_int; t := set_class_field(cur_val); scan_math_fam_int; t := t + set_family_field(cur_val); scan_usv_num; t := t + cur_val; set_math_char(t); end else if cur_chr = 1 then begin { XeTeXmathcharnum } scan_xetex_math_char_int; set_math_char(cur_val); end else begin scan_fifteen_bit_int; set_math_char(set_class_field(cur_val div @"1000) + set_family_field((cur_val mod @"1000) div @"100) + (cur_val mod @"100)); end; @z @x mmode+math_given: set_math_char(cur_chr); mmode+delim_num: begin scan_twenty_seven_bit_int; set_math_char(cur_val div @'10000); @y mmode+math_given: begin set_math_char(set_class_field(cur_chr div @"1000) + set_family_field((cur_chr mod @"1000) div @"100) + (cur_chr mod @"100)); end; mmode+XeTeX_math_given: set_math_char(cur_chr); mmode+delim_num: begin if cur_chr=1 then begin {XeTeXdelimiter} scan_math_class_int; t := set_class_field(cur_val); scan_math_fam_int; t := t + set_family_field(cur_val); scan_usv_num; t := t + cur_val; set_math_char(t); end else begin scan_delimiter_int; cur_val:=cur_val div @'10000; {discard the large delimiter code} set_math_char(set_class_field(cur_val div @"1000) + set_family_field((cur_val mod @"1000) div @"100) + (cur_val mod @"100)); end; @z @x procedure set_math_char(@!c:integer); var p:pointer; {the new noad} begin if c>=@'100000 then @ else begin p:=new_noad; math_type(nucleus(p)):=math_char; character(nucleus(p)):=qi(c mod 256); fam(nucleus(p)):=(c div 256) mod 16; if c>=var_code then begin if fam_in_range then fam(nucleus(p)):=cur_fam; type(p):=ord_noad; end else type(p):=ord_noad+(c div @'10000); @y procedure set_math_char(@!c:integer); var p,q,r:pointer; {the new noad} ch: UnicodeScalar; begin if is_active_math_char(c) then @ else begin p:=new_noad; math_type(nucleus(p)):=math_char; ch:=math_char_field(c); character(nucleus(p)):=qi(ch mod @"10000); plane_and_fam_field(nucleus(p)):=math_fam_field(c); if is_var_family(c) then begin if fam_in_range then plane_and_fam_field(nucleus(p)):=cur_fam; type(p):=ord_noad; end else type(p):=ord_noad+math_class_field(c); plane_and_fam_field(nucleus(p)) := plane_and_fam_field(nucleus(p)) + (ch div @"10000) * @"100; @z @x procedure scan_delimiter(@!p:pointer;@!r:boolean); begin if r then scan_twenty_seven_bit_int @y procedure scan_delimiter(@!p:pointer;@!r:boolean); begin if r then begin if cur_chr=1 then begin {XeTeXradical} cur_val1 := @"40000000; {extended delcode flag} scan_math_fam_int; cur_val1 := cur_val1 + cur_val * @"200000; scan_usv_num; cur_val := cur_val1 + cur_val; end else {radical} scan_delimiter_int; end @z @x letter,other_char: cur_val:=del_code(cur_chr); delim_num: scan_twenty_seven_bit_int; othercases cur_val:=-1 @y letter,other_char: begin cur_val:=del_code(cur_chr); end; delim_num: if cur_chr=1 then begin {XeTeXdelimiter} cur_val1 := @"40000000; {extended delcode flag} scan_math_class_int; {discarded} scan_math_fam_int; cur_val1 := cur_val1 + cur_val * @"200000; scan_usv_num; cur_val := cur_val1 + cur_val; end else scan_delimiter_int; {normal delimiter} othercases begin cur_val:=-1; end; @z @x if cur_val<0 then @; small_fam(p):=(cur_val div @'4000000) mod 16; small_char(p):=qi((cur_val div @'10000) mod 256); large_fam(p):=(cur_val div 256) mod 16; large_char(p):=qi(cur_val mod 256); @y if cur_val<0 then begin @; end; if cur_val>=@"40000000 then begin {extended delcode, only one size} small_plane_and_fam_field(p) := ((cur_val mod @"200000) div @"10000) * @"100 {plane} + (cur_val div @"200000) mod @"100; {family} small_char_field(p) := qi(cur_val mod @"10000); large_plane_and_fam_field(p) := 0; large_char_field(p) := 0; end else begin {standard delcode, 4-bit families and 8-bit char codes} small_plane_and_fam_field(p) := (cur_val div @'4000000) mod 16; small_char_field(p) := qi((cur_val div @'10000) mod 256); large_plane_and_fam_field(p) := (cur_val div 256) mod 16; large_char_field(p) := qi(cur_val mod 256); end; @z @x procedure math_ac; @y procedure math_ac; var c: integer; @z @x scan_fifteen_bit_int; character(accent_chr(tail)):=qi(cur_val mod 256); if (cur_val>=var_code)and fam_in_range then fam(accent_chr(tail)):=cur_fam else fam(accent_chr(tail)):=(cur_val div 256) mod 16; @y if cur_chr=1 then begin scan_math_class_int; c := set_class_field(cur_val); scan_math_fam_int; c := c + set_family_field(cur_val); scan_usv_num; cur_val := cur_val + c; end else begin scan_fifteen_bit_int; cur_val := set_class_field(cur_val div @"1000) + set_family_field((cur_val mod @"1000) div @"100) + (cur_val mod @"100); end; character(accent_chr(tail)):=qi(cur_val mod @"10000); if (is_var_family(cur_val))and fam_in_range then plane_and_fam_field(accent_chr(tail)):=cur_fam else plane_and_fam_field(accent_chr(tail)):=math_fam_field(cur_val); plane_and_fam_field(accent_chr(tail)) := plane_and_fam_field(accent_chr(tail)) + (math_char_field(cur_val) div @"10000) * @"100; @z @x @ @= if (font_params[fam_fnt(2+text_size)]= if ((font_params[fam_fnt(2+text_size)] 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 should")@/ ("not appear in between \mubyte and \endmubyte."); back_error; end; p := link(r); if (p = null) and mubyte_tablein then begin print_err("The empty , "); print_esc("mubyte"); print(" ignored"); help2("The in")@/ ("\mubyte \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 @d char_def_code=0 {|shorthand_def| for \.{\\chardef}} @d math_char_def_code=1 {|shorthand_def| for \.{\\mathchardef}} @d count_def_code=2 {|shorthand_def| for \.{\\countdef}} @d dimen_def_code=3 {|shorthand_def| for \.{\\dimendef}} @d skip_def_code=4 {|shorthand_def| for \.{\\skipdef}} @d mu_skip_def_code=5 {|shorthand_def| for \.{\\muskipdef}} @d toks_def_code=6 {|shorthand_def| for \.{\\toksdef}} @d char_sub_def_code=7 {|shorthand_def| for \.{\\charsubdef}} @y @d char_def_code=0 {|shorthand_def| for \.{\\chardef}} @d math_char_def_code=1 {|shorthand_def| for \.{\\mathchardef}} @d count_def_code=2 {|shorthand_def| for \.{\\countdef}} @d dimen_def_code=3 {|shorthand_def| for \.{\\dimendef}} @d skip_def_code=4 {|shorthand_def| for \.{\\skipdef}} @d mu_skip_def_code=5 {|shorthand_def| for \.{\\muskipdef}} @d toks_def_code=6 {|shorthand_def| for \.{\\toksdef}} @d char_sub_def_code=7 {|shorthand_def| for \.{\\charsubdef}} @d XeTeX_math_char_num_def_code=8 @d XeTeX_math_char_def_code=9 @z @x primitive("mathchardef",shorthand_def,math_char_def_code);@/ @!@:math_char_def_}{\.{\\mathchardef} primitive@> @y primitive("mathchardef",shorthand_def,math_char_def_code);@/ primitive("XeTeXmathcharnumdef",shorthand_def,XeTeX_math_char_num_def_code);@/ primitive("XeTeXmathchardef",shorthand_def,XeTeX_math_char_def_code);@/ @!@:math_char_def_}{\.{\\mathchardef} primitive@> @z @x math_char_def_code: print_esc("mathchardef"); @y math_char_def_code: print_esc("mathchardef"); XeTeX_math_char_def_code: print_esc("XeTeXmathchardef"); XeTeX_math_char_num_def_code: print_esc("XeTeXmathcharnumdef"); @z @x math_given: begin print_esc("mathchar"); print_hex(chr_code); end; @y math_given: begin print_esc("mathchar"); print_hex(chr_code); end; XeTeX_math_given: begin print_esc("XeTeXmathchar"); print_hex(chr_code); end; @z @x else begin n:=cur_chr; get_r_token; p:=cur_cs; define(p,relax,256); @y else begin n:=cur_chr; get_r_token; p:=cur_cs; define(p,relax,too_big_usv); @z @x char_def_code: begin scan_char_num; define(p,char_given,cur_val); @y char_def_code: begin scan_usv_num; define(p,char_given,cur_val); @z @x math_char_def_code: begin scan_fifteen_bit_int; define(p,math_given,cur_val); end; @y math_char_def_code: begin scan_fifteen_bit_int; define(p,math_given,cur_val); end; XeTeX_math_char_num_def_code: begin scan_xetex_math_char_int; define(p, XeTeX_math_given, cur_val); end; XeTeX_math_char_def_code: begin scan_math_class_int; n := set_class_field(cur_val); scan_math_fam_int; n := n + set_family_field(cur_val); scan_usv_num; n := n + cur_val; define(p, XeTeX_math_given, n); end; @z @x else e:=true; @y else e:=true else if cur_chr=XeTeX_inter_char_loc then begin scan_eight_bit_int; cur_ptr:=cur_val; scan_eight_bit_int; find_sa_element(inter_char_val, cur_ptr*@"100 + cur_val, true); cur_chr:=cur_ptr; e:=true; end; @z @x else q:=equiv(cur_chr); @y else if cur_chr=XeTeX_inter_char_loc then begin scan_eight_bit_int; cur_ptr:=cur_val; scan_eight_bit_int; find_sa_element(inter_char_val, cur_ptr*@"100 + cur_val, false); if cur_ptr=null then q:=null else q:=sa_ptr(cur_ptr); end else q:=equiv(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; primitive("mathcode",def_code,math_code_base); @y primitive("mathcode",def_code,math_code_base); primitive("XeTeXmathcodenum",XeTeX_def_code,math_code_base); primitive("XeTeXmathcode",XeTeX_def_code,math_code_base+1); @z @x primitive("sfcode",def_code,sf_code_base); @!@:sf_code_}{\.{\\sfcode} primitive@> primitive("delcode",def_code,del_code_base); @y primitive("sfcode",def_code,sf_code_base); @!@:sf_code_}{\.{\\sfcode} primitive@> primitive("XeTeXcharclass",XeTeX_def_code,sf_code_base); primitive("delcode",def_code,del_code_base); primitive("XeTeXdelcodenum",XeTeX_def_code,del_code_base); primitive("XeTeXdelcode",XeTeX_def_code,del_code_base+1); @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 def_family: print_size(chr_code-math_font_base); @y XeTeX_def_code: if chr_code=sf_code_base then print_esc("XeTeXcharclass") else if chr_code=math_code_base then print_esc("XeTeXmathcodenum") else if chr_code=math_code_base+1 then print_esc("XeTeXmathcode") else if chr_code=del_code_base then print_esc("XeTeXdelcodenum") else print_esc("XeTeXdelcode"); def_family: print_size(chr_code-math_font_base); @z @x def_code: begin @; p:=cur_chr; scan_char_num; @y XeTeX_def_code: begin if cur_chr = sf_code_base then begin p:=cur_chr; scan_usv_num; p:=p+cur_val; n:=sf_code(cur_val) mod @"10000; scan_optional_equals; scan_char_class; define(p,data,cur_val*@"10000 + n); end else if cur_chr = math_code_base then begin p:=cur_chr; scan_usv_num; p:=p+cur_val; scan_optional_equals; scan_xetex_math_char_int; define(p,data,hi(cur_val)); end else if cur_chr = math_code_base+1 then begin p:=cur_chr-1; scan_usv_num; p:=p+cur_val; scan_optional_equals; scan_math_class_int; n := set_class_field(cur_val); scan_math_fam_int; n := n + set_family_field(cur_val); scan_usv_num; n := n + cur_val; define(p,data,hi(n)); end else if cur_chr = del_code_base then begin p:=cur_chr; scan_usv_num; p:=p+cur_val; scan_optional_equals; scan_int; {|scan_xetex_del_code_int|; !!FIXME!!} word_define(p,hi(cur_val)); end else begin { bit usage in delcode values: original layout: @@"00cffCFF small/LARGE family \& char extended: @@"40000000 FLAG + ff << 21 (mult by @@"200000) FAMILY + 1ccccc (21 bits) USV } p:=cur_chr-1; scan_usv_num; p:=p+cur_val; scan_optional_equals; n := @"40000000; {extended delcode flag} scan_math_fam_int; n := n + cur_val * @"200000; scan_usv_num; n := n + cur_val; word_define(p,hi(n)); end; end; def_code: begin @; p:=cur_chr; scan_usv_num; @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 if p<256 then xord[p]:=cur_val else if p<512 then xchr[p-256]:=cur_val else if p<768 then xprn[p-512]:=cur_val else if p=sf_code_base then begin n:=equiv(p) div @"10000; define(p,data,n*@"10000 + cur_val); end else define(p,data,cur_val) end else if p0 then begin if s=font_size[f] then goto common_ending; end else if font_size[f]=xn_over_d(font_dsize[f],-s,1000) then goto common_ending; end @y for f:=font_base+1 to font_ptr do begin if str_eq_str(font_name[f],cur_name) and (((cur_area = "") and is_native_font(f)) or str_eq_str(font_area[f],cur_area)) then begin if s>0 then begin if s=font_size[f] then goto common_ending; end else if font_size[f]=xn_over_d(font_dsize[f],-s,1000) then goto common_ending; end; { could be a native font whose "name" ended up partly in area or extension } append_str(cur_area); append_str(cur_name); append_str(cur_ext); if str_eq_str(font_name[f], make_string) then begin flush_string; if is_native_font(f) then begin if s>0 then begin if s=font_size[f] then goto common_ending; end else if font_size[f]=xn_over_d(font_dsize[f],-s,1000) then goto common_ending; end end else flush_string; end @z @x set_font:begin print("select font "); slow_print(font_name[chr_code]); @y set_font:begin print("select font "); font_name_str:=font_name[chr_code]; if is_native_font(chr_code) then begin quote_char:=""""; for n:=0 to length(font_name_str) - 1 do if str_pool[str_start_macro(font_name_str) + n] = """" then quote_char:="'"; print_char(quote_char); slow_print(font_name_str); print_char(quote_char); end else slow_print(font_name_str); @z @x begin a_close(read_file[n]); read_open[n]:=closed; @y begin u_close(read_file[n]); read_open[n]:=closed; @z @x and a_open_in(read_file[n], kpse_tex_format) then read_open[n]:=just_open; @y and u_open_in(read_file[n], kpse_tex_format, XeTeX_default_input_mode, XeTeX_default_input_encoding) then begin make_utf16_name; name_in_progress:=true; begin_name; stop_at_space:=false; k:=0; while (k; @y @z @x @!format_engine: ^text_char; @y @!format_engine: ^char; @z @x @!dummy_xord: ASCII_code; @!dummy_xchr: text_char; @!dummy_xprn: ASCII_code; @y @z @x @; @y @z @x format_engine:=xmalloc_array(text_char,x+4); @y format_engine:=xmalloc_array(char,x+4); @z @x @; @y @z @x format_engine:=xmalloc_array(text_char, x); @y format_engine:=xmalloc_array(char, x); @z @x @; @y @z @x dump_things(str_start[0], str_ptr+1); @y dump_things(str_start_macro(too_big_char), str_ptr+1-too_big_char); @z @x undump_checked_things(0, pool_ptr, str_start[0], str_ptr+1);@/ @y undump_checked_things(0, pool_ptr, str_start_macro(too_big_char), str_ptr+1-too_big_char);@/ @z @x if eTeX_ex then for k:=int_val to tok_val do dump_int(sa_root[k]); @y if eTeX_ex then for k:=int_val to inter_char_val do dump_int(sa_root[k]); @z @x if eTeX_ex then for k:=int_val to tok_val do @y if eTeX_ex then for k:=int_val to inter_char_val do @z @x print_file_name(font_name[k],font_area[k],""); @y if is_native_font(k) or (font_mapping[k]<>0) then begin print_file_name(font_name[k],"",""); print_err("Can't \dump a format with native fonts or font-mappings"); help3("You really, really don't want to do this.") ("It won't work, and only confuses me.") ("(Load them at runtime, not as part of the format file.)"); error; end else print_file_name(font_name[k],font_area[k],""); @z @x begin {Allocate the font arrays} @y begin {Allocate the font arrays} font_mapping:=xmalloc_array(void_pointer, font_max); font_layout_engine:=xmalloc_array(void_pointer, font_max); font_flags:=xmalloc_array(char, font_max); font_letter_space:=xmalloc_array(scaled, font_max); @z @x font_bc:=xmalloc_array(eight_bits, font_max); font_ec:=xmalloc_array(eight_bits, font_max); @y font_bc:=xmalloc_array(UTF16_code, font_max); font_ec:=xmalloc_array(UTF16_code, font_max); @z @x undump_things(font_check[null_font], font_ptr+1-null_font); @y for k:=null_font to font_ptr do font_mapping[k]:=0; undump_things(font_check[null_font], font_ptr+1-null_font); @z @x dump_int(trie_op_ptr); @y dump_int(max_hyph_char); dump_int(trie_op_ptr); @z @x for k:=255 downto 0 do if trie_used[k]>min_quarterword then @y for k:=biggest_lang downto 0 do if trie_used[k]>min_quarterword then @z @x undump_size(0)(trie_op_size)('trie op size')(j); @+init trie_op_ptr:=j;@+tini @y undump_int(max_hyph_char); undump_size(0)(trie_op_size)('trie op size')(j); @+init trie_op_ptr:=j;@+tini @z @x init for k:=0 to 255 do trie_used[k]:=min_quarterword;@+tini@;@/ k:=256; @y init for k:=0 to biggest_lang do trie_used[k]:=min_quarterword;@+tini@;@/ k:=biggest_lang+1; @z @x undump_int(x); if (x<>69069)or feof(fmt_file) then goto bad_fmt @y undump_int(x); if (x<>69069) then goto bad_fmt; if not w_eof(fmt_file) then goto bad_fmt @z @x @* \[51] The main program. @y @* \[51] The main program. @z @x setup_bound_var (15000)('max_strings')(max_strings); @y setup_bound_var (15000)('max_strings')(max_strings); max_strings:=max_strings+too_big_char; {the |max_strings| value doesn't include the 64K synthetic strings} @z @x buffer:=xmalloc_array (ASCII_code, buf_size); @y buffer:=xmalloc_array (UnicodeScalar, buf_size); @z @x input_file:=xmalloc_array (alpha_file, max_in_open); @y input_file:=xmalloc_array (unicode_file, max_in_open); @z @x print_file_name(0, log_name, 0); print_char("."); @y print(log_name); print_char("."); @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 {Allocate and initialize font arrays} @y {Allocate and initialize font arrays} font_mapping:=xmalloc_array(void_pointer, font_max); font_layout_engine:=xmalloc_array(void_pointer, font_max); font_flags:=xmalloc_array(char, font_max); font_letter_space:=xmalloc_array(scaled, font_max); @z @x font_bc:=xmalloc_array(eight_bits, font_max); font_ec:=xmalloc_array(eight_bits, font_max); @y font_bc:=xmalloc_array(UTF16_code, font_max); font_ec:=xmalloc_array(UTF16_code, font_max); @z @x param_base[null_font]:=-1; @y font_mapping[null_font]:=0; param_base[null_font]:=-1; @z @x @* \[53] Extensions. @y @* \[53] Extensions. @z @x @d write_stream(#) == type(#+1) {stream number (0 to 17)} @d mubyte_zero == 64 @d write_mubyte(#) == subtype(#+1) {mubyte value + |mubyte_zero|} @y @d write_stream(#) == info(#+1) {stream number (0 to 17)} @z @x @d set_language_code=5 {command modifier for \.{\\setlanguage}} @y @d set_language_code=5 {command modifier for \.{\\setlanguage}} @d pdftex_first_extension_code = 6 @d pdf_save_pos_node == pdftex_first_extension_code + 0 @d pic_file_code=41 { command modifier for \.{\\XeTeXpicfile}, skipping codes pdfTeX might use } @d pdf_file_code=42 { command modifier for \.{\\XeTeXpdffile} } @d glyph_code=43 { command modifier for \.{\\XeTeXglyph} } @d XeTeX_input_encoding_extension_code=44 @d XeTeX_default_encoding_extension_code=45 @d XeTeX_linebreak_locale_extension_code=46 @z @x @!@:set_language_}{\.{\\setlanguage} primitive@> @y @!@:set_language_}{\.{\\setlanguage} primitive@> @ The \.{\\XeTeXpicfile} and \.{\\XeTeXpdffile} primitives are only defined in extended mode. @= primitive("XeTeXpicfile",extension,pic_file_code);@/ primitive("XeTeXpdffile",extension,pdf_file_code);@/ primitive("XeTeXglyph",extension,glyph_code);@/ primitive("XeTeXlinebreaklocale", extension, XeTeX_linebreak_locale_extension_code);@/ primitive("XeTeXinterchartoks",assign_toks,XeTeX_inter_char_loc); primitive("pdfsavepos",extension,pdf_save_pos_node);@/ @z @x set_language_code:print_esc("setlanguage"); @y set_language_code:print_esc("setlanguage"); pic_file_code:print_esc("XeTeXpicfile"); pdf_file_code:print_esc("XeTeXpdffile"); glyph_code:print_esc("XeTeXglyph"); XeTeX_linebreak_locale_extension_code:print_esc("XeTeXlinebreaklocale"); XeTeX_input_encoding_extension_code:print_esc("XeTeXinputencoding"); XeTeX_default_encoding_extension_code:print_esc("XeTeXdefaultencoding"); pdf_save_pos_node: print_esc("pdfsavepos"); @z % i and j are unused by TeX but required for XeTeX @x [53.1348] (do_extension) var k:integer; {all-purpose integers} @y var i,@!j,@!k:integer; {all-purpose integers} @z @x set_language_code:@; @y set_language_code:@; pic_file_code:@; pdf_file_code:@; glyph_code:@; XeTeX_input_encoding_extension_code:@; XeTeX_default_encoding_extension_code:@; XeTeX_linebreak_locale_extension_code:@; pdf_save_pos_node: @; @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 @= 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 @= 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 @ @= @y procedure print_native_word(@!p:pointer); var i,c,cc:integer; begin for i:=0 to native_length(p) - 1 do begin c:=get_native_char(p,i); if (c >= @"D800) and (c <= @"DBFF) then begin if i < native_length(p) - 1 then begin cc:=get_native_char(p, i+1); if (cc >= @"DC00) and (cc <= @"DFFF) then begin c := @"10000 + (c - @"D800) * @"400 + (cc - @"DC00); print_char(c); incr(i); end else print("."); end else print("."); end else print_char(c); end end; @ @= @z @x if write_stream(p) <> mubyte_zero then begin print_char ("<"); print_int (write_stream(p)-mubyte_zero); if (write_stream(p)-mubyte_zero = 2) or (write_stream(p)-mubyte_zero = 3) then begin print_char (":"); print_int (write_mubyte(p)-mubyte_zero); end; print_char (">"); end; @y @z @x othercases print("whatsit?") @y native_word_node:begin print_esc(font_id_text(native_font(p))); print_char(" "); print_native_word(p); end; glyph_node:begin print_esc(font_id_text(native_font(p))); print(" glyph#"); print_int(native_glyph(p)); end; pic_node,pdf_node: begin if subtype(p) = pic_node then print_esc("XeTeXpicfile") else print_esc("XeTeXpdffile"); print(" """); for i:=0 to pic_path_length(p)-1 do print_visible_char(pic_path_byte(p, i)); print(""""); end; pdf_save_pos_node: print_esc("pdfsavepos"); othercases print("whatsit?") @z @x @ @= @y @ Picture nodes are tricky in that they are variable size. @d total_pic_node_size(#) == (pic_node_size + (pic_path_length(#) + sizeof(memory_word) - 1) div sizeof(memory_word)) @= @z @x othercases confusion("ext2") @y native_word_node: begin words:=native_size(p); r:=get_node(words); while words > 0 do begin decr(words); mem[r+words]:=mem[p+words]; end; native_glyph_info_ptr(r):=null_ptr; native_glyph_count(r):=0; copy_native_glyph_info(p, r); end; glyph_node: begin r:=get_node(glyph_node_size); words:=glyph_node_size; end; pic_node,pdf_node: begin words:=total_pic_node_size(p); r:=get_node(words); end; pdf_save_pos_node: r := get_node(small_node_size); othercases confusion("ext2") @z @x othercases confusion("ext3") @y native_word_node: begin free_native_glyph_info(p); free_node(p,native_size(p)); end; glyph_node: free_node(p,glyph_node_size); pic_node,pdf_node: free_node(p,total_pic_node_size(p)); pdf_save_pos_node: free_node(p, small_node_size); othercases confusion("ext3") @z @x @ @=do_nothing @y @ @= begin if (subtype(p)=pic_node) or (subtype(p)=pdf_node) then begin x := x + d + height(p); d := depth(p); if width(p) > w then w := width(p); end; end @z @x @ @=do_nothing @y @ @= begin case subtype(p) of native_word_node: begin { merge with any following word fragments in same font, discarding discretionary breaks } if type(q) = disc_node then k:=replace_count(q) else k:=0; while (link(q) <> p) do begin decr(k); q := link(q); { bring q up in preparation for deletion of nodes starting at p } if type(q) = disc_node then k:=replace_count(q); end; pp := link(p); restart: if (k <= 0) and (pp <> null) and (not is_char_node(pp)) then begin if (type(pp) = whatsit_node) and (subtype(pp) = native_word_node) and (native_font(pp) = native_font(p)) then begin pp := link(pp); goto restart; end else if (type(pp) = disc_node) then begin ppp := link(pp); if (ppp <> null) and (not is_char_node(ppp)) and (type(ppp) = whatsit_node) and (subtype(ppp) = native_word_node) and (native_font(ppp) = native_font(p)) then begin pp := link(ppp); goto restart; end end end; { now pp points to the non-|native_word| node that ended the chain, or null } { we can just check type(p)=|whatsit_node| below, as we know that the chain contains only discretionaries and |native_word| nodes, no other whatsits or |char_nodes| } if (pp <> link(p)) then begin { found a chain of at least two pieces starting at p } total_chars := 0; p := link(q); { the first fragment } while (p <> pp) do begin if (type(p) = whatsit_node) then total_chars := total_chars + native_length(p); { accumulate char count } ppp := p; { remember last node seen } p := link(p); { point to next fragment or discretionary or terminator } end; p := link(q); { the first fragment again } pp := new_native_word_node(native_font(p), total_chars); { make new node for merged word } link(q) := pp; { link to preceding material } link(pp) := link(ppp); { attach remainder of hlist to it } link(ppp) := null; { and detach from the old fragments } { copy the chars into new node } total_chars := 0; ppp := p; repeat if (type(ppp) = whatsit_node) then for k := 0 to native_length(ppp)-1 do begin set_native_char(pp, total_chars, get_native_char(ppp, k)); incr(total_chars); end; ppp := link(ppp); until (ppp = null); flush_node_list(p); { delete the fragments } p := link(q); { update p to point to the new node } set_native_metrics(p, XeTeX_use_glyph_metrics); { and measure it (i.e., re-do the OT layout) } end; { now incorporate the |native_word| node measurements into the box we're packing } if height(p) > h then h := height(p); if depth(p) > d then d := depth(p); x := x + width(p); end; glyph_node, pic_node, pdf_node: begin if height(p) > h then h := height(p); if depth(p) > d then d := depth(p); x := x + width(p); end; othercases do_nothing endcases end @z @x @ @=d:=0 @y @ @= if (subtype(p)=native_word_node) or (subtype(p)=glyph_node) or (subtype(p)=pic_node) or (subtype(p)=pdf_node) then begin d:=width(p); goto found; end else d := 0 @z @x @ @d adv_past(#)==@+if subtype(#)=language_node then begin cur_lang:=what_lang(#); l_hyf:=what_lhm(#); r_hyf:=what_rhm(#); set_hyph_index; end @=@+ adv_past(cur_p) @y @ @d adv_past_linebreak(#)==@+if subtype(#)=language_node then begin cur_lang:=what_lang(#); l_hyf:=what_lhm(#); r_hyf:=what_rhm(#); set_hyph_index; end else if (subtype(#)=native_word_node) or (subtype(#)=glyph_node) or (subtype(#)=pic_node) or (subtype(#)=pdf_node) then begin act_width:=act_width+width(#); end @=@+ adv_past_linebreak(cur_p) @z @x @ @=@+ adv_past(s) @y @ @d adv_past_prehyph(#)==@+if subtype(#)=language_node then begin cur_lang:=what_lang(#); l_hyf:=what_lhm(#); r_hyf:=what_rhm(#); set_hyph_index; end @=@+ adv_past_prehyph(s) @z @x @ @= goto contribute @y @ @= begin if (subtype(p)=pic_node) or (subtype(p)=pdf_node) then begin page_total := page_total + page_depth + height(p); page_depth := depth(p); end; goto contribute; end @z @x @ @= goto not_found @y @ @= begin if (subtype(p)=pic_node) or (subtype(p)=pdf_node) then begin cur_height := cur_height + prev_dp + height(p); prev_dp := depth(p); end; goto not_found; end @z @x @ @= out_what(p) @y @ @= begin case subtype(p) of glyph_node: begin cur_v:=cur_v+height(p); cur_h:=left_edge; { synch DVI state to TeX state } synch_h; synch_v; f := native_font(p); if f<>dvi_f then @; dvi_out(set_glyph_string); dvi_four(0); { width } dvi_two(1); { glyph count } dvi_four(0); { x-offset as fixed point } dvi_two(native_glyph(p)); cur_v:=cur_v+depth(p); cur_h:=left_edge; end; pic_node, pdf_node: begin save_h:=dvi_h; save_v:=dvi_v; cur_v:=cur_v+height(p); pic_out(p, subtype(p) = pdf_node); dvi_h:=save_h; dvi_v:=save_v; cur_v:=save_v+depth(p); cur_h:=left_edge; end; pdf_save_pos_node: @; othercases out_what(p) endcases end @z @x @ @= out_what(p) @y @ @= begin pdf_last_x_pos := cur_h + cur_h_offset; pdf_last_y_pos := cur_page_height - cur_v - cur_v_offset end @ @= cur_h_offset := h_offset + (unity * 7227) / 100; cur_v_offset := v_offset + (unity * 7227) / 100; if pdf_page_width <> 0 then cur_page_width := pdf_page_width else cur_page_width := width(p) + 2*cur_h_offset; if pdf_page_height <> 0 then cur_page_height := pdf_page_height else cur_page_height := height(p) + depth(p) + 2*cur_v_offset @ @= @!cur_page_width: scaled; {width of page being shipped} @!cur_page_height: scaled; {height of page being shipped} @!cur_h_offset: scaled; {horizontal offset of page being shipped} @!cur_v_offset: scaled; {vertical offset of page being shipped} @ @= begin case subtype(p) of native_word_node, glyph_node: begin { synch DVI state to TeX state } synch_h; synch_v; f := native_font(p); if f<>dvi_f then @; if subtype(p) = glyph_node then begin dvi_out(set_glyph_string); dvi_four(width(p)); dvi_two(1); { glyph count } dvi_four(0); { x-offset as fixed point } dvi_two(native_glyph(p)); cur_h := cur_h + width(p); end else begin if native_glyph_info_ptr(p) <> null_ptr then begin len := make_xdv_glyph_array_data(p); for k := 0 to len-1 do dvi_out(xdv_buffer_byte(k)); end; cur_h := cur_h + width(p); end; dvi_h := cur_h; end; pic_node, pdf_node: begin save_h:=dvi_h; save_v:=dvi_v; cur_v:=base_line; edge:=cur_h+width(p); if cur_dir=right_to_left then cur_h:=edge; pic_out(p, subtype(p) = pdf_node); dvi_h:=save_h; dvi_v:=save_v; cur_h:=edge; cur_v:=base_line; end; pdf_save_pos_node: @; othercases out_what(p) endcases end @z @x procedure special_out(@!p:pointer); var old_setting:0..max_selector; {holds print |selector|} @!k:pool_pointer; {index into |str_pool|} begin synch_h; synch_v;@/ @y procedure special_out(@!p:pointer); var old_setting:0..max_selector; {holds print |selector|} @!k:pool_pointer; {index into |str_pool|} begin synch_h; synch_v;@/ doing_special := true; @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])]); for k:=str_start[str_ptr] to pool_ptr-1 do dvi_out(so(str_pool[k])); spec_out := spec_sout; mubyte_out := mubyte_sout; mubyte_log := mubyte_slog; special_printing := false; cs_converting := false; active_noconvert := false; pool_ptr:=str_start[str_ptr]; {erase the string} @y for k:=str_start_macro(str_ptr) to pool_ptr-1 do dvi_out(so(str_pool[k])); pool_ptr:=str_start_macro(str_ptr); {erase the string} doing_special := false; @z @x @!j:small_number; {write stream number} @y @!j:small_number; {write stream number} @!k:integer; @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; @ 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 print(so(str_pool[str_start[str_ptr]+d])); {N.B.: not |print_char|} @y print(so(str_pool[str_start_macro(str_ptr)+d])); {N.B.: not |print_char|} @z @x str_pool[str_start[str_ptr]+d]:=xchr[str_pool[str_start[str_ptr]+d]]; if (str_pool[str_start[str_ptr]+d]=null_code) @y if (str_pool[str_start_macro(str_ptr)+d]=null_code) @z @x convert from UTF-16 to UTF-8 for system(3). runsystem_ret := runsystem(conststringcast(addressof( str_pool[str_start[str_ptr]]))); @y if name_of_file then libc_free(name_of_file); name_of_file := xmalloc(cur_length * 3 + 2); k := 0; for d:=0 to cur_length-1 do append_to_name(str_pool[str_start_macro(str_ptr)+d]); name_of_file[k+1] := 0; runsystem_ret := runsystem(conststringcast(name_of_file+1)); @z @x pool_ptr:=str_start[str_ptr]; {erase the string} @y pool_ptr:=str_start_macro(str_ptr); {erase the string} @z @x @= @y @= procedure pic_out(@!p:pointer; @!is_pdf:boolean); var i:integer; begin synch_h; synch_v; dvi_out(pic_file); if is_pdf then dvi_out(pic_box_type(p)) else dvi_out(0); dvi_four(pic_transform1(p)); dvi_four(pic_transform2(p)); dvi_four(pic_transform3(p)); dvi_four(pic_transform4(p)); dvi_four(pic_transform5(p)); dvi_four(pic_transform6(p)); dvi_two(pic_page(p)); dvi_two(pic_path_length(p)); for i:=0 to pic_path_length(p)-1 do dvi_out(pic_path_byte(p, i)); end; @z @x language_node:do_nothing; @y language_node:do_nothing; @z @x @ @= for k:=0 to 15 do if write_open[k] then a_close(write_file[k]) @y @ @= terminate_font_manager; for k:=0 to 15 do if write_open[k] then a_close(write_file[k]) @ @= if abs(mode)=mmode then report_illegal_case else load_picture(false) @ @= if abs(mode)=mmode then report_illegal_case else load_picture(true) @ @= begin if abs(mode)=vmode then begin back_input; new_graf(true); end else if abs(mode)=mmode then report_illegal_case else begin if is_native_font(cur_font) then begin new_whatsit(glyph_node,glyph_node_size); scan_int; if (cur_val<0)or(cur_val>65535) then begin print_err("Bad glyph number"); help2("A glyph number must be between 0 and 65535.")@/ ("I changed this one to zero."); int_error(cur_val); cur_val:=0; end; native_font(tail):=cur_font; native_glyph(tail):=cur_val; set_native_glyph_metrics(tail, XeTeX_use_glyph_metrics); end else not_native_font_error(extension, glyph_code, cur_font); end end @ Load a picture file and handle following keywords. @d calc_min_and_max== begin xmin := 1000000.0; xmax := -xmin; ymin := xmin; ymax := xmax; for i := 0 to 3 do begin if xCoord(corners[i]) < xmin then xmin := xCoord(corners[i]); if xCoord(corners[i]) > xmax then xmax := xCoord(corners[i]); if yCoord(corners[i]) < ymin then ymin := yCoord(corners[i]); if yCoord(corners[i]) > ymax then ymax := yCoord(corners[i]); end; end @d update_corners== for i := 0 to 3 do transform_point(addressof(corners[i]), addressof(t2)) @d do_size_requests==begin { calculate current width and height } calc_min_and_max; if x_size_req = 0.0 then begin make_scale(addressof(t2), y_size_req / (ymax - ymin), y_size_req / (ymax - ymin)); end else if y_size_req = 0.0 then begin make_scale(addressof(t2), x_size_req / (xmax - xmin), x_size_req / (xmax - xmin)); end else begin make_scale(addressof(t2), x_size_req / (xmax - xmin), y_size_req / (ymax - ymin)); end; update_corners; x_size_req := 0.0; y_size_req := 0.0; transform_concat(addressof(t), addressof(t2)); end @= procedure load_picture(@!is_pdf:boolean); var pic_path: ^char; bounds: real_rect; t, t2: transform; corners: array[0..3] of real_point; x_size_req,y_size_req: real; check_keywords: boolean; xmin,xmax,ymin,ymax: real; i: small_number; page: integer; pdf_box_type: integer; result: integer; begin { scan the filename and pack into |name_of_file| } scan_file_name; pack_cur_name; pdf_box_type := 0; page := 0; if is_pdf then begin if scan_keyword("page") then begin scan_int; page := cur_val; end; pdf_box_type := pdfbox_crop; if scan_keyword("crop") then do_nothing else if scan_keyword("media") then pdf_box_type := pdfbox_media else if scan_keyword("bleed") then pdf_box_type := pdfbox_bleed else if scan_keyword("trim") then pdf_box_type := pdfbox_trim else if scan_keyword("art") then pdf_box_type := pdfbox_art; end; { access the picture file and check its size } result := find_pic_file(addressof(pic_path), addressof(bounds), pdf_box_type, page); setPoint(corners[0], xField(bounds), yField(bounds)); setPoint(corners[1], xField(corners[0]), yField(bounds) + htField(bounds)); setPoint(corners[2], xField(bounds) + wdField(bounds), yField(corners[1])); setPoint(corners[3], xField(corners[2]), yField(corners[0])); x_size_req := 0.0; y_size_req := 0.0; { look for any scaling requests for this picture } make_identity(addressof(t)); check_keywords := true; while check_keywords do begin if scan_keyword("scaled") then begin scan_int; if (x_size_req = 0.0) and (y_size_req = 0.0) then begin make_scale(addressof(t2), float(cur_val) / 1000.0, float(cur_val) / 1000.0); update_corners; transform_concat(addressof(t), addressof(t2)); end end else if scan_keyword("xscaled") then begin scan_int; if (x_size_req = 0.0) and (y_size_req = 0.0) then begin make_scale(addressof(t2), float(cur_val) / 1000.0, 1.0); update_corners; transform_concat(addressof(t), addressof(t2)); end end else if scan_keyword("yscaled") then begin scan_int; if (x_size_req = 0.0) and (y_size_req = 0.0) then begin make_scale(addressof(t2), 1.0, float(cur_val) / 1000.0); update_corners; transform_concat(addressof(t), addressof(t2)); end end else if scan_keyword("width") then begin scan_normal_dimen; if cur_val <= 0 then begin print_err("Improper image "); print("size ("); print_scaled(cur_val); print("pt) will be ignored"); help2("I can't scale images to zero or negative sizes, ") ("so I'm ignoring this."); error; end else x_size_req := Fix2X(cur_val); end else if scan_keyword("height") then begin scan_normal_dimen; if cur_val <= 0 then begin print_err("Improper image "); print("size ("); print_scaled(cur_val); print("pt) will be ignored"); help2("I can't scale images to zero or negative sizes, ") ("so I'm ignoring this."); error; end else y_size_req := Fix2X(cur_val); end else if scan_keyword("rotated") then begin scan_decimal; if (x_size_req <> 0.0) or (y_size_req <> 0.0) then do_size_requests; make_rotation(addressof(t2), Fix2X(cur_val) * 3.141592653589793 / 180.0); update_corners; calc_min_and_max; setPoint(corners[0], xmin, ymin); setPoint(corners[1], xmin, ymax); setPoint(corners[2], xmax, ymax); setPoint(corners[3], xmax, ymin); transform_concat(addressof(t), addressof(t2)); end else check_keywords := false; end; if (x_size_req <> 0.0) or (y_size_req <> 0.0) then do_size_requests; calc_min_and_max; make_translation(addressof(t2), -xmin * 72 / 72.27, -ymin * 72 / 72.27); transform_concat(addressof(t), addressof(t2)); if result = 0 then begin new_whatsit(pic_node, pic_node_size + (strlen(pic_path) + sizeof(memory_word) - 1) div sizeof(memory_word)); if is_pdf then begin subtype(tail) := pdf_node; pic_box_type(tail) := pdf_box_type; end; pic_path_length(tail) := strlen(pic_path); pic_page(tail) := page; width(tail) := X2Fix(xmax - xmin); height(tail) := X2Fix(ymax - ymin); depth(tail) := 0; pic_transform1(tail) := X2Fix(aField(t)); pic_transform2(tail) := X2Fix(bField(t)); pic_transform3(tail) := X2Fix(cField(t)); pic_transform4(tail) := X2Fix(dField(t)); pic_transform5(tail) := X2Fix(txField(t)); pic_transform6(tail) := X2Fix(tyField(t)); memcpy(addressof(mem[tail + pic_node_size]), pic_path, strlen(pic_path)); libc_free(pic_path); end else begin print_err("Unable to load picture or PDF file '"); print_file_name(cur_name,cur_area,cur_ext); print("'"); if result = -43 then begin { Mac OS file not found error } help2("The requested image couldn't be read because ") ("the file was not found."); end else begin { otherwise assume GraphicImport failed } help2("The requested image couldn't be read because ") ("it was not a recognized image format."); end; error; end; end; @ @= begin { scan a filename-like arg for the input encoding } scan_and_pack_name; { convert it to "mode" and "encoding" values, and apply to the current input file } i := get_encoding_mode_and_info(addressof(j)); if i = XeTeX_input_mode_auto then begin print_err("Encoding mode `auto' is not valid for \XeTeXinputencoding."); help2("You can't use `auto' encoding here, only for \XeTeXdefaultencoding. ") ("I'll ignore this and leave the current encoding unchanged."); error; end else set_input_file_encoding(input_file[in_open], i, j); end @ @= begin { scan a filename-like arg for the input encoding } scan_and_pack_name; { convert it to "mode" and "encoding" values, and store them as defaults for new input files } XeTeX_default_input_mode := get_encoding_mode_and_info(addressof(j)); XeTeX_default_input_encoding := j; end @ @= begin { scan a filename-like arg for the locale name } scan_file_name; if length(cur_name) = 0 then XeTeX_linebreak_locale := 0 else XeTeX_linebreak_locale := cur_name; { we ignore the area and extension! } end @ @= @!pdf_last_x_pos: integer; @!pdf_last_y_pos: integer; @ @= begin new_whatsit(pdf_save_pos_node, small_node_size); end @z @x @d eTeX_version_code=eTeX_int {code for \.{\\eTeXversion}} @y @d eTeX_version_code=eTeX_int {code for \.{\\eTeXversion}} @z @x @!@:eTeX_revision_}{\.{\\eTeXrevision} primitive@> @y @!@:eTeX_revision_}{\.{\\eTeXrevision} primitive@> primitive("XeTeXversion",last_item,XeTeX_version_code); @!@:XeTeX_version_}{\.{\\XeTeXversion} primitive@> primitive("XeTeXrevision",convert,XeTeX_revision_code);@/ @!@:XeTeXrevision_}{\.{\\XeTeXrevision} primitive@> primitive("XeTeXcountglyphs",last_item,XeTeX_count_glyphs_code); primitive("XeTeXcountvariations",last_item,XeTeX_count_variations_code); primitive("XeTeXvariation",last_item,XeTeX_variation_code); primitive("XeTeXfindvariationbyname",last_item,XeTeX_find_variation_by_name_code); primitive("XeTeXvariationmin",last_item,XeTeX_variation_min_code); primitive("XeTeXvariationmax",last_item,XeTeX_variation_max_code); primitive("XeTeXvariationdefault",last_item,XeTeX_variation_default_code); primitive("XeTeXcountfeatures",last_item,XeTeX_count_features_code); primitive("XeTeXfeaturecode",last_item,XeTeX_feature_code_code); primitive("XeTeXfindfeaturebyname",last_item,XeTeX_find_feature_by_name_code); primitive("XeTeXisexclusivefeature",last_item,XeTeX_is_exclusive_feature_code); primitive("XeTeXcountselectors",last_item,XeTeX_count_selectors_code); primitive("XeTeXselectorcode",last_item,XeTeX_selector_code_code); primitive("XeTeXfindselectorbyname",last_item,XeTeX_find_selector_by_name_code); primitive("XeTeXisdefaultselector",last_item,XeTeX_is_default_selector_code); primitive("XeTeXvariationname",convert,XeTeX_variation_name_code); primitive("XeTeXfeaturename",convert,XeTeX_feature_name_code); primitive("XeTeXselectorname",convert,XeTeX_selector_name_code); primitive("XeTeXOTcountscripts",last_item,XeTeX_OT_count_scripts_code); primitive("XeTeXOTcountlanguages",last_item,XeTeX_OT_count_languages_code); primitive("XeTeXOTcountfeatures",last_item,XeTeX_OT_count_features_code); primitive("XeTeXOTscripttag",last_item,XeTeX_OT_script_code); primitive("XeTeXOTlanguagetag",last_item,XeTeX_OT_language_code); primitive("XeTeXOTfeaturetag",last_item,XeTeX_OT_feature_code); primitive("XeTeXcharglyph", last_item, XeTeX_map_char_to_glyph_code); primitive("XeTeXglyphindex", last_item, XeTeX_glyph_index_code); primitive("XeTeXglyphbounds", last_item, XeTeX_glyph_bounds_code); primitive("XeTeXglyphname",convert,XeTeX_glyph_name_code); primitive("XeTeXfonttype", last_item, XeTeX_font_type_code); primitive("XeTeXfirstfontchar", last_item, XeTeX_first_char_code); primitive("XeTeXlastfontchar", last_item, XeTeX_last_char_code); primitive("pdflastxpos",last_item,pdf_last_x_pos_code); primitive("pdflastypos",last_item,pdf_last_y_pos_code); primitive("XeTeXpdfpagecount",last_item,XeTeX_pdf_page_count_code); @z @x eTeX_version_code: print_esc("eTeXversion"); @y eTeX_version_code: print_esc("eTeXversion"); XeTeX_version_code: print_esc("XeTeXversion"); XeTeX_count_glyphs_code: print_esc("XeTeXcountglyphs"); XeTeX_count_variations_code: print_esc("XeTeXcountvariations"); XeTeX_variation_code: print_esc("XeTeXvariation"); XeTeX_find_variation_by_name_code: print_esc("XeTeXfindvariationbyname"); XeTeX_variation_min_code: print_esc("XeTeXvariationmin"); XeTeX_variation_max_code: print_esc("XeTeXvariationmax"); XeTeX_variation_default_code: print_esc("XeTeXvariationdefault"); XeTeX_count_features_code: print_esc("XeTeXcountfeatures"); XeTeX_feature_code_code: print_esc("XeTeXfeaturecode"); XeTeX_find_feature_by_name_code: print_esc("XeTeXfindfeaturebyname"); XeTeX_is_exclusive_feature_code: print_esc("XeTeXisexclusivefeature"); XeTeX_count_selectors_code: print_esc("XeTeXcountselectors"); XeTeX_selector_code_code: print_esc("XeTeXselectorcode"); XeTeX_find_selector_by_name_code: print_esc("XeTeXfindselectorbyname"); XeTeX_is_default_selector_code: print_esc("XeTeXisdefaultselector"); XeTeX_OT_count_scripts_code: print_esc("XeTeXOTcountscripts"); XeTeX_OT_count_languages_code: print_esc("XeTeXOTcountlanguages"); XeTeX_OT_count_features_code: print_esc("XeTeXOTcountfeatures"); XeTeX_OT_script_code: print_esc("XeTeXOTscripttag"); XeTeX_OT_language_code: print_esc("XeTeXOTlanguagetag"); XeTeX_OT_feature_code: print_esc("XeTeXOTfeaturetag"); XeTeX_map_char_to_glyph_code: print_esc("XeTeXcharglyph"); XeTeX_glyph_index_code: print_esc("XeTeXglyphindex"); XeTeX_glyph_bounds_code: print_esc("XeTeXglyphbounds"); XeTeX_font_type_code: print_esc("XeTeXfonttype"); XeTeX_first_char_code: print_esc("XeTeXfirstfontchar"); XeTeX_last_char_code: print_esc("XeTeXlastfontchar"); pdf_last_x_pos_code: print_esc("pdflastxpos"); pdf_last_y_pos_code: print_esc("pdflastypos"); XeTeX_pdf_page_count_code: print_esc("XeTeXpdfpagecount"); @z @x eTeX_version_code: cur_val:=eTeX_version; @y eTeX_version_code: cur_val:=eTeX_version; XeTeX_version_code: cur_val:=XeTeX_version; XeTeX_count_glyphs_code: begin scan_font_ident; n:=cur_val; if is_atsu_font(n) then cur_val:=atsu_font_get(m - XeTeX_int, font_layout_engine[n]) else if is_otgr_font(n) then cur_val:=ot_font_get(m - XeTeX_int, font_layout_engine[n]) else cur_val:=0; end; XeTeX_count_variations_code: begin scan_font_ident; n:=cur_val; if is_atsu_font(n) then cur_val:=atsu_font_get(m - XeTeX_int, font_layout_engine[n]) else begin cur_val:=0; end; end; XeTeX_count_features_code: begin scan_font_ident; n:=cur_val; if is_atsu_font(n) then cur_val:=atsu_font_get(m - XeTeX_int, font_layout_engine[n]) else if is_gr_font(n) then cur_val:=ot_font_get(m - XeTeX_int, font_layout_engine[n]) else cur_val:=0; end; XeTeX_variation_code, XeTeX_variation_min_code, XeTeX_variation_max_code, XeTeX_variation_default_code: begin scan_font_ident; n:=cur_val; if is_atsu_font(n) then begin scan_int; k:=cur_val; cur_val:=atsu_font_get_1(m - XeTeX_int, font_layout_engine[n], k); end else begin not_atsu_font_error(last_item, m, n); cur_val:=-1; end; end; XeTeX_feature_code_code, XeTeX_is_exclusive_feature_code, XeTeX_count_selectors_code: begin scan_font_ident; n:=cur_val; if is_atsu_font(n) then begin scan_int; k:=cur_val; cur_val:=atsu_font_get_1(m - XeTeX_int, font_layout_engine[n], k); end else if is_gr_font(n) then begin scan_int; k:=cur_val; cur_val:=ot_font_get_1(m - XeTeX_int, font_layout_engine[n], k); end else begin not_atsu_gr_font_error(last_item, m, n); cur_val:=-1; end; end; XeTeX_selector_code_code, XeTeX_is_default_selector_code: begin scan_font_ident; n:=cur_val; if is_atsu_font(n) then begin scan_int; k:=cur_val; scan_int; cur_val:=atsu_font_get_2(m - XeTeX_int, font_layout_engine[n], k, cur_val); end else if is_gr_font(n) then begin scan_int; k:=cur_val; scan_int; cur_val:=ot_font_get_2(m - XeTeX_int, font_layout_engine[n], k, cur_val); end else begin not_atsu_gr_font_error(last_item, m, n); cur_val:=-1; end; end; XeTeX_find_variation_by_name_code: begin scan_font_ident; n:=cur_val; if is_atsu_font(n) then begin scan_and_pack_name; cur_val:=atsu_font_get_named(m - XeTeX_int, font_layout_engine[n]); end else begin not_atsu_font_error(last_item, m, n); cur_val:=-1; end; end; XeTeX_find_feature_by_name_code: begin scan_font_ident; n:=cur_val; if is_atsu_font(n) then begin scan_and_pack_name; cur_val:=atsu_font_get_named(m - XeTeX_int, font_layout_engine[n]); end else if is_gr_font(n) then begin scan_and_pack_name; cur_val:=gr_font_get_named(m - XeTeX_int, font_layout_engine[n]); end else begin not_atsu_gr_font_error(last_item, m, n); cur_val:=-1; end; end; XeTeX_find_selector_by_name_code: begin scan_font_ident; n:=cur_val; if is_atsu_font(n) then begin scan_int; k:=cur_val; scan_and_pack_name; cur_val:=atsu_font_get_named_1(m - XeTeX_int, font_layout_engine[n], k); end else if is_gr_font(n) then begin scan_int; k:=cur_val; scan_and_pack_name; cur_val:=gr_font_get_named_1(m - XeTeX_int, font_layout_engine[n], k); end else begin not_atsu_gr_font_error(last_item, m, n); cur_val:=-1; end; end; XeTeX_OT_count_scripts_code: begin scan_font_ident; n:=cur_val; if is_ot_font(n) then cur_val:=ot_font_get(m - XeTeX_int, font_layout_engine[n]) else begin cur_val:=0; end; end; XeTeX_OT_count_languages_code, XeTeX_OT_script_code: begin scan_font_ident; n:=cur_val; if is_ot_font(n) then begin scan_int; cur_val:=ot_font_get_1(m - XeTeX_int, font_layout_engine[n], cur_val); end else begin not_ot_font_error(last_item, m, n); cur_val:=-1; end; end; XeTeX_OT_count_features_code, XeTeX_OT_language_code: begin scan_font_ident; n:=cur_val; if is_ot_font(n) then begin scan_int; k:=cur_val; scan_int; cur_val:=ot_font_get_2(m - XeTeX_int, font_layout_engine[n], k, cur_val); end else begin not_ot_font_error(last_item, m, n); cur_val:=-1; end; end; XeTeX_OT_feature_code: begin scan_font_ident; n:=cur_val; if is_ot_font(n) then begin scan_int; k:=cur_val; scan_int; kk:=cur_val; scan_int; cur_val:=ot_font_get_3(m - XeTeX_int, font_layout_engine[n], k, kk, cur_val); end else begin not_ot_font_error(last_item, m, n); cur_val:=-1; end; end; XeTeX_map_char_to_glyph_code: begin if is_native_font(cur_font) then begin scan_int; n:=cur_val; cur_val:=map_char_to_glyph(cur_font, n) end else begin not_native_font_error(last_item, m, cur_font); cur_val:=0 end end; XeTeX_glyph_index_code: begin if is_native_font(cur_font) then begin scan_and_pack_name; cur_val:=map_glyph_to_index(cur_font) end else begin not_native_font_error(last_item, m, cur_font); cur_val:=0 end end; XeTeX_font_type_code: begin scan_font_ident; n:=cur_val; if is_atsu_font(n) then cur_val:=1 else if is_ot_font(n) then cur_val:=2 else if is_gr_font(n) then cur_val:=3 else cur_val:=0; end; XeTeX_first_char_code,XeTeX_last_char_code: begin scan_font_ident; n:=cur_val; if is_native_font(n) then cur_val:=get_font_char_range(n, m = XeTeX_first_char_code) else begin if m = XeTeX_first_char_code then cur_val:=font_bc[n] else cur_val:=font_ec[n]; end end; pdf_last_x_pos_code: cur_val := pdf_last_x_pos; pdf_last_y_pos_code: cur_val := pdf_last_y_pos; XeTeX_pdf_page_count_code: begin scan_and_pack_name; cur_val:=count_pdf_file_pages; end; @ Slip in an extra procedure here and there.... @= procedure scan_and_pack_name; forward; @ @= procedure scan_and_pack_name; begin scan_file_name; pack_cur_name; end; @ @= procedure not_atsu_font_error(cmd, c: integer; f: integer); begin print_err("Cannot use "); print_cmd_chr(cmd, c); print(" with "); print(font_name[f]); print("; not an AAT font"); error; end; procedure not_atsu_gr_font_error(cmd, c: integer; f: integer); begin print_err("Cannot use "); print_cmd_chr(cmd, c); print(" with "); print(font_name[f]); print("; not an AAT or Graphite font"); error; end; procedure not_ot_font_error(cmd, c: integer; f: integer); begin print_err("Cannot use "); print_cmd_chr(cmd, c); print(" with "); print(font_name[f]); print("; not an OpenType Layout font"); error; end; procedure not_native_font_error(cmd, c: integer; f: integer); begin print_err("Cannot use "); print_cmd_chr(cmd, c); print(" with "); print(font_name[f]); print("; not a native platform font"); error; end; @ @= XeTeX_glyph_bounds_code: begin if is_native_font(cur_font) then begin scan_int; n:=cur_val; { which edge: 1=left, 2=top, 3=right, 4=bottom } if (n < 1) or (n > 4) then begin print_err("\\XeTeXglyphbounds requires an edge index from 1 to 4;"); print_nl("I don't know anything about edge "); print_int(n); error; cur_val:=0; end else begin scan_int; { glyph number } cur_val:=get_glyph_bounds(cur_font, n, cur_val); end end else begin not_native_font_error(last_item, m, cur_font); cur_val:=0 end end; @ @= eTeX_revision_code: print_esc("eTeXrevision"); XeTeX_revision_code: print_esc("XeTeXrevision"); XeTeX_variation_name_code: print_esc("XeTeXvariationname"); XeTeX_feature_name_code: print_esc("XeTeXfeaturename"); XeTeX_selector_name_code: print_esc("XeTeXselectorname"); XeTeX_glyph_name_code: print_esc("XeTeXglyphname"); @ @= eTeX_revision_code: do_nothing; XeTeX_revision_code: do_nothing; XeTeX_variation_name_code: begin scan_font_ident; fnt:=cur_val; if is_atsu_font(fnt) then begin scan_int; arg1:=cur_val; arg2:=0; end else not_atsu_font_error(convert, c, fnt); end; XeTeX_feature_name_code: begin scan_font_ident; fnt:=cur_val; if is_atsu_font(fnt) or is_gr_font(fnt) then begin scan_int; arg1:=cur_val; arg2:=0; end else not_atsu_gr_font_error(convert, c, fnt); end; XeTeX_selector_name_code: begin scan_font_ident; fnt:=cur_val; if is_atsu_font(fnt) or is_gr_font(fnt) then begin scan_int; arg1:=cur_val; scan_int; arg2:=cur_val; end else not_atsu_gr_font_error(convert, c, fnt); end; XeTeX_glyph_name_code: begin scan_font_ident; fnt:=cur_val; if is_native_font(fnt) then begin scan_int; arg1:=cur_val; end else not_native_font_error(convert, c, fnt); end; @ @= eTeX_revision_code: print(eTeX_revision); XeTeX_revision_code: print(XeTeX_revision); XeTeX_variation_name_code: if is_atsu_font(fnt) then atsu_print_font_name(c, font_layout_engine[fnt], arg1, arg2); XeTeX_feature_name_code, XeTeX_selector_name_code: if is_atsu_font(fnt) then atsu_print_font_name(c, font_layout_engine[fnt], arg1, arg2) else if is_gr_font(fnt) then gr_print_font_name(c, font_layout_engine[fnt], arg1, arg2); XeTeX_glyph_name_code: if is_native_font(fnt) then print_glyph_name(fnt, arg1); @z @x @ @= dump_int(eTeX_mode); for j:=0 to eTeX_states-1 do eTeX_state(j):=0; {disable all enhancements} @y @ @= dump_int(eTeX_mode); { in a deliberate change from e-TeX, we allow non-zero state variables to be dumped } @z @x every_eof_loc: print_esc("everyeof"); @y every_eof_loc: print_esc("everyeof"); XeTeX_inter_char_loc: print_esc("XeTeXinterchartoks"); @z @x font_char_wd_code, font_char_ht_code, font_char_dp_code, font_char_ic_code: begin scan_font_ident; q:=cur_val; scan_char_num; 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 font_char_wd_code, font_char_ht_code, font_char_dp_code, font_char_ic_code: begin scan_font_ident; q:=cur_val; scan_usv_num; if is_native_font(q) then begin case m of font_char_wd_code: cur_val := getnativecharwd(q, cur_val); font_char_ht_code: cur_val := getnativecharht(q, cur_val); font_char_dp_code: cur_val := getnativechardp(q, cur_val); font_char_ic_code: cur_val := getnativecharic(q, cur_val); end; {there are no other cases} end else begin 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 end; @z @x @d TeXXeT_en==(TeXXeT_state>0) {is \TeXXeT\ enabled?} @y @d TeXXeT_en==(TeXXeT_state>0) {is \TeXXeT\ enabled?} @d XeTeX_upwards_state==eTeX_state(XeTeX_upwards_code) @d XeTeX_upwards==(XeTeX_upwards_state>0) @d XeTeX_use_glyph_metrics_state==eTeX_state(XeTeX_use_glyph_metrics_code) @d XeTeX_use_glyph_metrics==(XeTeX_use_glyph_metrics_state>0) @d XeTeX_inter_char_tokens_state==eTeX_state(XeTeX_inter_char_tokens_code) @d XeTeX_inter_char_tokens_en==(XeTeX_inter_char_tokens_state>0) @d XeTeX_dash_break_state == eTeX_state(XeTeX_dash_break_code) @d XeTeX_dash_break_en == (XeTeX_dash_break_state>0) @d XeTeX_input_normalization_state == eTeX_state(XeTeX_input_normalization_code) @d XeTeX_tracing_fonts_state == eTeX_state(XeTeX_tracing_fonts_code) @d XeTeX_default_input_mode == eTeX_state(XeTeX_default_input_mode_code) @d XeTeX_default_input_encoding == eTeX_state(XeTeX_default_input_encoding_code) @z @x eTeX_state_code+TeXXeT_code:print_esc("TeXXeTstate"); @y suppress_fontnotfound_error_code:print_esc("suppressfontnotfounderror"); eTeX_state_code+TeXXeT_code:print_esc("TeXXeTstate"); eTeX_state_code+XeTeX_upwards_code:print_esc("XeTeXupwardsmode"); eTeX_state_code+XeTeX_use_glyph_metrics_code:print_esc("XeTeXuseglyphmetrics"); eTeX_state_code+XeTeX_inter_char_tokens_code:print_esc("XeTeXinterchartokenstate"); eTeX_state_code+XeTeX_dash_break_code:print_esc("XeTeXdashbreakstate"); eTeX_state_code+XeTeX_input_normalization_code:print_esc("XeTeXinputnormalization"); eTeX_state_code+XeTeX_tracing_fonts_code:print_esc("XeTeXtracingfonts"); @z @x primitive("TeXXeTstate",assign_int,eTeX_state_base+TeXXeT_code); @!@:TeXXeT_state_}{\.{\\TeXXeT_state} primitive@> @y primitive("suppressfontnotfounderror",assign_int,int_base+suppress_fontnotfound_error_code);@/ primitive("TeXXeTstate",assign_int,eTeX_state_base+TeXXeT_code); @!@:TeXXeT_state_}{\.{\\TeXXeT_state} primitive@> primitive("XeTeXupwardsmode",assign_int,eTeX_state_base+XeTeX_upwards_code); @!@:XeTeX_upwards_mode_}{\.{\\XeTeX_upwards_mode} primitive@> primitive("XeTeXuseglyphmetrics",assign_int,eTeX_state_base+XeTeX_use_glyph_metrics_code); @!@:XeTeX_use_glyph_metrics_}{\.{\\XeTeX_use_glyph_metrics} primitive@> primitive("XeTeXinterchartokenstate",assign_int,eTeX_state_base+XeTeX_inter_char_tokens_code); @!@:XeTeX_use_inter_char_tokens_}{\.{\\XeTeX_use_inter_char_tokens} primitive@> primitive("XeTeXdashbreakstate",assign_int,eTeX_state_base+XeTeX_dash_break_code); @!@:XeTeX_dash_break_state_}{\.{\\XeTeX_dash_break_state} primitive@> primitive("XeTeXinputnormalization",assign_int,eTeX_state_base+XeTeX_input_normalization_code); @!@:XeTeX_input_normalization_}{\.{\\XeTeX_input_normalization} primitive@> primitive("XeTeXtracingfonts",assign_int,eTeX_state_base+XeTeX_tracing_fonts_code); primitive("XeTeXinputencoding",extension,XeTeX_input_encoding_extension_code); primitive("XeTeXdefaultencoding",extension,XeTeX_default_encoding_extension_code); @z @x @ Here we compute the effective width of a glue node as in |hlist_out|. @= glue_node: begin round_glue; @; end; @y @ Need to measure |native_word| and picture nodes when reversing! @= whatsit_node: if (subtype(p)=native_word_node) or (subtype(p)=glyph_node) or (subtype(p)=pic_node) or (subtype(p)=pdf_node) then rule_wd:=width(p) else goto next_p; @ Here we compute the effective width of a glue node as in |hlist_out|. @= glue_node: begin round_glue; @; end; @z @x str_pool[pool_ptr]:=si(" "); l:=str_start[s]; @y str_pool[pool_ptr]:=si(" "); l:=str_start_macro(s); @z @x buffer[m]:=info(p) mod @'400; incr(m); p:=link(p); @y buffer[m]:=info(p) mod max_char_val; incr(m); p:=link(p); @z @x if_font_char_code:begin scan_font_ident; n:=cur_val; scan_char_num; if (font_bc[n]<=cur_val)and(font_ec[n]>=cur_val) then b:=char_exists(char_info(n)(qi(cur_val))) else b:=false; end; @y if_font_char_code:begin scan_font_ident; n:=cur_val; scan_usv_num; if is_native_font(n) then b := (map_char_to_glyph(n, cur_val) > 0) else begin if (font_bc[n]<=cur_val)and(font_ec[n]>=cur_val) then b:=char_exists(char_info(n)(qi(cur_val))) else b:=false; end; end; @z @x @d mark_val=6 {the additional mark classes} @y @d mark_val=7 {the additional mark classes} @z @x for i:=int_val to tok_val do sa_root[i]:=null; @y for i:=int_val to inter_char_val do sa_root[i]:=null; @z @x {hyphenation code is only saved for chars 0..255} @d set_lc_code(#)== {set |hc[0]| to hyphenation or lc code for |#|} if hyph_index=0 then hc[0]:=lc_code(#) @y @d set_lc_code(#)== {set |hc[0]| to hyphenation or lc code for |#|} if (hyph_index=0) or ((#)>255) then hc[0]:=lc_code(#) @z @x for c := str_start[text(h)] to str_start[text(h) + 1] - 1 @y for c := str_start_macro(text(h)) to str_start_macro(text(h) + 1) - 1 @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_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. @= 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 while s>255 do {first 256 strings depend on implementation!!} @y while s>65535 do {first 64K strings don't really exist in the pool!} @z @x @!mltex_enabled_p:boolean; {enable character substitution} @y @!mltex_enabled_p:boolean; {enable character substitution} @!native_font_type_flag:integer; {used by XeTeX font loading code to record which font technology was used} @!xtx_ligature_present:boolean; {to suppress tfm font mapping of char codes from ligature nodes (already mapped)} @z @x begin result:=c; {return |c| unless it does not exist in the font} @y begin if (not xtx_ligature_present) and (font_mapping[f]<>nil) then c:=apply_tfm_font_mapping(font_mapping[f],c); xtx_ligature_present:=false; result:=c; {return |c| unless it does not exist in the font} @z @x begin if not mltex_enabled_p then @y begin if (not xtx_ligature_present) and (font_mapping[f]<>nil) then c:=apply_tfm_font_mapping(font_mapping[f],c); xtx_ligature_present:=false; if not mltex_enabled_p then @z @x effective_char_info:=null_character; exit:end; @y effective_char_info:=null_character; exit:end; { the following procedure has been moved so that |new_native_character| can call it } procedure char_warning(@!f:internal_font_number;@!c:integer); var old_setting: integer; {saved value of |tracing_online|} begin if tracing_lost_chars>0 then begin old_setting:=tracing_online; if eTeX_ex and(tracing_lost_chars>1) then tracing_online:=1; begin begin_diagnostic; print_nl("Missing character: There is no "); @.Missing character@> if c < @"10000 then print_ASCII(c) else begin { non-Plane 0 Unicodes can't be sent through |print_ASCII| } print("character number "); print_hex(c); end; print(" in font "); slow_print(font_name[f]); print_char("!"); end_diagnostic(false); end; tracing_online:=old_setting; end; end; { additional functions for native font support } function new_native_word_node(@!f:internal_font_number;@!n:integer):pointer; { note that this function creates the node, but does not actually set its metrics; call |set_native_metrics(node)| if that is required! } var l: integer; q: pointer; begin l := native_node_size + (n * sizeof(UTF16_code) + sizeof(memory_word) - 1) div sizeof(memory_word); q := get_node(l); type(q) := whatsit_node; subtype(q) := native_word_node; native_size(q) := l; native_font(q) := f; native_length(q) := n; native_glyph_count(q) := 0; native_glyph_info_ptr(q) := null_ptr; new_native_word_node := q; end; function new_native_character(@!f:internal_font_number;@!c:UnicodeScalar):pointer; var p: pointer; i, len: integer; begin if font_mapping[f] <> 0 then begin if c > @"FFFF then begin str_room(2); append_char((c - @"10000) div 1024 + @"D800); append_char((c - @"10000) mod 1024 + @"DC00); end else begin str_room(1); append_char(c); end; len := apply_mapping(font_mapping[f], addressof(str_pool[str_start_macro(str_ptr)]), cur_length); pool_ptr := str_start_macro(str_ptr); { flush the string, as we'll be using the mapped text instead } i := 0; while i < len do begin if (mapped_text[i] >= @"D800) and (mapped_text[i] < @"DC00) then begin c := (mapped_text[i] - @"D800) * 1024 + mapped_text[i+1] - @"DC00 + @"10000; if map_char_to_glyph(f, c) = 0 then begin char_warning(f, c); end; i := i + 2; end else begin if map_char_to_glyph(f, mapped_text[i]) = 0 then begin char_warning(f, mapped_text[i]); end; i := i + 1; end; end; p := new_native_word_node(f, len); for i := 0 to len-1 do begin set_native_char(p, i, mapped_text[i]); end end else begin if tracing_lost_chars > 0 then if map_char_to_glyph(f, c) = 0 then begin char_warning(f, c); end; p := get_node(native_node_size + 1); type(p) := whatsit_node; subtype(p) := native_word_node; native_size(p) := native_node_size + 1; native_glyph_count(p) := 0; native_glyph_info_ptr(p) := null_ptr; native_font(p) := f; if c > @"FFFF then begin native_length(p) := 2; set_native_char(p, 0, (c - @"10000) div 1024 + @"D800); set_native_char(p, 1, (c - @"10000) mod 1024 + @"DC00); end else begin native_length(p) := 1; set_native_char(p, 0, c); end; end; set_native_metrics(p, XeTeX_use_glyph_metrics); new_native_character := p; end; procedure font_feature_warning(featureNameP:void_pointer; featLen:integer; settingNameP:void_pointer; setLen:integer); var i: integer; begin begin_diagnostic; print_nl("Unknown "); if setLen > 0 then begin print("selector `"); print_utf8_str(settingNameP, setLen); print("' for "); end; print("feature `"); print_utf8_str(featureNameP, featLen); print("' in font `"); i := 1; while ord(name_of_file[i]) <> 0 do begin print_visible_char(name_of_file[i]); { this is already UTF-8 } incr(i); end; print("'."); end_diagnostic(false); end; procedure font_mapping_warning(mappingNameP:void_pointer; mappingNameLen:integer; warningType:integer); { 0: just logging; 1: file not found; 2: can't load } var i: integer; begin begin_diagnostic; if warningType=0 then print_nl("Loaded mapping `") else print_nl("Font mapping `"); print_utf8_str(mappingNameP, mappingNameLen); print("' for font `"); i := 1; while ord(name_of_file[i]) <> 0 do begin print_visible_char(name_of_file[i]); { this is already UTF-8 } incr(i); end; case warningType of 1: print("' not found."); 2: begin print("' not usable;"); print_nl("bad mapping file or incorrect mapping type."); end; othercases print("'.") endcases; end_diagnostic(false); end; procedure graphite_warning; var i: integer; begin begin_diagnostic; print_nl("Font `"); i := 1; while ord(name_of_file[i]) <> 0 do begin print_visible_char(name_of_file[i]); { this is already UTF-8 } incr(i); end; print("' does not support Graphite. Trying ICU layout instead."); end_diagnostic(false); end; function load_native_font(u: pointer; nom, aire:str_number; s: scaled): internal_font_number; label done; const first_math_fontdimen = 10; var k, num_font_dimens: integer; font_engine: void_pointer; {really an ATSUStyle or XeTeXLayoutEngine} actual_size: scaled; {|s| converted to real size, if it was negative} p: pointer; {for temporary |native_char| node we'll create} ascent, descent, font_slant, x_ht, cap_ht: scaled; f: internal_font_number; full_name: str_number; begin { on entry here, the full name is packed into |name_of_file| in UTF8 form } load_native_font := null_font; font_engine := find_native_font(name_of_file + 1, s); if font_engine = 0 then goto done; if s>=0 then actual_size := s else begin if (s <> -1000) then actual_size := xn_over_d(loaded_font_design_size,-s,1000) else actual_size := loaded_font_design_size; end; { look again to see if the font is already loaded, now that we know its canonical name } str_room(name_length); for k := 1 to name_length do append_char(name_of_file[k]); full_name := make_string; { not |slow_make_string| because we'll flush it if the font was already loaded } for f:=font_base+1 to font_ptr do if (font_area[f] = native_font_type_flag) and str_eq_str(font_name[f], full_name) and (font_size[f] = actual_size) then begin release_font_engine(font_engine, native_font_type_flag); flush_string; load_native_font := f; goto done; end; if (native_font_type_flag = otgr_font_flag) and isOpenTypeMathFont(font_engine) then num_font_dimens := first_math_fontdimen + lastMathConstant else num_font_dimens := 8; if (font_ptr = font_max) or (fmem_ptr + num_font_dimens > font_mem_size) then begin @; end; { we've found a valid installed font, and have room } incr(font_ptr); font_area[font_ptr] := native_font_type_flag; { set by |find_native_font| to either |aat_font_flag| or |ot_font_flag| } { store the canonical name } font_name[font_ptr] := full_name; font_check[font_ptr].b0 := 0; font_check[font_ptr].b1 := 0; font_check[font_ptr].b2 := 0; font_check[font_ptr].b3 := 0; font_glue[font_ptr] := null; font_dsize[font_ptr] := loaded_font_design_size; font_size[font_ptr] := actual_size; if (native_font_type_flag = aat_font_flag) then begin atsu_get_font_metrics(font_engine, addressof(ascent), addressof(descent), addressof(x_ht), addressof(cap_ht), addressof(font_slant)) end else begin ot_get_font_metrics(font_engine, addressof(ascent), addressof(descent), addressof(x_ht), addressof(cap_ht), addressof(font_slant)); end; height_base[font_ptr] := ascent; depth_base[font_ptr] := -descent; font_params[font_ptr] := num_font_dimens; { we add an extra fontdimen: \#8 -> |cap_height|; then OT math fonts have a bunch more } font_bc[font_ptr] := 0; font_ec[font_ptr] := 65535; font_used[font_ptr] := false; hyphen_char[font_ptr] := default_hyphen_char; skew_char[font_ptr] := default_skew_char; param_base[font_ptr] := fmem_ptr-1; font_layout_engine[font_ptr] := font_engine; font_mapping[font_ptr] := 0; { don't use the mapping, if any, when measuring space here } font_letter_space[font_ptr] := loaded_font_letter_space; {measure the width of the space character and set up font parameters} p := new_native_character(font_ptr, " "); s := width(p) + loaded_font_letter_space; free_node(p, native_size(p)); font_info[fmem_ptr].sc := font_slant; {|slant|} incr(fmem_ptr); font_info[fmem_ptr].sc := s; {|space| = width of space character} incr(fmem_ptr); font_info[fmem_ptr].sc := s div 2; {|space_stretch| = 1/2 * space} incr(fmem_ptr); font_info[fmem_ptr].sc := s div 3; {|space_shrink| = 1/3 * space} incr(fmem_ptr); font_info[fmem_ptr].sc := x_ht; {|x_height|} incr(fmem_ptr); font_info[fmem_ptr].sc := font_size[font_ptr]; {|quad| = font size} incr(fmem_ptr); font_info[fmem_ptr].sc := s div 3; {|extra_space| = 1/3 * space} incr(fmem_ptr); font_info[fmem_ptr].sc := cap_ht; {|cap_height|} incr(fmem_ptr); if num_font_dimens = first_math_fontdimen + lastMathConstant then begin font_info[fmem_ptr].int := num_font_dimens; { \fontdimen9 = number of assigned fontdimens } incr(fmem_ptr); for k := 0 to lastMathConstant do begin font_info[fmem_ptr].sc := get_ot_math_constant(font_ptr, k); incr(fmem_ptr); end; end; font_mapping[font_ptr] := loaded_font_mapping; font_flags[font_ptr] := loaded_font_flags; load_native_font := font_ptr; done: end; procedure do_locale_linebreaks(s: integer; len: integer); var offs, prevOffs, i: integer; use_penalty, use_skip: boolean; begin if (XeTeX_linebreak_locale = 0) or (len = 1) then begin link(tail) := new_native_word_node(main_f, len); tail := link(tail); for i := 0 to len - 1 do set_native_char(tail, i, native_text[s + i]); set_native_metrics(tail, XeTeX_use_glyph_metrics); end else begin use_skip := XeTeX_linebreak_skip <> zero_glue; use_penalty := XeTeX_linebreak_penalty <> 0 or not use_skip; if (is_gr_font(main_f)) and (str_eq_str(XeTeX_linebreak_locale, "G")) then begin initGraphiteBreaking(font_layout_engine[main_f], native_text + s, len); offs := 0; repeat prevOffs := offs; offs := findNextGraphiteBreak(offs, 15); {klbWordBreak = 15} if offs > 0 then begin if prevOffs <> 0 then begin if use_penalty then tail_append(new_penalty(XeTeX_linebreak_penalty)); if use_skip then tail_append(new_param_glue(XeTeX_linebreak_skip_code)); end; link(tail) := new_native_word_node(main_f, offs - prevOffs); tail := link(tail); for i := prevOffs to offs - 1 do set_native_char(tail, i - prevOffs, native_text[s + i]); set_native_metrics(tail, XeTeX_use_glyph_metrics); end; until offs < 0; end else begin linebreak_start(XeTeX_linebreak_locale, native_text + s, len); offs := 0; repeat prevOffs := offs; offs := linebreak_next; if offs > 0 then begin if prevOffs <> 0 then begin if use_penalty then tail_append(new_penalty(XeTeX_linebreak_penalty)); if use_skip then tail_append(new_param_glue(XeTeX_linebreak_skip_code)); end; link(tail) := new_native_word_node(main_f, offs - prevOffs); tail := link(tail); for i := prevOffs to offs - 1 do set_native_char(tail, i - prevOffs, native_text[s + i]); set_native_metrics(tail, XeTeX_use_glyph_metrics); end; until offs < 0; end end end; procedure bad_utf8_warning; begin begin_diagnostic; print_nl("Invalid UTF-8 byte or sequence"); if terminal_input then print(" in terminal input") else begin print(" at line "); print_int(line); end; print(" replaced by U+FFFD."); end_diagnostic(false); end; function get_input_normalization_state: integer; begin if eqtb=nil then get_input_normalization_state:=0 { may be called before eqtb is initialized } else get_input_normalization_state:=XeTeX_input_normalization_state; end; function get_tracing_fonts_state: integer; begin get_tracing_fonts_state:=XeTeX_tracing_fonts_state; end; @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. @ = @!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. @= @!enctex_enabled_p:boolean; {enable encTeX} @ @= 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 (#) @= { 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; @ @= 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. @= { 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_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_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