more texk/web2c/omegaware bugfixes for ofm2opl&Co

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

6 files changed, 113 insertions, 42 deletions

diff --git a/Build/source/texk/web2c/omegaware/ChangeLog b/Build/source/texk/web2c/omegaware/ChangeLog
index 0d21b3b0757..d40681925d0 100644
--- a/Build/source/texk/web2c/omegaware/ChangeLog
+++ b/Build/source/texk/web2c/omegaware/ChangeLog
@@ -1,3 +1,24 @@
+2009-09-22  Peter Breitenlohner  <peb@mppmu.mpg.de>
+
+	* ovf2ovp.{web,ch}: Bugfix in handling of local fonts with
+	ofm_level=0,1 and characters in the range 0..65535, diagnosing
+	characters outside this range.
+
+	* opl2ofm.web, ovp2ovf.web: Bugfix. Don't forget to output the
+	mvalues.
+
+2009-09-20  Peter Breitenlohner  <peb@mppmu.mpg.de>
+
+	* ovp2ovf.web: Bugfix in handling of ofm_level=-1.
+
+2009-09-19  Peter Breitenlohner  <peb@mppmu.mpg.de>
+
+	* opl2ofm.web (get_integer), ovp2ovf.web (get_integer):
+	Avoid relying on 32-Bit integer overflow.
+	* ofm2opl.web (check_unused), ovf2ovp.web (check_unused):
+	New function to check for non-zero unused char info bits.
+	* opl2ofm.web, ovp2ovf.web: Check for parameter index <0.
+
 2009-09-18  Peter Breitenlohner  <peb@mppmu.mpg.de>
 
 	* opl2ofm.web: Use top_width as maximum number as character
diff --git a/Build/source/texk/web2c/omegaware/ofm2opl.web b/Build/source/texk/web2c/omegaware/ofm2opl.web
index 7ad21791472..8f4cc3fd963 100644
--- a/Build/source/texk/web2c/omegaware/ofm2opl.web
+++ b/Build/source/texk/web2c/omegaware/ofm2opl.web
@@ -771,6 +771,20 @@ else
   tfm[char_info(c)+5] := (tfm[char_info(c)+5] div 64)*64 + no_tag;
 end;
 
+procedure check_unused(c:char_type);
+var @!x:integer;
+begin if ofm_level=1 then x:=tfm[char_info(c)+5] div 8
+else x:=tfm[char_info(c)+5] div 4;
+if x<>0 then begin
+  if ofm_level=1 then x:=tfm[char_info(c)+5] mod 8
+  else x:=tfm[char_info(c)+5] mod 4;
+  tfm[char_info(c)+5]:=x;
+  perfect:=false; if chars_on_line>0 then print_ln(' ');
+  chars_on_line:=0; print_ln('Ignoring non-zero unused char info bits');
+@.Ignoring non-zero unused...@>
+  end;
+end;
+
 function ctag(c:char_type):boolean;
 begin if not (ofm_level=1) then
   ctag:=false
@@ -1924,6 +1938,7 @@ if width_index(c)>0 then begin
     print_hex(c); {progress report}
     left; out('CHARACTER'); out_char(c); out_ln;
     end;
+  if ofm_on then check_unused(c);
   @<Output the character's width@>;
   if height_index(c)>0 then @<Output the character's height@>;
   if depth_index(c)>0 then @<Output the character's depth@>;
diff --git a/Build/source/texk/web2c/omegaware/opl2ofm.web b/Build/source/texk/web2c/omegaware/opl2ofm.web
index 529c4afbb36..d249ce6e3f7 100644
--- a/Build/source/texk/web2c/omegaware/opl2ofm.web
+++ b/Build/source/texk/web2c/omegaware/opl2ofm.web
@@ -1385,8 +1385,11 @@ if r>0 then begin
 end;
 
 function get_integer:integer; {scans an integer property value}
+var @!a:integer; {accumulator}
 begin get_four_bytes;
