[xetex] Merge UTF-16 surrogate handling fixes and \Uchar[cat] primitives from github.

git-svn-id: svn://tug.org/texlive/trunk@37244 c570f23f-e606-0410-a88d-b1316a301751

2 files changed, 86 insertions, 17 deletions

diff --git a/Build/source/texk/web2c/xetexdir/ChangeLog b/Build/source/texk/web2c/xetexdir/ChangeLog
index 5668fddba85..da973ad61f6 100644
--- a/Build/source/texk/web2c/xetexdir/ChangeLog
+++ b/Build/source/texk/web2c/xetexdir/ChangeLog
@@ -1,3 +1,8 @@
+2015-05-07  Jonathan Kew  <jfkthame@gmail.com>
+
+	* xetex.web: Merged UTF-16 surrogate-handling fixes from github.
+	* xetex.web: New \Uchar and \Ucharcat primitives.
+
 2015-05-05  Peter Breitenlohner  <peb@mppmu.mpg.de>
 
 	* XeTeX_ext.c: Can not use non-locking getc() for MinGW.
diff --git a/Build/source/texk/web2c/xetexdir/xetex.web b/Build/source/texk/web2c/xetexdir/xetex.web
index 608070d2f7c..e49d6495c9e 100644
--- a/Build/source/texk/web2c/xetexdir/xetex.web
+++ b/Build/source/texk/web2c/xetexdir/xetex.web
@@ -1761,15 +1761,16 @@ else if s<biggest_char then
     return;
     end;
 j:=str_start_macro(s);