-get_integer:=(c0*@"1000000)+(c1*@"10000)+(c2*@"100)+c3;
+a:=c0;
+if a>=@"80 then a:=a-@"100;
+get_integer:=(a*@"1000000)+(c1*@"10000)+(c2*@"100)+c3;
 end;
 
 @ @<Multiply by |r|...@>=
@@ -1932,8 +1935,8 @@ else if (cur_code<parameter_code)or(cur_code>=char_wd_code) then
 else begin
   if cur_code=parameter_code then c:=get_integer
   else c:=cur_code-parameter_code;
-  if c=0 then flush_error('PARAMETER index must not be zero')
-@.PARAMETER index must not...@>
+  if c<1 then flush_error('PARAMETER index must be at least 1')
+@.PARAMETER index must be...@>
   else if c>max_param_words then
     flush_error('This PARAMETER index is too big for my present table size')
 @.This PARAMETER index is too big...@>
@@ -2928,8 +2931,8 @@ case ofm_level of
     @<Compute the character info size@>;
     lf:=29+lh+ncw+memory[width]+memory[height]+memory[depth]+
     memory[italic]+2*(nl+lk_offset)+nk+2*ne+np+
-    nki+nwi+nkf+nwf+nkm+nwm++nkr+nwr+nkg+nwg+nkp+nwp;
-    nco:=29+lh+nki+nwi+nkf+nwf+nkm+nwm++nkr+nwr+nkg+nwg+nkp+nwp;
+    nki+nwi+nkf+nwf+nkm+nwm+nkr+nwr+nkg+nwg+nkp+nwp;
+    nco:=29+lh+nki+nwi+nkf+nwf+nkm+nwm+nkr+nwr+nkg+nwg+nkp+nwp;
     end;
   end;
 
@@ -4346,6 +4349,7 @@ begin
 @<Output the penalty headers@>;
 @<Output the ivalues@>;
 @<Output the fvalues@>;
+@<Output the mvalues@>;
 @<Output the rules@>;
 @<Output the glues@>;
 @<Output the penalties@>;
diff --git a/Build/source/texk/web2c/omegaware/ovf2ovp.ch b/Build/source/texk/web2c/omegaware/ovf2ovp.ch
index 9bc7054d2b8..2e40680f093 100644
--- a/Build/source/texk/web2c/omegaware/ovf2ovp.ch
+++ b/Build/source/texk/web2c/omegaware/ovf2ovp.ch
@@ -385,18 +385,19 @@ lig_f:=lig_z[h];
     @<Cases of \.{DVI} instructions that can appear in character packets@>@;
 @y
     o:=vf[vf_ptr]; incr(vf_ptr);
-    if ((o<=set_char_0+127))or
-       ((o>=set1)and(o<=set1+3))or((o>=put1)and(o<=put1+3)) then
+    if (o<=set1+3)or((o>=put1)and(o<=put1+3)) then
 begin if o>=set1 then
     if o>=put1 then c:=get_bytes(o-put1+1,false)
     else c:=get_bytes(o-set1+1,false)
   else c:=o;
-  if f=font_ptr then
+  if (c<0)or(c>65535) then
+    bad_vf('Character ',c:1,' is out of range and will be ignored')
+  else if f=font_ptr then
     bad_vf('Character ',c:1,' in undeclared font will be ignored')
 @.Character...will be ignored@>
-  else begin vf[font_start[f+1]-1]:=c; {store |c| in the ``hole'' we left}
-    k:=font_chars[f];@+while vf[k]<>c do incr(k);
-    if k=font_start[f+1]-1 then
+  else begin vc[font_chars[f+1]-1]:=c; {store |c| in the ``hole'' we left}
+    k:=font_chars[f];@+while vc[k]<>c do incr(k);
+    if k=font_chars[f+1]-1 then
       bad_vf('Character ',c:1,' in font ',f:1,' will be ignored')
     else begin if o>=put1 then out('(PUSH)');
       left; out('SETCHAR'); out_char(c);
@@ -431,12 +432,14 @@ sixty_four_cases(set_char_0),sixty_four_cases(set_char_0+64),
     if o>=put1 then c:=get_bytes(o-put1+1,false)
     else c:=get_bytes(o-set1+1,false)
   else c:=o;
-  if f=font_ptr then
+  if (c<0)or(c>65535) then
+    bad_vf('Character ',c:1,' is out of range and will be ignored')
+  else if f=font_ptr then
     bad_vf('Character ',c:1,' in undeclared font will be ignored')
 @.Character...will be ignored@>
-  else begin vf[font_start[f+1]-1]:=c; {store |c| in the ``hole'' we left}
-    k:=font_chars[f];@+while vf[k]<>c do incr(k);
-    if k=font_start[f+1]-1 then
+  else begin vc[font_chars[f+1]-1]:=c; {store |c| in the ``hole'' we left}
+    k:=font_chars[f];@+while vc[k]<>c do incr(k);
+    if k=font_chars[f+1]-1 then
       bad_vf('Character ',c:1,' in font ',f:1,' will be ignored')
     else begin if o>=put1 then out('(PUSH)');
       left; out('SETCHAR'); out_char(c);
diff --git a/Build/source/texk/web2c/omegaware/ovf2ovp.web b/Build/source/texk/web2c/omegaware/ovf2ovp.web
index 9a6615c477e..f3cb5bcc6c7 100644
--- a/Build/source/texk/web2c/omegaware/ovf2ovp.web
+++ b/Build/source/texk/web2c/omegaware/ovf2ovp.web
@@ -108,6 +108,7 @@ reduce \.{VFtoVP}'s capacity.
 @!tfm_size=2000000; {maximum length of |tfm| data, in bytes}
 @!vf_size=600000; {maximum length of |vf| data, in bytes}
 @!max_fonts=300; {maximum number of local fonts in the |vf| file}
+@!vc_size=150000; {maximum number of characters from local fonts}
 @!lig_size=800000; {maximum length of |lig_kern| program, in words}
 @!hash_size=130003; {preferably a prime number, a bit larger than the number
   of character pairs in lig/kern steps}
@@ -915,6 +916,20 @@ else
   tfm[char_info(c)+5] := (tfm[char_info(c)+5] div 64)*64 + no_tag;
 end;
 
+procedure check_unused(c:char_type);
+var @!x:integer;
+begin if ofm_level=1 then x:=tfm[char_info(c)+5] div 8
+else x:=tfm[char_info(c)+5] div 4;
+if x<>0 then begin
+  if ofm_level=1 then x:=tfm[char_info(c)+5] mod 8
+  else x:=tfm[char_info(c)+5] mod 4;
+  tfm[char_info(c)+5]:=x;
+  perfect:=false; if chars_on_line>0 then print_ln(' ');
+  chars_on_line:=0; print_ln('Ignoring non-zero unused char info bits');
+@.Ignoring non-zero unused...@>
+  end;
+end;
+
 function ctag(c:char_type):boolean;
 begin if not (ofm_level=1) then
   ctag:=false
@@ -1046,8 +1061,10 @@ the packets.
 
 @<Glob...@>=
 @!vf:array[0..vf_size] of byte; {the \.{VF} input data goes here}
+@!vc:array[0..vc_size] of char_type; {the valid characters from local fonts}
 @!font_number:array[0..max_fonts] of integer; {local font numbers}
-@!font_start,@!font_chars:array[0..max_fonts] of 0..vf_size; {font info}
+@!font_start:array[0..max_fonts] of 0..vf_size; {font info}
+@!font_chars:array[0..max_fonts] of 0..vc_size; {font info}
 @!font_ptr:0..max_fonts; {number of local fonts}
 @!packet_start,@!packet_end:array[char_type] of 0..vf_size;
   {character packet boundaries}
@@ -1056,6 +1073,7 @@ the packets.
 @!real_dsize:real; {the design size, converted to floating point}
 @!pl:integer; {packet length}
 @!vf_ptr:0..vf_size; {first unused location in |vf|}
+@!vc_ptr:0..vc_size; {first unused location in |vc|}
 @!vf_count:integer; {number of bytes read from |vf_file|}
 
 @ Again we cautiously verify that we've been given decent data.
@@ -1113,6 +1131,7 @@ if reg_count<>8 then
 @ @<Read and store the font definitions and character packets@>=
 for k:=0 to 65535 do packet_start[k]:=vf_size;
 font_ptr:=0; packet_found:=false; font_start[0]:=vf_ptr;
+vc_ptr:=0; font_chars[0]:=vc_ptr;
 repeat if eof(vf_file) then
   begin print_ln('File ended without a postamble!'); temp_byte:=post;
 @.File ended without a postamble@>
@@ -1151,7 +1170,7 @@ if vf[vf_ptr-10]>0 then {|s| is negative or exceeds $2^{24}-1$}
 a:=vf[vf_ptr-2]; l:=vf[vf_ptr-1]; vf_store(a+l); {|n[a+l]|}
 @<Print the name of the local font@>;
 @<Read the local font's \.{TFM} file and record the characters it contains@>;
-incr(font_ptr); font_start[font_ptr]:=vf_ptr; 
+incr(font_ptr); font_start[font_ptr]:=vf_ptr; font_chars[font_ptr]:=vc_ptr;
 end
 
 @ The font area may need to be separated from the font name on some systems.
@@ -1199,11 +1218,12 @@ begin read_tfm(b0); read_tfm(b1);
 read_tfm(b2); read_tfm(b3);
 end;
 
-@ We use the |vf| array to store a list of all valid characters in the
-local font, beginning at location |font_chars[f]|.
+@ We use the |vc| array to store a list of all valid characters in the local
+font, beginning at location |font_chars[f]|.  In \.{VFtoVP} the |vf| array
+is used for that purpose, but that is not possible for \.{OVF2OVP} with
+characters in the range |0..65535|.
 
 @<Read the local font's \.{TFM} file...@>=
-font_chars[font_ptr]:=vf_ptr;
 @<Move font name into the |cur_name| string@>;
 reset(tfm_file,cur_name);
 @^system dependencies@>
@@ -1220,7 +1240,7 @@ else  begin font_bc:=0; font_ec:=65536; {will cause error if not modified soon}
     print_ln('---trouble is brewing, font metric file ended too soon!');
 @.trouble is brewing...@>
   end;
-incr(vf_ptr) {leave space for character search later}
+incr(vc_ptr) {leave space for character search later}
 
 @ @<Read past the header@>=
 read_tfm_word;
@@ -1238,6 +1258,7 @@ if (b0*256+b1)<>0 then begin {TFM file}
   end
 else begin
   font_ofm_level:=b2*256+b3;
+  read_tfm_word;
   read_tfm_word; font_lh:=((b0*256+b1)*256+b2)*256+b3;
   read_tfm_word; font_bc:=((b0*256+b1)*256+b2)*256+b3;
   read_tfm_word; font_ec:=((b0*256+b1)*256+b2)*256+b3;
@@ -1247,9 +1268,10 @@ else begin
     read_tfm_word;
     end;
   if font_ofm_level=1 then begin
-    read_tfm_word; read_tfm_word; read_tfm_word;
+    read_tfm_word; font_lh:=((b0*256+b1)*256+b2)*256+b3-29;
+    read_tfm_word; read_tfm_word;
     font_extra_words:=(((b0*256+b1)*256+b2)*256+b3) div 2;
-    for k:=1 to 5 do begin
+    for k:=1 to 12 do begin
       read_tfm_word;
       end;
     end;
@@ -1266,8 +1288,8 @@ case font_ofm_level of
     for k:=font_bc to font_ec do begin
       read_tfm_word;
       if b0>0 then begin {character |k| exists in the font}
-        vf[vf_ptr]:=k; incr(vf_ptr);
-        if vf_ptr=vf_size then vf_abort('I''m out of OVF memory!');
+        vc[vc_ptr]:=k; incr(vc_ptr);
+        if vc_ptr=vc_size then vf_abort('I''m out of OVF memory!');
         end;
       end;
     end;
@@ -1275,27 +1297,27 @@ case font_ofm_level of
     for k:=font_bc to font_ec do
       begin read_tfm_word;
       if (b0*256+b1)>0 then {character |k| exists in the font}
-        begin vf[vf_ptr]:=k; incr(vf_ptr);
-        if vf_ptr=vf_size then vf_abort('I''m out of OVF memory!');
+        begin vc[vc_ptr]:=k; incr(vc_ptr);
+        if vc_ptr=vc_size then vf_abort('I''m out of OVF memory!');
         end;
       read_tfm_word;
       end;
     end;
   1: begin
     k:=font_bc;
-    while k<font_ec do begin
+    while k<=font_ec do begin
       read_tfm_word;
       if (b0*256+b1)>0 then begin {character |k| exists in the font}
-        vf[vf_ptr]:=k; incr(vf_ptr);
-        if vf_ptr=vf_size then vf_abort('I''m out of OVF memory!');
+        vc[vc_ptr]:=k; incr(vc_ptr);
+        if vc_ptr=vc_size then vf_abort('I''m out of OVF memory!');
         end;
       read_tfm_word; read_tfm_word;
       font_kprime:=k+(b0*256+b1);
       for font_j:=k+1 to font_kprime do begin
-        vf[vf_ptr]:=font_j; incr(vf_ptr);
-        if vf_ptr=vf_size then vf_abort('I''m out of OVF memory!');
+        vc[vc_ptr]:=font_j; incr(vc_ptr);
+        if vc_ptr=vc_size then vf_abort('I''m out of OVF memory!');
         end;
-      k:=font_kprime;
+      k:=font_kprime+1;
       for font_j:=1 to font_extra_words do
         read_tfm_word;
       end
@@ -2448,6 +2470,7 @@ while (c<=ec) do begin
     for cprime:=c to (c+no_repeats(c)) do begin
       print_hex(cprime); {progress report}
       left; out('CHARACTER'); out_char(cprime); out_ln;
+      if ofm_on then check_unused(c);
       @<Output the character's width@>;
       if height_index(c)>0 then @<Output the character's height@>;
       if depth_index(c)>0 then @<Output the character's depth@>;
@@ -3002,12 +3025,14 @@ sixty_four_cases(set_char_0),sixty_four_cases(set_char_0+64),
     if o>=put1 then c:=get_bytes(o-put1+1,false)
     else c:=get_bytes(o-set1+1,false)
   else c:=o;
-  if f=font_ptr then
+  if (c<0)or(c>65535) then
+    bad_vf('Character ',c:1,' is out of range and will be ignored')
+  else if f=font_ptr then
     bad_vf('Character ',c:1,' in undeclared font will be ignored')
 @.Character...will be ignored@>
-  else begin vf[font_start[f+1]-1]:=c; {store |c| in the ``hole'' we left}
-    k:=font_chars[f];@+while vf[k]<>c do incr(k);
-    if k=font_start[f+1]-1 then
+  else begin vc[font_chars[f+1]-1]:=c; {store |c| in the ``hole'' we left}
+    k:=font_chars[f];@+while vc[k]<>c do incr(k);
+    if k=font_chars[f+1]-1 then
       bad_vf('Character ',c:1,' in font ',f:1,' will be ignored')
     else begin if o>=put1 then out('(PUSH)');
       left; out('SETCHAR'); out_char(c);
diff --git a/Build/source/texk/web2c/omegaware/ovp2ovf.web b/Build/source/texk/web2c/omegaware/ovp2ovf.web
index c489080383e..69c1ded4d6b 100644
--- a/Build/source/texk/web2c/omegaware/ovp2ovf.web
+++ b/Build/source/texk/web2c/omegaware/ovp2ovf.web
@@ -1652,11 +1652,13 @@ if r>0 then begin
 end;
 
 function get_integer:integer; {scans an integer property value}
+var @!a:integer; {accumulator}
 begin get_four_bytes;
-get_integer:=(c0*@"1000000)+(c1*@"10000)+(c2*@"100)+c3;
+a:=c0;
+if a>=@"80 then a:=a-@"100;
+get_integer:=(a*@"1000000)+(c1*@"10000)+(c2*@"100)+c3;
 end;
 
-
 @ @<Multiply by |r|...@>=
 begin if cur_char>="A" then cur_char:=cur_char+"0"+10-"A";
 if cur_char>="0"+r then skip_error('Illegal digit')
@@ -2235,8 +2237,8 @@ else if (cur_code<parameter_code)or(cur_code>=char_wd_code) then
 @.This property name doesn't belong...@>
 else  begin if cur_code=parameter_code then c:=get_integer
   else c:=cur_code-parameter_code;
-  if c=0 then flush_error('PARAMETER index must not be zero')
-@.PARAMETER index must not...@>
+  if c<1 then flush_error('PARAMETER index must be at least 1')
+@.PARAMETER index must be...@>
   else if c>max_param_words then
     flush_error('This PARAMETER index is too big for my present table size')
 @.This PARAMETER index is too big...@>
@@ -4133,7 +4135,7 @@ end.
 @!ofm_level:integer;
 
 @ @<Set init...@>=
-ofm_level:=0; {Suppose that it is a level 0 OFM file}
+ofm_level:=-1; {Suppose that it is a TFM file}
 
 @ @<Read OFM level code@>=
 begin
@@ -5057,6 +5059,7 @@ begin
 @<Output the penalty headers@>;
 @<Output the ivalues@>;
 @<Output the fvalues@>;
+@<Output the mvalues@>;
 @<Output the rules@>;
 @<Output the glues@>;
 @<Output the penalties@>;