-while j<str_start_macro(s+1) do
-  if (so(str_pool[j])>=@"D800) and (so(str_pool[j])<=@"DFFF) then
-  begin if (so(str_pool[j])<=@"DBFF) and (j+1<str_start_macro(s+1))
+while j<str_start_macro(s+1) do begin
+  if (so(str_pool[j])>=@"D800) and (so(str_pool[j])<=@"DBFF)
+    and (j+1<str_start_macro(s+1))
     and (so(str_pool[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);
+  else begin print_char(so(str_pool[j])); incr(j);
   end;
+end;
 exit:end;
 
 @ Old versions of \TeX\ needed a procedure called |slow_print| whose function
@@ -6104,7 +6105,7 @@ eq_level(frozen_primitive):=level_one;
 text(frozen_primitive):="primitive";
 
 @ Here is the subroutine that searches the hash table for an identifier
-that matches a given string of length |l>1| appearing in |buffer[j..
+that matches a given string of length |l>0| appearing in |buffer[j..
 (j+l-1)]|. If the identifier is found, the corresponding hash table address
 is returned. Otherwise, if the global variable |no_new_control_sequence|
 is |true|, the dummy address |undefined_control_sequence| is returned.
@@ -6165,8 +6166,8 @@ than two table probes, on the average, when the search is successful.
 @^Vitter, Jeffrey Scott@>
 
 @<Compute the hash code |h|@>=
-h:=buffer[j];
-for k:=j+1 to j+l-1 do
+h:=0;
+for k:=j to j+l-1 do
   begin h:=h+h+buffer[k];
   while h>=hash_prime do h:=h-hash_prime;
   end
@@ -8035,6 +8036,7 @@ var k:0..buf_size; {an index into |buffer|}
 @!t:halfword; {a token}
 @!cat:0..max_char_code; {|cat_code(cur_chr)|, usually}
 @!c:UnicodeScalar; {constituent of a possible expanded code}
+@!lower:UTF16_code; {lower surrogate of a possible UTF-16 compound}
 @!d:small_number; {number of excess characters in an expanded code}
 @!sup_count:small_number; {number of identical |sup_mark| characters}
 begin restart: cur_cs:=0;
@@ -8059,6 +8061,13 @@ if cur_cmd<=car_ret then if cur_cmd>=tab_mark then if align_state=0 then
 @^inner loop@>
 begin switch: if loc<=limit then {current line not yet finished}
   begin cur_chr:=buffer[loc]; incr(loc);
+  if (cur_chr >= @"D800) and (cur_chr < @"DC00)
+  and (loc <= limit) and (buffer[loc] >= @"DC00) and (buffer[loc] < @"E000) then
+    begin
+      lower := buffer[loc] - @"DC00;
+      incr(loc);
+      cur_chr := @"10000 + (cur_chr - @"D800) * 1024 + lower;
+    end;
   reswitch: cur_cmd:=cat_code(cur_chr);
   @<Change state if necessary, and |goto switch| if the
     current character should be ignored,
@@ -8246,6 +8255,12 @@ else  begin start_cs: k:=loc; cur_chr:=buffer[k]; cat:=cat_code(cur_chr);
     sequence is found, adjust |cur_cs| and |loc|, and
     |goto found|@>
   else @<If an expanded code is present, reduce it and |goto start_cs|@>;
+  {At this point, we have a single-character cs name in the buffer.
+   But if the character code is > @"FFFF, we treat it like a multiletter name
+   for string purposes, because we use UTF-16 in the string pool.}
+  if buffer[loc]>@"FFFF then begin
+    cur_cs:=id_lookup(loc,1); incr(loc); goto found;
+    end;
   cur_cs:=single_base+buffer[loc]; incr(loc);
   end;
 found: cur_cmd:=eq_type(cur_cs); cur_chr:=equiv(cur_cs);
@@ -8687,7 +8702,7 @@ while p<>null do
     end;
   buffer[j]:=info(p) mod max_char_val; incr(j); p:=link(p);
   end;
-if j>first+1 then
+if (j>first+1) or (buffer[first]>@"FFFF) then
   begin no_new_control_sequence:=false; cur_cs:=id_lookup(first,j-first);
   no_new_control_sequence:=true;
   end
@@ -9802,7 +9817,7 @@ begin scan_int;
 if (cur_val<0)or(cur_val>biggest_usv) then
   begin print_err("Bad character code");
 @.Bad character code@>
-  help2("A Unicode Scalar Value must be between 0 and ""10FFFF.")@/
+  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;
@@ -10389,8 +10404,12 @@ and everything else as type |other_char|.
 The token list created by |str_toks| begins at |link(temp_head)| and ends
 at the value |p| that is returned. (If |p=temp_head|, the list is empty.)
 
+The |str_toks_cat| function is the same, except that the catcode |cat| is
+stamped on all the characters, unless zero is passed in which case it
+chooses |spacer| or |other_char| automatically.
+
 @p @t\4@>@<Declare \eTeX\ procedures for token lists@>@;@/
-function str_toks(@!b:pool_pointer):pointer;
+function str_toks_cat(@!b:pool_pointer;@!cat:small_number):pointer;
   {changes the string |str_pool[b..pool_ptr]| to a token list}
 var p:pointer; {tail of the token list}
 @!q:pointer; {new node being added to the token list via |store_new_token|}
@@ -10400,14 +10419,25 @@ begin str_room(1);
 p:=temp_head; link(p):=null; k:=b;
 while k<pool_ptr do
   begin t:=so(str_pool[k]);
-  if t=" " then t:=space_token
-  else t:=other_token+t;
+  if (t=" ") and (cat=0) then t:=space_token
+  else begin if (t >= @"D800) and (t <= @"DBFF) and (k+1 < pool_ptr)
+             and (so(str_pool[k+1]) >= @"DC00) and (so(str_pool[k+1]) <= @"DFFF) then
+    begin
+      incr(k);
+      t := @"10000 + (t - @"D800) * @"400 + (so(str_pool[k]) - @"DC00);
+    end;
+    if cat=0 then t := other_token + t
+    else t := max_char_val * cat + t;
+  end;
   fast_store_new_token(t);
   incr(k);
   end;
-pool_ptr:=b; str_toks:=p;
+pool_ptr:=b; str_toks_cat:=p;
 end;
 
+function str_toks(@!b:pool_pointer):pointer;
+begin str_toks:=str_toks_cat(b,0); end;
+
 @ The main reason for wanting |str_toks| is the next function,
 |the_toks|, which has similar input/output characteristics.
 
@@ -10478,7 +10508,10 @@ end;
 @d left_margin_kern_code=11
 @d right_margin_kern_code=12
 
-@d etex_convert_codes=right_margin_kern_code+1 {end of \eTeX's command codes}
+@d XeTeX_Uchar_code = 13
+@d XeTeX_Ucharcat_code = 14
+
+@d etex_convert_codes=XeTeX_Ucharcat_code+1 {end of \eTeX's command codes}
 @d job_name_code=etex_convert_codes {command code for \.{\\jobname}}
 
 @<Put each...@>=
@@ -10499,6 +10532,11 @@ primitive("leftmarginkern",convert,left_margin_kern_code);@/
 primitive("rightmarginkern",convert,right_margin_kern_code);@/
 @!@:right_margin_kern_}{\.{\\rightmarginkern} primitive@>
 
+primitive("Uchar",convert,XeTeX_Uchar_code);@/
+@!@:XeTeX_Uchar_}{\.{\\Uchar} primitive@>
+primitive("Ucharcat",convert,XeTeX_Ucharcat_code);@/
+@!@:XeTeX_Ucharcat_}{\.{\\Ucharcat} primitive@>
+
 @ @<Cases of |print_cmd_chr|...@>=
 convert: case chr_code of
   number_code: print_esc("number");
@@ -10535,20 +10573,41 @@ var old_setting:0..max_selector; {holds |selector| setting}
 @!font_name_str:str_number; {local vars for \.{\\fontname} quoting extension}
 @!i:small_number;
 @!quote_char:UTF16_code;
+@!cat:small_number; {desired catcode, or 0 for automatic |spacer|/|other_char| selection}
+@!saved_chr:UnicodeScalar;
 p, q: pointer;
-begin c:=cur_chr; @<Scan the argument for command |c|@>;
+begin cat:=0; c:=cur_chr; @<Scan the argument for command |c|@>;
 old_setting:=selector; selector:=new_string; b:=pool_ptr;
 @<Print the result of command |c|@>;
-selector:=old_setting; link(garbage):=str_toks(b); ins_list(link(temp_head));
+selector:=old_setting; link(garbage):=str_toks_cat(b,cat); ins_list(link(temp_head));
 end;
 
-@ @<Scan the argument for command |c|@>=
+@ Not all catcode values are allowed by \.{\\Ucharcat}:
+@d illegal_Ucharcat_catcode(#)==(#<left_brace)or(#>other_char)or(#=out_param)or(#=ignore)
+
+@<Scan the argument for command |c|@>=
 case c of
 number_code,roman_numeral_code: scan_int;
 string_code, meaning_code: begin save_scanner_status:=scanner_status;
   scanner_status:=normal; get_token; scanner_status:=save_scanner_status;
   end;
 font_name_code: scan_font_ident;
+XeTeX_Uchar_code: scan_usv_num;
+XeTeX_Ucharcat_code:
+  begin
+    scan_usv_num;
+    saved_chr:=cur_val;
+    scan_int;
+    if illegal_Ucharcat_catcode(cur_val) then
+      begin print_err("Invalid code ("); print_int(cur_val);
+@.Invalid code@>
+      print("), should be in the ranges 1..4, 6..8, 10..12");
+      help1("I'm going to use 12 instead of that illegal code value.");@/
+      error; cat:=12;
+    end else
+     cat:=cur_val;
+    cur_val:=saved_chr;
+  end;
 @/@<Cases of `Scan the argument for command |c|'@>@/
 job_name_code: if job_name=0 then open_log_file;
 end {there are no other cases}
@@ -10576,6 +10635,8 @@ font_name_code: begin
     print("pt");
     end;
   end;
+XeTeX_Uchar_code,
+XeTeX_Ucharcat_code: print_char(cur_val);
 @/@<Cases of `Print the result of command |c|'@>@/
 job_name_code: print_file_name(job_name, 0, 0);
 end {there are no other cases}
@@ -30003,6 +30064,9 @@ XeTeX_feature_name_code: print_esc("XeTeXfeaturename");
 XeTeX_selector_name_code: print_esc("XeTeXselectorname");
 XeTeX_glyph_name_code: print_esc("XeTeXglyphname");
 
+XeTeX_Uchar_code: print_esc("Uchar");
+XeTeX_Ucharcat_code: print_esc("Ucharcat");
+
 @ @<Cases of `Scan the argument for command |c|'@>=
 eTeX_revision_code: do_nothing;
 pdf_strcmp_code: