summaryrefslogtreecommitdiff
path: root/Build/source/texk/web2c/omegaware
diff options
context:
space:
mode:
authorPeter Breitenlohner <peb@mppmu.mpg.de>2014-01-09 12:56:28 +0000
committerPeter Breitenlohner <peb@mppmu.mpg.de>2014-01-09 12:56:28 +0000
commit04d22733fda61f856746b38a37add87bd19aa035 (patch)
treef0e3bccdacb29d2d1aa11636aa68eb8778d3a00c /Build/source/texk/web2c/omegaware
parent05e38350226b5da4ed5ad2132525f9b31ac0bc50 (diff)
web2c/omegaware: Version 1.13 of Omega font utilities OFM2OPL & Co
git-svn-id: svn://tug.org/texlive/trunk@32616 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build/source/texk/web2c/omegaware')
-rw-r--r--Build/source/texk/web2c/omegaware/ChangeLog19
-rw-r--r--Build/source/texk/web2c/omegaware/am/omegaware.am9
-rw-r--r--Build/source/texk/web2c/omegaware/ofm2opl.ch52
-rw-r--r--Build/source/texk/web2c/omegaware/ofm2opl.up4
-rw-r--r--Build/source/texk/web2c/omegaware/ofm2opl.web358
-rw-r--r--Build/source/texk/web2c/omegaware/opl2ofm.ch39
-rw-r--r--Build/source/texk/web2c/omegaware/opl2ofm.up70
-rw-r--r--Build/source/texk/web2c/omegaware/opl2ofm.web674
-rw-r--r--Build/source/texk/web2c/omegaware/ovf2ovp.ch46
-rw-r--r--Build/source/texk/web2c/omegaware/ovf2ovp.up4
-rw-r--r--Build/source/texk/web2c/omegaware/ovf2ovp.web577
-rw-r--r--Build/source/texk/web2c/omegaware/ovp2ovf.ch41
-rw-r--r--Build/source/texk/web2c/omegaware/ovp2ovf.up83
-rw-r--r--Build/source/texk/web2c/omegaware/ovp2ovf.web750
-rw-r--r--Build/source/texk/web2c/omegaware/tests/vrepeat0.ofmbin0 -> 656 bytes
-rw-r--r--Build/source/texk/web2c/omegaware/tests/vrepeat0.opl95
-rw-r--r--Build/source/texk/web2c/omegaware/tests/vrepeat1.ofmbin0 -> 604 bytes
-rw-r--r--Build/source/texk/web2c/omegaware/tests/vrepeat1.opl106
-rw-r--r--Build/source/texk/web2c/omegaware/tests/vrepeat1.ovfbin0 -> 228 bytes
-rw-r--r--Build/source/texk/web2c/omegaware/tests/vrepeat1.ovp164
-rwxr-xr-xBuild/source/texk/web2c/omegaware/vrepeat.test43
21 files changed, 1761 insertions, 1373 deletions
diff --git a/Build/source/texk/web2c/omegaware/ChangeLog b/Build/source/texk/web2c/omegaware/ChangeLog
index 04c9879f6cf..6c627f84dd6 100644
--- a/Build/source/texk/web2c/omegaware/ChangeLog
+++ b/Build/source/texk/web2c/omegaware/ChangeLog
@@ -1,3 +1,22 @@
+2014-01-09 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ Version 1.13 (January 2014) of OFM2OPL & Co.
+
+ * {ofm2opl,opl2ofm,ovf2ovp,ovp2ovf}.{ch,up,web}: Bug fixes.
+ With character codes up to 0x10ffff the ligature hash keys no
+ longer fit into 32-bit integers, thus we use type integer64.
+
+ * vrepeat.test, vrepeat0.{ofm,opl}, vrepeat1.{ofm,opl,ovf,ovp}:
+ Shell script and data for a new test,
+ * am/omegaware.am: Adapted.
+
+2014-01-06 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * ofm2opl.{ch,web}: Adapt formatting to ../tftopl.web.
+ * opl2ofm.{ch,up,web}: Adapt formatting to ../pltotf.web.
+ * ovf2ovp.{ch,web}: Adapt formatting to ../vftovp.web.
+ * ovp2ovf.{ch,up,web}: Adapt formatting to ../vptovf.web.
+
2014-01-04 Peter Breitenlohner <peb@mppmu.mpg.de>
* am/omegaware.am: Add rules to build wofm2opl wopl2ofm wovf2ovp.
diff --git a/Build/source/texk/web2c/omegaware/am/omegaware.am b/Build/source/texk/web2c/omegaware/am/omegaware.am
index aeb5f0bac21..3c267bf1521 100644
--- a/Build/source/texk/web2c/omegaware/am/omegaware.am
+++ b/Build/source/texk/web2c/omegaware/am/omegaware.am
@@ -111,7 +111,8 @@ OTANGLE_tests = omegaware/odvicopy.test omegaware/odvitype.test \
OMFONTS_tests = omegaware/level1.test omegaware/ofonts.test \
omegaware/omfonts.test omegaware/overbmp.test\
omegaware/realnum.test omegaware/repeat.test \
- omegaware/selectfont.test omegaware/specialhex.test
+ omegaware/selectfont.test omegaware/specialhex.test \
+ omegaware/vrepeat.test
EXTRA_DIST += $(OTANGLE_tests) $(OMFONTS_tests)
if OTANGLE
@@ -174,4 +175,10 @@ DISTCLEANFILES += omegaware/tests/sample*.ofm omegaware/tests/sample*.ovf \
EXTRA_DIST += omegaware/tests/specialhex.ovp
DISTCLEANFILES += omegaware/tests/specialhex.ofm omegaware/tests/specialhex.opl \
omegaware/tests/specialhex.ovf omegaware/tests/xspecialhex.*
+## omegaware/vrepeat.test
+EXTRA_DIST += \
+ omegaware/tests/vrepeat0.ofm omegaware/tests/vrepeat0.opl \
+ omegaware/tests/vrepeat1.ofm omegaware/tests/vrepeat1.opl \
+ omegaware/tests/vrepeat1.ovf omegaware/tests/vrepeat1.ovp
+DISTCLEANFILES += omegaware/tests/yrepeat*
diff --git a/Build/source/texk/web2c/omegaware/ofm2opl.ch b/Build/source/texk/web2c/omegaware/ofm2opl.ch
index 44a540aac4b..e437a5b1464 100644
--- a/Build/source/texk/web2c/omegaware/ofm2opl.ch
+++ b/Build/source/texk/web2c/omegaware/ofm2opl.ch
@@ -31,10 +31,10 @@
@z
@x [1] Define my_name
-@d banner=='This is OFM2OPL, Version 1.12'
+@d banner=='This is OFM2OPL, Version 1.13' {printed when the program starts}
@y
@d my_name=='ofm2opl'
-@d banner=='This is OFM2OPL, Version 1.12'
+@d banner=='This is OFM2OPL, Version 1.13' {printed when the program starts}
@z
% [2] Fix files in program statement. We need to tell web2c about one
@@ -224,29 +224,29 @@ f:=((tfm[k+1] mod 16)*intcast(@'400)+tfm[k+2])*@'400+tfm[k+3];
% [78] No progress reports unless verbose.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
- incr(chars_on_line);
- end;
- if no_repeats(c)>0 then begin
- print_hex(c); print('-'); print_hex(c+no_repeats(c));
- left; out('CHARREPEAT'); out_char(c); out_char(no_repeats(c)); out_ln;
- end
- else begin
- print_hex(c); {progress report}
- left; out('CHARACTER'); out_char(c); out_ln;
- end;
-@y
- if verbose then incr(chars_on_line);
- end;
- if no_repeats(c)>0 then begin
- if verbose then begin
+ incr(chars_on_line);
+ end;
+ if no_repeats(c)>0 then begin
print_hex(c); print('-'); print_hex(c+no_repeats(c));
+ left; out('CHARREPEAT'); out_char(c); out_char(no_repeats(c)); out_ln;
+ end
+ else begin
+ print_hex(c); {progress report}
+ left; out('CHARACTER'); out_char(c); out_ln;
+ end;
+@y
+ if verbose then incr(chars_on_line);
+ end;
+ if no_repeats(c)>0 then begin
+ if verbose then begin
+ print_hex(c); print('-'); print_hex(c+no_repeats(c));
+ end;
+ left; out('CHARREPEAT'); out_char(c); out_char(no_repeats(c)); out_ln;
+ end
+ else begin
+ if verbose then print_hex(c); {progress report}
+ left; out('CHARACTER'); out_char(c); out_ln;
end;
- left; out('CHARREPEAT'); out_char(c); out_char(no_repeats(c)); out_ln;
- end
- else begin
- if verbose then print_hex(c); {progress report}
- left; out('CHARACTER'); out_char(c); out_ln;
- end;
@z
% [89] Change the name of the variable `class', since AIX 3.1's <math.h>
@@ -273,12 +273,12 @@ f:=((tfm[k+1] mod 16)*intcast(@'400)+tfm[k+2])*@'400+tfm[k+3];
% symbol table. We also have to change the name, because there is also a
% variable named `f', and some C compilers can't deal with that.
@x
-@p function f(@!h,@!x,@!y:index):index; forward;@t\2@>
+@p function f(@!h:integer64;@!x,@!y:index):index; forward;@t\2@>
{compute $f$ for arguments known to be in |hash[h]|}
@y
@p
ifdef('notdef')
-function f_fn(@!h,@!x,@!y:index):index; begin end;@t\2@>
+function f_fn(@!h:integer64;@!x,@!y:index):index; begin end;@t\2@>
{compute $f$ for arguments known to be in |hash[h]|}
endif('notdef')
@z
@@ -293,7 +293,7 @@ else eval:=f_fn(h,x,y);
@x
@p function f;
@y
-@p function f_fn(@!h,@!x,@!y:index):index;
+@p function f_fn(@!h:integer64;@!x,@!y:index):index;
@z
@x
f:=lig_z[h];
diff --git a/Build/source/texk/web2c/omegaware/ofm2opl.up b/Build/source/texk/web2c/omegaware/ofm2opl.up
index 0c750e35b66..58a52fae602 100644
--- a/Build/source/texk/web2c/omegaware/ofm2opl.up
+++ b/Build/source/texk/web2c/omegaware/ofm2opl.up
@@ -1,3 +1,7 @@
+% ofm2opl.up. Public domain.
+%
+% Allow character codes up to "10FFFF.
+
@x [4] Increase constants.
@d char_max=@"FFFF
@y
diff --git a/Build/source/texk/web2c/omegaware/ofm2opl.web b/Build/source/texk/web2c/omegaware/ofm2opl.web
index 848861a6c34..6e3f442ca79 100644
--- a/Build/source/texk/web2c/omegaware/ofm2opl.web
+++ b/Build/source/texk/web2c/omegaware/ofm2opl.web
@@ -23,6 +23,7 @@
% Version 1.0 of OFM2OPL (December 1995) allows one to read OFM files.
% Version 1.11 (February 2000).
% Version 1.12 (September 2009) various bug fixes by Peter Breitenlohner.
+% Version 1.13 (January 2014) more bug fixes.
% Here is TeX material that gets inserted after \input webmac
\def\hang{\hangindent 3em\indent\ignorespaces}
@@ -41,7 +42,7 @@
\vfill
\centerline{\titlefont The {\ttitlefont OFM2OPL} processor}
\vskip 15pt
- \centerline{(Version 1.12, September 2009)}
+ \centerline{(Version 1.13, January 2014)}
\vfill}
\def\botofcontents{\vfill
\centerline{\hsize 5in\baselineskip9pt
@@ -83,7 +84,7 @@ and \.{OPL} files.
The |banner| string defined here should be changed whenever \.{OFM2OPL}
gets modified.
-@d banner=='This is OFM2OPL, Version 1.12'
+@d banner=='This is OFM2OPL, Version 1.13' {printed when the program starts}
@ This program is written entirely in standard \PASCAL, except that
it occasionally has lower case letters in strings that are output.
@@ -472,8 +473,7 @@ bytes, |tfm[0..(4*lf-1)]|.
@!xxchar_type=0..xxchar_max;
@!xxxchar_type=0..xxxchar_max;
-@
-@<Glob...@>=
+@ @<Glob...@>=
@!tfm:array [-1000..tfm_size] of byte; {the input data all goes here}
{the negative addresses avoid range checks for invalid characters}
@!top_char,@!top_width,@!top_height,@!top_depth,@!top_italic:integer;
@@ -495,13 +495,12 @@ if tfm[0]>127 then abort('The first byte of the input file exceeds 127!');
if eof(tfm_file) then abort('The input file is only one byte long!');
@.The input...one byte long@>
read(tfm_file,tfm[1]); lf:=tfm[0]*@'400+tfm[1];
-if lf=0 then begin
- for i:=2 to 7 do
- begin
- if eof(tfm_file)
- then abort('The input file is too short to designate its length!');
+if lf=0 then
+ begin for i:=2 to 7 do
+ begin if eof(tfm_file) then
+ abort('The input file is too short to designate its length!');
read(tfm_file, tfm[i]);
- end;
+ end;
ofm_on := true; ofm_level := tfm[2]*@"100+tfm[3];
if ofm_level>1 then
abort('OFMLEVEL ',ofm_level:1,' not supported, must be 0 or 1!');
@@ -509,11 +508,9 @@ if lf=0 then begin
if tfm[4]>127 then abort('The fifth byte of the input file exceeds 127!');
@.The fifth byte...@>
lf := tfm[4]*@"1000000 + tfm[5]*@"10000 + tfm[6]*@"100 + tfm[7];
-end
-else
-begin
- ofm_on := false;
-end;
+ end
+else begin ofm_on := false;
+ end;
case ofm_level of
-1: begin start_ptr:=2; check_sum:=24; end;
0: begin start_ptr:=8; check_sum:=56; end;
@@ -687,7 +684,7 @@ if not ofm_on then begin
for i:=bc to ec do begin
char_start[i]:=4*char_base+4*(i-bc);
end;
- end
+ end
else if ofm_level=0 then begin
for i:=bc to ec do begin
char_start[i]:=4*char_base+8*(i-bc);
@@ -944,17 +941,17 @@ HEX:='0123456789ABCDEF';@/
@<Glob...@>=
@!dig:array[0..32] of integer;
-@ Here, in fact, are two procedures that output
-|dig[j-1]|$\,\ldots\,$|dig[0]|, given $j>0$.
+@ Here, in fact, are two procedures that output |dig[j-1]|$\,\ldots\,$|dig[0]|,
+given $j>0$.
@p procedure out_digs(j:integer); {outputs |j| digits}
begin repeat decr(j); out(HEX[1+dig[j]]);
- until j=0;
+until j=0;
end;
@#
procedure print_digs(j:integer); {prints |j| digits}
begin repeat decr(j); print(HEX[1+dig[j]]);
- until j=0;
+until j=0;
end;
@ The |print_number| procedure indicates how |print_digs| can be used.
@@ -1091,11 +1088,11 @@ if tfm[k+l]<>0 then begin
dig[j]:=a mod 16; a:=a div 16; b:=b-4; incr(j);
end;
case b of
- 0: a:=tfm[k+l];
- 1:a:=a+2*tfm[k+l];
- 2:a:=a+4*tfm[k+l];
- 3:a:=a+8*tfm[k+l];
- end;
+ 0: a:=tfm[k+l];
+ 1:a:=a+2*tfm[k+l];
+ 2:a:=a+4*tfm[k+l];
+ 3:a:=a+8*tfm[k+l];
+ end;
end;
b:=b+8;
end
@@ -1173,8 +1170,8 @@ end;
@ @<Reduce \(2)negative to positive@>=
begin out('-'); a:=@'10000-a;
-if f>0 then begin
- f:=@'4000000-f; decr(a);
+if f>0 then
+ begin f:=@'4000000-f; decr(a);
end;
end
@@ -1249,20 +1246,20 @@ case ofm_level of
0: begin out('(OFMLEVEL H 0)'); out_ln; end;
1: begin out('(OFMLEVEL H 1)'); out_ln; end;
end;
-if ofm_on then begin
- left;
+if ofm_on then
+ begin left;
if font_dir<=7 then out('FONTDIR')
else out('NFONTDIR');
case font_dir mod 8 of
- 0: out(' TL');
- 1: out(' LT');
- 2: out(' TR');
- 3: out(' LB');
- 4: out(' BL');
- 5: out(' RT');
- 6: out(' BR');
- 7: out(' RB');
- end;
+ 0: out(' TL');
+ 1: out(' LT');
+ 2: out(' TR');
+ 3: out(' LB');
+ 4: out(' BL');
+ 5: out(' RT');
+ 6: out(' BR');
+ 7: out(' RB');
+ end;
right
end;
font_type:=vanilla;
@@ -1356,8 +1353,8 @@ right
@ @<Output the rest of the header@>=
begin left; out('FACE'); out_face(random_word+3); right;
-for i:=18 to lh-1 do begin
- left; out('HEADER D ',i:1);
+for i:=18 to lh-1 do
+ begin left; out('HEADER D ',i:1);
out_hex(check_sum+4*i,@,4); right;
end;
end
@@ -1381,8 +1378,8 @@ else if (lh>17) and (tfm[random_word]>127) then
@ The next thing to take care of is the list of parameters.
@<Do the parameters@>=
-if np>0 then begin
- left; out('FONTDIMEN'); out_ln;
+if np>0 then
+ begin left; out('FONTDIMEN'); out_ln;
for i:=1 to np do @<Check and output the $i$th parameter@>;
right;
end;
@@ -1505,18 +1502,16 @@ end;
@ @<Do the rule parameters@>=
if nkr>0 then
- begin
- start_counter:=rules_start*4;
+ begin start_counter:=rules_start*4;
base_counter:=rules_base*4;
for i:=0 to nkr-1 do @<Check and output the $i$th rule table@>;
- end;
+ end
@ @<Check and output the $i$th rule table@>=
-begin
-left; out('FONTRULE'); out_hex_number(i); out_ln;
+begin left; out('FONTRULE'); out_hex_number(i); out_ln;
number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
-for j:=0 to number_entries-1 do begin
- left; out('RULE'); out_hex_number(j); out_ln;
+for j:=0 to number_entries-1 do
+ begin left; out('RULE'); out_hex_number(j); out_ln;
left; out('RULEWD'); out_fix(base_counter); right;
left; out('RULEHT'); out_fix(base_counter+4); right;
left; out('RULEDP'); out_fix(base_counter+8); right;
@@ -1528,8 +1523,8 @@ start_counter:=start_counter+4;
end;
@ @<Do the glue parameters@>=
-if nkg>0 then begin
- start_counter:=glues_start*4;
+if nkg>0 then
+ begin start_counter:=glues_start*4;
base_counter:=glues_base*4;
for i:=0 to nkg-1 do @<Check and output the $i$th glue table@>;
end;
@@ -1539,11 +1534,10 @@ if nkg>0 then begin
@!glue_shrink_order,@!glue_argument:integer;
@ @<Check and output the $i$th glue table@>=
-begin
-left; out('FONTGLUE'); out_hex_number(i); out_ln;
+begin left; out('FONTGLUE'); out_hex_number(i); out_ln;
number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
-for j:=0 to number_entries-1 do begin
- left; out('GLUE'); out_hex_number(j); out_ln;
+for j:=0 to number_entries-1 do
+ begin left; out('GLUE'); out_hex_number(j); out_ln;
glue_subtype:=tfm[base_counter] div 16;
glue_argument_kind:=tfm[base_counter] mod 16;
glue_stretch_order:=tfm[base_counter+1] div 16;
@@ -1552,39 +1546,39 @@ for j:=0 to number_entries-1 do begin
left;
out('GLUETYPE');
case glue_subtype of
- 0: out(' H 0');
- 1: out(' H 1');
- 2: out(' H 2');
- 3: out(' H 3');
- end;
+ 0: out(' H 0');
+ 1: out(' H 1');
+ 2: out(' H 2');
+ 3: out(' H 3');
+ end;
right;
case glue_argument_kind of
- 1: begin
- left; out('GLUERULE'); out_hex_number(glue_argument); right;
- end;
- 2: begin
- left; out('GLUECHAR'); out_hex_number(glue_argument); right;
- end;
+ 1: begin
+ left; out('GLUERULE'); out_hex_number(glue_argument); right;
+ end;
+ 2: begin
+ left; out('GLUECHAR'); out_hex_number(glue_argument); right;
+ end;
end;
left;
out('GLUESTRETCHORDER');
case glue_stretch_order of
- 0: out(' H 0');
- 1: out(' H 1');
- 2: out(' H 2');
- 3: out(' H 3');
- 4: out(' H 4');
- end;
+ 0: out(' H 0');
+ 1: out(' H 1');
+ 2: out(' H 2');
+ 3: out(' H 3');
+ 4: out(' H 4');
+ end;
right;
left;
out('GLUESHRINKORDER');
case glue_shrink_order of
- 0: out(' H 0');
- 1: out(' H 1');
- 2: out(' H 2');
- 3: out(' H 3');
- 4: out(' H 4');
- end;
+ 0: out(' H 0');
+ 1: out(' H 1');
+ 2: out(' H 2');
+ 3: out(' H 3');
+ 4: out(' H 4');
+ end;
right;
left; out('GLUEWD'); out_fix(base_counter+4); right;
left; out('GLUESTRETCH'); out_fix(base_counter+8); right;
@@ -1597,8 +1591,8 @@ start_counter:=start_counter+4;
end;
@ @<Do the penalty parameters@>=
-if nkp>0 then begin
- start_counter:=penalties_start*4;
+if nkp>0 then
+ begin start_counter:=penalties_start*4;
base_counter:=penalties_base*4;
for i:=0 to nkp-1 do @<Check and output the $i$th penalty table@>;
end;
@@ -1674,7 +1668,7 @@ label_ptr:=0; label_table[0].rr:=0; {a sentinel appears at the bottom}
@ @<Do the ligatures and kerns@>=
if nl>0 then
- begin for ai:=0 to (nl-1) do activity[ai]:=unreachable;
+ begin for ai:=0 to nl-1 do activity[ai]:=unreachable;
@<Check for a boundary char@>;
end;
@<Build the label table@>;
@@ -1691,8 +1685,8 @@ that would not otherwise be detected.
@<Build...@>=
for c:=bc to ec do
-if (tag(c)=lig_tag) or (ctag(c)) then begin
- r:=rremainder(c);
+if (tag(c)=lig_tag) or (ctag(c)) then
+ begin r:=rremainder(c);
if (l_skip_byte(lig_step(r)) div 256)=0 then begin
if r<nl then begin
if l_skip_byte(lig_step(r))>stop_flag then begin
@@ -1703,8 +1697,8 @@ if (tag(c)=lig_tag) or (ctag(c)) then begin
end;
end;
end;
- if r>=nl then begin
- perfect:=false; print_ln(' ');
+ if r>=nl then
+ begin perfect:=false; print_ln(' ');
print('Ligature/kern starting index for character '); print_hex(c);
print_ln(' is too large;'); print_ln('so I removed it.'); set_no_tag(c);
set_no_ctag(c);
@@ -1716,8 +1710,8 @@ label_table[label_ptr+1].rr:=lig_size; {put ``infinite'' sentinel at the end}
@ @<Insert |(c,r)|...@>=
begin sort_ptr:=label_ptr; {there's a hole at position |sort_ptr+1|}
-while label_table[sort_ptr].rr>r do begin
- label_table[sort_ptr+1]:=label_table[sort_ptr];
+while label_table[sort_ptr].rr>r do
+ begin label_table[sort_ptr+1]:=label_table[sort_ptr];
decr(sort_ptr); {move the hole}
end;
label_table[sort_ptr+1].ischar:=not ctag(c);
@@ -1730,21 +1724,20 @@ incr(label_ptr); activity[r]:=accessible;
end
@ @<Check for a bound...@>=
-if l_skip_byte(lig_step(0))=255 then begin
- left; out('BOUNDARYCHAR');
+if l_skip_byte(lig_step(0))=255 then
+ begin left; out('BOUNDARYCHAR');
boundary_char:=l_next_char(lig_step(0)); out_char(boundary_char); right;
activity[0]:=pass_through;
end;
-if l_skip_byte(lig_step(nl-1))=255 then begin
- r:=256*l_op_byte(lig_step(nl-1))+l_remainder(lig_step(nl-1));
- if r>=nl then begin
- perfect:=false; print_ln(' ');
+if l_skip_byte(lig_step(nl-1))=255 then
+ begin r:=256*l_op_byte(lig_step(nl-1))+l_remainder(lig_step(nl-1));
+ if r>=nl then
+ begin perfect:=false; print_ln(' ');
print('Ligature/kern starting index for boundarychar is too large;');
print_ln('so I removed it.');
@.Ligature/kern starting index...@>
end
- else begin label_ptr:=1; label_table[1].cc:=xmax_char;
- label_table[1].rr:=r;
+ else begin label_ptr:=1; label_table[1].cc:=xmax_char; label_table[1].rr:=r;
bchar_label:=r; activity[r]:=accessible;
end;
activity[nl-1]:=pass_through;
@@ -1809,9 +1802,9 @@ while i=label_table[sort_ptr].rr do begin
end
@ @<Take care of commenting out...@>=
-if activity[i]=unreachable then begin
- if level=1 then begin
- left; out('COMMENT THIS PART OF THE PROGRAM IS NEVER USED!'); out_ln;
+if activity[i]=unreachable then
+ begin if level=1 then
+ begin left; out('COMMENT THIS PART OF THE PROGRAM IS NEVER USED!'); out_ln;
end
end
else if level=2 then right
@@ -1868,12 +1861,10 @@ end
inaccessible commands.
@<Output either...@>=
-begin
-if (l_skip_byte(k) mod 256)>=stop_flag then out('(STOP)')
-else begin
- count:=0;
- for ai:=(i+1) to (i+(l_skip_byte(k) mod 256)) do
- if activity[ai]=accessible then incr(count);
+begin if (l_skip_byte(k) mod 256)>=stop_flag then out('(STOP)')
+else begin count:=0;
+ for ai:=i+1 to (i+(l_skip_byte(k) mod 256)) do
+ if activity[ai]=accessible then incr(count);
out('(SKIP D ',count:1,')'); {possibly $count=0$, so who cares}
end;
out_ln;
@@ -1896,8 +1887,7 @@ right;
end
@ @<Output a ligature step@>=
-begin
-if nonexistent(l_next_char(k)) then
+begin if nonexistent(l_next_char(k)) then
if l_next_char(k)<>boundary_char then
correct_bad_char('Ligature step for')(l_next_char)(set_l_next_char);
@.Ligature step for nonexistent...@>
@@ -1905,15 +1895,15 @@ if nonexistent(l_remainder(k)) then
correct_bad_char('Ligature step produces the')(l_remainder)(set_l_remainder);
@.Ligature step produces...@>
left; r:=l_op_byte(k);
-if (r=4)or((r>7)and(r<>11)) then begin
- print_ln('Ligature step with nonstandard code changed to LIG');
+if (r=4)or((r>7)and(r<>11)) then
+ begin print_ln('Ligature step with nonstandard code changed to LIG');
r:=0; set_l_op_byte(k,0);
end;
if r mod 4>1 then out('/');
out('LIG');
if odd(r) then out('/');
-while r>3 do begin
- out('>'); r:=r-4;
+while r>3 do
+ begin out('>'); r:=r-4;
end;
out_char(l_next_char(k)); out_char(l_remainder(k)); right;
end
@@ -1926,64 +1916,62 @@ character.
sort_ptr:=0; {this will suppress `\.{STOP}' lines in ligature comments}
c:=bc;
while (c<=ec) do
-begin
-if width_index(c)>0 then begin
- if chars_on_line=8 then begin
- print_ln(' '); chars_on_line:=1;
- end
- else begin
- if chars_on_line>0 then print(' ');
- incr(chars_on_line);
- end;
- if no_repeats(c)>0 then begin
- print_hex(c); print('-'); print_hex(c+no_repeats(c));
- left; out('CHARREPEAT'); out_char(c); out_char(no_repeats(c)); out_ln;
- end
- else 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@>;
- if italic_index(c)>0 then @<Output the italic correction@>;
- case tag(c) of
+ begin if width_index(c)>0 then
+ begin if chars_on_line=8 then
+ begin print_ln(' '); chars_on_line:=1;
+ end
+ else begin if chars_on_line>0 then print(' ');
+ incr(chars_on_line);
+ end;
+ if no_repeats(c)>0 then begin
+ print_hex(c); print('-'); print_hex(c+no_repeats(c));
+ left; out('CHARREPEAT'); out_char(c); out_char(no_repeats(c)); out_ln;
+ end
+ else 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@>;
+ if italic_index(c)>0 then @<Output the italic correction@>;
+ case tag(c) of
no_tag: do_nothing;
lig_tag: @<Output the applicable part of the ligature/kern
program as a comment@>;
list_tag: @<Output the character link unless there is a problem@>;
ext_tag: @<Output an extensible character recipe@>;
end; {there are no other cases}
- for i:=0 to npc-1 do begin
- if char_param(c,i)<>0 then begin
- left;
- if i<nki then begin
- out('CHARIVALUE'); out_hex_number(i);
- end
- else if i<(nki+nkf) then begin
- out('CHARFVALUE'); out_hex_number(i-nki);
- end
- else if i<(nki+nkf+nkm) then begin
- out('CHARMVALUE'); out_hex_number(i-nki-nkf);
- end
- else if i<(nki+nkf+nkm+nkr) then begin
- out('CHARRULE'); out_hex_number(i-nki-nkf-nkm);
- end
- else if i<(nki+nkf+nkm+nkr+nkg) then begin
- out('CHARGLUE'); out_hex_number(i-nki-nkf-nkm-nkr);
- end
- else if i<(nki+nkf+nkm+nkr+nkg+nkp) then begin
- out('CHARPENALTY'); out_hex_number(i-nki-nkf-nkm-nkr-nkg);
+ for i:=0 to npc-1 do begin
+ if char_param(c,i)<>0 then begin
+ left;
+ if i<nki then begin
+ out('CHARIVALUE'); out_hex_number(i);
+ end
+ else if i<(nki+nkf) then begin
+ out('CHARFVALUE'); out_hex_number(i-nki);
+ end
+ else if i<(nki+nkf+nkm) then begin
+ out('CHARMVALUE'); out_hex_number(i-nki-nkf);
+ end
+ else if i<(nki+nkf+nkm+nkr) then begin
+ out('CHARRULE'); out_hex_number(i-nki-nkf-nkm);
+ end
+ else if i<(nki+nkf+nkm+nkr+nkg) then begin
+ out('CHARGLUE'); out_hex_number(i-nki-nkf-nkm-nkr);
+ end
+ else if i<(nki+nkf+nkm+nkr+nkg+nkp) then begin
+ out('CHARPENALTY'); out_hex_number(i-nki-nkf-nkm-nkr-nkg);
+ end;
+ out_hex_number(char_param(c,i));
+ right;
end;
- out_hex_number(char_param(c,i));
- right;
end;
+ right;
end;
- right;
- end;
-c:=c+1+no_repeats(c);
-end
+ c:=c+1+no_repeats(c);
+ end
@ @<Output the character's width@>=
if width_index(c)>=nw then range_error('Width')
@@ -2012,8 +2000,7 @@ else begin left; out('CHARIC'); out_fix(italic(c)); right;
@ @<Output the applicable part of the ligature...@>=
begin left; out('COMMENT'); out_ln;@/
i:=rremainder(c); r:=lig_step(i);
-if (l_skip_byte(r) mod 256)>stop_flag
-then i:=256*l_op_byte(r)+l_remainder(r);
+if (l_skip_byte(r) mod 256)>stop_flag then i:=256*l_op_byte(r)+l_remainder(r);
repeat @<Output step...@>;
if (l_skip_byte(k) mod 256)>=stop_flag then i:=nl
else i:=i+1+(l_skip_byte(k) mod 256);
@@ -2022,8 +2009,8 @@ right;
end
@ We want to make sure that there is no cycle of characters linked together
-by |list_tag| entries, since such a cycle would get \TeX\ into an endless
-loop. If such a cycle exists, the routine here detects it when processing
+by |list_tag| entries, since \TeX\ doesn't want to risk endless loops.
+If such a cycle exists, the routine here detects it when processing
the largest character code in the cycle.
@<Output the character link unless there is a problem@>=
@@ -2072,7 +2059,7 @@ for d:=0 to 3 do begin
if (d=3)or(exten_char>0) then begin
left;
case d of
- 0:out('TOP');@+1:out('MID');@+2:out('BOT');@+3:out('REP')@+end;
+ 0:out('TOP');@+1:out('MID');@+2:out('BOT');@+3:out('REP')@+end;
if nonexistent(exten_char) then out_char(c)
else out_char(exten_char);
right;
@@ -2114,9 +2101,9 @@ if ne>0 then
@* Checking for ligature loops.
We have programmed almost everything but the most interesting calculation of
-all, which has been saved for last as a special treat. \TeX's extended
-ligature mechanism allows unwary users to specify sequences of ligature
-replacements that never terminate. For example, the pair of commands
+all, which has been saved for last as a special treat. \TeX's extended ligature
+mechanism allows unwary users to specify sequences of ligature replacements
+that never terminate. For example, the pair of commands
$$\.{(/LIG $x$ $y$) (/LIG $y$ $x$)}$$
alternately replaces character $x$ by character $y$ and vice versa. A similar
loop occurs if \.{(LIG/ $z$ $y$)} occurs in the program for $x$ and
@@ -2139,8 +2126,8 @@ $f(x,y)$. This function is defined if and only if no infinite loop is
generated when the cursor is between $x$ and~$y$.
The function $f(x,y)$ can be defined recursively. It turns out that all pairs
-$(x,y)$ belong to one of five classes. The simplest class has $f(x,y)=y$;
-this happens if there's no ligature between $x$ and $y$, or in the cases
+$(x,y)$ belong to one of five classes. The simplest class has $f(x,y)=y$; this
+happens if there's no ligature between $x$ and $y$, or in the cases
\.{LIG/>} and \.{/LIG/>>}. Another simple class arises when there's a
\.{LIG} or \.{/LIG>} between $x$ and~$y$, generating the character~$z$;
then $f(x,y)=z$. Otherwise we always have $f(x,y)$ equal to
@@ -2162,12 +2149,11 @@ $(x,y)$ in a hash table from which the values $z$ and $class$ can be read.
@d pending=4 {$f(x,y)$ is being evaluated}
@<Glob...@>=
-@!hash:array[0..hash_size] of integer;
+@!hash:array[0..hash_size] of integer64;
@!class:array[0..hash_size] of simple..pending;
@!lig_z:array[0..hash_size] of xxchar_type;
@!hash_ptr:0..hash_size; {the number of nonzero entries in |hash|}
-@!hash_list:array[0..hash_size] of 0..hash_size;
- {list of those nonzero entries}
+@!hash_list:array[0..hash_size] of 0..hash_size; {list of those nonzero entries}
@!h,@!hh:0..hash_size; {indices into the hash table}
@!x_lig_cycle,@!y_lig_cycle:integer; {problematic ligature pair}
@@ -2197,8 +2183,7 @@ for hh:=1 to hash_ptr do
if y_lig_cycle<xmax_char then
begin print('Infinite ligature loop starting with ');
@.Infinite ligature loop...@>
- if x_lig_cycle=xmax_char
- then print('boundary')@+else print_hex(x_lig_cycle);
+ if x_lig_cycle=xmax_char then print('boundary')@+else print_hex(x_lig_cycle);
print(' and '); print_hex(y_lig_cycle); print_ln('!');
out('(INFINITE LIGATURE LOOP MUST BE BROKEN!)'); goto final_end;
end
@@ -2217,15 +2202,16 @@ label 30; {go here for a quick exit}
var @!cc:simple..both_z; {class of data being entered}
@!zz:char_type; {function value or ligature character being entered}
@!y:char_type; {the character after the cursor}
-@!key:integer; {value to be stored in |hash|}
+@!key:integer64; {value to be stored in |hash|}
+@!t64:integer64; {temporary register for swapping}
@!t:integer; {temporary register for swapping}
begin if hash_ptr=hash_size then goto 30;
@<Compute the command parameters |y|, |cc|, and |zz|@>;
-key:=xmax_char*c+y+1; h:=(hash_mult*(key mod hash_size)) mod hash_size;
+key:=int64cast(xmax_char)*c+y+1; h:=(hash_mult*key) mod hash_size;
while hash[h]>0 do
begin if hash[h]<=key then
begin if hash[h]=key then goto 30; {unused ligature command}
- t:=hash[h]; hash[h]:=key; key:=t; {do ordered-hash-table insertion}
+ t64:=hash[h]; hash[h]:=key; key:=t64; {do ordered-hash-table insertion}
t:=class[h]; class[h]:=cc; cc:=t; {namely, do a swap}
t:=lig_z[h]; lig_z[h]:=zz; zz:=t;
end;
@@ -2235,8 +2221,8 @@ hash[h]:=key; class[h]:=cc; lig_z[h]:=zz;
incr(hash_ptr); hash_list[hash_ptr]:=h;
30:end;
-@ We must store kern commands as well as ligature commands, because
-the former might make the latter inapplicable.
+@ We must store kern commands as well as ligature commands, because the former
+might make the latter inapplicable.
@<Compute the command param...@>=
k:=lig_step(i); y:=l_next_char(k); t:=l_op_byte(k);
@@ -2254,11 +2240,11 @@ else begin case t of
@ Evaluation of $f(x,y)$ is handled by two mutually recursive procedures.
Kind of a neat algorithm, generalizing a depth-first search.
-@p function f(@!h,@!x,@!y:index):index; forward;@t\2@>
+@p function f(@!h:integer64;@!x,@!y:index):index; forward;@t\2@>
{compute $f$ for arguments known to be in |hash[h]|}
function eval(@!x,@!y:index):index; {compute $f(x,y)$ with hashtable lookup}
-var @!key:integer; {value sought in hash table}
-begin key:=xmax_char*x+y+1; h:=(hash_mult*key) mod hash_size;
+var @!key:integer64; {value sought in hash table}
+begin key:=int64cast(xmax_char)*x+y+1; h:=(hash_mult*key) mod hash_size;
while hash[h]>key do
if h>0 then decr(h)@+else h:=hash_size;
if hash[h]<key then eval:=y {not in ordered hash table}
@@ -2266,7 +2252,7 @@ else eval:=f(h,x,y);
end;
@ Pascal's beastly convention for |forward| declarations prevents us from
-saying |function f(h,x,y:index):index| here.
+saying |function f(h:integer64;x,y:index):index| here.
@p function f;
begin case class[h] of
@@ -2278,10 +2264,8 @@ right_z: begin class[h]:=pending; lig_z[h]:=eval(x,lig_z[h]); class[h]:=simple;
both_z: begin class[h]:=pending; lig_z[h]:=eval(eval(x,lig_z[h]),y);
class[h]:=simple;
end;
-pending: begin x_lig_cycle:=x; y_lig_cycle:=y;
- lig_z[h]:=xxmax_char; class[h]:=simple;
- end; {the value |xxmax_char| will break all cycles,
- since it's not in |hash|}
+pending: begin x_lig_cycle:=x; y_lig_cycle:=y; lig_z[h]:=xxmax_char; class[h]:=simple;
+ end; {the value |xxmax_char| will break all cycles, since it's not in |hash|}
end; {there are no other cases}
f:=lig_z[h];
end;
diff --git a/Build/source/texk/web2c/omegaware/opl2ofm.ch b/Build/source/texk/web2c/omegaware/opl2ofm.ch
index 61ba2462ea1..1d09ca8ac14 100644
--- a/Build/source/texk/web2c/omegaware/opl2ofm.ch
+++ b/Build/source/texk/web2c/omegaware/opl2ofm.ch
@@ -27,10 +27,10 @@
@z
@x [1] Define my_name
-@d banner=='This is OPL2OFM, Version 1.12'
+@d banner=='This is OPL2OFM, Version 1.13' {printed when the program starts}
@y
@d my_name=='opl2ofm'
-@d banner=='This is OPL2OFM, Version 1.12'
+@d banner=='This is OPL2OFM, Version 1.13' {printed when the program starts}
@z
@x [still 2] No banner unless verbose.
@@ -41,15 +41,14 @@ procedure initialize; {this procedure gets things started properly}
@<Define |parse_arguments|@>
procedure initialize; {this procedure gets things started properly}
var @<Local variables for initialization@>@/
-begin
- kpse_set_program_name (argv[0], my_name);
+ begin kpse_set_program_name (argv[0], my_name);
parse_arguments;
@z
@x [3] Larger constants.
@!buf_size=60; {length of lines displayed in error messages}
@y
-@!buf_size=3000; {max input line length, output error line length}
+@!buf_size=3000; {length of lines displayed in error messages}
@z
@x [6] Open PL file.
@@ -96,13 +95,13 @@ correspond to one-character constants like \.{"A"} in \.{WEB} language.
@z
@x [28] (fill_buffer) end-of-line counts as a delimiter. Possibly a bug.
- while (limit<buf_size-1)and(not eoln(pl_file)) do begin
- incr(limit); read(pl_file,buffer[limit]);
+else begin while (limit<buf_size-1)and(not eoln(pl_file)) do
+ begin incr(limit); read(pl_file,buffer[limit]);
end;
buffer[limit+1]:=' '; right_ln:=eoln(pl_file);
@y
- while (limit<buf_size-2)and(not eoln(pl_file)) do begin
- incr(limit); read(pl_file,buffer[limit]);
+else begin while (limit<buf_size-2)and(not eoln(pl_file)) do
+ begin incr(limit); read(pl_file,buffer[limit]);
end;
buffer[limit+1]:=' '; right_ln:=eoln(pl_file);
if right_ln then begin incr(limit); buffer[limit+1]:=' ';
@@ -112,10 +111,10 @@ correspond to one-character constants like \.{"A"} in \.{WEB} language.
@x [31] (get_keyword_char) Unnecessary due to previous change.
begin while (loc=limit)and(not right_ln) do fill_buffer;
if loc=limit then cur_char:=" " {end-of-line counts as a delimiter}
-else begin
+else begin cur_char:=xord[buffer[loc+1]];
@y
begin while loc=limit do fill_buffer;
-begin
+ begin cur_char:=xord[buffer[loc+1]];
@z
@x [79] `index' might be a library routine.
@@ -184,12 +183,12 @@ HEX:=' 0123456789ABCDEF';@/
% symbol table...
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
-@p function f(@!h,@!x,@!y:indx):indx; forward;@t\2@>
+@p function f(@!h:integer64;@!x,@!y:indx):indx; forward;@t\2@>
{compute $f$ for arguments known to be in |hash[h]|}
@y
@p
ifdef('notdef')
-function f(@!h,@!x,@!y:indx):indx; begin end;@t\2@>
+function f(@!h:integer64;@!x,@!y:indx):indx; begin end;@t\2@>
{compute $f$ for arguments known to be in |hash[h]|}
endif('notdef')
@z
@@ -199,7 +198,7 @@ endif('notdef')
@x
@p function f;
@y
-@p function f(@!h,@!x,@!y:indx):indx;
+@p function f(@!h:integer64;@!x,@!y:indx):indx;
@z
@x [127] Fix up output of bytes.
@@ -212,8 +211,8 @@ endif('notdef')
@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|}
var @!n:byte; {the first byte after the sign}
@!m:0..65535; {the two least significant bytes}
-begin if abs(x/design_units)>=16.0 then begin
- print_ln('The relative dimension ',x/@'4000000:1:3,
+begin if abs(x/design_units)>=16.0 then
+ begin print_ln('The relative dimension ',x/@'4000000:1:3,
' is too large.');
@.The relative dimension...@>
print(' (Must be less than 16*designsize');
@@ -223,8 +222,8 @@ begin if abs(x/design_units)>=16.0 then begin
@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|}
var @!n:byte; {the first byte after the sign}
@!m:0..65535; {the two least significant bytes}
-begin if fabs(x/design_units)>=16.0 then begin
- print('The relative dimension ');
+begin if fabs(x/design_units)>=16.0 then
+ begin print('The relative dimension ');
print_real(x/@'4000000,1,3);
print_ln(' is too large.');
@.The relative dimension...@>
@@ -239,9 +238,9 @@ begin if fabs(x/design_units)>=16.0 then begin
% might be -1, and if -1 is coerced to being unsigned, it will be bigger
% than anything else.
@x
- while label_table[sort_ptr].rr>char_remainder[c] do begin
+ while label_table[sort_ptr].rr>char_remainder[c] do
@y
- while label_table[sort_ptr].rr>intcast(char_remainder[c]) do begin
+ while label_table[sort_ptr].rr>intcast(char_remainder[c]) do
@z
@x [170] Eliminate unused variables.
diff --git a/Build/source/texk/web2c/omegaware/opl2ofm.up b/Build/source/texk/web2c/omegaware/opl2ofm.up
index 7889604012c..cedd3badb91 100644
--- a/Build/source/texk/web2c/omegaware/opl2ofm.up
+++ b/Build/source/texk/web2c/omegaware/opl2ofm.up
@@ -1,37 +1,77 @@
+% opl2ofm.up. Public domain.
+%
+% Allow character codes up to "10FFFF.
+
@x [3] Increase constants.
@d char_max=@"FFFF
@y
@d char_max=@"10FFFF
@z
-@x [3] Increase constants.
-@d width_max=@"FFFF
-@y
-@d width_max=@"10FFFF
-@z
@x [51]
-@d max_byte=@"FFFF
-
@p function get_byte:byte; {scans a one-byte property value}
@y
-@d max_byte=@"10FFFF
+We have to distinguish between character codes that may exceed |@"FFFF|
+and those that are store in one |byte| and thus must not exceed |@"FFFF|.
-@p function get_byte:integer; {scans a one-byte property value}
+@p function get_char_code:integer; {scans a character code value}
+@z
+@x [51]
+cur_char:=" "; get_byte:=acc;
+@y
+cur_char:=" "; get_char_code:=acc;
+end;
+@#
+function get_byte:integer; {scans a one-byte property value}
+var acc:integer; {an accumulator}
+begin acc:=get_char_code;
+if acc>@"FFFF then begin
+ skip_error('This value shouldn''t exceed "FFFF');
+@.This value shouldn't...@>
+ acc:=0; cur_char:=" ";
+ end;
+get_byte:=acc;
@z
@x [53]
- skip_error('This value shouldn''t exceed 65535');
+ begin skip_error('This value shouldn''t exceed 65535');
@y
- skip_error('This value shouldn''t exceed 1114111');
+ begin skip_error('This value shouldn''t exceed 1114111');
@z
@x [54]
- skip_error('This value shouldn''t exceed ''177777');
+ begin skip_error('This value shouldn''t exceed ''177777');
@y
- skip_error('This value shouldn''t exceed ''4177777');
+ begin skip_error('This value shouldn''t exceed ''4177777');
@z
@x [55]
- skip_error('This value shouldn''t exceed "FFFF');
+ begin skip_error('This value shouldn''t exceed "FFFF');
+@y
+ begin skip_error('This value shouldn''t exceed "10FFFF');
+@z
+
+@x [??]
+else begin backup; c:=get_byte;
+@y
+else begin backup; c:=get_char_code;
+@z
+
+@x [??]
+@ @<Read an extended label step@>=
+begin c:=get_byte;
+@y
+@ @<Read an extended label step@>=
+begin c:=get_char_code;
+@z
+
+@x [??]
+c:=get_byte; {read the character code that is being specified}
+@y
+c:=get_char_code; {read the character code that is being specified}
+@z
+
+@x [??]
+c:=get_byte; {read the character code that is being specified}
@y
- skip_error('This value shouldn''t exceed "10FFFF');
+c:=get_char_code; {read the character code that is being specified}
@z
@x [159]
diff --git a/Build/source/texk/web2c/omegaware/opl2ofm.web b/Build/source/texk/web2c/omegaware/opl2ofm.web
index 0008e898708..1d18184f58e 100644
--- a/Build/source/texk/web2c/omegaware/opl2ofm.web
+++ b/Build/source/texk/web2c/omegaware/opl2ofm.web
@@ -29,6 +29,7 @@
% and generate OFM files.
% Version 1.11 (February 2000).
% Version 1.12 (September 2009) various bug fixes by Peter Breitenlohner.
+% Version 1.13 (January 2014) more bug fixes.
% Here is TeX material that gets inserted after \input webmac
\def\hang{\hangindent 3em\indent\ignorespaces}
@@ -49,7 +50,7 @@
\vfill
\centerline{\titlefont The {\ttitlefont OPL2OFM} processor}
\vskip 15pt
- \centerline{(Version 1.12, September 2009)}
+ \centerline{(Version 1.13, January 2014)}
\vfill}
\def\botofcontents{\vfill
\centerline{\hsize 5in\baselineskip9pt
@@ -84,7 +85,7 @@ apply to the \.{OPL2OFM} program and to \.{OFM} and \.{OPL} files.
The |banner| string defined here should be changed whenever \.{OPL2OFM}
gets modified.
-@d banner=='This is OPL2OFM, Version 1.12'
+@d banner=='This is OPL2OFM, Version 1.13' {printed when the program starts}
@ This program is written entirely in standard \PASCAL, except that
it has to do some slightly system-dependent character code conversion
@@ -466,7 +467,7 @@ The slashes specify retention of the left or right original character; the
`\.{(KRN} $c$ $r$\.)' means, ``If the next character is $c$, then insert
a blank space of width $r$ between the current character character and $c$;
otherwise go on to the next intruction.'' The value of $r$, which is in
-units of the design size, is often negative. Character code $c$ must exist
+design units, is often negative. Character code $c$ must exist
in the font.
\yskip\hang\.{STOP} (no value). This instruction ends a ligature/kern program.
@@ -475,8 +476,8 @@ or \.{STOP} or \.{SKIP}.
\yskip\hang\.{SKIP} (value in the range |0..127|). This instruction specifies
continuation of a ligature/kern program after the specified number of \.{LIG}
-or \.{KRN} has been skipped over. The number of subsequent \.{LIG} and \.{KRN}
-instructions must therefore exceed this specified amount.
+or \.{KRN} steps has been skipped over. The number of subsequent \.{LIG} and
+\.{KRN} instructions must therefore exceed this specified amount.
@ In addition to all these possibilities, the property name \.{COMMENT} is
allowed in any property list. Such comments are ignored.
@@ -640,16 +641,15 @@ error messages would not come out properly aligned.)
@p procedure fill_buffer;
begin left_ln:=right_ln; limit:=0; loc:=0;
-if left_ln then begin
- if line>0 then read_ln(pl_file);
+if left_ln then
+ begin if line>0 then read_ln(pl_file);
incr(line);
end;
-if eof(pl_file) then begin
- limit:=1; buffer[1]:=')'; right_ln:=false; input_has_ended:=true;
+if eof(pl_file) then
+ begin limit:=1; buffer[1]:=')'; right_ln:=false; input_has_ended:=true;
end
-else begin
- while (limit<buf_size-1)and(not eoln(pl_file)) do begin
- incr(limit); read(pl_file,buffer[limit]);
+else begin while (limit<buf_size-1)and(not eoln(pl_file)) do
+ begin incr(limit); read(pl_file,buffer[limit]);
end;
buffer[limit+1]:=' '; right_ln:=eoln(pl_file);
if left_ln then @<Set |loc| to the number of leading blanks in
@@ -666,14 +666,14 @@ indentation conventions the user is following, if any.
@<Set |loc|...@>=
begin while (loc<limit)and(buffer[loc+1]=' ') do incr(loc);
-if loc<limit then begin
- if level=0 then
+if loc<limit then
+ begin if level=0 then
if loc=0 then incr(good_indent)
else bad_indent('Warning: Indented line occurred at level zero')
@.Warning: Indented line...@>
else if indent=0 then
- if loc mod level=0 then begin
- indent:=loc div level; good_indent:=1;
+ if loc mod level=0 then
+ begin indent:=loc div level; good_indent:=1;
end
else good_indent:=0
else if indent*level=loc then incr(good_indent)
@@ -701,8 +701,7 @@ Lower case letters are converted to upper case.
@p procedure get_keyword_char;
begin while (loc=limit)and(not right_ln) do fill_buffer;
if loc=limit then cur_char:=" " {end-of-line counts as a delimiter}
-else begin
- cur_char:=xord[buffer[loc+1]];
+else begin cur_char:=xord[buffer[loc+1]];
if cur_char>="a" then cur_char:=cur_char-@'40;
if ((cur_char>="0")and(cur_char<="9")) then incr(loc)
else if ((cur_char>="A")and(cur_char<="Z")) then incr(loc)
@@ -728,9 +727,8 @@ begin while loc=limit do fill_buffer;
incr(loc); cur_char:=xord[buffer[loc]];
if cur_char>="a" then
if cur_char<="z" then cur_char:=cur_char-@'40 {uppercasify}
- else begin
- if cur_char=invalid_code then begin
- err_print('Illegal character in the file');
+ else begin if cur_char=invalid_code then
+ begin err_print('Illegal character in the file');
@.Illegal character...@>
cur_char:="?";
end;
@@ -746,8 +744,8 @@ the level in force when the procedure was called.
@p procedure skip_to_end_of_item;
var l:integer; {initial value of |level|}
begin l:=level;
-while level>=l do begin
- while loc=limit do fill_buffer;
+while level>=l do
+ begin while loc=limit do fill_buffer;
incr(loc);
if buffer[loc]=')' then decr(level)
else if buffer[loc]='(' then incr(level);
@@ -837,8 +835,8 @@ var k:0..longest_name; {index into |cur_name|}
begin @<Compute the hash code, |cur_hash|, for |cur_name|@>;
not_found:=true;
cur_hash_reset:=false;
-while not_found do begin
- if (cur_hash=0) and (cur_hash_reset) then
+while not_found do
+ begin if (cur_hash=0) and (cur_hash_reset) then
not_found:=false
else begin
if cur_hash=0 then begin
@@ -1213,8 +1211,8 @@ cur_char:=" ";
while cur_char=" " do get_next;
if (cur_char>")")or(cur_char<"(") then decr(loc); {back up one character}
name_length:=0; get_keyword_char; {prepare to scan the name}
-while cur_char<>" " do begin
- if name_length=longest_name then cur_name[1]:="X" {force error}
+while cur_char<>" " do
+ begin if name_length=longest_name then cur_name[1]:="X" {force error}
else incr(name_length);
cur_name[name_length]:=cur_char;
get_keyword_char;
@@ -1235,8 +1233,6 @@ and $2^{31}-1$, inclusive, so that a computer with two's complement
@ The first number scanner, which returns a one-byte value, surely has
no problems of arithmetic overflow.
-@d max_byte=@"FFFF
-
@p function get_byte:byte; {scans a one-byte property value}
var acc:integer; {an accumulator}
@!t:ASCII_code; {the type of value to be scanned}
@@ -1266,10 +1262,10 @@ else skip_error('"C" value must be standard ASCII and not a paren')
@:C value}\.{"C" value must be...@>
@ @<Scan a small dec...@>=
-begin while (cur_char>="0")and(cur_char<="9") do begin
- acc:=acc*10+cur_char-"0";
- if acc>max_byte then begin
- skip_error('This value shouldn''t exceed 65535');
+begin while (cur_char>="0")and(cur_char<="9") do
+ begin acc:=acc*10+cur_char-"0";
+ if acc>char_max then
+ begin skip_error('This value shouldn''t exceed 65535');
@.This value shouldn't...@>
acc:=0; cur_char:=" ";
end
@@ -1281,8 +1277,8 @@ end
@ @<Scan a small oct...@>=
begin while (cur_char>="0")and(cur_char<="7") do
begin acc:=acc*8+cur_char-"0";
- if acc>max_byte then begin
- skip_error('This value shouldn''t exceed ''177777');
+ if acc>char_max then
+ begin skip_error('This value shouldn''t exceed ''177777');
@.This value shouldn't...@>
acc:=0; cur_char:=" ";
end
@@ -1293,11 +1289,11 @@ end
@ @<Scan a small hex...@>=
begin while ((cur_char>="0")and(cur_char<="9"))or
- ((cur_char>="A")and(cur_char<="F")) do begin
- if cur_char>="A" then cur_char:=cur_char+"0"+10-"A";
+ ((cur_char>="A")and(cur_char<="F")) do
+ begin if cur_char>="A" then cur_char:=cur_char+"0"+10-"A";
acc:=acc*16+cur_char-"0";
- if acc>max_byte then begin
- skip_error('This value shouldn''t exceed "FFFF');
+ if acc>char_max then
+ begin skip_error('This value shouldn''t exceed "FFFF');
@.This value shouldn't...@>
acc:=0; cur_char:=" ";
end
@@ -1317,8 +1313,8 @@ get_next;
if cur_char="C" then acc:=acc+6
else if cur_char="E" then acc:=acc+12
else if cur_char<>"R" then acc:=18;
-if acc>=18 then begin
- skip_error('Illegal face code, I changed it to MRR');
+if acc>=18 then
+ begin skip_error('Illegal face code, I changed it to MRR');
@.Illegal face code...@>
acc:=0;
end;
@@ -1423,8 +1419,7 @@ negative:=false; acc:=0; {start with the accumulators zero}
if (cur_char<>"R")and(cur_char<>"D") then
skip_error('An "R" or "D" value is needed here')
@.An "R" or "D" ... needed here@>
-else begin
- @<Scan the blanks and/or signs after the type code@>;
+else begin @<Scan the blanks and/or signs after the type code@>;
while (cur_char>="0") and (cur_char<="9") do
@<Multiply by 10, add |cur_char-"0"|, and |get_next|@>;
int_part:=acc; acc:=0;
@@ -1439,16 +1434,16 @@ end;
@ @<Scan the blanks...@>=
repeat get_next;
-if cur_char="-" then begin
- cur_char:=" "; negative:=not negative;
+if cur_char="-" then
+ begin cur_char:=" "; negative:=not negative;
end
else if cur_char="+" then cur_char:=" ";
until cur_char<>" "
@ @<Multiply by 10...@>=
begin acc:=acc*10+cur_char-"0";
-if acc>=2048 then begin
- skip_error('Real constants must be less than 2048');
+if acc>=2048 then
+ begin skip_error('Real constants must be less than 2048');
@.Real constants must be...@>
acc:=0; cur_char:=" ";
end
@@ -1465,15 +1460,15 @@ $f=\lfloor(f^\prime+1)/2\rfloor$. It is possible to have $f=1.0$.
@ @<Scan the frac...@>=
begin j:=0; get_next;
-while (cur_char>="0")and(cur_char<="9") do begin
- if j<7 then begin
- incr(j); fraction_digits[j]:=@'10000000*(cur_char-"0");
+while (cur_char>="0")and(cur_char<="9") do
+ begin if j<7 then
+ begin incr(j); fraction_digits[j]:=@'10000000*(cur_char-"0");
end;
get_next;
end;
acc:=0;
-while j>0 do begin
- acc:=fraction_digits[j]+(acc div 10); decr(j);
+while j>0 do
+ begin acc:=fraction_digits[j]+(acc div 10); decr(j);
end;
acc:=(acc+10) div 20;
end
@@ -1550,11 +1545,11 @@ font_dir:=0;
@ Most of the dimensions, however, go into the |memory| array. There are
at most |max_char+2| widths, |max_char+2| heights, |max_char+2| depths,
-and |max_char+2| italic corrections, since the value 0 is required but
-it need not be used. So |memory| has room for |4*max_char+8| entries,
-each of which is a |fix_word|. An auxiliary table called |link| is
-used to link these words together in linear lists, so that sorting and
-other operations can be done conveniently.
+and |max_char+2| italic corrections,
+since the value 0 is required but it need not be used. So |memory| has room
+for |4*max_char+8| entries, each of which is a |fix_word|. An auxiliary table called
+|link| is used to link these words together in linear lists, so that
+sorting and other operations can be done conveniently.
We also add four ``list head'' words to the |memory| and |link| arrays;
these are in locations |width| through |italic|, i.e., 1 through 4.
@@ -1586,9 +1581,8 @@ the other information that \.{TFM} files pack into a |char_info_word|.
@!char_dp:array[char_type] of pointer; {pointers to the depths}
@!char_ic:array[char_type] of pointer; {pointers to italic corrections}
@!char_tag:array[char_type] of no_tag..ext_tag; {character tags}
-@!char_remainder:array[xchar_type] of xchar_type;
- {pointers to ligature labels,
- next larger characters, or extensible characters}
+@!char_remainder:array[xchar_type] of xchar_type; {pointers to ligature labels,
+ next larger characters, or extensible characters}
@!top_width,@!top_height,@!top_depth,@!top_italic:integer;
@ @<Local...@>=
@@ -1596,8 +1590,8 @@ the other information that \.{TFM} files pack into a |char_info_word|.
@ @<Set init...@>=
bchar_label:=xmax_label;
-for c:=0 to max_char do begin
- char_wd[c]:=0; char_ht[c]:=0; char_dp[c]:=0; char_ic[c]:=0;@/
+for c:=0 to max_char do
+ begin char_wd[c]:=0; char_ht[c]:=0; char_dp[c]:=0; char_ic[c]:=0;@/
char_tag[c]:=no_tag; char_remainder[c]:=0;
end;
memory[0]:=@'17777777777; {an ``infinite'' element at the end of the lists}
@@ -1628,8 +1622,7 @@ different sizes to the same character.
@p function sort_in(@!h:pointer;@!d:fix_word):pointer; {inserts into list}
var p:pointer; {the current node of interest}
begin if (d=0)and(h<>width) then sort_in:=0
-else begin
- p:=h;
+else begin p:=h;
while d>=memory[link[p]] do p:=link[p];
if (d=memory[p])and(p<>h) then sort_in:=p
else if mem_ptr=mem_size then
@@ -1638,8 +1631,7 @@ else begin
print_ln('Congratulations! It''s hard to make this error.');
sort_in:=p;
end
- else begin
- incr(mem_ptr); memory[mem_ptr]:=d;
+ else begin incr(mem_ptr); memory[mem_ptr]:=d;
link[mem_ptr]:=link[p]; link[p]:=mem_ptr; incr(memory[h]);
sort_in:=mem_ptr;
end;
@@ -1650,14 +1642,14 @@ end;
file, we may have to do some rounding of values, because the \.{OFM} file
allows at most 65536 widths, 256 heights, 256 depths, and 256 italic
corrections. The following procedure takes a given list head |h| and a
-given dimension |d|, and returns the minimum $m$ such that the elements
-of the list can be covered by $m$ intervals of width $d$. It also sets
+given dimension |d|, and returns the minimum $m$ such that the elements of
+the list can be covered by $m$ intervals of width $d$. It also sets
|next_d| to the smallest value $d^\prime>d$ such that the covering found
by this procedure would be different. In particular, if $d=0$ it computes
the number of elements of the list, and sets |next_d| to the smallest
-distance between two list elements. (The covering by intervals of width
-|next_d| is not guaranteed to have fewer than $m$ elements, but in
-practice this seems to happen most of the time.)
+distance between two list elements. (The covering by intervals of width
+|next_d| is not guaranteed to have fewer than $m$ elements, but in practice
+this seems to happen most of the time.)
@<Glob...@>=
@!next_d:fix_word; {the next larger interval that is worth trying}
@@ -1669,8 +1661,8 @@ var p:pointer; {the current node of interest}
@!l:fix_word; {the least element covered by the current interval}
@!m:integer; {the current size of the cover being generated}
begin m:=0; p:=link[h]; next_d:=memory[0];
-while p<>0 do begin
- incr(m); l:=memory[p];
+while p<>0 do
+ begin incr(m); l:=memory[p];
while memory[link[p]]<=l+d do p:=link[p];
p:=link[p];
if memory[p]-l<next_d then next_d:=memory[p]-l;
@@ -1691,8 +1683,8 @@ begin if memory[h]>m then begin
repeat d:=d+d; k:=min_cover(h,d);
until k<=m; {first we ascend rapidly until finding the range}
d:=d div 2; k:=min_cover(h,d); {now we run through the feasible steps}
- while k>m do begin
- d:=next_d; k:=min_cover(h,d);
+ while k>m do
+ begin d:=next_d; k:=min_cover(h,d);
end;
shorten:=d;
end
@@ -1711,17 +1703,16 @@ end;
the list so that there is only one element per covering interval;
the remaining elements are the midpoints of their clusters.
-@p procedure set_indices(@!h:pointer;@!d:fix_word);
- {reduces and indexes a list}
+@p procedure set_indices(@!h:pointer;@!d:fix_word); {reduces and indexes a list}
var p:pointer; {the current node of interest}
@!q:pointer; {trails one step behind |p|}
@!m:byte; {index number of nodes in the current interval}
@!l:fix_word; {least value in the current interval}
begin q:=h; p:=link[q]; m:=0;
-while p<>0 do begin
- incr(m); l:=memory[p]; index[p]:=m;
- while memory[link[p]]<=l+d do begin
- p:=link[p]; index[p]:=m; decr(excess);
+while p<>0 do
+ begin incr(m); l:=memory[p]; index[p]:=m;
+ while memory[link[p]]<=l+d do
+ begin p:=link[p]; index[p]:=m; decr(excess);
if excess=0 then d:=0;
end;
link[q]:=p; memory[p]:=l+(memory[p]-l) div 2; q:=p; p:=link[p];
@@ -1742,8 +1733,8 @@ values as we go.
cur_char:=" ";
repeat while cur_char=" " do get_next;
if cur_char="(" then @<Read a font property value@>
-else if (cur_char=")")and not input_has_ended then begin
- err_print('Extra right parenthesis');
+else if (cur_char=")")and not input_has_ended then
+ begin err_print('Extra right parenthesis');
incr(loc); cur_char:=" ";
end
@.Extra right parenthesis@>
@@ -1762,8 +1753,7 @@ end;
@ For each font property, we are supposed to read the data from the
left parenthesis that is the current value of |cur_char| to the right
parenthesis that matches it in the input. The main complication is
-to recover with reasonable grace from various error conditions that
-might arise.
+to recover with reasonable grace from various error conditions that might arise.
@<Read a font property value@>=
begin get_name;
@@ -1778,36 +1768,33 @@ end
@ @<Read the font property value spec...@>=
case cur_code of
- check_sum_code: begin
- check_sum_specified:=true;
- read_four_bytes(check_sum_loc);
- end;
- design_size_code: @<Read the design size@>;
- design_units_code: @<Read the design units@>;
- coding_scheme_code: read_BCPL(coding_scheme_loc,40);
- family_code: read_BCPL(family_loc,20);
- face_code: begin
- c:=get_byte; if c>255 then
- begin err_print('FACE clipped to 255'); c:=255 end;
- header_bytes[face_loc]:=c
- end;
- seven_bit_safe_flag_code: @<Read the seven-bit-safe flag@>;
- header_code: @<Read an indexed header word@>;
- font_dimen_code: @<Read font parameter list@>;
- lig_table_code: read_lig_kern;
- boundary_char_code: bchar:=get_byte;
- character_code: read_char_info;
- ofm_level_code: @<Read OFM level code@>;
- font_dir_code: @<Read font direction code@>;
- n_font_dir_code: @<Read natural font direction code@>;
- char_repeat_code: read_repeated_character_info;
- font_rule_code: read_font_rule_list;
- font_glue_code: read_font_glue_list;
- font_penalty_code: read_font_penalty_list;
- font_mvalue_code: read_font_mvalue_list;
- font_fvalue_code: read_font_fvalue_list;
- font_ivalue_code: read_font_ivalue_list;
- end
+check_sum_code: begin check_sum_specified:=true; read_four_bytes(check_sum_loc);
+ end;
+design_size_code: @<Read the design size@>;
+design_units_code: @<Read the design units@>;
+coding_scheme_code: read_BCPL(coding_scheme_loc,40);
+family_code: read_BCPL(family_loc,20);
+face_code: begin c:=get_byte; if c>255 then
+ begin err_print('FACE clipped to 255'); c:=255; end;
+ header_bytes[face_loc]:=c;
+ end;
+seven_bit_safe_flag_code: @<Read the seven-bit-safe flag@>;
+header_code: @<Read an indexed header word@>;
+font_dimen_code: @<Read font parameter list@>;
+lig_table_code: read_lig_kern;
+boundary_char_code: bchar:=get_byte;
+character_code: read_char_info;
+ofm_level_code: @<Read OFM level code@>;
+font_dir_code: @<Read font direction code@>;
+n_font_dir_code: @<Read natural font direction code@>;
+char_repeat_code: read_repeated_character_info;
+font_rule_code: read_font_rule_list;
+font_glue_code: read_font_glue_list;
+font_penalty_code: read_font_penalty_list;
+font_mvalue_code: read_font_mvalue_list;
+font_fvalue_code: read_font_fvalue_list;
+font_ivalue_code: read_font_ivalue_list;
+end
@ The |case| statement just given makes use of two subroutines that we
haven't defined yet. The first of these puts a 32-bit octal quantity
@@ -1830,19 +1817,19 @@ length of the rest of the string).
var k:header_index;
begin k:=l;
while cur_char=" " do get_next;
-while (cur_char<>"(")and(cur_char<>")") do begin
- if k<l+n then incr(k);
+while (cur_char<>"(")and(cur_char<>")") do
+ begin if k<l+n then incr(k);
if k<l+n then header_bytes[k]:=cur_char;
get_next;
end;
-if k=l+n then begin
- err_print('String is too long; its first ',n-1:1,
+if k=l+n then
+ begin err_print('String is too long; its first ',n-1:1,
@.String is too long...@>
' characters will be kept'); decr(k);
end;
header_bytes[l]:=k-l;
-while k<l+n-1 do begin {tidy up the remaining bytes by setting them to nulls}
- incr(k); header_bytes[k]:=0;
+while k<l+n-1 do {tidy up the remaining bytes by setting them to nulls}
+ begin incr(k); header_bytes[k]:=0;
end;
end;
@@ -1878,9 +1865,8 @@ if c<18 then skip_error('HEADER indices should be 18 or more')
else if 4*c+4>max_header_bytes then
skip_error('This HEADER index is too big for my present table size')
@.This HEADER index is too big...@>
-else begin
- while header_ptr<4*c+4 do begin
- header_bytes[header_ptr]:=0; incr(header_ptr);
+else begin while header_ptr<4*c+4 do
+ begin header_bytes[header_ptr]:=0; incr(header_ptr);
end;
read_four_bytes(4*c);
end;
@@ -1896,8 +1882,8 @@ there is probably a more elegant way to do this.
end
@<Read font parameter list@>=
-begin while level=1 do begin
- while cur_char=" " do get_next;
+begin while level=1 do
+ begin while cur_char=" " do get_next;
if cur_char="(" then @<Read a parameter value@>
else if cur_char=")" then skip_to_end_of_item
else junk_error;
@@ -1911,17 +1897,15 @@ if cur_code=comment_code then skip_to_end_of_item
else if (cur_code<parameter_code)or(cur_code>=char_wd_code) then
flush_error('This property name doesn''t belong in a FONTDIMEN list')
@.This property name doesn't belong...@>
-else begin
- if cur_code=parameter_code then c:=get_integer
+else begin if cur_code=parameter_code then c:=get_integer
else c:=cur_code-parameter_code;
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...@>
- else begin
- while np<c do begin
- incr(np); param[np]:=0;
+ else begin while np<c do
+ begin incr(np); param[np]:=0;
end;
param[c]:=get_fix;
finish_the_property;
@@ -1931,8 +1915,8 @@ end
@ @<Read ligature/kern list@>=
begin lk_step_ended:=false;
-while level=1 do begin
- while cur_char=" " do get_next;
+while level=1 do
+ begin while cur_char=" " do get_next;
if cur_char="(" then read_lig_kern_command
else if cur_char=")" then skip_to_end_of_item
else junk_error;
@@ -1946,20 +1930,19 @@ if cur_code=comment_code then skip_to_end_of_item
else if (cur_code<label_code)or(cur_code>ckrn_code) then
flush_error('This property name doesn''t belong in a LIGTABLE list')
@.This property name doesn't belong...@>
-else begin
- case cur_code of
- label_code:@<Read a label step@>;
- stop_code:@<Read a stop step@>;
- skip_code:@<Read a skip step@>;
- krn_code:@<Read a kerning step@>;
- lig_code,lig_code+1,lig_code+2,lig_code+3,lig_code+5,
- lig_code+6,lig_code+7,lig_code+11:@<Read a ligature step@>;
- clabel_code:@<Read an extended label step@>;
- cpen_code:@<Read an extended penalty step@>;
- cglue_code:@<Read an extended glue step@>;
- cpenglue_code:@<Read an extended penalty/glue step@>;
- ckrn_code:@<Read an extended kern step@>;
- end; {there are no other cases |>=label_code| and |<=ckrn_code|}
+else begin case cur_code of
+ label_code:@<Read a label step@>;
+ stop_code:@<Read a stop step@>;
+ skip_code:@<Read a skip step@>;
+ krn_code:@<Read a kerning step@>;
+ lig_code,lig_code+1,lig_code+2,lig_code+3,lig_code+5,lig_code+6,lig_code+7,
+ lig_code+11:@<Read a ligature step@>;
+ clabel_code:@<Read an extended label step@>;
+ cpen_code:@<Read an extended penalty step@>;
+ cglue_code:@<Read an extended glue step@>;
+ cpenglue_code:@<Read an extended penalty/glue step@>;
+ ckrn_code:@<Read an extended kern step@>;
+ end; {there are no other cases |>=label_code| and |<=ckrn_code|}
finish_the_property;
end;
end
@@ -1969,21 +1952,20 @@ procedure so that an error message is given in case of multiple tags.
@p procedure check_tag(c:integer); {print error if |c| already tagged}
begin case char_tag[c] of
- no_tag: do_nothing;
- lig_tag: err_print('This character already appeared in a LIGTABLE LABEL');
+no_tag: do_nothing;
+lig_tag: err_print('This character already appeared in a LIGTABLE LABEL');
@.This character already...@>
- list_tag: err_print('This character already has a NEXTLARGER spec');
- ext_tag: err_print('This character already has a VARCHAR spec');
- end;
+list_tag: err_print('This character already has a NEXTLARGER spec');
+ext_tag: err_print('This character already has a VARCHAR spec');
+end;
end;
@ @<Read a label step@>=
begin while cur_char=" " do get_next;
-if cur_char="B" then begin
- bchar_label:=nl; skip_to_paren; {\.{LABEL BOUNDARYCHAR}}
+if cur_char="B" then
+ begin bchar_label:=nl; skip_to_paren; {\.{LABEL BOUNDARYCHAR}}
end
-else begin
- backup; c:=get_byte;
+else begin backup; c:=get_byte;
check_tag(c); char_tag[c]:=lig_tag; char_remainder[c]:=nl;
end;
if min_nl<=nl then min_nl:=nl+1;
@@ -2002,8 +1984,7 @@ end
if not lk_step_ended then
err_print('STOP must follow LIG or KRN')
@.STOP must follow LIG or KRN@>
-else begin
- lig_kern[nl-1].b0:=lig_kern[nl-1].b0 div 256 * 256 + stop_flag;
+else begin lig_kern[nl-1].b0:=lig_kern[nl-1].b0 div 256 * 256 + stop_flag;
lk_step_ended:=false;
end
@@ -2011,15 +1992,13 @@ else begin
if not lk_step_ended then
err_print('SKIP must follow LIG or KRN')
@.SKIP must follow LIG or KRN@>
-else begin
- c:=get_byte;
+else begin c:=get_byte;
if c>=128 then err_print('Maximum SKIP amount is 127')
@.Maximum SKIP amount...@>
else if nl+c>=max_lig_steps then
err_print('Sorry, LIGTABLE too long for me to handle')
@.Sorry, LIGTABLE too long...@>
- else begin
- lig_kern[nl-1].b0:=c;
+ else begin lig_kern[nl-1].b0:=c;
if min_nl<=nl+c then min_nl:=nl+c+1;
end;
lk_step_ended:=false;
@@ -2041,10 +2020,9 @@ end
begin lig_kern[nl].b0:=0; lig_kern[nl].b1:=get_byte;
kern[nk]:=get_fix; krn_ptr:=0;
while kern[krn_ptr]<>kern[nk] do incr(krn_ptr);
-if krn_ptr=nk then begin
- if nk<max_kerns then incr(nk)
- else begin
- err_print('Sorry, too many different kerns for me to handle');
+if krn_ptr=nk then
+ begin if nk<max_kerns then incr(nk)
+ else begin err_print('Sorry, too many different kerns for me to handle');
@.Sorry, too many different kerns...@>
decr(krn_ptr);
end;
@@ -2079,8 +2057,7 @@ max_glue_category:=-1;
max_penalty_category:=-1;
@ @<Read an extended label step@>=
-begin
-c:=get_byte;
+begin c:=get_byte;
category_remainders[c]:=nl;
if max_ivalue_category<c then max_ivalue_category:=c;
if min_nl<=nl then min_nl:=nl+1;
@@ -2211,15 +2188,14 @@ tables_read:=false;
that is used most, the processing of individual character data.
@<Read character info list@>=
-begin
-if not tables_read then begin
- compute_new_header_ofm;
+begin if not tables_read then
+ begin compute_new_header_ofm;
tables_read:=true;
end;
c:=get_byte; {read the character code that is being specified}
@<Print |c| in hex notation@>;
-while level=1 do begin
- while cur_char=" " do get_next;
+while level=1 do
+ begin while cur_char=" " do get_next;
if cur_char="(" then read_character_property
else if cur_char=")" then skip_to_end_of_item
else junk_error;
@@ -2272,6 +2248,8 @@ for c:=(cprime+1) to (cprime+crange) do begin
char_ht[c]:=char_ht[cprime];
char_dp[c]:=char_dp[cprime];
char_ic[c]:=char_ic[cprime];
+ char_tag[c]:=char_tag[cprime];
+ char_remainder[c]:=char_remainder[cprime];
for tab:=0 to (nki+nkf+nkm+nkr+nkg+nkp-1) do begin
char_table[c,tab]:= char_table[cprime,tab];
end;
@@ -2316,42 +2294,41 @@ if cur_code=comment_code then skip_to_end_of_item
else if (cur_code<char_wd_code)or(cur_code>var_char_code) then
flush_error('This property name doesn''t belong in a CHARACTER list')
@.This property name doesn't belong...@>
-else begin
- case cur_code of
- char_wd_code:char_wd[c]:=sort_in(width,get_fix);
- char_ht_code:char_ht[c]:=sort_in(height,get_fix);
- char_dp_code:char_dp[c]:=sort_in(depth,get_fix);
- char_ic_code:char_ic[c]:=sort_in(italic,get_fix);
- sec_width_code,
- sec_height_code,
- sec_depth_code,
- sec_italic_code,
- accent_code,
- prim_top_axis_code,
- prim_top_axis_bis_code,
- prim_bot_axis_code,
- prim_bot_axis_bis_code,
- prim_mid_hor_code,
- prim_mid_vert_code,
- prim_base_slant_code,
- sec_top_axis_code,
- sec_top_axis_bis_code,
- sec_bot_axis_code,
- sec_bot_axis_bis_code,
- sec_mid_hor_code,
- sec_mid_vert_code,
- sec_base_slant_code:temp_value:=get_fix;
- next_larger_code:begin check_tag(c); char_tag[c]:=list_tag;
- char_remainder[c]:=get_byte;
- end;
- var_char_code:@<Read an extensible recipe for |c|@>;
- char_ivalue_code: get_char_table_entry(nki)(0);
- char_fvalue_code: get_char_table_entry(nkf)(nki);
- char_mvalue_code: get_char_table_entry(nkm)(nki+nkf);
- char_rule_code: get_char_table_entry(nkr)(nki+nkf+nkm);
- char_glue_code: get_char_table_entry(nkg)(nki+nkf+nkm+nkr);
- char_penalty_code: get_char_table_entry(nkp)(nki+nkf+nkm+nkr+nkg);
- end;@/
+else begin case cur_code of
+ char_wd_code:char_wd[c]:=sort_in(width,get_fix);
+ char_ht_code:char_ht[c]:=sort_in(height,get_fix);
+ char_dp_code:char_dp[c]:=sort_in(depth,get_fix);
+ char_ic_code:char_ic[c]:=sort_in(italic,get_fix);
+ sec_width_code,
+ sec_height_code,
+ sec_depth_code,
+ sec_italic_code,
+ accent_code,
+ prim_top_axis_code,
+ prim_top_axis_bis_code,
+ prim_bot_axis_code,
+ prim_bot_axis_bis_code,
+ prim_mid_hor_code,
+ prim_mid_vert_code,
+ prim_base_slant_code,
+ sec_top_axis_code,
+ sec_top_axis_bis_code,
+ sec_bot_axis_code,
+ sec_bot_axis_bis_code,
+ sec_mid_hor_code,
+ sec_mid_vert_code,
+ sec_base_slant_code:temp_value:=get_fix;
+ next_larger_code:begin check_tag(c); char_tag[c]:=list_tag;
+ char_remainder[c]:=get_byte;
+ end;
+ var_char_code:@<Read an extensible recipe for |c|@>;
+ char_ivalue_code: get_char_table_entry(nki)(0);
+ char_fvalue_code: get_char_table_entry(nkf)(nki);
+ char_mvalue_code: get_char_table_entry(nkm)(nki+nkf);
+ char_rule_code: get_char_table_entry(nkr)(nki+nkf+nkm);
+ char_glue_code: get_char_table_entry(nkg)(nki+nkf+nkm+nkr);
+ char_penalty_code: get_char_table_entry(nkp)(nki+nkf+nkm+nkr+nkg);
+ end;@/
finish_the_property;
end;
end
@@ -2360,11 +2337,10 @@ end
begin if ne=xmax_char then
err_print('Sorry, too many VARCHAR specs')
@.Sorry, too many VARCHAR specs@>
-else begin
- check_tag(c); char_tag[c]:=ext_tag; char_remainder[c]:=ne;@/
+else begin check_tag(c); char_tag[c]:=ext_tag; char_remainder[c]:=ne;@/
exten[ne]:=zero_bytes;
- while level=2 do begin
- while cur_char=" " do get_next;
+ while level=2 do
+ begin while cur_char=" " do get_next;
if cur_char="(" then @<Read an extensible piece@>
else if cur_char=")" then skip_to_end_of_item
else junk_error;
@@ -2380,13 +2356,12 @@ if cur_code=comment_code then skip_to_end_of_item
else if (cur_code<var_char_code+1)or(cur_code>var_char_code+4) then
flush_error('This property name doesn''t belong in a VARCHAR list')
@.This property name doesn't belong...@>
-else begin
- case cur_code-(var_char_code+1) of
- 0:exten[ne].b0:=get_byte;
- 1:exten[ne].b1:=get_byte;
- 2:exten[ne].b2:=get_byte;
- 3:exten[ne].b3:=get_byte;
- end;@/
+else begin case cur_code-(var_char_code+1) of
+ 0:exten[ne].b0:=get_byte;
+ 1:exten[ne].b1:=get_byte;
+ 2:exten[ne].b2:=get_byte;
+ 3:exten[ne].b3:=get_byte;
+ end;@/
finish_the_property;
end;
end
@@ -2444,13 +2419,11 @@ while (c>0) or (j=0) do begin
print_digs(j);
end;
-
@ @<Print |c| in hex...@>=
-begin if chars_on_line=8 then begin
- print_ln(' '); chars_on_line:=1;
+begin if chars_on_line=8 then
+ begin print_ln(' '); chars_on_line:=1;
end
-else begin
- if chars_on_line>0 then print(' ');
+else begin if chars_on_line>0 then print(' ');
incr(chars_on_line);
end;
print_hex(c); {progress report}
@@ -2475,8 +2448,8 @@ for c:=0 to max_char do if char_wd[c]<>0 then
@<For all characters |g| generated by |c|,
make sure that |char_wd[g]| is nonzero, and
set |seven_unsafe| if |c<128<=g|@>;
-if bchar_label<xmax_label then begin
- c:=xmax_char; @<Check ligature program of |c|@>;
+if bchar_label<xmax_label then
+ begin c:=xmax_char; @<Check ligature program of |c|@>;
end;
if seven_bit_safe_flag and seven_unsafe then
print_ln('The font is not really seven-bit-safe!');
@@ -2504,13 +2477,13 @@ macros that are only slightly tricky.
@<For all characters |g| generated by |c|...@>=
case char_tag[c] of
- no_tag: do_nothing;
- lig_tag: @<Check ligature program of |c|@>;
- list_tag: check_existence_and_safety(char_remainder[c])
- ('The character NEXTLARGER than');
+no_tag: do_nothing;
+lig_tag: @<Check ligature program of |c|@>;
+list_tag: check_existence_and_safety(char_remainder[c])
+ ('The character NEXTLARGER than');
@.The character NEXTLARGER...@>
- ext_tag:@<Check the pieces of |exten[c]|@>;
- end
+ext_tag:@<Check the pieces of |exten[c]|@>;
+end
@ @<Check the pieces...@>=
begin if exten[char_remainder[c]].b0>0 then
@@ -2531,18 +2504,18 @@ check_existence_and_safety(exten[char_remainder[c]].b3)
end
@ @<Make sure that |c| is not the largest element of a charlist cycle@>=
-if char_tag[c]=list_tag then begin
- g:=char_remainder[c];
+if char_tag[c]=list_tag then
+ begin g:=char_remainder[c];
while (g<c)and(char_tag[g]=list_tag) do g:=char_remainder[g];
- if g=c then begin
- char_tag[c]:=no_tag;
+ if g=c then
+ begin char_tag[c]:=no_tag;
print('A cycle of NEXTLARGER characters has been broken at ');
@.A cycle of NEXTLARGER...@>
print_hex(c); print_ln('.');
end;
end
-@ @<Global...@>=
+@ @<Glob...@>=
@!delta:fix_word; {size of the intervals needed for rounding}
@ @d round_message(#)==if delta>0 then print_ln('I had to round some ',
@@ -2575,11 +2548,11 @@ delta:=shorten(italic,top_italic); set_indices(italic,delta);
lig_kern[nl].b2:=0; lig_kern[nl].b3:=0
@<Make sure the ligature/kerning program ends...@>=
-begin if bchar_label<xmax_label then {make room for it} begin
- clear_lig_kern_entry; incr(nl);
+begin if bchar_label<xmax_label then {make room for it}
+ begin clear_lig_kern_entry; incr(nl);
end; {|bchar_label| will be stored later}
-while min_nl>nl do begin
- clear_lig_kern_entry; incr(nl);
+while min_nl>nl do
+ begin clear_lig_kern_entry; incr(nl);
end;
if (lig_kern[nl-1].b0 mod 256)=0 then
lig_kern[nl-1].b0:=lig_kern[nl-1].b0 div 256 * 256 + stop_flag;
@@ -2599,7 +2572,7 @@ where it is explained further.
@ @<Glo...@>=
@!lig_ptr:0..max_lig_steps; {an index into |lig_kern|}
-@!hash:array[0..hash_size] of integer;
+@!hash:array[0..hash_size] of integer64;
@!class:array[0..hash_size] of simple..pending;
@!lig_z:array[0..hash_size] of xxchar_type;
@!hash_ptr:0..hash_size; {the number of nonzero entries in |hash|}
@@ -2617,11 +2590,11 @@ for k:=0 to hash_size do hash[k]:=0;
@<Check lig...@>=
begin lig_ptr:=char_remainder[c];
-if (lig_kern[lig_ptr].b0 div 256)=0 then
+if lig_kern[lig_ptr].b0<256 then
begin
-repeat if hash_input(lig_ptr,c) then begin
- if lig_kern[lig_ptr].b2<kern_flag then begin
- if lig_exam<>bchar then
+repeat if hash_input(lig_ptr,c) then
+ begin if lig_kern[lig_ptr].b2<kern_flag then
+ begin if lig_exam<>bchar then
check_existence(lig_exam)('LIG character examined by');
@.LIG character examined...@>
check_existence(lig_gen)('LIG character generated by');
@@ -2633,7 +2606,7 @@ repeat if hash_input(lig_ptr,c) then begin
check_existence(lig_exam)('KRN character examined by');
@.KRN character examined...@>
end;
-if (lig_kern[lig_ptr].b0 mod 256)>=stop_flag then lig_ptr:=nl
+if lig_kern[lig_ptr].b0>=stop_flag then lig_ptr:=nl
else lig_ptr:=lig_ptr+1+lig_kern[lig_ptr].b0;
until lig_ptr>=nl;
end;
@@ -2649,18 +2622,19 @@ label 30; {go here for a quick exit}
var @!cc:simple..both_z; {class of data being entered}
@!zz:char_type; {function value or ligature character being entered}
@!y:char_type; {the character after the cursor}
-@!key:integer; {value to be stored in |hash|}
+@!key:integer64; {value to be stored in |hash|}
+@!t64:integer64; {temporary register for swapping}
@!t:integer; {temporary register for swapping}
begin if hash_ptr=hash_size then
begin hash_input:=false; goto 30;@+end;
@<Compute the command parameters |y|, |cc|, and |zz|@>;
-key:=xmax_char*c+y+1; h:=(hash_mult*(key mod hash_size)) mod hash_size;
-while hash[h]>0 do begin
- if hash[h]<=key then begin
- if hash[h]=key then begin
- hash_input:=false; goto 30; {unused ligature command}
+key:=int64cast(xmax_char)*c+y+1; h:=(hash_mult*key) mod hash_size;
+while hash[h]>0 do
+ begin if hash[h]<=key then
+ begin if hash[h]=key then
+ begin hash_input:=false; goto 30; {unused ligature command}
end;
- t:=hash[h]; hash[h]:=key; key:=t; {do ordered-hash-table insertion}
+ t64:=hash[h]; hash[h]:=key; key:=t64; {do ordered-hash-table insertion}
t:=class[h]; class[h]:=cc; cc:=t; {namely, do a swap}
t:=lig_z[h]; lig_z[h]:=zz; zz:=t;
end;
@@ -2675,23 +2649,22 @@ hash_input:=true;
y:=lig_kern[p].b1; t:=lig_kern[p].b2; cc:=simple;
zz:=lig_kern[p].b3;
if t>=kern_flag then zz:=y
-else begin
- case t of
- 0,6:do_nothing; {\.{LIG},\.{/LIG>}}
- 5,11:zz:=y; {\.{LIG/>}, \.{/LIG/>>}}
- 1,7:cc:=left_z; {\.{LIG/}, \.{/LIG/>}}
- 2:cc:=right_z; {\.{/LIG}}
- 3:cc:=both_z; {\.{/LIG/}}
- end; {there are no other cases}
+else begin case t of
+ 0,6:do_nothing; {\.{LIG},\.{/LIG>}}
+ 5,11:zz:=y; {\.{LIG/>}, \.{/LIG/>>}}
+ 1,7:cc:=left_z; {\.{LIG/}, \.{/LIG/>}}
+ 2:cc:=right_z; {\.{/LIG}}
+ 3:cc:=both_z; {\.{/LIG/}}
+ end; {there are no other cases}
end
@ (More good stuff from \.{TFtoPL}.)
-@p function f(@!h,@!x,@!y:indx):indx; forward;@t\2@>
+@p function f(@!h:integer64;@!x,@!y:indx):indx; forward;@t\2@>
{compute $f$ for arguments known to be in |hash[h]|}
function eval(@!x,@!y:indx):indx; {compute $f(x,y)$ with hashtable lookup}
-var @!key:integer; {value sought in hash table}
-begin key:=xmax_char*x+y+1; h:=(hash_mult*key) mod hash_size;
+var @!key:integer64; {value sought in hash table}
+begin key:=int64cast(xmax_char)*x+y+1; h:=(hash_mult*key) mod hash_size;
while hash[h]>key do
if h>0 then decr(h)@+else h:=hash_size;
if hash[h]<key then eval:=y {not in ordered hash table}
@@ -2699,46 +2672,42 @@ else eval:=f(h,x,y);
end;
@ Pascal's beastly convention for |forward| declarations prevents us from
-saying |function f(h,x,y:indx):indx| here.
+saying |function f(h:integer64;x,y:indx):indx| here.
@p function f;
-begin
-case class[h] of
- simple: do_nothing;
- left_z: begin class[h]:=pending; lig_z[h]:=eval(lig_z[h],y); class[h]:=simple;
- end;
- right_z: begin class[h]:=pending; lig_z[h]:=eval(x,lig_z[h]); class[h]:=simple;
- end;
- both_z: begin class[h]:=pending; lig_z[h]:=eval(eval(x,lig_z[h]),y);
- class[h]:=simple;
- end;
- pending: begin x_lig_cycle:=x; y_lig_cycle:=y;
- lig_z[h]:=xxmax_char; class[h]:=simple;
- end; {the value |xxmax_char| will break all cycles,
- since it's not in |hash|}
- end; {there are no other cases}
+begin case class[h] of
+simple: do_nothing;
+left_z: begin class[h]:=pending; lig_z[h]:=eval(lig_z[h],y); class[h]:=simple;
+ end;
+right_z: begin class[h]:=pending; lig_z[h]:=eval(x,lig_z[h]); class[h]:=simple;
+ end;
+both_z: begin class[h]:=pending; lig_z[h]:=eval(eval(x,lig_z[h]),y);
+ class[h]:=simple;
+ end;
+pending: begin x_lig_cycle:=x; y_lig_cycle:=y; lig_z[h]:=xxmax_char; class[h]:=simple;
+ end; {the value |xxmax_char| will break all cycles, since it's not in |hash|}
+end; {there are no other cases}
f:=lig_z[h];
end;
@ @<Check for infinite...@>=
-if hash_ptr<hash_size then for hh:=1 to hash_ptr do begin
- tt:=hash_list[hh];
+if hash_ptr<hash_size then for hh:=1 to hash_ptr do
+ begin tt:=hash_list[hh];
if class[tt]>simple then {make sure $f$ is well defined}
tt:=f(tt,(hash[tt]-1)div xmax_char,(hash[tt]-1)mod xmax_char);
end;
-if(hash_ptr=hash_size)or(y_lig_cycle<xmax_char) then begin
- if hash_ptr<hash_size then begin
- print('Infinite ligature loop starting with ');
+if(hash_ptr=hash_size)or(y_lig_cycle<xmax_char) then
+ begin if hash_ptr<hash_size then
+ begin print('Infinite ligature loop starting with ');
@.Infinite ligature loop...@>
- if x_lig_cycle=xmax_char
- then print('boundary')@+else print_hex(x_lig_cycle);
+ if x_lig_cycle=xmax_char then print('boundary')@+else print_hex(x_lig_cycle);
print(' and '); print_hex(y_lig_cycle); print_ln('!');
end
else print_ln('Sorry, I haven''t room for so many ligature/kern pairs!');
@.Sorry, I haven't room...@>
print_ln('All ligatures will be cleared.');
- for c:=0 to max_char do if char_tag[c]=lig_tag then begin
- char_tag[c]:=no_tag; char_remainder[c]:=0;
+ for c:=0 to max_char do if char_tag[c]=lig_tag then
+ begin char_tag[c]:=no_tag; char_remainder[c]:=0;
end;
nl:=0; bchar:=xmax_char; bchar_label:=xmax_label;
end
@@ -2768,17 +2737,17 @@ must fix such errors.
@<Doublecheck...@>=
if nl>0 then for lig_ptr:=0 to nl-1 do
if (lig_kern[lig_ptr].b0 div 256)=0 then begin
- if lig_kern[lig_ptr].b2<kern_flag then begin
- if lig_kern[lig_ptr].b0<255 then begin
- double_check_lig(b1)('LIG step'); double_check_lig(b3)('LIG step');
- end;
- end
- else double_check_lig(b1)('KRN step');
- end;
+ if lig_kern[lig_ptr].b2<kern_flag then
+ begin if lig_kern[lig_ptr].b0<255 then
+ begin double_check_lig(b1)('LIG step'); double_check_lig(b3)('LIG step');
+ end;
+ end
+ else double_check_lig(b1)('KRN step');
+ end;
@.Unused LIG step...@>
@.Unused KRN step...@>
-if ne>0 then for g:=0 to ne-1 do begin
- double_check_ext(b0)('VARCHAR TOP');
+if ne>0 then for g:=0 to ne-1 do
+ begin double_check_ext(b0)('VARCHAR TOP');
double_check_ext(b1)('VARCHAR MID');
double_check_ext(b2)('VARCHAR BOT');
double_check_rep(b3)('VARCHAR REP');
@@ -2817,7 +2786,7 @@ output_character_info;
@<Output the dimensions themselves@>;
@<Output the ligature/kern program@>;
@<Output the extensible character recipes@>;
-@<Output the parameters@>;
+@<Output the parameters@>
@ A \.{TFM} file begins with 12 numbers that tell how big its subfiles are.
We already know most of these numbers; for example, the number of distinct
@@ -2843,55 +2812,30 @@ going and writes the \.{TFM} anyway. In this case |ec| will be~0 and |bc|
will be~1.
@<Compute the subfile sizes@>=
+lh:=header_ptr div 4;@/
+not_found:=true; bc:=0;
+if (ofm_level=-1) then ec:=255 @+ else ec:=max_char;
+while not_found do
+ if (char_wd[bc]>0)or(bc=ec) then not_found:=false
+ else incr(bc);
+not_found:=true;
+while not_found do
+ if (char_wd[ec]>0)or(ec=0) then not_found:=false
+ else decr(ec);
+if bc>ec then bc:=1;
+incr(memory[width]); incr(memory[height]); incr(memory[depth]);
+incr(memory[italic]);@/
+@<Compute the ligature/kern program offset@>;
case ofm_level of
-1: begin
- lh:=header_ptr div 4;@/
- not_found:=true; bc:=0;
- while not_found do
- if (char_wd[bc]>0)or(bc=255) then not_found:=false
- else incr(bc);
- not_found:=true; ec:=255;
- while not_found do
- if (char_wd[ec]>0)or(ec=0) then not_found:=false
- else decr(ec);
- if bc>ec then bc:=1;
- incr(memory[width]); incr(memory[height]); incr(memory[depth]);
- incr(memory[italic]);@/
- @<Compute the ligature/kern program offset@>;
lf:=6+lh+(ec-bc+1)+memory[width]+memory[height]+memory[depth]+
memory[italic]+nl+lk_offset+nk+ne+np;
end;
0: begin
- lh:=header_ptr div 4;@/
- not_found:=true; bc:=0;
- while not_found do
- if (char_wd[bc]>0)or(bc=max_char) then not_found:=false
- else incr(bc);
- not_found:=true; ec:=max_char;
- while not_found do
- if (char_wd[ec]>0)or(ec=0) then not_found:=false
- else decr(ec);
- if bc>ec then bc:=1;
- incr(memory[width]); incr(memory[height]); incr(memory[depth]);
- incr(memory[italic]);@/
- @<Compute the ligature/kern program offset@>;
lf:=14+lh+2*(ec-bc+1)+memory[width]+memory[height]+memory[depth]+
memory[italic]+2*nl+lk_offset+nk+2*ne+np;
end;
1: begin
- lh:=header_ptr div 4;@/
- not_found:=true; bc:=0;
- while not_found do
- if (char_wd[bc]>0)or(bc=max_char) then not_found:=false
- else incr(bc);
- not_found:=true; ec:=max_char;
- while not_found do
- if (char_wd[ec]>0)or(ec=0) then not_found:=false
- else decr(ec);
- if bc>ec then bc:=1;
- incr(memory[width]); incr(memory[height]); incr(memory[depth]);
- incr(memory[italic]);@/
- @<Compute the ligature/kern program offset@>;
@<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+
@@ -2956,13 +2900,13 @@ header_bytes[design_size_loc]:=design_size div @'100000000;
header_bytes[design_size_loc+1]:=(design_size div @'200000) mod 256;
header_bytes[design_size_loc+2]:=(design_size div 256) mod 256;
header_bytes[design_size_loc+3]:=design_size mod 256;
-if not seven_unsafe then header_bytes[seven_flag_loc]:=128;
+if (not seven_unsafe)and(ofm_level=-1) then header_bytes[seven_flag_loc]:=128;
for j:=0 to header_ptr-1 do out(header_bytes[j]);
@ @<Compute the check sum@>=
begin c0:=bc; c1:=ec; c2:=bc; c3:=ec;
-for c:=bc to ec do if char_wd[c]>0 then begin
- temp_width:=memory[char_wd[c]];
+for c:=bc to ec do if char_wd[c]>0 then
+ begin temp_width:=memory[char_wd[c]];
if design_units<>unity then
temp_width:=round((temp_width/design_units)*1048576.0);
temp_width:=temp_width + (c+4)*@'20000000; {this should be positive}
@@ -2996,6 +2940,7 @@ if ofm_level=1 then begin
if index[char_ht[c]]<>index[char_ht[cprime]] then diff:=true;
if index[char_dp[c]]<>index[char_dp[cprime]] then diff:=true;
if index[char_ic[c]]<>index[char_ic[cprime]] then diff:=true;
+ if char_tag[c]<>char_tag[cprime] then diff:=true;
if char_remainder[c]<>char_remainder[cprime] then diff:=true;
for tab:=0 to npc-1 do begin
if char_table[c,tab]<>char_table[cprime,tab] then diff:=true;
@@ -3060,8 +3005,8 @@ only if |design_units<>1.0|.
@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|}
var @!n:byte; {the first byte after the sign}
@!m:0..65535; {the two least significant bytes}
-begin if abs(x/design_units)>=16.0 then begin
- print_ln('The relative dimension ',x/@'4000000:1:3,
+begin if abs(x/design_units)>=16.0 then
+ begin print_ln('The relative dimension ',x/@'4000000:1:3,
' is too large.');
@.The relative dimension...@>
print(' (Must be less than 16*designsize');
@@ -3070,8 +3015,8 @@ begin if abs(x/design_units)>=16.0 then begin
print_ln(')'); x:=0;
end;
if design_units<>unity then x:=round((x/design_units)*1048576.0);
-if x<0 then begin
- out(255); x:=x+@'100000000;
+if x<0 then
+ begin out(255); x:=x+@'100000000;
if x<=0 then x:=1;
end
else begin out(0);
@@ -3085,11 +3030,11 @@ end;
The scaled widths, heights, depths, and italic corrections are next.
@<Output the dimensions themselves@>=
-for q:=width to italic do begin
- out(0); out(0); out(0); out(0); {output the zero word}
+for q:=width to italic do
+ begin out(0); out(0); out(0); out(0); {output the zero word}
p:=link[q]; {head of list}
- while p>0 do begin
- out_scaled(memory[p]);
+ while p>0 do
+ begin out_scaled(memory[p]);
p:=link[p];
end;
end;
@@ -3115,11 +3060,10 @@ For this we need a sorted table of all relevant remainders.
@ @<Compute the ligature/kern program offset@>=
@<Insert all labels into |label_table|@>;
-if bchar<xmax_char then begin
- extra_loc_needed:=true; lk_offset:=1;
+if bchar<xmax_char then
+ begin extra_loc_needed:=true; lk_offset:=1;
end
-else begin
- extra_loc_needed:=false; lk_offset:=0;
+else begin extra_loc_needed:=false; lk_offset:=0;
end;
@<Find the minimum |lk_offset| and adjust all remainders@>;
if bchar_label<xmax_label then begin
@@ -3135,10 +3079,10 @@ if bchar_label<xmax_label then begin
@ @<Insert all labels...@>=
label_ptr:=0; label_table[0].rr:=-1; {sentinel}
-for c:=bc to ec do if char_tag[c]=lig_tag then begin
- sort_ptr:=label_ptr; {there's a hole at position |sort_ptr+1|}
- while label_table[sort_ptr].rr>char_remainder[c] do begin
- label_table[sort_ptr+1]:=label_table[sort_ptr];
+for c:=bc to ec do if char_tag[c]=lig_tag then
+ begin sort_ptr:=label_ptr; {there's a hole at position |sort_ptr+1|}
+ while label_table[sort_ptr].rr>char_remainder[c] do
+ begin label_table[sort_ptr+1]:=label_table[sort_ptr];
decr(sort_ptr); {move the hole}
end;
label_table[sort_ptr+1].cc:=c;
@@ -3172,8 +3116,8 @@ else begin
{N.B.: |lk_offset=65536| satisfies this when |sort_ptr=0|}
end;
end;
-if lk_offset>0 then while sort_ptr>0 do begin
- char_remainder[label_table[sort_ptr].cc]:=
+if lk_offset>0 then while sort_ptr>0 do
+ begin char_remainder[label_table[sort_ptr].cc]:=
char_remainder[label_table[sort_ptr].cc]+lk_offset;
decr(sort_ptr);
end;
@@ -3250,15 +3194,15 @@ else begin
@ For our grand finale, we wind everything up by outputting the parameters.
@<Output the parameters@>=
-for par_ptr:=1 to np do begin
- if par_ptr=1 then
+for par_ptr:=1 to np do
+ begin if par_ptr=1 then
@<Output the slant (|param[1]|) without scaling@>
else out_scaled(param[par_ptr]);
end
@ @<Output the slant...@>=
-begin if param[1]<0 then begin
- param[1]:=param[1]+@'10000000000;
+begin if param[1]<0 then
+ begin param[1]:=param[1]+@'10000000000;
out((param[1] div @'100000000)+256-64);
end
else out(param[1] div @'100000000);
diff --git a/Build/source/texk/web2c/omegaware/ovf2ovp.ch b/Build/source/texk/web2c/omegaware/ovf2ovp.ch
index a5af15e17db..1c6259e46aa 100644
--- a/Build/source/texk/web2c/omegaware/ovf2ovp.ch
+++ b/Build/source/texk/web2c/omegaware/ovf2ovp.ch
@@ -18,10 +18,10 @@
@z
@x [1] Define my_name
-@d banner=='This is OVF2OVP, Version 1.12' {printed when the program starts}
+@d banner=='This is OVF2OVP, Version 1.13' {printed when the program starts}
@y
@d my_name=='ovf2ovp'
-@d banner=='This is OVF2OVP, Version 1.12' {printed when the program starts}
+@d banner=='This is OVF2OVP, Version 1.13' {printed when the program starts}
@z
% [2] We need to tell web2c about one special variable.
@@ -160,14 +160,14 @@ tfm_file_array
% [31] Ditto for vf_abort.
@x
-@d vf_abort(#)==begin
- print_ln(#);
+@d vf_abort(#)==
+ begin print_ln(#);
print_ln('Sorry, but I can''t go on; are you sure this is a OVF?');
goto final_end;
end
@y
-@d vf_abort(#)==begin
- write_ln(stderr, #);
+@d vf_abort(#)==
+ begin write_ln(stderr, #);
write_ln(stderr, 'Sorry, but I can''t go on; are you sure this is a OVF?');
uexit(1);
end
@@ -215,9 +215,9 @@ tfm_file := kpse_open_file (cur_name, kpse_ofm_format);
@z
@x [40] Be quiet if not -verbose.
- print_ln('Check sum in OVF file being replaced by font metric check sum');
+ begin print_ln('Check sum in OVF file being replaced by font metric check sum');
@y
- if verbose then
+ begin if verbose then
print_ln('Check sum in OVF file being replaced by font metric check sum');
@z
@@ -230,14 +230,14 @@ default_directory:=default_directory_name;
@x [44] Don't append `.tfm' here, and keep lowercase.
for k:=1 to name_length do cur_name[k]:=' ';
-if a=0 then begin
- for k:=1 to default_directory_name_length do
+if a=0 then
+ begin for k:=1 to default_directory_name_length do
cur_name[k]:=default_directory[k];
r:=default_directory_name_length;
end
else r:=0;
-for k:=font_start[font_ptr]+14 to vf_ptr-1 do begin
- incr(r);
+for k:=font_start[font_ptr]+14 to vf_ptr-1 do
+ begin incr(r);
if r+4>name_length then vf_abort('Font name too long for me!');
@.Font name too long for me@>
if (vf[k]>="a")and(vf[k]<="z") then
@@ -259,8 +259,8 @@ r := name_end - name_start;
cur_name := xmalloc (r + 1);
{|strncpy| might be faster, but it's probably a good idea to keep the
|xchr| translation.}
-for k := name_start to name_end do begin
- cur_name[k - name_start] := xchr[vf[k]];
+for k := name_start to name_end do
+ begin cur_name[k - name_start] := xchr[vf[k]];
end;
cur_name[r] := 0; {Append null byte since this is C.}
@z
@@ -348,21 +348,21 @@ f:=((tfm[k+1] mod 16)*intcast(@'400)+tfm[k+2])*@'400+tfm[k+3];
incr(chars_on_line);
end;
for cprime:=c to (c+no_repeats(c)) do begin
- print_hex(cprime); {progress report}
+ print_hex(cprime); {progress report}
@y
if verbose then incr(chars_on_line);
end;
for cprime:=c to (c+no_repeats(c)) do begin
- if verbose then print_hex(cprime); {progress report}
+ if verbose then print_hex(cprime); {progress report}
@z
% [112] No nonlocal goto's.
@x
- print_ln('Sorry, I haven''t room for so many ligature/kern pairs!');
+ begin print_ln('Sorry, I haven''t room for so many ligature/kern pairs!');
@.Sorry, I haven't room...@>
goto final_end;
@y
- write_ln(stderr, 'Sorry, I haven''t room for so many ligature/kern pairs!');
+ begin write_ln(stderr, 'Sorry, I haven''t room for so many ligature/kern pairs!');
@.Sorry, I haven't room...@>
uexit(1);
@z
@@ -386,12 +386,12 @@ f:=((tfm[k+1] mod 16)*intcast(@'400)+tfm[k+2])*@'400+tfm[k+3];
% But let's do a fake definition of f here, so that it gets into web2c's
% symbol table...
@x
-@p function f(@!h,@!x,@!y:index):index; forward;@t\2@>
+@p function f(@!h:integer64;@!x,@!y:index):index; forward;@t\2@>
{compute $f$ for arguments known to be in |hash[h]|}
@y
@p
ifdef('notdef')
-function lig_f(@!h,@!x,@!y:index):index; begin end;@t\2@>
+function lig_f(@!h:integer64;@!x,@!y:index):index; begin end;@t\2@>
{compute $f$ for arguments known to be in |hash[h]|}
endif('notdef')
@z
@@ -405,7 +405,7 @@ else eval:=lig_f(h,x,y);
@x [117] ... and then really define it now.
@p function f;
@y
-@p function lig_f(@!h,@!x,@!y:index):index;
+@p function lig_f(@!h:integer64;@!x,@!y:index):index;
@z
@x
@@ -415,10 +415,10 @@ lig_f:=lig_z[h];
@z
@x [124] Some cc's can't handle 136 case labels.
- o:=vf[vf_ptr]; incr(vf_ptr);
+ begin o:=vf[vf_ptr]; incr(vf_ptr);
case o of
@y
- o:=vf[vf_ptr]; incr(vf_ptr);
+ begin o:=vf[vf_ptr]; incr(vf_ptr);
if (o<=set1+3)or((o>=put1)and(o<=put1+3)) then
@<Special cases of \.{DVI} instructions to typeset characters@>@;
else case o of
diff --git a/Build/source/texk/web2c/omegaware/ovf2ovp.up b/Build/source/texk/web2c/omegaware/ovf2ovp.up
index 0c750e35b66..6304a2b9815 100644
--- a/Build/source/texk/web2c/omegaware/ovf2ovp.up
+++ b/Build/source/texk/web2c/omegaware/ovf2ovp.up
@@ -1,3 +1,7 @@
+% ovf2ovp.up. Public domain.
+%
+% Allow character codes up to "10FFFF.
+
@x [4] Increase constants.
@d char_max=@"FFFF
@y
diff --git a/Build/source/texk/web2c/omegaware/ovf2ovp.web b/Build/source/texk/web2c/omegaware/ovf2ovp.web
index 3efb4cc19fb..d6d9a6f3e79 100644
--- a/Build/source/texk/web2c/omegaware/ovf2ovp.web
+++ b/Build/source/texk/web2c/omegaware/ovf2ovp.web
@@ -13,6 +13,7 @@
% Version 1.0 of OVF2OVP (Month Year).
% Version 1.11 (February 2000).
% Version 1.12 (September 2009) various bug fixes by Peter Breitenlohner.
+% Version 1.13 (January 2014) more bug fixes.
% Here is TeX material that gets inserted after \input webmac
\def\hang{\hangindent 3em\indent\ignorespaces}
@@ -31,7 +32,7 @@
\vfill
\centerline{\titlefont The {\ttitlefont OVF2OVP} processor}
\vskip 15pt
- \centerline{(Version 1.12, September 2009)}
+ \centerline{(Version 1.13, January 2014)}
\vfill}
\def\botofcontents{\vfill
\centerline{\hsize 5in\baselineskip9pt
@@ -66,7 +67,7 @@ called \.{AMFtoXPL}.
The |banner| string defined here should be changed whenever \.{VFtoVP}
gets modified.
-@d banner=='This is OVF2OVP, Version 1.12' {printed when the program starts}
+@d banner=='This is OVF2OVP, Version 1.13' {printed when the program starts}
@ This program is written entirely in standard \PASCAL, except that
it occasionally has lower case letters in strings that are output.
@@ -619,8 +620,7 @@ bytes, |tfm[0..(4*lf-1)]|.
@!xxchar_type=0..xxchar_max;
@!xxxchar_type=0..xxxchar_max;
-@
-@<Glob...@>=
+@ @<Glob...@>=
@!tfm:array [-1000..tfm_size] of byte; {the input data all goes here}
{the negative addresses avoid range checks for invalid characters}
@!top_char,@!top_width,@!top_height,@!top_depth,@!top_italic:integer;
@@ -642,10 +642,10 @@ if tfm[0]>127 then abort('The first byte of the input file exceeds 127!');
if eof(tfm_file) then abort('The input file is only one byte long!');
@.The input...one byte long@>
read(tfm_file,tfm[1]); lf:=tfm[0]*@'400+tfm[1];
-if lf=0 then begin
- for i:=2 to 7 do begin
- if eof(tfm_file)
- then abort('The input file is too short to designate its length!');
+if lf=0 then
+ begin for i:=2 to 7 do
+ begin if eof(tfm_file) then
+ abort('The input file is too short to designate its length!');
read(tfm_file, tfm[i]);
end;
ofm_on := true; ofm_level := tfm[2]*@"100+tfm[3];
@@ -656,14 +656,13 @@ if lf=0 then begin
@.The fifth byte...@>
lf := tfm[4]*@"1000000 + tfm[5]*@"10000 + tfm[6]*@"100 + tfm[7];
end
-else begin
- ofm_on := false;
+else begin ofm_on := false;
end;
case ofm_level of
- -1: begin start_ptr:=2; check_sum:=24; end;
- 0: begin start_ptr:=8; check_sum:=56; end;
- 1: begin start_ptr:=8; check_sum:=116; end;
- end;
+-1: begin start_ptr:=2; check_sum:=24; end;
+ 0: begin start_ptr:=8; check_sum:=56; end;
+ 1: begin start_ptr:=8; check_sum:=116; end;
+end;
design_size:=check_sum+4;
scheme:=design_size+4;
family:=scheme+40;
@@ -673,14 +672,14 @@ if lf=0 then
@.The file claims...@>
if 4*lf-1>tfm_size then abort('The file is bigger than I can handle!');
@.The file is bigger...@>
-for tfm_ptr:=start_ptr to 4*lf-1 do begin
- if eof(tfm_file) then
+for tfm_ptr:=start_ptr to 4*lf-1 do
+ begin if eof(tfm_file) then
abort('The file has fewer bytes than it claims!');
@.The file has fewer bytes...@>
read(tfm_file,tfm[tfm_ptr]);
end;
-if not eof(tfm_file) then begin
- print_ln('There''s some extra junk at the end of the OFM file,');
+if not eof(tfm_file) then
+ begin print_ln('There''s some extra junk at the end of the OFM file,');
@.There's some extra junk...@>
print_ln('but I''ll proceed as if it weren''t there.');
end
@@ -793,8 +792,8 @@ if ne>(top_char+1) then abort('There are ',ne:1,' extensible recipes!');
end
@ Once the input data successfully passes these basic checks,
-\.{TFtoPL} believes that it is a \.{TFM} file, and the conversion
-to \.{PL} format will take place. Access to the various subfiles
+\.{VFtoVP} believes that it is a \.{TFM} file, and the conversion
+to \.{VPL} format will take place. Access to the various subfiles
is facilitated by computing the following base addresses. For example,
the |char_info| for character |c| in a \.{TFM} file will start in location
|4*(char_base+c)| of the |tfm| array.
@@ -1083,8 +1082,8 @@ the packets.
@ Again we cautiously verify that we've been given decent data.
@d read_vf(#)==read(vf_file,#)
-@d vf_abort(#)==begin
- print_ln(#);
+@d vf_abort(#)==
+ begin print_ln(#);
print_ln('Sorry, but I can''t go on; are you sure this is a OVF?');
goto final_end;
end
@@ -1209,7 +1208,7 @@ the fourth.
@!font_lh:integer; {header length of current local font}
@!font_bc,@!font_ec:integer; {character range of current local font}
@!font_ofm_level,@!font_extra_words:integer;
-@!font_kprime,@!font_j:integer;
+@!font_kprime,@!font_j,@!font_wd:integer;
@ The |read_tfm_word| procedure sets |b0| through |b3| to the next
four bytes in the current \.{TFM} file.
@@ -1222,10 +1221,10 @@ begin read_tfm(b0); read_tfm(b1);
read_tfm(b2); read_tfm(b3);
end;
-@ 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..char_max|.
+@ 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..char_max|.
@<Read the local font's \.{TFM} file...@>=
@<Move font name into the |cur_name| string@>;
@@ -1291,8 +1290,8 @@ case font_ofm_level of
-1: begin
for k:=font_bc to font_ec do begin
read_tfm_word;
- if b0>0 then begin {character |k| exists in the font}
- vc[vc_ptr]:=k; incr(vc_ptr);
+ if b0>0 then {character |k| exists in the font}
+ begin vc[vc_ptr]:=k; incr(vc_ptr);
if vc_ptr=vc_size then vf_abort('I''m out of OVF memory!');
end;
end;
@@ -1309,18 +1308,15 @@ case font_ofm_level of
end;
1: begin
k:=font_bc;
- while k<=font_ec do begin
- read_tfm_word;
- if (b0*256+b1)>0 then begin {character |k| exists in the font}
- vc[vc_ptr]:=k; incr(vc_ptr);
- if vc_ptr=vc_size then vf_abort('I''m out of OVF memory!');
- end;
+ while k<=font_ec do
+ begin read_tfm_word; font_wd:=b0*256+b1;
read_tfm_word; read_tfm_word;
font_kprime:=k+(b0*256+b1);
- for font_j:=k+1 to font_kprime do begin
- vc[vc_ptr]:=font_j; incr(vc_ptr);
- if vc_ptr=vc_size then vf_abort('I''m out of OVF memory!');
- end;
+ if font_wd>0 then {character |k| exists in the font}
+ for font_j:=k to font_kprime do
+ begin 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+1;
for font_j:=1 to font_extra_words do
read_tfm_word;
@@ -1333,8 +1329,8 @@ if b0+b1+b2+b3>0 then
if(b0<>vf[font_start[font_ptr]])or@|
(b1<>vf[font_start[font_ptr]+1])or@|
(b2<>vf[font_start[font_ptr]+2])or@|
- (b3<>vf[font_start[font_ptr]+3]) then begin
- print_ln('Check sum in OVF file being replaced by font metric check sum');
+ (b3<>vf[font_start[font_ptr]+3]) then
+ begin print_ln('Check sum in OVF file being replaced by font metric check sum');
@.Check sum...replaced...@>
vf[font_start[font_ptr]]:=b0;
vf[font_start[font_ptr]+1]:=b1;
@@ -1379,14 +1375,14 @@ to upper case, since |cur_name| is a \PASCAL\ string.
@<Move font name into the |cur_name| string@>=
for k:=1 to name_length do cur_name[k]:=' ';
-if a=0 then begin
- for k:=1 to default_directory_name_length do
+if a=0 then
+ begin for k:=1 to default_directory_name_length do
cur_name[k]:=default_directory[k];
r:=default_directory_name_length;
end
else r:=0;
-for k:=font_start[font_ptr]+14 to vf_ptr-1 do begin
- incr(r);
+for k:=font_start[font_ptr]+14 to vf_ptr-1 do
+ begin incr(r);
if r+4>name_length then vf_abort('Font name too long for me!');
@.Font name too long for me@>
if (vf[k]>="a")and(vf[k]<="z") then
@@ -1406,15 +1402,16 @@ var @!b:byte; {input byte}
@!a:integer; {accumulator}
begin vf_count:=vf_count+k; get_vf(b); a:=b;
if k=4 then if b>=128 then a:=a-256; {4-byte numbers are signed}
-while k>1 do begin
- get_vf(b);
+while k>1 do
+ begin get_vf(b);
a:=256*a+b; decr(k);
end;
vf_read:=a;
end;
@ The \.{VF} format supports arbitrary 4-byte character codes,
-but \.{VPL} format presently does not. But \.{OVP} does.
+but \.{VPL} format presently does not.
+But \.{OVP} does.
@<Read and store a character packet@>=
begin if temp_byte=long_char then
@@ -1475,8 +1472,8 @@ ASCII_04:=' !"#$%&''()*+,-./0123456789:;<=>?';@/
ASCII_10:='@@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';@/
ASCII_14:='`abcdefghijklmnopqrstuvwxyz{|}~?';@/
for k:=0 to 255 do xchr[k]:='?';
-for k:=0 to @'37 do begin
- xchr[k+@'40]:=ASCII_04[k+1];
+for k:=0 to @'37 do
+ begin xchr[k+@'40]:=ASCII_04[k+1];
xchr[k+@'100]:=ASCII_10[k+1];
xchr[k+@'140]:=ASCII_14[k+1];
end;
@@ -1488,17 +1485,17 @@ HEX:='0123456789ABCDEF';@/
@<Glob...@>=
@!dig:array[0..11] of integer;
-@ Here, in fact, are two procedures that output
-|dig[j-1]|$\,\ldots\,$|dig[0]|, given $j>0$.
+@ Here, in fact, are two procedures that output |dig[j-1]|$\,\ldots\,$|dig[0]|,
+given $j>0$.
@p procedure out_digs(j:integer); {outputs |j| digits}
begin repeat decr(j); out(HEX[1+dig[j]]);
- until j=0;
+until j=0;
end;
@#
procedure print_digs(j:integer); {prints |j| digits}
begin repeat decr(j); print(HEX[1+dig[j]]);
- until j=0;
+until j=0;
end;
@ The |print_number| procedure indicates how |print_digs| can be used.
@@ -1565,8 +1562,8 @@ begins in |tfm[k]|:
@p procedure out_BCPL(@!k:index); {outputs a string, preceded by a blank space}
var l:0..39; {the number of bytes remaining}
begin out(' '); l:=tfm[k];
-while l>0 do begin
- incr(k); decr(l); out(xchr[tfm[k]]);
+while l>0 do
+ begin incr(k); decr(l); out(xchr[tfm[k]]);
end;
end;
@@ -1630,11 +1627,11 @@ if tfm[k+l]<>0 then begin
dig[j]:=a mod 16; a:=a div 16; b:=b-4; incr(j);
end;
case b of
- 0: a:=tfm[k+l];
- 1:a:=a+2*tfm[k+l];
- 2:a:=a+4*tfm[k+l];
- 3:a:=a+8*tfm[k+l];
- end;
+ 0: a:=tfm[k+l];
+ 1:a:=a+2*tfm[k+l];
+ 2:a:=a+4*tfm[k+l];
+ 3:a:=a+8*tfm[k+l];
+ end;
end;
b:=b+8;
end
@@ -1663,8 +1660,7 @@ curious code mentioned earlier, provided that it is less than 18.
var s:0..1; {the slope}
@!b:0..8; {the weight and expansion}
begin if tfm[k]>=18 then out_hex(k,1)
-else begin
- out(' F '); {specify face-code format}
+else begin out(' F '); {specify face-code format}
s:=tfm[k] mod 2; b:=tfm[k] div 2;
out(MBL_string[1+(b mod 3)]);
out(RI_string[1+s]);
@@ -1713,8 +1709,8 @@ end;
@ @<Reduce \(2)negative to positive@>=
begin out('-'); a:=@'10000-a;
-if f>0 then begin
- f:=@'4000000-f; decr(a);
+if f>0 then
+ begin f:=@'4000000-f; decr(a);
end;
end
@@ -1786,23 +1782,23 @@ that \.{VFtoVP} will put into the \.{VPL} file appear in the header part.
@<Do the header@>=
begin
case ofm_level of
- 0: begin out('(OFMLEVEL H 0)'); out_ln; end;
- 1: begin out('(OFMLEVEL H 1)'); out_ln; end;
- end;
-if ofm_on then begin
- left;
+0: begin out('(OFMLEVEL H 0)'); out_ln; end;
+1: begin out('(OFMLEVEL H 1)'); out_ln; end;
+end;
+if ofm_on then
+ begin left;
if font_dir<=7 then out('FONTDIR')
else out('NFONTDIR');
case font_dir mod 8 of
- 0: out(' TL');
- 1: out(' LT');
- 2: out(' TR');
- 3: out(' LB');
- 4: out(' BL');
- 5: out(' RT');
- 6: out(' BR');
- 7: out(' RB');
- end;
+ 0: out(' TL');
+ 1: out(' LT');
+ 2: out(' TR');
+ 3: out(' LB');
+ 4: out(' BL');
+ 5: out(' RT');
+ 6: out(' BR');
+ 7: out(' RB');
+ end;
right
end;
font_type:=vanilla;
@@ -1848,20 +1844,20 @@ we might as well write a subroutine to make the check.
@p procedure check_BCPL(@!k,@!l:index); {checks a string of length |<l|}
var j:index; {runs through the string}
@!c:integer; {character being checked}
-begin if tfm[k]>=l then begin
- bad('String is too long; I''ve shortened it drastically.');
+begin if tfm[k]>=l then
+ begin bad('String is too long; I''ve shortened it drastically.');
@.String is too long...@>
tfm[k]:=1;
end;
-for j:=k+1 to k+tfm[k] do begin
- c:=tfm[j];
+for j:=k+1 to k+tfm[k] do
+ begin c:=tfm[j];
if (c="(")or(c=")") then
begin bad('Parenthesis in string has been changed to slash.');
@.Parenthesis...changed to slash@>
tfm[j]:="/";
end
- else if (c<" ")or(c>"~") then begin
- bad('Nonstandard ASCII code has been blotted out.');
+ else if (c<" ")or(c>"~") then
+ begin bad('Nonstandard ASCII code has been blotted out.');
@.Nonstandard ASCII code...@>
tfm[j]:="?";
end
@@ -1877,8 +1873,8 @@ if (tfm[scheme]>=11)and@|(tfm[scheme+1]="T")and@|
(tfm[scheme+2]="E")and@|(tfm[scheme+3]="X")and@|
(tfm[scheme+4]=" ")and@|(tfm[scheme+5]="M")and@|
(tfm[scheme+6]="A")and@|(tfm[scheme+7]="T")and@|
- (tfm[scheme+8]="H")and@|(tfm[scheme+9]=" ") then begin
- if (tfm[scheme+10]="S")and(tfm[scheme+11]="Y") then font_type:=mathsy
+ (tfm[scheme+8]="H")and@|(tfm[scheme+9]=" ") then
+ begin if (tfm[scheme+10]="S")and(tfm[scheme+11]="Y") then font_type:=mathsy
else if (tfm[scheme+10]="E")and(tfm[scheme+11]="X") then font_type:=mathex;
end;
end
@@ -1896,8 +1892,8 @@ right
@ @<Output the rest of the header@>=
begin left; out('FACE'); out_face(random_word+3); right;
-for i:=18 to lh-1 do begin
- left; out('HEADER D ',i:1);
+for i:=18 to lh-1 do
+ begin left; out('HEADER D ',i:1);
out_hex(check_sum+4*i,@,4); right;
end;
end
@@ -1921,8 +1917,8 @@ else if (lh>17) and (tfm[random_word]>127) then
@ The next thing to take care of is the list of parameters.
@<Do the parameters@>=
-if np>0 then begin
- left; out('FONTDIMEN'); out_ln;
+if np>0 then
+ begin left; out('FONTDIMEN'); out_ln;
for i:=1 to np do @<Check and output the $i$th parameter@>;
right;
end;
@@ -2044,18 +2040,17 @@ start_counter:=start_counter+4;
end;
@ @<Do the rule parameters@>=
-if nkr>0 then begin
- start_counter:=rules_start*4;
+if nkr>0 then
+ begin start_counter:=rules_start*4;
base_counter:=rules_base*4;
for i:=0 to nkr-1 do @<Check and output the $i$th rule table@>;
- end;
+ end
@ @<Check and output the $i$th rule table@>=
-begin
-left; out('FONTRULE'); out_hex_number(i); out_ln;
+begin left; out('FONTRULE'); out_hex_number(i); out_ln;
number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
-for j:=0 to number_entries-1 do begin
- left; out('RULE'); out_hex_number(j); out_ln;
+for j:=0 to number_entries-1 do
+ begin left; out('RULE'); out_hex_number(j); out_ln;
left; out('RULEWD'); out_fix(base_counter); right;
left; out('RULEHT'); out_fix(base_counter+4); right;
left; out('RULEDP'); out_fix(base_counter+8); right;
@@ -2067,8 +2062,8 @@ start_counter:=start_counter+4;
end;
@ @<Do the glue parameters@>=
-if nkg>0 then begin
- start_counter:=glues_start*4;
+if nkg>0 then
+ begin start_counter:=glues_start*4;
base_counter:=glues_base*4;
for i:=0 to nkg-1 do @<Check and output the $i$th glue table@>;
end;
@@ -2078,11 +2073,10 @@ if nkg>0 then begin
@!glue_shrink_order,@!glue_argument:integer;
@ @<Check and output the $i$th glue table@>=
-begin
-left; out('FONTGLUE'); out_hex_number(i); out_ln;
+begin left; out('FONTGLUE'); out_hex_number(i); out_ln;
number_entries:=256*tfm[start_counter+2]+tfm[start_counter+3];
-for j:=0 to number_entries-1 do begin
- left; out('GLUE'); out_hex_number(j); out_ln;
+for j:=0 to number_entries-1 do
+ begin left; out('GLUE'); out_hex_number(j); out_ln;
glue_subtype:=tfm[base_counter] div 16;
glue_argument_kind:=tfm[base_counter] mod 16;
glue_stretch_order:=tfm[base_counter+1] div 16;
@@ -2091,39 +2085,39 @@ for j:=0 to number_entries-1 do begin
left;
out('GLUETYPE');
case glue_subtype of
- 0: out(' H 0');
- 1: out(' H 1');
- 2: out(' H 2');
- 3: out(' H 3');
- end;
+ 0: out(' H 0');
+ 1: out(' H 1');
+ 2: out(' H 2');
+ 3: out(' H 3');
+ end;
right;
case glue_argument_kind of
- 1: begin
- left; out('GLUERULE'); out_hex_number(glue_argument); right;
- end;
- 2: begin
- left; out('GLUECHAR'); out_hex_number(glue_argument); right;
- end;
+ 1: begin
+ left; out('GLUERULE'); out_hex_number(glue_argument); right;
+ end;
+ 2: begin
+ left; out('GLUECHAR'); out_hex_number(glue_argument); right;
end;
+ end;
left;
out('GLUESTRETCHORDER');
case glue_stretch_order of
- 0: out(' H 0');
- 1: out(' H 1');
- 2: out(' H 2');
- 3: out(' H 3');
- 4: out(' H 4');
- end;
+ 0: out(' H 0');
+ 1: out(' H 1');
+ 2: out(' H 2');
+ 3: out(' H 3');
+ 4: out(' H 4');
+ end;
right;
left;
out('GLUESHRINKORDER');
case glue_shrink_order of
- 0: out(' H 0');
- 1: out(' H 1');
- 2: out(' H 2');
- 3: out(' H 3');
- 4: out(' H 4');
- end;
+ 0: out(' H 0');
+ 1: out(' H 1');
+ 2: out(' H 2');
+ 3: out(' H 3');
+ 4: out(' H 4');
+ end;
right;
left; out('GLUEWD'); out_fix(base_counter+4); right;
left; out('GLUESTRETCH'); out_fix(base_counter+8); right;
@@ -2136,8 +2130,8 @@ start_counter:=start_counter+4;
end;
@ @<Do the penalty parameters@>=
-if nkp>0 then begin
- start_counter:=penalties_start*4;
+if nkp>0 then
+ begin start_counter:=penalties_start*4;
base_counter:=penalties_base*4;
for i:=0 to nkp-1 do @<Check and output the $i$th penalty table@>;
end;
@@ -2180,7 +2174,7 @@ if nk>0 then for i:=0 to nk-1 do check_fix(kern(i))('Kern');
@.Kern n is too big@>
@ The ligature/kerning program comes next. Before we can put it out in
-\.{PL} format, we need to make a table of ``labels'' that will be inserted
+\.{VPL} format, we need to make a table of ``labels'' that will be inserted
into the program. For each character |c| whose |tag| is |lig_tag| and
whose starting address is |r|, we will store the pair |(c,r)| in the
|label_table| array. If there's a boundary-char program starting at~|r|,
@@ -2212,13 +2206,13 @@ label_ptr:=0; label_table[0].rr:=0; {a sentinel appears at the bottom}
@!ai,@!acti:0..lig_size; {indices into |activity|}
@ @<Do the ligatures and kerns@>=
-if nl>0 then begin
- for ai:=0 to (nl-1) do activity[ai]:=unreachable;
+if nl>0 then
+ begin for ai:=0 to (nl-1) do activity[ai]:=unreachable;
@<Check for a boundary char@>;
end;
@<Build the label table@>;
-if nl>0 then begin
- left; out('LIGTABLE'); out_ln;@/
+if nl>0 then
+ begin left; out('LIGTABLE'); out_ln;@/
@<Compute the |activity| array@>;
@<Output and correct the ligature/kern program@>;
right;
@@ -2230,19 +2224,20 @@ that would not otherwise be detected.
@<Build...@>=
for c:=bc to ec do
-if (tag(c)=lig_tag) or (ctag(c)) then begin
- r:=rremainder(c);
+if (tag(c)=lig_tag) or (ctag(c)) then
+ begin r:=rremainder(c);
if (l_skip_byte(lig_step(r)) div 256)=0 then begin
if r<nl then begin
if l_skip_byte(lig_step(r))>stop_flag then begin
r:=256*l_op_byte(lig_step(r))+l_remainder(lig_step(r));
- if r<nl then if activity[rremainder(c)]=unreachable then
- activity[rremainder(c)]:=pass_through;
+ if r<nl then
+ if activity[rremainder(c)]=unreachable then
+ activity[rremainder(c)]:=pass_through;
end;
end;
end;
- if r>=nl then begin
- perfect:=false; print_ln(' ');
+ if r>=nl then
+ begin perfect:=false; print_ln(' ');
print('Ligature/kern starting index for character '); print_hex(c);
print_ln(' is too large;'); print_ln('so I removed it.'); set_no_tag(c);
set_no_ctag(c);
@@ -2254,8 +2249,8 @@ label_table[label_ptr+1].rr:=lig_size; {put ``infinite'' sentinel at the end}
@ @<Insert |(c,r)|...@>=
begin sort_ptr:=label_ptr; {there's a hole at position |sort_ptr+1|}
-while label_table[sort_ptr].rr>r do begin
- label_table[sort_ptr+1]:=label_table[sort_ptr];
+while label_table[sort_ptr].rr>r do
+ begin label_table[sort_ptr+1]:=label_table[sort_ptr];
decr(sort_ptr); {move the hole}
end;
label_table[sort_ptr+1].ischar:=not ctag(c);
@@ -2268,22 +2263,20 @@ incr(label_ptr); activity[r]:=accessible;
end
@ @<Check for a bound...@>=
-if l_skip_byte(lig_step(0))=255 then begin
- left; out('BOUNDARYCHAR');
+if l_skip_byte(lig_step(0))=255 then
+ begin left; out('BOUNDARYCHAR');
boundary_char:=l_next_char(lig_step(0)); out_char(boundary_char); right;
activity[0]:=pass_through;
end;
-if l_skip_byte(lig_step(nl-1))=255 then begin
- r:=256*l_op_byte(lig_step(nl-1))+l_remainder(lig_step(nl-1));
- if r>=nl then begin
- perfect:=false; print_ln(' ');
+if l_skip_byte(lig_step(nl-1))=255 then
+ begin r:=256*l_op_byte(lig_step(nl-1))+l_remainder(lig_step(nl-1));
+ if r>=nl then
+ begin perfect:=false; print_ln(' ');
print('Ligature/kern starting index for boundarychar is too large;');
print_ln('so I removed it.');
@.Ligature/kern starting index...@>
end
- else begin
- label_ptr:=1; label_table[1].cc:=xmax_char;
- label_table[1].rr:=r;
+ else begin label_ptr:=1; label_table[1].cc:=xmax_char; label_table[1].rr:=r;
bchar_label:=r; activity[r]:=accessible;
end;
activity[nl-1]:=pass_through;
@@ -2307,12 +2300,12 @@ else if activity[ai]=accessible then begin
end
@ We ignore |pass_through| items, which don't need to be mentioned in
-the \.{PL} file.
+the \.{VPL} file.
@<Output and correct the ligature...@>=
sort_ptr:=1; {point to the next label that will be needed}
-for acti:=0 to nl-1 do if activity[acti]<>pass_through then begin
- i:=acti; @<Take care of commenting out unreachable steps@>;
+for acti:=0 to nl-1 do if activity[acti]<>pass_through then
+ begin i:=acti; @<Take care of commenting out unreachable steps@>;
@<Output any labels for step $i$@>;
@<Output step $i$ of the ligature/kern program@>;
end;
@@ -2349,9 +2342,9 @@ while i=label_table[sort_ptr].rr do begin
end
@ @<Take care of commenting out...@>=
-if activity[i]=unreachable then begin
- if level=1 then begin
- left; out('COMMENT THIS PART OF THE PROGRAM IS NEVER USED!'); out_ln;
+if activity[i]=unreachable then
+ begin if level=1 then
+ begin left; out('COMMENT THIS PART OF THE PROGRAM IS NEVER USED!'); out_ln;
end
end
else if level=2 then right
@@ -2409,9 +2402,8 @@ inaccessible commands.
@<Output either...@>=
begin if (l_skip_byte(k) mod 256)>=stop_flag then out('(STOP)')
-else begin
- count:=0;
- for ai:=(i+1) to (i+(l_skip_byte(k) mod 256)) do
+else begin count:=0;
+ for ai:=i+1 to (i+(l_skip_byte(k) mod 256)) do
if activity[ai]=accessible then incr(count);
out('(SKIP D ',count:1,')'); {possibly $count=0$, so who cares}
end;
@@ -2425,8 +2417,8 @@ begin if nonexistent(l_next_char(k)) then
@.Kern step for nonexistent...@>
left; out('KRN'); out_char(l_next_char(k));
r:=256*(l_op_byte(k)-kern_flag)+l_remainder(k);
-if r>=nk then begin
- bad('Kern index too large.');
+if r>=nk then
+ begin bad('Kern index too large.');
@.Kern index too large@>
out(' R 0.0');
end
@@ -2436,22 +2428,22 @@ end
@ @<Output a ligature step@>=
begin if nonexistent(l_next_char(k)) then
- if l_next_char(k)<>boundary_char then
- correct_bad_char('Ligature step for')(l_next_char)(set_l_next_char);
+ if l_next_char(k)<>boundary_char then
+ correct_bad_char('Ligature step for')(l_next_char)(set_l_next_char);
@.Ligature step for nonexistent...@>
if nonexistent(l_remainder(k)) then
-correct_bad_char('Ligature step produces the')(l_remainder)(set_l_remainder);
+ correct_bad_char('Ligature step produces the')(l_remainder)(set_l_remainder);
@.Ligature step produces...@>
left; r:=l_op_byte(k);
-if (r=4)or((r>7)and(r<>11)) then begin
- print_ln('Ligature step with nonstandard code changed to LIG');
+if (r=4)or((r>7)and(r<>11)) then
+ begin print_ln('Ligature step with nonstandard code changed to LIG');
r:=0; set_l_op_byte(k,0);
end;
if r mod 4>1 then out('/');
out('LIG');
if odd(r) then out('/');
-while r>3 do begin
- out('>'); r:=r-4;
+while r>3 do
+ begin out('>'); r:=r-4;
end;
out_char(l_next_char(k)); out_char(l_remainder(k)); right;
end
@@ -2463,58 +2455,57 @@ character.
@<Do the characters@>=
sort_ptr:=0; {this will suppress `\.{STOP}' lines in ligature comments}
c:=bc;
-while (c<=ec) do begin
- if width_index(c)>0 then begin
- if chars_on_line=8 then begin
- print_ln(' '); chars_on_line:=1;
+while (c<=ec) do
+ begin if width_index(c)>0 then
+ begin if chars_on_line=8 then
+ begin print_ln(' '); chars_on_line:=1;
end
- else begin
- if chars_on_line>0 then print(' ');
+ else begin if chars_on_line>0 then print(' ');
incr(chars_on_line);
end;
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@>;
- if italic_index(c)>0 then @<Output the italic correction@>;
- case tag(c) of
- no_tag: do_nothing;
- lig_tag: @<Output the applicable part of the ligature/kern
- program as a comment@>;
- list_tag: @<Output the character link unless there is a problem@>;
- ext_tag: @<Output an extensible character recipe@>;
- end; {there are no other cases}
- for i:=0 to npc-1 do begin
- if char_param(c,i)<>0 then begin
- left;
- if i<nki then begin
- out('CHARIVALUE'); out_hex_number(i);
- end
- else if i<(nki+nkf) then begin
- out('CHARFVALUE'); out_hex_number(i-nki);
- end
- else if i<(nki+nkf+nkm) then begin
- out('CHARMVALUE'); out_hex_number(i-nki-nkf);
- end
- else if i<(nki+nkf+nkm+nkr) then begin
- out('CHARRULE'); out_hex_number(i-nki-nkf-nkm);
- end
- else if i<(nki+nkf+nkm+nkr+nkg) then begin
- out('CHARGLUE'); out_hex_number(i-nki-nkf-nkm-nkr);
- end
- else if i<(nki+nkf+nkm+nkr+nkg+nkp) then begin
- out('CHARPENALTY'); out_hex_number(i-nki-nkf-nkm-nkr-nkg);
- end;
- out_hex_number(char_param(c,i));
- right;
+ 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@>;
+ if italic_index(c)>0 then @<Output the italic correction@>;
+ case tag(c) of
+ no_tag: do_nothing;
+ lig_tag: @<Output the applicable part of the ligature/kern
+ program as a comment@>;
+ list_tag: @<Output the character link unless there is a problem@>;
+ ext_tag: @<Output an extensible character recipe@>;
+ end; {there are no other cases}
+ for i:=0 to npc-1 do begin
+ if char_param(c,i)<>0 then begin
+ left;
+ if i<nki then begin
+ out('CHARIVALUE'); out_hex_number(i);
+ end
+ else if i<(nki+nkf) then begin
+ out('CHARFVALUE'); out_hex_number(i-nki);
+ end
+ else if i<(nki+nkf+nkm) then begin
+ out('CHARMVALUE'); out_hex_number(i-nki-nkf);
+ end
+ else if i<(nki+nkf+nkm+nkr) then begin
+ out('CHARRULE'); out_hex_number(i-nki-nkf-nkm);
+ end
+ else if i<(nki+nkf+nkm+nkr+nkg) then begin
+ out('CHARGLUE'); out_hex_number(i-nki-nkf-nkm-nkr);
+ end
+ else if i<(nki+nkf+nkm+nkr+nkg+nkp) then begin
+ out('CHARPENALTY'); out_hex_number(i-nki-nkf-nkm-nkr-nkg);
end;
+ out_hex_number(char_param(c,i));
+ right;
end;
- if not do_map(cprime) then goto final_end;
- right;
end;
+ if not do_map(cprime) then goto final_end;
+ right;
+ end;
end;
c:=c+1+no_repeats(c);
end
@@ -2546,8 +2537,7 @@ else begin left; out('CHARIC'); out_fix(italic(c)); right;
@ @<Output the applicable part of the ligature...@>=
begin left; out('COMMENT'); out_ln;@/
i:=rremainder(c); r:=lig_step(i);
-if (l_skip_byte(r) mod 256)>stop_flag
-then i:=256*l_op_byte(r)+l_remainder(r);
+if (l_skip_byte(r) mod 256)>stop_flag then i:=256*l_op_byte(r)+l_remainder(r);
repeat @<Output step...@>;
if (l_skip_byte(k) mod 256)>=stop_flag then i:=nl
else i:=i+1+(l_skip_byte(k) mod 256);
@@ -2562,33 +2552,30 @@ the largest character code in the cycle.
@<Output the character link unless there is a problem@>=
begin r:=rremainder(c);
-if nonexistent(r) then begin
- bad_char('Character list link to')(r); set_no_tag(c);
+if nonexistent(r) then
+ begin bad_char('Character list link to')(r); set_no_tag(c);
@.Character list link...@>
end
-else begin
- while (r<c)and(tag(r)=list_tag) do r:=rremainder(r);
- if r=c then begin
- bad('Cycle in a character list!');
+else begin while (r<c)and(tag(r)=list_tag) do r:=rremainder(r);
+ if r=c then
+ begin bad('Cycle in a character list!');
@.Cycle in a character list@>
print('Character '); print_hex(c);
print_ln(' now ends the list.');
set_no_tag(c);
end
- else begin
- left; out('NEXTLARGER'); out_char(rremainder(c));
+ else begin left; out('NEXTLARGER'); out_char(rremainder(c));
right;
end;
end;
end
@ @<Output an extensible character recipe@>=
-if rremainder(c)>=ne then begin
- range_error('Extensible'); set_no_tag(c);
+if rremainder(c)>=ne then
+ begin range_error('Extensible'); set_no_tag(c);
@.Extensible index for char@>
end
-else begin
- left; out('VARCHAR'); out_ln;
+else begin left; out('VARCHAR'); out_ln;
@<Output the extensible pieces that exist@>;
right;
end
@@ -2609,10 +2596,10 @@ for d:=0 to 3 do begin
if (d=3)or(exten_char>0) then begin
left;
case d of
- 0:out('TOP');@+1:out('MID');@+2:out('BOT');@+3:out('REP')@+end;
- if nonexistent(exten_char) then out_char(c)
- else out_char(exten_char);
- right;
+ 0:out('TOP');@+1:out('MID');@+2:out('BOT');@+3:out('REP')@+end;
+ if nonexistent(exten_char) then out_char(c)
+ else out_char(exten_char);
+ right;
end
end
@@ -2651,9 +2638,9 @@ if ne>0 then
@* Checking for ligature loops.
We have programmed almost everything but the most interesting calculation of
-all, which has been saved for last as a special treat. \TeX's extended
-ligature mechanism allows unwary users to specify sequences of ligature
-replacements that never terminate. For example, the pair of commands
+all, which has been saved for last as a special treat. \TeX's extended ligature
+mechanism allows unwary users to specify sequences of ligature replacements
+that never terminate. For example, the pair of commands
$$\.{(/LIG $x$ $y$) (/LIG $y$ $x$)}$$
alternately replaces character $x$ by character $y$ and vice versa. A similar
loop occurs if \.{(LIG/ $z$ $y$)} occurs in the program for $x$ and
@@ -2667,7 +2654,7 @@ $$\vcenter{\halign{#\hfil\cr
then the adjacent characters $xz$ change to $xwz$, $xywz$, $xxz$, $xxwz$,
\dots, ad infinitum.
-@ To detect such loops, \.{TFtoPL} attempts to evaluate the function
+@ To detect such loops, \.{VFtoVP} attempts to evaluate the function
$f(x,y)$ for all character pairs $x$ and~$y$, where $f$ is defined as
follows: If the current character is $x$ and the next character is
$y$, we say the ``cursor'' is between $x$ and $y$; when the cursor
@@ -2676,8 +2663,8 @@ $f(x,y)$. This function is defined if and only if no infinite loop is
generated when the cursor is between $x$ and~$y$.
The function $f(x,y)$ can be defined recursively. It turns out that all pairs
-$(x,y)$ belong to one of five classes. The simplest class has $f(x,y)=y$;
-this happens if there's no ligature between $x$ and $y$, or in the cases
+$(x,y)$ belong to one of five classes. The simplest class has $f(x,y)=y$; this
+happens if there's no ligature between $x$ and $y$, or in the cases
\.{LIG/>} and \.{/LIG/>>}. Another simple class arises when there's a
\.{LIG} or \.{/LIG>} between $x$ and~$y$, generating the character~$z$;
then $f(x,y)=z$. Otherwise we always have $f(x,y)$ equal to
@@ -2699,7 +2686,7 @@ $(x,y)$ in a hash table from which the values $z$ and $class$ can be read.
@d pending=4 {$f(x,y)$ is being evaluated}
@<Glob...@>=
-@!hash:array[0..hash_size] of integer;
+@!hash:array[0..hash_size] of integer64;
@!class:array[0..hash_size] of simple..pending;
@!lig_z:array[0..hash_size] of xxchar_type;
@!hash_ptr:0..hash_size; {the number of nonzero entries in |hash|}
@@ -2711,31 +2698,30 @@ $(x,y)$ in a hash table from which the values $z$ and $class$ can be read.
@ @<Check for ligature cycles@>=
hash_ptr:=0; y_lig_cycle:=xmax_char;
for hh:=0 to hash_size do hash[hh]:=0; {clear the hash table}
-for c:=bc to ec do if tag(c)=lig_tag then begin
- i:=rremainder(c);
+for c:=bc to ec do if tag(c)=lig_tag then
+ begin i:=rremainder(c);
if (l_skip_byte(lig_step(i)) mod 256)>stop_flag then
i:=256*l_op_byte(lig_step(i))+l_remainder(lig_step(i));
@<Enter data for character $c$ starting at location |i| in the hash table@>;
end;
-if bchar_label<nl then begin
- c:=xmax_char; i:=bchar_label;
+if bchar_label<nl then
+ begin c:=xmax_char; i:=bchar_label;
@<Enter data for character $c$ starting at location |i| in the hash table@>;
end;
-if hash_ptr=hash_size then begin
- print_ln('Sorry, I haven''t room for so many ligature/kern pairs!');
+if hash_ptr=hash_size then
+ begin print_ln('Sorry, I haven''t room for so many ligature/kern pairs!');
@.Sorry, I haven't room...@>
goto final_end;
end;
-for hh:=1 to hash_ptr do begin
- r:=hash_list[hh];
+for hh:=1 to hash_ptr do
+ begin r:=hash_list[hh];
if class[r]>simple then {make sure $f$ is defined}
r:=f(r,(hash[r]-1)div xmax_char,(hash[r]-1)mod xmax_char);
end;
-if y_lig_cycle<xmax_char then begin
- print('Infinite ligature loop starting with ');
+if y_lig_cycle<xmax_char then
+ begin print('Infinite ligature loop starting with ');
@.Infinite ligature loop...@>
- if x_lig_cycle=xmax_char
- then print('boundary')@+else print_hex(x_lig_cycle);
+ if x_lig_cycle=xmax_char then print('boundary')@+else print_hex(x_lig_cycle);
print(' and '); print_hex(y_lig_cycle); print_ln('!');
out('(INFINITE LIGATURE LOOP MUST BE BROKEN!)'); goto final_end;
end
@@ -2750,19 +2736,20 @@ until i>=nl
is efficient when the lookup of a random key tends to be unsuccessful.
@p procedure hash_input; {enter data for character |c| and command |i|}
-label 30; {go here for a quick exit}
+label exit;
var @!cc:simple..both_z; {class of data being entered}
@!zz:char_type; {function value or ligature character being entered}
@!y:char_type; {the character after the cursor}
-@!key:integer; {value to be stored in |hash|}
+@!key:integer64; {value to be stored in |hash|}
+@!t64:integer64; {temporary register for swapping}
@!t:integer; {temporary register for swapping}
-begin if hash_ptr=hash_size then goto 30;
+begin if hash_ptr=hash_size then goto exit;
@<Compute the command parameters |y|, |cc|, and |zz|@>;
-key:=xmax_char*c+y+1; h:=(hash_mult*(key mod hash_size)) mod hash_size;
-while hash[h]>0 do begin
- if hash[h]<=key then begin
- if hash[h]=key then goto 30; {unused ligature command}
- t:=hash[h]; hash[h]:=key; key:=t; {do ordered-hash-table insertion}
+key:=int64cast(xmax_char)*c+y+1; h:=(hash_mult*key) mod hash_size;
+while hash[h]>0 do
+ begin if hash[h]<=key then
+ begin if hash[h]=key then goto exit; {unused ligature command}
+ t64:=hash[h]; hash[h]:=key; key:=t64; {do ordered-hash-table insertion}
t:=class[h]; class[h]:=cc; cc:=t; {namely, do a swap}
t:=lig_z[h]; lig_z[h]:=zz; zz:=t;
end;
@@ -2770,10 +2757,10 @@ while hash[h]>0 do begin
end;
hash[h]:=key; class[h]:=cc; lig_z[h]:=zz;
incr(hash_ptr); hash_list[hash_ptr]:=h;
-30:end;
+exit:end;
-@ We must store kern commands as well as ligature commands, because
-the former might make the latter inapplicable.
+@ We must store kern commands as well as ligature commands, because the former
+might make the latter inapplicable.
@<Compute the command param...@>=
k:=lig_step(i); y:=l_next_char(k); t:=l_op_byte(k);
@@ -2791,11 +2778,11 @@ else begin case t of
@ Evaluation of $f(x,y)$ is handled by two mutually recursive procedures.
Kind of a neat algorithm, generalizing a depth-first search.
-@p function f(@!h,@!x,@!y:index):index; forward;@t\2@>
+@p function f(@!h:integer64;@!x,@!y:index):index; forward;@t\2@>
{compute $f$ for arguments known to be in |hash[h]|}
function eval(@!x,@!y:index):index; {compute $f(x,y)$ with hashtable lookup}
-var @!key:integer; {value sought in hash table}
-begin key:=xmax_char*x+y+1; h:=(hash_mult*key) mod hash_size;
+var @!key:integer64; {value sought in hash table}
+begin key:=int64cast(xmax_char)*x+y+1; h:=(hash_mult*key) mod hash_size;
while hash[h]>key do
if h>0 then decr(h)@+else h:=hash_size;
if hash[h]<key then eval:=y {not in ordered hash table}
@@ -2803,7 +2790,7 @@ else eval:=f(h,x,y);
end;
@ Pascal's beastly convention for |forward| declarations prevents us from
-saying |function f(h,x,y:index):index| here.
+saying |function f(h:integer64;x,y:index):index| here.
@p function f;
begin case class[h] of
@@ -2815,10 +2802,8 @@ right_z: begin class[h]:=pending; lig_z[h]:=eval(x,lig_z[h]); class[h]:=simple;
both_z: begin class[h]:=pending; lig_z[h]:=eval(eval(x,lig_z[h]),y);
class[h]:=simple;
end;
-pending: begin x_lig_cycle:=x; y_lig_cycle:=y;
- lig_z[h]:=xxmax_char; class[h]:=simple;
- end; {the value |xxmax_char| will break all cycles,
- since it's not in |hash|}
+pending: begin x_lig_cycle:=x; y_lig_cycle:=y; lig_z[h]:=xxmax_char; class[h]:=simple;
+ end; {the value |xxmax_char| will break all cycles, since it's not in |hash|}
end; {there are no other cases}
f:=lig_z[h];
end;
@@ -2835,8 +2820,8 @@ var @!j,@!bal:integer;
begin if l>0 then if vf[k]=" " then goto not_found;
{a leading blank is considered unbalanced}
bal:=0;
-for j:=k to k+l-1 do begin
- if (vf[j]<" ")or(vf[j]>=127) then goto not_found;
+for j:=k to k+l-1 do
+ begin if (vf[j]<" ")or(vf[j]>=127) then goto not_found;
if vf[j]="(" then incr(bal)
else if vf[j]=")" then
if bal=0 then goto not_found else decr(bal);
@@ -2852,8 +2837,8 @@ exit:end;
@.Bad OVF file@>
@<Do the virtual font title@>=
-if string_balance(0,font_start[0]) then begin
- left; out('VTITLE ');
+if string_balance(0,font_start[0]) then
+ begin left; out('VTITLE ');
for k:=0 to font_start[0]-1 do out(xchr[vf[k]]);
right;
end
@@ -2869,22 +2854,21 @@ begin if abs(x)>=@'100000000 then
bad_vf('Oversize dimension has been reset to zero.');
@.Oversize dimension...@>
if x>=0 then tfm[design_size]:=0
-else begin
- tfm[design_size]:=255; x:=x+@'100000000;
+else begin tfm[design_size]:=255; x:=x+@'100000000;
end;
-for k:=3 downto 1 do begin
- tfm[design_size+k]:=x mod 256; x:=x div 256;
+for k:=3 downto 1 do
+ begin tfm[design_size+k]:=x mod 256; x:=x div 256;
end;
out_fix(design_size);
end;
@ @<Do the local fonts@>=
-for f:=0 to font_ptr-1 do begin
- left; out('MAPFONT D ',f:1); out_ln;
+for f:=0 to font_ptr-1 do
+ begin left; out('MAPFONT D ',f:1); out_ln;
@<Output the font area and name@>;
for k:=0 to 11 do tfm[k]:=vf[font_start[f]+k];
- if tfm[0]+tfm[1]+tfm[2]+tfm[3]>0 then begin
- left; out('FONTCHECKSUM'); out_hex(0,4); right;
+ if tfm[0]+tfm[1]+tfm[2]+tfm[3]>0 then
+ begin left; out('FONTCHECKSUM'); out_hex(0,4); right;
end;
left; out('FONTAT'); out_fix(4); right;
left; out('FONTDSIZE'); out_fix(8); right; right;
@@ -2896,16 +2880,14 @@ if a>0 then
if not string_balance(font_start[f]+14,a) then
bad_vf('Improper font area will be ignored')
@.Improper font area@>
- else begin
- left; out('FONTAREA ');
+ else begin left; out('FONTAREA ');
for k:=font_start[f]+14 to font_start[f]+a+13 do out(xchr[vf[k]]);
right;
end;
if (l=0)or not string_balance(font_start[f]+14+a,l) then
bad_vf('Improper font name will be ignored')
@.Improper font name@>
-else begin
- left; out('FONTNAME ');
+else begin left; out('FONTNAME ');
for k:=font_start[f]+14+a to font_start[f]+a+l+13 do out(xchr[vf[k]]);
right;
end
@@ -2928,19 +2910,18 @@ used by \.{DVI}-reading software.
if packet_start[c]=vf_size then
bad_vf('Missing packet for character ',c:1)
@.Missing packet@>
-else begin
- left; out('MAP'); out_ln;
+else begin left; out('MAP'); out_ln;
top:=0; wstack[0]:=0; xstack[0]:=0; ystack[0]:=0; zstack[0]:=0;
vf_ptr:=packet_start[c]; vf_limit:=packet_end[c]+1; f:=0;
- while vf_ptr<vf_limit do begin
- o:=vf[vf_ptr]; incr(vf_ptr);
+ while vf_ptr<vf_limit do
+ begin o:=vf[vf_ptr]; incr(vf_ptr);
case o of
@<Cases of \.{DVI} instructions that can appear in character packets@>@;
improper_DVI_for_VF: bad_vf('Illegal DVI code ',o:1,' will be ignored');
end; {there are no other cases}
end;
- if top>0 then begin
- bad_vf('More pushes than pops!');
+ if top>0 then
+ begin bad_vf('More pushes than pops!');
@.More pushes than pops@>
repeat out('(POP)'); decr(top);@+until top=0;
end;
@@ -2951,15 +2932,15 @@ else begin
@p function get_bytes(@!k:integer;@!signed:boolean):integer;
var @!a:integer; {accumulator}
-begin if vf_ptr+k>vf_limit then begin
- bad_vf('Packet ended prematurely'); k:=vf_limit-vf_ptr;
+begin if vf_ptr+k>vf_limit then
+ begin bad_vf('Packet ended prematurely'); k:=vf_limit-vf_ptr;
end;
a:=vf[vf_ptr];
if (k=4) or signed then
if a>=128 then a:=a-256;
incr(vf_ptr);
-while k>1 do begin
- a:=a*256+vf[vf_ptr]; incr(vf_ptr); decr(k);
+while k>1 do
+ begin a:=a*256+vf[vf_ptr]; incr(vf_ptr); decr(k);
end;
get_bytes:=a;
end;
@@ -3165,8 +3146,8 @@ if not do_characters then goto final_end;
print_ln('.');@/
if level<>0 then print_ln('This program isn''t working!');
@.This program isn't working@>
-if not perfect then begin
- out('(COMMENT THE OFM AND/OR OVF FILE WAS BAD, ');
+if not perfect then
+ begin out('(COMMENT THE OFM AND/OR OVF FILE WAS BAD, ');
out('SO THE DATA HAS BEEN CHANGED!)');
write_ln(vpl_file);
end;
diff --git a/Build/source/texk/web2c/omegaware/ovp2ovf.ch b/Build/source/texk/web2c/omegaware/ovp2ovf.ch
index 258bafb26d6..f003e8bf211 100644
--- a/Build/source/texk/web2c/omegaware/ovp2ovf.ch
+++ b/Build/source/texk/web2c/omegaware/ovp2ovf.ch
@@ -16,10 +16,10 @@
@z
@x [1] Define my_name
-@d banner=='This is OVP2OVF, Version 1.12'
+@d banner=='This is OVP2OVF, Version 1.13' {printed when the program starts}
@y
@d my_name=='ovp2ovf'
-@d banner=='This is OVP2OVF, Version 1.12'
+@d banner=='This is OVP2OVF, Version 1.13' {printed when the program starts}
@z
@x [2] Print the banner later.
@@ -30,15 +30,14 @@ procedure initialize; {this procedure gets things started properly}
@<Define |parse_arguments|@>
procedure initialize; {this procedure gets things started properly}
var @<Local variables for initialization@>@/
- begin
- kpse_set_program_name (argv[0], my_name);
- parse_arguments;
+ begin kpse_set_program_name (argv[0], my_name);
+ parse_arguments;
@z
@x [3] Increase constants.
@!buf_size=60; {length of lines displayed in error messages}
@y
-@!buf_size=3000; {max input line length, output error line length}
+@!buf_size=3000; {length of lines displayed in error messages}
@z
@x [6] Open VPL file.
@@ -86,13 +85,13 @@ correspond to one-character constants like \.{"A"} in \.{WEB} language.
@z
@x [34] (fill_buffer) end-of-line counts as a delimiter. Possibly a bug.
- while (limit<buf_size-1)and(not eoln(vpl_file)) do begin
- incr(limit); read(vpl_file,buffer[limit]);
+else begin while (limit<buf_size-1)and(not eoln(vpl_file)) do
+ begin incr(limit); read(vpl_file,buffer[limit]);
end;
buffer[limit+1]:=' '; right_ln:=eoln(vpl_file);
@y
- while (limit<buf_size-1)and(not eoln(vpl_file)) do begin
- incr(limit); read(vpl_file,buffer[limit]);
+else begin while (limit<buf_size-1)and(not eoln(vpl_file)) do
+ begin incr(limit); read(vpl_file,buffer[limit]);
end;
buffer[limit+1]:=' '; right_ln:=eoln(vpl_file);
if right_ln then begin incr(limit); buffer[limit+1]:=' ';
@@ -102,10 +101,10 @@ correspond to one-character constants like \.{"A"} in \.{WEB} language.
@x [37] (get_keyword_char) Unnecessary due to previous change.
begin while (loc=limit)and(not right_ln) do fill_buffer;
if loc=limit then cur_char:=" " {end-of-line counts as a delimiter}
-else begin
+else begin cur_char:=xord[buffer[loc+1]];
@y
begin while loc=limit do fill_buffer;
-begin
+ begin cur_char:=xord[buffer[loc+1]];
@z
% [89] `index' is not a good choice for an identifier on Unix systems.
@@ -163,12 +162,12 @@ HEX:=' 0123456789ABCDEF';@/
@z
@x [152] Fix up the mutually recursive procedures a la pltotf.
-@p function f(@!h,@!x,@!y:indx):indx; forward;@t\2@>
+@p function f(@!h:integer64;@!x,@!y:indx):indx; forward;@t\2@>
{compute $f$ for arguments known to be in |hash[h]|}
@y
@p
ifdef('notdef')
-function f(@!h,@!x,@!y:indx):indx; begin end;@t\2@>
+function f(@!h:integer64;@!x,@!y:indx):indx; begin end;@t\2@>
{compute $f$ for arguments known to be in |hash[h]|}
endif('notdef')
@z
@@ -176,7 +175,7 @@ endif('notdef')
@x [153] Finish fixing up f.
@p function f;
@y
-@p function f(@!h,@!x,@!y:indx):indx;
+@p function f(@!h:integer64;@!x,@!y:indx):indx;
@z
@x [156] Change TFM-byte output to fix ranges.
@@ -189,8 +188,8 @@ endif('notdef')
@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|}
var @!n:byte; {the first byte after the sign}
@!m:0..65535; {the two least significant bytes}
-begin if abs(x/design_units)>=16.0 then begin
- print_ln('The relative dimension ',x/@'4000000:1:3,
+begin if abs(x/design_units)>=16.0 then
+ begin print_ln('The relative dimension ',x/@'4000000:1:3,
' is too large.');
@.The relative dimension...@>
print(' (Must be less than 16*designsize');
@@ -200,8 +199,8 @@ begin if abs(x/design_units)>=16.0 then begin
@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|}
var @!n:byte; {the first byte after the sign}
@!m:0..65535; {the two least significant bytes}
-begin if fabs(x/design_units)>=16.0 then begin
- print('The relative dimension ');
+begin if fabs(x/design_units)>=16.0 then
+ begin print('The relative dimension ');
print_real(x/@'4000000,1,3);
print_ln(' is too large.');
@.The relative dimension...@>
@@ -217,9 +216,9 @@ begin if fabs(x/design_units)>=16.0 then begin
% than anything else.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@x
- while label_table[sort_ptr].rr>char_remainder[c] do begin
+ while label_table[sort_ptr].rr>char_remainder[c] do
@y
- while label_table[sort_ptr].rr>intcast(char_remainder[c]) do begin
+ while label_table[sort_ptr].rr>intcast(char_remainder[c]) do
@z
@x [175] Change VF-byte output to fix ranges.
diff --git a/Build/source/texk/web2c/omegaware/ovp2ovf.up b/Build/source/texk/web2c/omegaware/ovp2ovf.up
index 5726dbb737b..58388680154 100644
--- a/Build/source/texk/web2c/omegaware/ovp2ovf.up
+++ b/Build/source/texk/web2c/omegaware/ovp2ovf.up
@@ -1,42 +1,89 @@
+% ovp2ovf.up. Public domain.
+%
+% Allow character codes up to "10FFFF.
+
@x [3] Increase constants.
@d char_max=@"FFFF
@y
@d char_max=@"10FFFF
@z
@x [3] Increase constants.
-@d width_max=@"FFFF
-@y
-@d width_max=@"10FFFF
-@z
-@x [3] Increase constants.
@!vf_size=200000; {maximum length of |vf| data, in bytes}
@y
@!vf_size=800000; {maximum length of |vf| data, in bytes}
@z
@x [60]
-@d max_byte=@"FFFF
-
@p function get_byte:byte; {scans a one-byte property value}
@y
-@d max_byte=@"10FFFF
+We have to distinguish between character codes that may exceed |@"FFFF|
+and those that are store in one |byte| and thus must not exceed |@"FFFF|.
-@p function get_byte:integer; {scans a one-byte property value}
+@p function get_char_code:integer; {scans a character code value}
+@z
+@x [60]
+cur_char:=" "; get_byte:=acc;
+@y
+cur_char:=" "; get_char_code:=acc;
+end;
+@#
+function get_byte:integer; {scans a one-byte property value}
+var acc:integer; {an accumulator}
+begin acc:=get_char_code;
+if acc>@"FFFF then begin
+ skip_error('This value shouldn''t exceed "FFFF');
+@.This value shouldn't...@>
+ acc:=0; cur_char:=" ";
+ end;
+get_byte:=acc;
@z
@x [62]
- skip_error('This value shouldn''t exceed 65535');
+ begin skip_error('This value shouldn''t exceed 65535');
@y
- skip_error('This value shouldn''t exceed 1114111');
+ begin skip_error('This value shouldn''t exceed 1114111');
@z
@x [63]
- skip_error('This value shouldn''t exceed ''177777');
+ begin skip_error('This value shouldn''t exceed ''177777');
@y
- skip_error('This value shouldn''t exceed ''4177777');
+ begin skip_error('This value shouldn''t exceed ''4177777');
@z
@x [64]
- skip_error('This value shouldn''t exceed "FFFF');
+ begin skip_error('This value shouldn''t exceed "FFFF');
+@y
+ begin skip_error('This value shouldn''t exceed "10FFFF');
+@z
+
+@x [??]
+for k:=256 to max_char do packet_length[k]:=3;
+@y
+for k:=256 to @"FFFF do packet_length[k]:=3;
+for k:=@"10000 to max_char do packet_length[k]:=4;
+@z
+
+@x [??]
+else begin backup; c:=get_byte;
+@y
+else begin backup; c:=get_char_code;
+@z
+
+@x [??]
+@ @<Read an extended label step@>=
+begin c:=get_byte;
+@y
+@ @<Read an extended label step@>=
+begin c:=get_char_code;
+@z
+
+@x [??]
+c:=get_byte; {read the character code that is being specified}
@y
- skip_error('This value shouldn''t exceed "10FFFF');
+c:=get_char_code; {read the character code that is being specified}
+@z
+
+@x [??]
+c:=get_byte; {read the character code that is being specified}
+@y
+c:=get_char_code; {read the character code that is being specified}
@z
@x [152]
@@ -45,6 +92,12 @@ procedure read_packet(@!c:byte);
procedure read_packet(@!c:integer);
@z
+@x [156]
+else begin cc:=get_byte;
+@y
+else begin cc:=get_char_code;
+@z
+
@x [188]
while (not diff) and (cprime<=ec) do begin
@y
diff --git a/Build/source/texk/web2c/omegaware/ovp2ovf.web b/Build/source/texk/web2c/omegaware/ovp2ovf.web
index 3cab42c23f7..c09ed23af6b 100644
--- a/Build/source/texk/web2c/omegaware/ovp2ovf.web
+++ b/Build/source/texk/web2c/omegaware/ovp2ovf.web
@@ -15,6 +15,7 @@
% Version 1.0 of OVP2OVF (Month Year).
% Version 1.11 (February 2000).
% Version 1.12 (September 2009) various bug fixes by Peter Breitenlohner.
+% Version 1.13 (January 2014) more bug fixes.
% Here is TeX material that gets inserted after \input webmac
\def\hang{\hangindent 3em\indent\ignorespaces}
@@ -35,7 +36,7 @@
\vfill
\centerline{\titlefont The {\ttitlefont OVP2OVF} processor}
\vskip 15pt
- \centerline{(Version 1.12, September 2009)}
+ \centerline{(Version 1.13, January 2014)}
\vfill}
\def\botofcontents{\vfill
\centerline{\hsize 5in\baselineskip9pt
@@ -71,8 +72,7 @@ called \.{PLFONT}.
The |banner| string defined here should be changed whenever \.{OVP2OVF}
gets modified.
-@d banner=='This is OVP2OVF, Version 1.12'
-{printed when the program starts}
+@d banner=='This is OVP2OVF, Version 1.13' {printed when the program starts}
@ This program is written entirely in standard \PASCAL, except that
it has to do some slightly system-dependent character code conversion
@@ -131,8 +131,7 @@ reduce \.{VPtoVF}'s capacity.
@!max_param_words=100; {the maximum number of \.{fontdimen} parameters allowed}
@!max_lig_steps=800000; {maximum length of ligature program}
@!xmax_label=800001; {must be greater than |max_lig_steps|}
-@!hash_size=130003; {preferably a prime number,
- a bit larger than |max_lig_steps|, the number
+@!hash_size=130003; {preferably a prime number, a bit larger than |max_lig_steps|, the number
of character pairs in lig/kern steps}
@!hash_mult=16007; {another prime}
@!max_kerns=100000; {the maximum number of distinct kern values}
@@ -240,7 +239,7 @@ the question mark is replaced by \.f and the ligature program is
started over. (Thus, the character pair `\.{f?}' would actually become
the ligature `ff', and `\.{ff?}' or `\.{f?f}' would become `fff'. To
avoid this restart procedure, the \.{/LIG} command could be replaced
-by \.{/LIG>}; then `\.{f?} would become `f\kern0ptf' and `\.{f?f}'
+by \.{/LIG>}; then `\.{f?}' would become `f\kern0ptf' and `\.{f?f}'
would become `f\kern0ptff'.)
Character \.f itself is 6 units wide and 13.5 units tall, in this example.
@@ -263,8 +262,8 @@ list. For example, \.{CHARWD} shouldn't occur on the outer level or
within \.{FONTDIMEN}.
The individual property-and-value pairs in a property list can appear in
-any order. For instance, `\.{SHRINK}' precedes `\.{STRETCH}' in the above
-example, although the \.{TFM} file always puts the stretch parameter first.
+any order. For instance, `\.{SHRINK}' precedes `\.{STRETCH}' in the example
+above, although the \.{TFM} file always puts the stretch parameter first.
One could even give the information about characters like `\.f' before
specifying the number of units in the design size, or before specifying the
ligature and kerning table. However, the \.{LIGTABLE} itself is an exception
@@ -326,7 +325,7 @@ then typeset a rule that is 1 unit high and 8 units wide.
Finally, to typeset character |@'201|, we do something that requires a
special ability to interpret PostScript commands; this example
sets the PostScript ``color'' to 50\char`\%\ gray and typesets an `A'
-from \.{cmr10} in that color.
+from \.{cmr10} \.{at} \.{20\\u} in that color.
In general, the \.{MAP} attribute of a virtual character can be any sequence
of typesetting commands that might appear in a page of a \.{DVI} file.
@@ -516,7 +515,7 @@ The slashes specify retention of the left or right original character; the
`\.{(KRN} $c$ $r$\.)' means, ``If the next character is $c$, then insert
a blank space of width $r$ between the current character character and $c$;
otherwise go on to the next intruction.'' The value of $r$, which is in
-units of the design size, is often negative. Character code $c$ must exist
+design units, is often negative. Character code $c$ must exist
in the font.
\yskip\hang\.{STOP} (no value). This instruction ends a ligature/kern program.
@@ -525,8 +524,8 @@ or \.{STOP} or \.{SKIP}.
\yskip\hang\.{SKIP} (value in the range |0..127|). This instruction specifies
continuation of a ligature/kern program after the specified number of \.{LIG}
-or \.{KRN} has been skipped over. The number of subsequent \.{LIG} and \.{KRN}
-instructions must therefore exceed this specified amount.
+or \.{KRN} steps has been skipped over. The number of subsequent \.{LIG} and
+\.{KRN} instructions must therefore exceed this specified amount.
@ In addition to all these possibilities, the property name \.{COMMENT} is
allowed in any property list. Such comments are ignored.
@@ -606,10 +605,10 @@ moves right, by the specified width.
value). The typesetter moves its current position
by the number of design units specified.
-\yskip\hang\.{PUSH} The current typesetter position is remembered, to
+\yskip\hang\.{PUSH}. The current typesetter position is remembered, to
be restored on a subsequent \.{POP}.
-\yskip\hang\.{POP} The current typesetter position is reset to where it
+\yskip\hang\.{POP}. The current typesetter position is reset to where it
was on the most recent unmatched \.{PUSH}. The \.{PUSH} and \.{POP}
commands in any \.{MAP} must be properly nested like balanced parentheses.
@@ -817,16 +816,15 @@ error messages would not come out properly aligned.)
@p procedure fill_buffer;
begin left_ln:=right_ln; limit:=0; loc:=0;
-if left_ln then begin
- if line>0 then read_ln(vpl_file);
+if left_ln then
+ begin if line>0 then read_ln(vpl_file);
incr(line);
end;
-if eof(vpl_file) then begin
- limit:=1; buffer[1]:=')'; right_ln:=false; input_has_ended:=true;
+if eof(vpl_file) then
+ begin limit:=1; buffer[1]:=')'; right_ln:=false; input_has_ended:=true;
end
-else begin
- while (limit<buf_size-1)and(not eoln(vpl_file)) do begin
- incr(limit); read(vpl_file,buffer[limit]);
+else begin while (limit<buf_size-1)and(not eoln(vpl_file)) do
+ begin incr(limit); read(vpl_file,buffer[limit]);
end;
buffer[limit+1]:=' '; right_ln:=eoln(vpl_file);
if left_ln then @<Set |loc| to the number of leading blanks in
@@ -843,14 +841,14 @@ indentation conventions the user is following, if any.
@<Set |loc|...@>=
begin while (loc<limit)and(buffer[loc+1]=' ') do incr(loc);
-if loc<limit then begin
- if level=0 then
+if loc<limit then
+ begin if level=0 then
if loc=0 then incr(good_indent)
else bad_indent('Warning: Indented line occurred at level zero')
@.Warning: Indented line...@>
else if indent=0 then
- if loc mod level=0 then begin
- indent:=loc div level; good_indent:=1;
+ if loc mod level=0 then
+ begin indent:=loc div level; good_indent:=1;
end
else good_indent:=0
else if indent*level=loc then incr(good_indent)
@@ -878,8 +876,7 @@ Lower case letters are converted to upper case.
@p procedure get_keyword_char;
begin while (loc=limit)and(not right_ln) do fill_buffer;
if loc=limit then cur_char:=" " {end-of-line counts as a delimiter}
-else begin
- cur_char:=xord[buffer[loc+1]];
+else begin cur_char:=xord[buffer[loc+1]];
if cur_char>="a" then cur_char:=cur_char-@'40;
if ((cur_char>="0")and(cur_char<="9")) then incr(loc)
else if ((cur_char>="A")and(cur_char<="Z")) then incr(loc)
@@ -906,8 +903,8 @@ incr(loc); cur_char:=xord[buffer[loc]];
if cur_char>="a" then
if cur_char<="z" then cur_char:=cur_char-@'40 {uppercasify}
else begin
- if cur_char=invalid_code then begin
- err_print('Illegal character in the file');
+ if cur_char=invalid_code then
+ begin err_print('Illegal character in the file');
@.Illegal character...@>
cur_char:="?";
end;
@@ -922,13 +919,13 @@ var @!a:integer; {partial result}
begin repeat get_next;
until cur_char<>" ";
a:=cur_char-")";
-if a>0 then begin
- a:=cur_char-"0";
+if a>0 then
+ begin a:=cur_char-"0";
if cur_char>"9" then
if cur_char<"A" then a:=-1 else a:=cur_char-"A"+10;
end;
-if (a<0)or(a>15) then begin
- err_print('Illegal hexadecimal digit'); get_hex:=0;
+if (a<0)or(a>15) then
+ begin err_print('Illegal hexadecimal digit'); get_hex:=0;
@.Illegal hexadecimal digit@>
end
else get_hex:=a;
@@ -942,8 +939,8 @@ the level in force when the procedure was called.
@p procedure skip_to_end_of_item;
var l:integer; {initial value of |level|}
begin l:=level;
-while level>=l do begin
- while loc=limit do fill_buffer;
+while level>=l do
+ begin while loc=limit do fill_buffer;
incr(loc);
if buffer[loc]=')' then decr(level)
else if buffer[loc]='(' then incr(level);
@@ -968,16 +965,16 @@ label 30;
var l:integer; {initial value of |level|}
@!nonblank_found:boolean; {have we seen a nonblank character yet?}
begin l:=level; nonblank_found:=false;
-while true do begin
- while loc=limit do fill_buffer;
+while true do
+ begin while loc=limit do fill_buffer;
if buffer[loc+1]=')' then
if level=l then goto 30@+else decr(level);
incr(loc);
if buffer[loc]='(' then incr(level);
if buffer[loc]<>' ' then nonblank_found:=true;
if nonblank_found then
- if xord[buffer[loc]]=invalid_code then begin
- err_print('Illegal character in the file');
+ if xord[buffer[loc]]=invalid_code then
+ begin err_print('Illegal character in the file');
@.Illegal character...@>
vf_store("?");
end
@@ -1254,8 +1251,8 @@ begin for k:=1 to name_length do
{now the name has been shifted into the correct position}
lookup; {this sets |cur_hash| to the proper insertion place}
nhash[cur_hash]:=start_ptr; equiv[start_ptr]:=v;
-for k:=1 to name_length do begin
- dictionary[dict_ptr]:=cur_name[k]; incr(dict_ptr);
+for k:=1 to name_length do
+ begin dictionary[dict_ptr]:=cur_name[k]; incr(dict_ptr);
end;
incr(start_ptr); start[start_ptr]:=dict_ptr;
end;
@@ -1485,8 +1482,8 @@ cur_char:=" ";
while cur_char=" " do get_next;
if (cur_char>")")or(cur_char<"(") then decr(loc); {back up one character}
name_length:=0; get_keyword_char; {prepare to scan the name}
-while cur_char<>" " do begin
- if name_length=longest_name then cur_name[1]:="X" {force error}
+while cur_char<>" " do
+ begin if name_length=longest_name then cur_name[1]:="X" {force error}
else incr(name_length);
cur_name[name_length]:=cur_char;
get_keyword_char;
@@ -1507,8 +1504,6 @@ and $2^{31}-1$, inclusive, so that a computer with two's complement
@ The first number scanner, which returns a one-byte value, surely has
no problems of arithmetic overflow.
-@d max_byte=@"FFFF
-
@p function get_byte:byte; {scans a one-byte property value}
var acc:integer; {an accumulator}
@!t:ASCII_code; {the type of value to be scanned}
@@ -1538,10 +1533,10 @@ else skip_error('"C" value must be standard ASCII and not a paren')
@:C value}\.{"C" value must be...@>
@ @<Scan a small dec...@>=
-begin while (cur_char>="0")and(cur_char<="9") do begin
- acc:=acc*10+cur_char-"0";
- if acc>max_byte then begin
- skip_error('This value shouldn''t exceed 65535');
+begin while (cur_char>="0")and(cur_char<="9") do
+ begin acc:=acc*10+cur_char-"0";
+ if acc>char_max then
+ begin skip_error('This value shouldn''t exceed 65535');
@.This value shouldn't...@>
acc:=0; cur_char:=" ";
end
@@ -1551,10 +1546,10 @@ backup;
end
@ @<Scan a small oct...@>=
-begin while (cur_char>="0")and(cur_char<="7") do begin
- acc:=acc*8+cur_char-"0";
- if acc>max_byte then begin
- skip_error('This value shouldn''t exceed ''177777');
+begin while (cur_char>="0")and(cur_char<="7") do
+ begin acc:=acc*8+cur_char-"0";
+ if acc>char_max then
+ begin skip_error('This value shouldn''t exceed ''177777');
@.This value shouldn't...@>
acc:=0; cur_char:=" ";
end
@@ -1565,11 +1560,11 @@ end
@ @<Scan a small hex...@>=
begin while ((cur_char>="0")and(cur_char<="9"))or
- ((cur_char>="A")and(cur_char<="F")) do begin
- if cur_char>="A" then cur_char:=cur_char+"0"+10-"A";
+ ((cur_char>="A")and(cur_char<="F")) do
+ begin if cur_char>="A" then cur_char:=cur_char+"0"+10-"A";
acc:=acc*16+cur_char-"0";
- if acc>max_byte then begin
- skip_error('This value shouldn''t exceed "FFFF');
+ if acc>char_max then
+ begin skip_error('This value shouldn''t exceed "FFFF');
@.This value shouldn't...@>
acc:=0; cur_char:=" ";
end
@@ -1589,8 +1584,8 @@ get_next;
if cur_char="C" then acc:=acc+6
else if cur_char="E" then acc:=acc+12
else if cur_char<>"R" then acc:=18;
-if acc>=18 then begin
- skip_error('Illegal face code, I changed it to MRR');
+if acc>=18 then
+ begin skip_error('Illegal face code, I changed it to MRR');
@.Illegal face code...@>
acc:=0;
end;
@@ -1629,8 +1624,8 @@ else if cur_char="O" then r:=8
else if cur_char="D" then r:=10
else skip_error('Decimal ("D"), octal ("O"), or hex ("H") value needed here');
@.Decimal ("D"), octal ("O"), or hex...@>
-if r>0 then begin
- repeat get_next;
+if r>0 then
+ begin repeat get_next;
until cur_char<>" "; {skip the blanks after the type code}
while ((cur_char>="0")and(cur_char<="9"))or@|
((cur_char>="A")and(cur_char<="F")) do
@@ -1650,14 +1645,12 @@ end;
begin if cur_char>="A" then cur_char:=cur_char+"0"+10-"A";
if cur_char>="0"+r then skip_error('Illegal digit')
@.Illegal digit@>
-else begin
- c:=c3*r+cur_char-"0"; c3:=c mod 256;@/
+else begin c:=c3*r+cur_char-"0"; c3:=c mod 256;@/
c:=c2*r+c div 256; c2:=c mod 256;@/
c:=c1*r+c div 256; c1:=c mod 256;@/
c:=c0*r+c div 256;
if c<256 then c0:=c
- else begin
- cur_bytes:=zero_bytes;
+ else begin cur_bytes:=zero_bytes;
if r=8 then
skip_error('Sorry, the maximum octal value is O 37777777777')
@.Sorry, the maximum...@>
@@ -1710,16 +1703,16 @@ end;
@ @<Scan the blanks...@>=
repeat get_next;
-if cur_char="-" then begin
- cur_char:=" "; negative:=not negative;
+if cur_char="-" then
+ begin cur_char:=" "; negative:=not negative;
end
else if cur_char="+" then cur_char:=" ";
until cur_char<>" "
@ @<Multiply by 10...@>=
begin acc:=acc*10+cur_char-"0";
-if acc>=2048 then begin
- skip_error('Real constants must be less than 2048');
+if acc>=2048 then
+ begin skip_error('Real constants must be less than 2048');
@.Real constants must be...@>
acc:=0; cur_char:=" ";
end
@@ -1736,15 +1729,15 @@ $f=\lfloor(f^\prime+1)/2\rfloor$. It is possible to have $f=1.0$.
@ @<Scan the frac...@>=
begin j:=0; get_next;
-while (cur_char>="0")and(cur_char<="9") do begin
- if j<7 then begin
- incr(j); fraction_digits[j]:=@'10000000*(cur_char-"0");
+while (cur_char>="0")and(cur_char<="9") do
+ begin if j<7 then
+ begin incr(j); fraction_digits[j]:=@'10000000*(cur_char-"0");
end;
get_next;
end;
acc:=0;
-while j>0 do begin
- acc:=fraction_digits[j]+(acc div 10); decr(j);
+while j>0 do
+ begin acc:=fraction_digits[j]+(acc div 10); decr(j);
end;
acc:=(acc+10) div 20;
end
@@ -1886,9 +1879,8 @@ the other information that \.{TFM} files pack into a |char_info_word|.
@!char_dp:array[char_type] of pointer; {pointers to the depths}
@!char_ic:array[char_type] of pointer; {pointers to italic corrections}
@!char_tag:array[char_type] of no_tag..ext_tag; {character tags}
-@!char_remainder:array[xchar_type] of xchar_type;
- {pointers to ligature labels,
- next larger characters, or extensible characters}
+@!char_remainder:array[xchar_type] of xchar_type; {pointers to ligature labels,
+ next larger characters, or extensible characters}
@!top_width,@!top_height,@!top_depth,@!top_italic:integer;
@ @<Local...@>=
@@ -1896,8 +1888,8 @@ the other information that \.{TFM} files pack into a |char_info_word|.
@ @<Set init...@>=
bchar_label:=xmax_label;
-for c:=0 to max_char do begin
- char_wd[c]:=0; char_ht[c]:=0; char_dp[c]:=0; char_ic[c]:=0;@/
+for c:=0 to max_char do
+ begin char_wd[c]:=0; char_ht[c]:=0; char_dp[c]:=0; char_ic[c]:=0;@/
char_tag[c]:=no_tag; char_remainder[c]:=0;
end;
memory[0]:=@'17777777777; {an ``infinite'' element at the end of the lists}
@@ -1931,14 +1923,13 @@ begin if (d=0)and(h<>width) then sort_in:=0
else begin p:=h;
while d>=memory[link[p]] do p:=link[p];
if (d=memory[p])and(p<>h) then sort_in:=p
- else if mem_ptr=mem_size then begin
- err_print('Memory overflow: too many widths, etc');
+ else if mem_ptr=mem_size then
+ begin err_print('Memory overflow: too many widths, etc');
@.Memory overflow...@>
print_ln('Congratulations! It''s hard to make this error.');
sort_in:=p;
end
- else begin
- incr(mem_ptr); memory[mem_ptr]:=d;
+ else begin incr(mem_ptr); memory[mem_ptr]:=d;
link[mem_ptr]:=link[p]; link[p]:=mem_ptr; incr(memory[h]);
sort_in:=mem_ptr;
end;
@@ -1949,14 +1940,14 @@ end;
file, we may have to do some rounding of values, because the \.{OFM} file
allows at most 65536 widths, 256 heights, 256 depths, and 256 italic
corrections. The following procedure takes a given list head |h| and a
-given dimension |d|, and returns the minimum $m$ such that the elements
-of the list can be covered by $m$ intervals of width $d$. It also sets
+given dimension |d|, and returns the minimum $m$ such that the elements of
+the list can be covered by $m$ intervals of width $d$. It also sets
|next_d| to the smallest value $d^\prime>d$ such that the covering found
by this procedure would be different. In particular, if $d=0$ it computes
the number of elements of the list, and sets |next_d| to the smallest
distance between two list elements. (The covering by intervals of width
-|next_d| is not guaranteed to have fewer than $m$ elements, but in
-practice this seems to happen most of the time.)
+|next_d| is not guaranteed to have fewer than $m$ elements, but in practice
+this seems to happen most of the time.)
@<Glob...@>=
@!next_d:fix_word; {the next larger interval that is worth trying}
@@ -1968,8 +1959,8 @@ var p:pointer; {the current node of interest}
@!l:fix_word; {the least element covered by the current interval}
@!m:integer; {the current size of the cover being generated}
begin m:=0; p:=link[h]; next_d:=memory[0];
-while p<>0 do begin
- incr(m); l:=memory[p];
+while p<>0 do
+ begin incr(m); l:=memory[p];
while memory[link[p]]<=l+d do p:=link[p];
p:=link[p];
if memory[p]-l<next_d then next_d:=memory[p]-l;
@@ -1984,14 +1975,14 @@ intervals.
@p function shorten(@!h:pointer;m:integer):fix_word; {finds best way to round}
var d:fix_word; {the current trial interval length}
@!k:integer; {the size of a minimum cover}
-begin if memory[h]>m then begin
- excess:=memory[h]-m;
+begin if memory[h]>m then
+ begin excess:=memory[h]-m;
k:=min_cover(h,0); d:=next_d; {now the answer is at least |d|}
repeat d:=d+d; k:=min_cover(h,d);
until k<=m; {first we ascend rapidly until finding the range}
d:=d div 2; k:=min_cover(h,d); {now we run through the feasible steps}
- while k>m do begin
- d:=next_d; k:=min_cover(h,d);
+ while k>m do
+ begin d:=next_d; k:=min_cover(h,d);
end;
shorten:=d;
end
@@ -2016,10 +2007,10 @@ var p:pointer; {the current node of interest}
@!m:byte; {index number of nodes in the current interval}
@!l:fix_word; {least value in the current interval}
begin q:=h; p:=link[q]; m:=0;
-while p<>0 do begin
- incr(m); l:=memory[p]; index[p]:=m;
- while memory[link[p]]<=l+d do begin
- p:=link[p]; index[p]:=m; decr(excess);
+while p<>0 do
+ begin incr(m); l:=memory[p]; index[p]:=m;
+ while memory[link[p]]<=l+d do
+ begin p:=link[p]; index[p]:=m; decr(excess);
if excess=0 then d:=0;
end;
link[q]:=p; memory[p]:=l+(memory[p]-l) div 2; q:=p; p:=link[p];
@@ -2042,8 +2033,8 @@ values as we go.
cur_char:=" ";
repeat while cur_char=" " do get_next;
if cur_char="(" then @<Read a font property value@>
-else if (cur_char=")")and not input_has_ended then begin
- err_print('Extra right parenthesis');
+else if (cur_char=")")and not input_has_ended then
+ begin err_print('Extra right parenthesis');
incr(loc); cur_char:=" ";
end
@.Extra right parenthesis@>
@@ -2062,8 +2053,7 @@ end;
@ For each font property, we are supposed to read the data from the
left parenthesis that is the current value of |cur_char| to the right
parenthesis that matches it in the input. The main complication is
-to recover with reasonable grace from various error conditions that
-might arise.
+to recover with reasonable grace from various error conditions that might arise.
@<Read a font property value@>=
begin get_name;
@@ -2071,8 +2061,7 @@ if cur_code=comment_code then skip_to_end_of_item
else if cur_code>char_repeat_code then
flush_error('This property name doesn''t belong on the outer level')
@.This property name doesn't belong...@>
-else begin
- @<Read the font property value specified by |cur_code|@>;
+else begin @<Read the font property value specified by |cur_code|@>;
finish_the_property;
end;
end
@@ -2085,8 +2074,8 @@ design_size_code: @<Read the design size@>;
design_units_code: @<Read the design units@>;
coding_scheme_code: read_BCPL(coding_scheme_loc,40);
family_code: read_BCPL(family_loc,20);
-face_code: begin c:=get_byte; if c>255 then begin
- err_print('FACE clipped to 255'); c:=255 end;
+face_code: begin c:=get_byte; if c>255 then
+ begin err_print('FACE clipped to 255'); c:=255 end;
header_bytes[face_loc]:=c
end;
seven_bit_safe_flag_code: @<Read the seven-bit-safe flag@>;
@@ -2095,8 +2084,8 @@ font_dimen_code: @<Read font parameter list@>;
lig_table_code: read_lig_kern;
boundary_char_code: bchar:=get_byte;
virtual_title_code: begin vtitle_start:=vf_ptr; copy_to_end_of_item;
- if vf_ptr>vtitle_start+255 then begin
- err_print('VTITLE clipped to 255 characters'); vtitle_length:=255;
+ if vf_ptr>vtitle_start+255 then
+ begin err_print('VTITLE clipped to 255 characters'); vtitle_length:=255;
@.VTITLE clipped...@>
end
else vtitle_length:=vf_ptr-vtitle_start;
@@ -2136,19 +2125,19 @@ length of the rest of the string).
var k:header_index;
begin k:=l;
while cur_char=" " do get_next;
-while (cur_char<>"(")and(cur_char<>")") do begin
- if k<l+n then incr(k);
+while (cur_char<>"(")and(cur_char<>")") do
+ begin if k<l+n then incr(k);
if k<l+n then header_bytes[k]:=cur_char;
get_next;
end;
-if k=l+n then begin
- err_print('String is too long; its first ',n-1:1,
+if k=l+n then
+ begin err_print('String is too long; its first ',n-1:1,
@.String is too long...@>
' characters will be kept'); decr(k);
end;
header_bytes[l]:=k-l;
-while k<l+n-1 do begin {tidy up the remaining bytes by setting them to nulls}
- incr(k); header_bytes[k]:=0;
+while k<l+n-1 do {tidy up the remaining bytes by setting them to nulls}
+ begin incr(k); header_bytes[k]:=0;
end;
end;
@@ -2188,8 +2177,8 @@ else if 4*c+4>max_header_bytes then
skip_error('This HEADER index is too big for my present table size')
@.This HEADER index is too big...@>
else begin
- while header_ptr<4*c+4 do begin
- header_bytes[header_ptr]:=0; incr(header_ptr);
+ while header_ptr<4*c+4 do
+ begin header_bytes[header_ptr]:=0; incr(header_ptr);
end;
read_four_bytes(4*c);
end;
@@ -2227,9 +2216,8 @@ else begin if cur_code=parameter_code then c:=get_integer
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...@>
- else begin
- while np<c do begin
- incr(np); param[np]:=0;
+ else begin while np<c do
+ begin incr(np); param[np]:=0;
end;
param[c]:=get_fix;
finish_the_property;
@@ -2245,8 +2233,8 @@ if cur_font=font_ptr then {it's a new font number}
else err_print('Sorry, too many different mapfonts');
@.Sorry, too many different mapfonts@>
if cur_font=font_ptr then skip_to_end_of_item
-else while level=1 do begin
- while cur_char=" " do get_next;
+else while level=1 do
+ begin while cur_char=" " do get_next;
if cur_char="(" then @<Read a local font property@>
else if cur_char=")" then skip_to_end_of_item
else junk_error;
@@ -2269,27 +2257,25 @@ if cur_code=comment_code then skip_to_end_of_item
else if (cur_code<font_name_code)or(cur_code>font_dsize_code) then
flush_error('This property name doesn''t belong in a MAPFONT list')
@.This property name doesn't belong...@>
-else begin
- case cur_code of
- font_name_code:@<Read a local font name@>;
- font_area_code:@<Read a local font area@>;
- font_checksum_code:begin
- get_four_bytes; font_checksum[cur_font]:=cur_bytes;
- end;
- font_at_code: begin frozen_du:=true;
- if design_units=unity then font_at[cur_font]:=get_fix
- else font_at[cur_font]:=round((get_fix/design_units)*1048576.0);
- end;
- font_dsize_code:font_dsize[cur_font]:=get_fix;
- end; {there are no other cases}
+else begin case cur_code of
+ font_name_code:@<Read a local font name@>;
+ font_area_code:@<Read a local font area@>;
+ font_checksum_code:begin get_four_bytes; font_checksum[cur_font]:=cur_bytes;
+ end;
+ font_at_code: begin frozen_du:=true;
+ if design_units=unity then font_at[cur_font]:=get_fix
+ else font_at[cur_font]:=round((get_fix/design_units)*1048576.0);
+ end;
+ font_dsize_code:font_dsize[cur_font]:=get_fix;
+ end; {there are no other cases}
finish_the_property;
end;
end
@ @<Read a local font name@>=
begin fname_start[cur_font]:=vf_ptr; copy_to_end_of_item;
-if vf_ptr>fname_start[cur_font]+255 then begin
- err_print('FONTNAME clipped to 255 characters');
+if vf_ptr>fname_start[cur_font]+255 then
+ begin err_print('FONTNAME clipped to 255 characters');
@.FONTNAME clipped...@>
fname_length[cur_font]:=255;
end
@@ -2298,8 +2284,8 @@ end
@ @<Read a local font area@>=
begin farea_start[cur_font]:=vf_ptr; copy_to_end_of_item;
-if vf_ptr>farea_start[cur_font]+255 then begin
- err_print('FONTAREA clipped to 255 characters');
+if vf_ptr>farea_start[cur_font]+255 then
+ begin err_print('FONTAREA clipped to 255 characters');
@.FONTAREA clipped...@>
farea_length[cur_font]:=255;
end
@@ -2323,20 +2309,19 @@ if cur_code=comment_code then skip_to_end_of_item
else if (cur_code<label_code)or(cur_code>ckrn_code) then
flush_error('This property name doesn''t belong in a LIGTABLE list')
@.This property name doesn't belong...@>
-else begin
- case cur_code of
- label_code:@<Read a label step@>;
- stop_code:@<Read a stop step@>;
- skip_code:@<Read a skip step@>;
- krn_code:@<Read a kerning step@>;
- lig_code,lig_code+1,lig_code+2,lig_code+3,lig_code+5,lig_code+6,
- lig_code+7,lig_code+11:@<Read a ligature step@>;
- clabel_code:@<Read an extended label step@>;
- cpen_code:@<Read an extended penalty step@>;
- cglue_code:@<Read an extended glue step@>;
- cpenglue_code:@<Read an extended penalty/glue step@>;
- ckrn_code:@<Read an extended kern step@>;
- end; {there are no other cases |>=label_code| and |<=ckrn_code|}
+else begin case cur_code of
+ label_code:@<Read a label step@>;
+ stop_code:@<Read a stop step@>;
+ skip_code:@<Read a skip step@>;
+ krn_code:@<Read a kerning step@>;
+ lig_code,lig_code+1,lig_code+2,lig_code+3,lig_code+5,lig_code+6,lig_code+7,
+ lig_code+11:@<Read a ligature step@>;
+ clabel_code:@<Read an extended label step@>;
+ cpen_code:@<Read an extended penalty step@>;
+ cglue_code:@<Read an extended glue step@>;
+ cpenglue_code:@<Read an extended penalty/glue step@>;
+ ckrn_code:@<Read an extended kern step@>;
+ end; {there are no other cases |>=label_code| and |<=ckrn_code|}
finish_the_property;
end;
end
@@ -2344,7 +2329,7 @@ end
@ When a character is about to be tagged, we call the following
procedure so that an error message is given in case of multiple tags.
-@p procedure check_tag(c:byte); {print error if |c| already tagged}
+@p procedure check_tag(c:integer); {print error if |c| already tagged}
begin case char_tag[c] of
no_tag: do_nothing;
lig_tag: err_print('This character already appeared in a LIGTABLE LABEL');
@@ -2356,11 +2341,10 @@ end;
@ @<Read a label step@>=
begin while cur_char=" " do get_next;
-if cur_char="B" then begin
- bchar_label:=nl; skip_to_paren; {\.{LABEL BOUNDARYCHAR}}
+if cur_char="B" then
+ begin bchar_label:=nl; skip_to_paren; {\.{LABEL BOUNDARYCHAR}}
end
-else begin
- backup; c:=get_byte;
+else begin backup; c:=get_byte;
check_tag(c); char_tag[c]:=lig_tag; char_remainder[c]:=nl;
end;
if min_nl<=nl then min_nl:=nl+1;
@@ -2388,15 +2372,13 @@ else begin
if not lk_step_ended then
err_print('SKIP must follow LIG or KRN')
@.SKIP must follow LIG or KRN@>
-else begin
- c:=get_byte;
+else begin c:=get_byte;
if c>=128 then err_print('Maximum SKIP amount is 127')
@.Maximum SKIP amount...@>
else if nl+c>=max_lig_steps then
err_print('Sorry, LIGTABLE too long for me to handle')
@.Sorry, LIGTABLE too long...@>
- else begin
- lig_kern[nl-1].b0:=c;
+ else begin lig_kern[nl-1].b0:=c;
if min_nl<=nl+c then min_nl:=nl+c+1;
end;
lk_step_ended:=false;
@@ -2418,10 +2400,9 @@ end
begin lig_kern[nl].b0:=0; lig_kern[nl].b1:=get_byte;
kern[nk]:=get_fix; krn_ptr:=0;
while kern[krn_ptr]<>kern[nk] do incr(krn_ptr);
-if krn_ptr=nk then begin
- if nk<max_kerns then incr(nk)
- else begin
- err_print('Sorry, too many different kerns for me to handle');
+if krn_ptr=nk then
+ begin if nk<max_kerns then incr(nk)
+ else begin err_print('Sorry, too many different kerns for me to handle');
@.Sorry, too many different kerns...@>
decr(krn_ptr);
end;
@@ -2448,16 +2429,15 @@ end
@!penalty_category,@!max_penalty_category:integer;
@ @<Set init...@>=
-for ivalue_category:=0 to 256 do begin
- category_remainders[ivalue_category]:=-1;
-end;
+for ivalue_category:=0 to 256 do
+ begin category_remainders[ivalue_category]:=-1;
+ end;
max_ivalue_category:=-1;
max_glue_category:=-1;
max_penalty_category:=-1;
@ @<Read an extended label step@>=
-begin
-c:=get_byte;
+begin c:=get_byte;
category_remainders[c]:=nl;
if max_ivalue_category<c then max_ivalue_category:=c;
if min_nl<=nl then min_nl:=nl+1;
@@ -2514,10 +2494,9 @@ begin lig_kern[nl].b0:=256; lig_kern[nl].b1:=get_byte;
lig_kern[nl].b2:=20;
kern[nk]:=get_fix; krn_ptr:=0;
while kern[krn_ptr]<>kern[nk] do incr(krn_ptr);
-if krn_ptr=nk then begin
- if nk<max_kerns then incr(nk)
- else begin
- err_print('Sorry, too many different kerns for me to handle');
+if krn_ptr=nk then
+ begin if nk<max_kerns then incr(nk)
+ else begin err_print('Sorry, too many different kerns for me to handle');
@.Sorry, too many different kerns...@>
decr(krn_ptr);
end;
@@ -2595,8 +2574,8 @@ if not tables_read then begin
end;
c:=get_byte; {read the character code that is being specified}
@<Print |c| in hex notation@>;
-while level=1 do begin
- while cur_char=" " do get_next;
+while level=1 do
+ begin while cur_char=" " do get_next;
if cur_char="(" then read_character_property
else if cur_char=")" then skip_to_end_of_item
else junk_error;
@@ -2649,6 +2628,10 @@ for c:=(cprime+1) to (cprime+crange) do begin
char_ht[c]:=char_ht[cprime];
char_dp[c]:=char_dp[cprime];
char_ic[c]:=char_ic[cprime];
+ char_tag[c]:=char_tag[cprime];
+ char_remainder[c]:=char_remainder[cprime];
+ packet_start[c]:=packet_start[cprime];
+ packet_length[c]:=packet_length[cprime];
for tab:=0 to (nki+nkf+nkm+nkr+nkg+nkp-1) do begin
char_table[c,tab]:= char_table[cprime,tab];
end;
@@ -2693,43 +2676,42 @@ if cur_code=comment_code then skip_to_end_of_item
else if (cur_code<char_wd_code)or(cur_code>var_char_code) then
flush_error('This property name doesn''t belong in a CHARACTER list')
@.This property name doesn't belong...@>
-else begin
- case cur_code of
- char_wd_code:char_wd[c]:=sort_in(width,get_fix);
- char_ht_code:char_ht[c]:=sort_in(height,get_fix);
- char_dp_code:char_dp[c]:=sort_in(depth,get_fix);
- char_ic_code:char_ic[c]:=sort_in(italic,get_fix);
- sec_width_code,
- sec_height_code,
- sec_depth_code,
- sec_italic_code,
- accent_code,
- prim_top_axis_code,
- prim_top_axis_bis_code,
- prim_bot_axis_code,
- prim_bot_axis_bis_code,
- prim_mid_hor_code,
- prim_mid_vert_code,
- prim_base_slant_code,
- sec_top_axis_code,
- sec_top_axis_bis_code,
- sec_bot_axis_code,
- sec_bot_axis_bis_code,
- sec_mid_hor_code,
- sec_mid_vert_code,
- sec_base_slant_code:temp_value:=get_fix;
- next_larger_code:begin check_tag(c); char_tag[c]:=list_tag;
- char_remainder[c]:=get_byte;
- end;
- map_code:read_packet(c);
- var_char_code:@<Read an extensible recipe for |c|@>;
- char_ivalue_code: get_char_table_entry(nki)(0);
- char_fvalue_code: get_char_table_entry(nkf)(nki);
- char_mvalue_code: get_char_table_entry(nkm)(nki+nkf);
- char_rule_code: get_char_table_entry(nkr)(nki+nkf+nkm);
- char_glue_code: get_char_table_entry(nkg)(nki+nkf+nkm+nkr);
- char_penalty_code: get_char_table_entry(nkp)(nki+nkf+nkm+nkr+nkg);
- end;@/
+else begin case cur_code of
+ char_wd_code:char_wd[c]:=sort_in(width,get_fix);
+ char_ht_code:char_ht[c]:=sort_in(height,get_fix);
+ char_dp_code:char_dp[c]:=sort_in(depth,get_fix);
+ char_ic_code:char_ic[c]:=sort_in(italic,get_fix);
+ sec_width_code,
+ sec_height_code,
+ sec_depth_code,
+ sec_italic_code,
+ accent_code,
+ prim_top_axis_code,
+ prim_top_axis_bis_code,
+ prim_bot_axis_code,
+ prim_bot_axis_bis_code,
+ prim_mid_hor_code,
+ prim_mid_vert_code,
+ prim_base_slant_code,
+ sec_top_axis_code,
+ sec_top_axis_bis_code,
+ sec_bot_axis_code,
+ sec_bot_axis_bis_code,
+ sec_mid_hor_code,
+ sec_mid_vert_code,
+ sec_base_slant_code:temp_value:=get_fix;
+ next_larger_code:begin check_tag(c); char_tag[c]:=list_tag;
+ char_remainder[c]:=get_byte;
+ end;
+ map_code:read_packet(c);
+ var_char_code:@<Read an extensible recipe for |c|@>;
+ char_ivalue_code: get_char_table_entry(nki)(0);
+ char_fvalue_code: get_char_table_entry(nkf)(nki);
+ char_mvalue_code: get_char_table_entry(nkm)(nki+nkf);
+ char_rule_code: get_char_table_entry(nkr)(nki+nkf+nkm);
+ char_glue_code: get_char_table_entry(nkg)(nki+nkf+nkm+nkr);
+ char_penalty_code: get_char_table_entry(nkp)(nki+nkf+nkm+nkr+nkg);
+ end;@/
finish_the_property;
end;
end
@@ -2738,11 +2720,10 @@ end
begin if ne=xmax_char then
err_print('Sorry, too many VARCHAR specs')
@.Sorry, too many VARCHAR specs@>
-else begin
- check_tag(c); char_tag[c]:=ext_tag; char_remainder[c]:=ne;@/
+else begin check_tag(c); char_tag[c]:=ext_tag; char_remainder[c]:=ne;@/
exten[ne]:=zero_bytes;
- while level=2 do begin
- while cur_char=" " do get_next;
+ while level=2 do
+ begin while cur_char=" " do get_next;
if cur_char="(" then @<Read an extensible piece@>
else if cur_char=")" then skip_to_end_of_item
else junk_error;
@@ -2758,13 +2739,12 @@ if cur_code=comment_code then skip_to_end_of_item
else if (cur_code<var_char_code+1)or(cur_code>var_char_code+4) then
flush_error('This property name doesn''t belong in a VARCHAR list')
@.This property name doesn't belong...@>
-else begin
- case cur_code-(var_char_code+1) of
- 0:exten[ne].b0:=get_byte;
- 1:exten[ne].b1:=get_byte;
- 2:exten[ne].b2:=get_byte;
- 3:exten[ne].b3:=get_byte;
- end;@/
+else begin case cur_code-(var_char_code+1) of
+ 0:exten[ne].b0:=get_byte;
+ 1:exten[ne].b1:=get_byte;
+ 2:exten[ne].b2:=get_byte;
+ 3:exten[ne].b3:=get_byte;
+ end;@/
finish_the_property;
end;
end
@@ -2942,14 +2922,14 @@ var @!cc:char_type; {character being typeset}
@!k:0..vf_size; {loop index}
begin packet_start[c]:=vf_ptr; stack_ptr:=0; h:=0; v:=0;
cur_font:=0;
-while level=2 do begin
- while cur_char=" " do get_next;
+while level=2 do
+ begin while cur_char=" " do get_next;
if cur_char="(" then @<Read and assemble a list of \.{DVI} commands@>
else if cur_char=")" then skip_to_end_of_item
else junk_error;
end;
-while stack_ptr>0 do begin
- err_print('Missing POP supplied');
+while stack_ptr>0 do
+ begin err_print('Missing POP supplied');
@.Missing POP supplied@>
vf_store(pop); decr(stack_ptr);
end;
@@ -2963,17 +2943,16 @@ if cur_code=comment_code then skip_to_end_of_item
else if (cur_code<select_font_code)or(cur_code>special_hex_code) then
flush_error('This property name doesn''t belong in a MAP list')
@.This property name doesn't belong...@>
-else begin
- case cur_code of
- select_font_code:@<Assemble a font selection@>;
- set_char_code:@<Assemble a typesetting instruction@>;
- set_rule_code:@<Assemble a rulesetting instruction@>;
- move_right_code,move_right_code+1:@<Assemble a horizontal movement@>;
- move_down_code,move_down_code+1:@<Assemble a vertical movement@>;
- push_code:@<Assemble a stack push@>;
- pop_code:@<Assemble a stack pop@>;
- special_code,special_hex_code:@<Assemble a special command@>;
- end;@/
+else begin case cur_code of
+ select_font_code:@<Assemble a font selection@>;
+ set_char_code:@<Assemble a typesetting instruction@>;
+ set_rule_code:@<Assemble a rulesetting instruction@>;
+ move_right_code,move_right_code+1:@<Assemble a horizontal movement@>;
+ move_down_code,move_down_code+1:@<Assemble a vertical movement@>;
+ push_code:@<Assemble a stack push@>;
+ pop_code:@<Assemble a stack pop@>;
+ special_code,special_hex_code:@<Assemble a special command@>;
+ end;@/
finish_the_property;
end;
end
@@ -2989,10 +2968,10 @@ end
@ @<Assemble a typesetting instruction@>=
if cur_font=font_ptr then
- err_print('Character cannot be typeset in undefined font')
+ err_print('Character cannot be typeset in undefined font')
@.Character cannot be typeset...@>
-else begin
- cc:=get_byte; vf_store_set(cc);
+else begin cc:=get_byte;
+ vf_store_set(cc);
end
@ Here's a procedure that converts a |fix_word| to a sequence of
@@ -3005,19 +2984,18 @@ var negative:boolean;
@!t:integer; {threshold}
begin frozen_du:=true;
if design_units<>unity then x:=round((x/design_units)*1048576.0);
-if x>0 then negative:=false
+if x>=0 then negative:=false
else begin negative:=true; x:=-1-x;@+end;
-if opcode=0 then begin
- k:=4; t:=@'100000000;@+end
-else begin
- t:=127; k:=1;
- while x>t do begin
- t:=256*t+255; incr(k);
+if opcode=0 then
+ begin k:=4; t:=@'100000000;@+end
+else begin t:=127; k:=1;
+ while x>t do
+ begin t:=256*t+255; incr(k);
end;
vf_store(opcode+k-1); t:=t div 128 +1;
end;
-repeat if negative then begin
- vf_store(255-(x div t)); negative:=false;
+repeat if negative then
+ begin vf_store(255-(x div t)); negative:=false;
x:=(x div t)*t+t-1-x;
end
else vf_store((x div t) mod 256);
@@ -3031,22 +3009,22 @@ end
@ @<Assemble a horizontal movement@>=
begin if cur_code=move_right_code then x:=get_fix@+else x:=-get_fix;
-if h=0 then begin
- wstack[stack_ptr]:=x; h:=1; vf_fix(w1,x);@+end
+if h=0 then
+ begin wstack[stack_ptr]:=x; h:=1; vf_fix(w1,x);@+end
else if x=wstack[stack_ptr] then vf_store(w0)
-else if h=1 then begin
- xstack[stack_ptr]:=x; h:=2; vf_fix(x1,x);@+end
+else if h=1 then
+ begin xstack[stack_ptr]:=x; h:=2; vf_fix(x1,x);@+end
else if x=xstack[stack_ptr] then vf_store(x0)
else vf_fix(right1,x);
end
@ @<Assemble a vertical movement@>=
begin if cur_code=move_down_code then x:=get_fix@+else x:=-get_fix;
-if v=0 then begin
- ystack[stack_ptr]:=x; v:=1; vf_fix(y1,x);@+end
+if v=0 then
+ begin ystack[stack_ptr]:=x; v:=1; vf_fix(y1,x);@+end
else if x=ystack[stack_ptr] then vf_store(y0)
-else if v=1 then begin
- zstack[stack_ptr]:=x; v:=2; vf_fix(z1,x);@+end
+else if v=1
+ then begin zstack[stack_ptr]:=x; v:=2; vf_fix(z1,x);@+end
else if x=zstack[stack_ptr] then vf_store(z0)
else vf_fix(down1,x);
end
@@ -3055,8 +3033,7 @@ end
if stack_ptr=max_stack then {too pushy}
err_print('Don''t push so much---stack is full!')
@.Don't push so much...@>
-else begin
- vf_store(push); hstack[stack_ptr]:=h; vstack[stack_ptr]:=v;
+else begin vf_store(push); hstack[stack_ptr]:=h; vstack[stack_ptr]:=v;
incr(stack_ptr); h:=0; v:=0;
end
@@ -3064,8 +3041,7 @@ else begin
if stack_ptr=0 then
err_print('Empty stack cannot be popped')
@.Empty stack...@>
-else begin
- vf_store(pop); decr(stack_ptr);
+else begin vf_store(pop); decr(stack_ptr);
h:=hstack[stack_ptr]; v:=vstack[stack_ptr];
end
@@ -3073,9 +3049,8 @@ else begin
begin vf_store(xxx1); vf_store(0); {dummy length}
special_start:=vf_ptr;
if cur_code=special_code then copy_to_end_of_item
-else begin
- repeat x:=get_hex;
- if cur_char>")" then vf_store(x*16+get_hex);
+else begin repeat x:=get_hex;
+ if cur_char>")" then vf_store(x*16+get_hex);
until cur_char<=")";
end;
if vf_ptr-special_start>255 then @<Convert |xxx1| command to |xxx4|@>
@@ -3083,13 +3058,12 @@ else vf[special_start-1]:=vf_ptr-special_start;
end
@ @<Convert |xxx1|...@>=
-if vf_ptr+3>vf_size then begin
- err_print('Special command being clipped---no room left!');
+if vf_ptr+3>vf_size then
+ begin err_print('Special command being clipped---no room left!');
@.Special command being clipped...@>
vf_ptr:=special_start+255; vf[special_start-1]:=255;
end
-else begin
- for k:=vf_ptr downto special_start do vf[k+3]:=vf[k];
+else begin for k:=vf_ptr downto special_start do vf[k+3]:=vf[k];
x:=vf_ptr-special_start; vf_ptr:=vf_ptr+3;
vf[special_start-2]:=xxx4;
vf[special_start-1]:=x div @'100000000;
@@ -3117,8 +3091,8 @@ for c:=0 to max_char do if char_wd[c]<>0 then
@<For all characters |g| generated by |c|,
make sure that |char_wd[g]| is nonzero, and
set |seven_unsafe| if |c<128<=g|@>;
-if bchar_label<xmax_label then begin
- c:=xmax_char; @<Check ligature program of |c|@>;
+if bchar_label<xmax_label then
+ begin c:=xmax_char; @<Check ligature program of |c|@>;
end;
if seven_bit_safe_flag and seven_unsafe then
print_ln('The font is not really seven-bit-safe!');
@@ -3173,11 +3147,11 @@ check_existence_and_safety(exten[char_remainder[c]].b3)
end
@ @<Make sure that |c| is not the largest element of a charlist cycle@>=
-if char_tag[c]=list_tag then begin
- g:=char_remainder[c];
+if char_tag[c]=list_tag then
+ begin g:=char_remainder[c];
while (g<c)and(char_tag[g]=list_tag) do g:=char_remainder[g];
- if g=c then begin
- char_tag[c]:=no_tag;
+ if g=c then
+ begin char_tag[c]:=no_tag;
print('A cycle of NEXTLARGER characters has been broken at ');
@.A cycle of NEXTLARGER...@>
print_hex(c); print_ln('.');
@@ -3217,11 +3191,11 @@ delta:=shorten(italic,top_italic); set_indices(italic,delta);
lig_kern[nl].b2:=0; lig_kern[nl].b3:=0
@<Make sure the ligature/kerning program ends...@>=
-begin if bchar_label<xmax_label then begin {make room for it}
- clear_lig_kern_entry; incr(nl);
+begin if bchar_label<xmax_label then {make room for it}
+ begin clear_lig_kern_entry; incr(nl);
end; {|bchar_label| will be stored later}
-while min_nl>nl do begin
- clear_lig_kern_entry; incr(nl);
+while min_nl>nl do
+ begin clear_lig_kern_entry; incr(nl);
end;
if (lig_kern[nl-1].b0 mod 256)=0 then
lig_kern[nl-1].b0:=lig_kern[nl-1].b0 div 256 * 256 + stop_flag;
@@ -3241,7 +3215,7 @@ where it is explained further.
@ @<Glo...@>=
@!lig_ptr:0..max_lig_steps; {an index into |lig_kern|}
-@!hash:array[0..hash_size] of integer;
+@!hash:array[0..hash_size] of integer64;
@!class:array[0..hash_size] of simple..pending;
@!lig_z:array[0..hash_size] of xxchar_type;
@!hash_ptr:0..hash_size; {the number of nonzero entries in |hash|}
@@ -3259,6 +3233,8 @@ for k:=0 to hash_size do hash[k]:=0;
@<Check lig...@>=
begin lig_ptr:=char_remainder[c];
+if lig_kern[lig_ptr].b0<256 then
+begin
repeat if hash_input(lig_ptr,c) then begin
if lig_kern[lig_ptr].b2<kern_flag then begin
if lig_exam<>bchar then
@@ -3273,9 +3249,10 @@ repeat if hash_input(lig_ptr,c) then begin
check_existence(lig_exam)('KRN character examined by');
@.KRN character examined...@>
end;
-if (lig_kern[lig_ptr].b0 mod 256)>=stop_flag then lig_ptr:=nl
+if lig_kern[lig_ptr].b0>=stop_flag then lig_ptr:=nl
else lig_ptr:=lig_ptr+1+lig_kern[lig_ptr].b0;
until lig_ptr>=nl;
+end;
end
@ The |hash_input| procedure is copied from \.{TFtoPL}, but it is made
@@ -3288,18 +3265,19 @@ label 30; {go here for a quick exit}
var @!cc:simple..both_z; {class of data being entered}
@!zz:char_type; {function value or ligature character being entered}
@!y:char_type; {the character after the cursor}
-@!key:integer; {value to be stored in |hash|}
+@!key:integer64; {value to be stored in |hash|}
+@!t64:integer64; {temporary register for swapping}
@!t:integer; {temporary register for swapping}
begin if hash_ptr=hash_size then
begin hash_input:=false; goto 30;@+end;
@<Compute the command parameters |y|, |cc|, and |zz|@>;
-key:=xmax_char*c+y+1; h:=(hash_mult*(key mod hash_size)) mod hash_size;
-while hash[h]>0 do begin
- if hash[h]<=key then begin
- if hash[h]=key then begin
- hash_input:=false; goto 30; {unused ligature command}
+key:=int64cast(xmax_char)*c+y+1; h:=(hash_mult*key) mod hash_size;
+while hash[h]>0 do
+ begin if hash[h]<=key then
+ begin if hash[h]=key then
+ begin hash_input:=false; goto 30; {unused ligature command}
end;
- t:=hash[h]; hash[h]:=key; key:=t; {do ordered-hash-table insertion}
+ t64:=hash[h]; hash[h]:=key; key:=t64; {do ordered-hash-table insertion}
t:=class[h]; class[h]:=cc; cc:=t; {namely, do a swap}
t:=lig_z[h]; lig_z[h]:=zz; zz:=t;
end;
@@ -3314,23 +3292,22 @@ hash_input:=true;
y:=lig_kern[p].b1; t:=lig_kern[p].b2; cc:=simple;
zz:=lig_kern[p].b3;
if t>=kern_flag then zz:=y
-else begin
- case t of
- 0,6:do_nothing; {\.{LIG},\.{/LIG>}}
- 5,11:zz:=y; {\.{LIG/>}, \.{/LIG/>>}}
- 1,7:cc:=left_z; {\.{LIG/}, \.{/LIG/>}}
- 2:cc:=right_z; {\.{/LIG}}
- 3:cc:=both_z; {\.{/LIG/}}
- end; {there are no other cases}
+else begin case t of
+ 0,6:do_nothing; {\.{LIG},\.{/LIG>}}
+ 5,11:zz:=y; {\.{LIG/>}, \.{/LIG/>>}}
+ 1,7:cc:=left_z; {\.{LIG/}, \.{/LIG/>}}
+ 2:cc:=right_z; {\.{/LIG}}
+ 3:cc:=both_z; {\.{/LIG/}}
+ end; {there are no other cases}
end
@ (More good stuff from \.{TFtoPL}.)
-@p function f(@!h,@!x,@!y:indx):indx; forward;@t\2@>
+@p function f(@!h:integer64;@!x,@!y:indx):indx; forward;@t\2@>
{compute $f$ for arguments known to be in |hash[h]|}
function eval(@!x,@!y:indx):indx; {compute $f(x,y)$ with hashtable lookup}
-var @!key:integer; {value sought in hash table}
-begin key:=xmax_char*x+y+1; h:=(hash_mult*(key mod hash_size)) mod hash_size;
+var @!key:integer64; {value sought in hash table}
+begin key:=int64cast(xmax_char)*x+y+1; h:=(hash_mult*key) mod hash_size;
while hash[h]>key do
if h>0 then decr(h)@+else h:=hash_size;
if hash[h]<key then eval:=y {not in ordered hash table}
@@ -3338,44 +3315,42 @@ else eval:=f(h,x,y);
end;
@ Pascal's beastly convention for |forward| declarations prevents us from
-saying |function f(h,x,y:indx):indx| here.
+saying |function f(h:integer64;x,y:indx):indx| here.
@p function f;
begin case class[h] of
- simple: do_nothing;
- left_z: begin class[h]:=pending; lig_z[h]:=eval(lig_z[h],y); class[h]:=simple;
- end;
- right_z: begin class[h]:=pending; lig_z[h]:=eval(x,lig_z[h]); class[h]:=simple;
- end;
- both_z: begin class[h]:=pending; lig_z[h]:=eval(eval(x,lig_z[h]),y);
- class[h]:=simple;
- end;
- pending: begin x_lig_cycle:=x; y_lig_cycle:=y;
- lig_z[h]:=xxmax_char; class[h]:=simple;
- end; {the value |xxmax_char| will break all cycles, since it's not in |hash|}
- end; {there are no other cases}
+simple: do_nothing;
+left_z: begin class[h]:=pending; lig_z[h]:=eval(lig_z[h],y); class[h]:=simple;
+ end;
+right_z: begin class[h]:=pending; lig_z[h]:=eval(x,lig_z[h]); class[h]:=simple;
+ end;
+both_z: begin class[h]:=pending; lig_z[h]:=eval(eval(x,lig_z[h]),y);
+ class[h]:=simple;
+ end;
+pending: begin x_lig_cycle:=x; y_lig_cycle:=y; lig_z[h]:=xxmax_char; class[h]:=simple;
+ end; {the value |xxmax_char| will break all cycles, since it's not in |hash|}
+end; {there are no other cases}
f:=lig_z[h];
end;
@ @<Check for infinite...@>=
-if hash_ptr<hash_size then for hh:=1 to hash_ptr do begin
- tt:=hash_list[hh];
+if hash_ptr<hash_size then for hh:=1 to hash_ptr do
+ begin tt:=hash_list[hh];
if class[tt]>simple then {make sure $f$ is well defined}
tt:=f(tt,(hash[tt]-1)div xmax_char,(hash[tt]-1)mod xmax_char);
end;
-if(hash_ptr=hash_size)or(y_lig_cycle<xmax_char) then begin
- if hash_ptr<hash_size then begin
- print('Infinite ligature loop starting with ');
+if(hash_ptr=hash_size)or(y_lig_cycle<xmax_char) then
+ begin if hash_ptr<hash_size then
+ begin print('Infinite ligature loop starting with ');
@.Infinite ligature loop...@>
- if x_lig_cycle=xmax_char
- then print('boundary')@+else print_hex(x_lig_cycle);
+ if x_lig_cycle=xmax_char then print('boundary')@+else print_hex(x_lig_cycle);
print(' and '); print_hex(y_lig_cycle); print_ln('!');
end
else print_ln('Sorry, I haven''t room for so many ligature/kern pairs!');
@.Sorry, I haven't room...@>
print_ln('All ligatures will be cleared.');
- for c:=0 to max_char do if char_tag[c]=lig_tag then begin
- char_tag[c]:=no_tag; char_remainder[c]:=0;
+ for c:=0 to max_char do if char_tag[c]=lig_tag then
+ begin char_tag[c]:=no_tag; char_remainder[c]:=0;
end;
nl:=0; bchar:=xmax_char; bchar_label:=xmax_label;
end
@@ -3414,8 +3389,8 @@ if nl>0 then for lig_ptr:=0 to nl-1 do
end;
@.Unused LIG step...@>
@.Unused KRN step...@>
-if ne>0 then for g:=0 to ne-1 do begin
- double_check_ext(b0)('VARCHAR TOP');
+if ne>0 then for g:=0 to ne-1 do
+ begin double_check_ext(b0)('VARCHAR TOP');
double_check_ext(b1)('VARCHAR MID');
double_check_ext(b2)('VARCHAR BOT');
double_check_rep(b3)('VARCHAR REP');
@@ -3473,55 +3448,30 @@ going and writes the \.{TFM} anyway. In this case |ec| will be~0 and |bc|
will be~1.
@<Compute the subfile sizes@>=
+lh:=header_ptr div 4;@/
+not_found:=true; bc:=0;
+if (ofm_level=-1) then ec:=255 @+ else ec:=max_char;
+while not_found do
+ if (char_wd[bc]>0)or(bc=ec) then not_found:=false
+ else incr(bc);
+not_found:=true;
+while not_found do
+ if (char_wd[ec]>0)or(ec=0) then not_found:=false
+ else decr(ec);
+if bc>ec then bc:=1;
+incr(memory[width]); incr(memory[height]); incr(memory[depth]);
+incr(memory[italic]);@/
+@<Compute the ligature/kern program offset@>;
case ofm_level of
-1: begin
- lh:=header_ptr div 4;@/
- not_found:=true; bc:=0;
- while not_found do
- if (char_wd[bc]>0)or(bc=255) then not_found:=false
- else incr(bc);
- not_found:=true; ec:=255;
- while not_found do
- if (char_wd[ec]>0)or(ec=0) then not_found:=false
- else decr(ec);
- if bc>ec then bc:=1;
- incr(memory[width]); incr(memory[height]); incr(memory[depth]);
- incr(memory[italic]);@/
- @<Compute the ligature/kern program offset@>;
lf:=6+lh+(ec-bc+1)+memory[width]+memory[height]+memory[depth]+
memory[italic]+nl+lk_offset+nk+ne+np;
end;
0: begin
- lh:=header_ptr div 4;@/
- not_found:=true; bc:=0;
- while not_found do
- if (char_wd[bc]>0)or(bc=max_char) then not_found:=false
- else incr(bc);
- not_found:=true; ec:=max_char;
- while not_found do
- if (char_wd[ec]>0)or(ec=0) then not_found:=false
- else decr(ec);
- if bc>ec then bc:=1;
- incr(memory[width]); incr(memory[height]); incr(memory[depth]);
- incr(memory[italic]);@/
- @<Compute the ligature/kern program offset@>;
lf:=14+lh+2*(ec-bc+1)+memory[width]+memory[height]+memory[depth]+
memory[italic]+2*nl+lk_offset+nk+2*ne+np;
end;
1: begin
- lh:=header_ptr div 4;@/
- not_found:=true; bc:=0;
- while not_found do
- if (char_wd[bc]>0)or(bc=max_char) then not_found:=false
- else incr(bc);
- not_found:=true; ec:=max_char;
- while not_found do
- if (char_wd[ec]>0)or(ec=0) then not_found:=false
- else decr(ec);
- if bc>ec then bc:=1;
- incr(memory[width]); incr(memory[height]); incr(memory[depth]);
- incr(memory[italic]);@/
- @<Compute the ligature/kern program offset@>;
@<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+
@@ -3591,8 +3541,8 @@ for j:=0 to header_ptr-1 do out(header_bytes[j]);
@ @<Compute the check sum@>=
begin c0:=bc; c1:=ec; c2:=bc; c3:=ec;
-for c:=bc to ec do if char_wd[c]>0 then begin
- temp_width:=memory[char_wd[c]];
+for c:=bc to ec do if char_wd[c]>0 then
+ begin temp_width:=memory[char_wd[c]];
if design_units<>unity then
temp_width:=round((temp_width/design_units)*1048576.0);
temp_width:=temp_width + (c+4)*@'20000000; {this should be positive}
@@ -3626,6 +3576,7 @@ if ofm_level=1 then begin
if index[char_ht[c]]<>index[char_ht[cprime]] then diff:=true;
if index[char_dp[c]]<>index[char_dp[cprime]] then diff:=true;
if index[char_ic[c]]<>index[char_ic[cprime]] then diff:=true;
+ if char_tag[c]<>char_tag[cprime] then diff:=true;
if char_remainder[c]<>char_remainder[cprime] then diff:=true;
for tab:=0 to npc-1 do begin
if char_table[c,tab]<>char_table[cprime,tab] then diff:=true;
@@ -3695,8 +3646,8 @@ only if |design_units<>1.0|.
@p procedure out_scaled(x:fix_word); {outputs a scaled |fix_word|}
var @!n:byte; {the first byte after the sign}
@!m:0..65535; {the two least significant bytes}
-begin if abs(x/design_units)>=16.0 then begin
- print_ln('The relative dimension ',x/@'4000000:1:3,
+begin if abs(x/design_units)>=16.0 then
+ begin print_ln('The relative dimension ',x/@'4000000:1:3,
' is too large.');
@.The relative dimension...@>
print(' (Must be less than 16*designsize');
@@ -3705,12 +3656,11 @@ begin if abs(x/design_units)>=16.0 then begin
print_ln(')'); x:=0;
end;
if design_units<>unity then x:=round((x/design_units)*1048576.0);
-if x<0 then begin
- out(255); x:=x+@'100000000;
+if x<0 then
+ begin out(255); x:=x+@'100000000;
if x<=0 then x:=1;
end
-else begin
- out(0);
+else begin out(0);
if x>=@'100000000 then x:=@'77777777;
end;
n:=x div @'200000; m:=x mod @'200000;
@@ -3721,11 +3671,11 @@ end;
The scaled widths, heights, depths, and italic corrections are next.
@<Output the dimensions themselves@>=
-for q:=width to italic do begin
- out(0); out(0); out(0); out(0); {output the zero word}
+for q:=width to italic do
+ begin out(0); out(0); out(0); out(0); {output the zero word}
p:=link[q]; {head of list}
- while p>0 do begin
- out_scaled(memory[p]);
+ while p>0 do
+ begin out_scaled(memory[p]);
p:=link[p];
end;
end;
@@ -3751,24 +3701,23 @@ For this we need a sorted table of all relevant remainders.
@ @<Compute the ligature/kern program offset@>=
@<Insert all labels into |label_table|@>;
-if bchar<xmax_char then begin
- extra_loc_needed:=true; lk_offset:=1;
+if bchar<xmax_char then
+ begin extra_loc_needed:=true; lk_offset:=1;
end
-else begin
- extra_loc_needed:=false; lk_offset:=0;
+else begin extra_loc_needed:=false; lk_offset:=0;
end;
@<Find the minimum |lk_offset| and adjust all remainders@>;
-if bchar_label<xmax_label then begin
- lig_kern[nl-1].b2:=(bchar_label+lk_offset)div 65536;
+if bchar_label<xmax_label then
+ begin lig_kern[nl-1].b2:=(bchar_label+lk_offset)div 65536;
lig_kern[nl-1].b3:=(bchar_label+lk_offset)mod 65536;
end
@ @<Insert all labels...@>=
label_ptr:=0; label_table[0].rr:=-1; {sentinel}
-for c:=bc to ec do if char_tag[c]=lig_tag then begin
- sort_ptr:=label_ptr; {there's a hole at position |sort_ptr+1|}
- while label_table[sort_ptr].rr>char_remainder[c] do begin
- label_table[sort_ptr+1]:=label_table[sort_ptr];
+for c:=bc to ec do if char_tag[c]=lig_tag then
+ begin sort_ptr:=label_ptr; {there's a hole at position |sort_ptr+1|}
+ while label_table[sort_ptr].rr>char_remainder[c] do
+ begin label_table[sort_ptr+1]:=label_table[sort_ptr];
decr(sort_ptr); {move the hole}
end;
label_table[sort_ptr+1].cc:=c;
@@ -3802,12 +3751,11 @@ else begin
{N.B.: |lk_offset=65536| satisfies this when |sort_ptr=0|}
end;
end;
-if lk_offset>0 then
- while sort_ptr>0 do begin
- char_remainder[label_table[sort_ptr].cc]:=
- char_remainder[label_table[sort_ptr].cc]+lk_offset;
- decr(sort_ptr);
- end;
+if lk_offset>0 then while sort_ptr>0 do
+ begin char_remainder[label_table[sort_ptr].cc]:=
+ char_remainder[label_table[sort_ptr].cc]+lk_offset;
+ decr(sort_ptr);
+ end;
end
@ @<Output the ligature/kern program@>=
@@ -3880,15 +3828,15 @@ else begin
@ For our grand finale, we wind everything up by outputting the parameters.
@<Output the parameters@>=
-for par_ptr:=1 to np do begin
- if par_ptr=1 then
+for par_ptr:=1 to np do
+ begin if par_ptr=1 then
@<Output the slant (|param[1]|) without scaling@>
else out_scaled(param[par_ptr]);
end
@ @<Output the slant...@>=
-begin if param[1]<0 then begin
- param[1]:=param[1]+@'10000000000;
+begin if param[1]<0 then
+ begin param[1]:=param[1]+@'10000000000;
out((param[1] div @'100000000)+256-64);
end
else out(param[1] div @'100000000);
@@ -3911,8 +3859,7 @@ will never be less than $-2^{24}$.
@p procedure vout_int(@!x:integer);
begin if x>=0 then vout(x div @'100000000)
-else begin
- vout(255); x:=x+@'100000000;
+else begin vout(255); x:=x+@'100000000;
end;
vout((x div @'200000) mod 256);
vout((x div @'400) mod 256); vout(x mod 256);
@@ -3940,8 +3887,8 @@ vout_int(font_dsize[cur_font]);
vout(farea_length[cur_font]);
vout(fname_length[cur_font]);
for k:=0 to farea_length[cur_font]-1 do vout(vf[farea_start[cur_font]+k]);
-if fname_start[cur_font]=vf_size then begin
- vout("N"); vout("U"); vout("L"); vout("L");
+if fname_start[cur_font]=vf_size then
+ begin vout("N"); vout("U"); vout("L"); vout("L");
end
else for k:=0 to fname_length[cur_font]-1 do vout(vf[fname_start[cur_font]+k]);
vcount:=vcount+12+farea_length[cur_font]+fname_length[cur_font];
@@ -3950,12 +3897,11 @@ end
@ @<Output a packet for character |c|@>=
begin x:=memory[char_wd[c]];
if design_units<>unity then x:=round((x/design_units)*1048576.0);
-if (packet_length[c]>241)or(x<0)or(x>=@'100000000)or(c<0)or(c>255) then begin
- vout(242); vout_int(packet_length[c]); vfout_char(c); vout_int(x);
+if (packet_length[c]>241)or(x<0)or(x>=@'100000000)or(c<0)or(c>255) then
+ begin vout(242); vout_int(packet_length[c]); vfout_char(c); vout_int(x);
vcount:=vcount+13+packet_length[c];
end
-else begin
- vout(packet_length[c]); vout(c); vout(x div @'200000);
+else begin vout(packet_length[c]); vout(c); vout(x div @'200000);
vout((x div @'400) mod 256); vout(x mod 256);
vcount:=vcount+5+packet_length[c];
end;
diff --git a/Build/source/texk/web2c/omegaware/tests/vrepeat0.ofm b/Build/source/texk/web2c/omegaware/tests/vrepeat0.ofm
new file mode 100644
index 00000000000..0be734c9ecb
--- /dev/null
+++ b/Build/source/texk/web2c/omegaware/tests/vrepeat0.ofm
Binary files differ
diff --git a/Build/source/texk/web2c/omegaware/tests/vrepeat0.opl b/Build/source/texk/web2c/omegaware/tests/vrepeat0.opl
new file mode 100644
index 00000000000..5e102375d4e
--- /dev/null
+++ b/Build/source/texk/web2c/omegaware/tests/vrepeat0.opl
@@ -0,0 +1,95 @@
+(OFMLEVEL H 1)
+(FONTDIR TL)
+(FAMILY UNSPECIFIED)
+(FACE F MRR)
+(CODINGSCHEME UNSPECIFIED)
+(DESIGNSIZE R 10.0)
+(COMMENT DESIGNSIZE IS IN POINTS)
+(COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)
+(CHECKSUM H 33869C45)
+(SEVENBITSAFEFLAG FALSE)
+(LIGTABLE
+ (LABEL H 65)
+ (LABEL H FF65)
+ (LABEL H 10FF65)
+ (LIG H 67 H 69)
+ (KRN H 69 R -0.25)
+ (LIG H FF67 H FF69)
+ (KRN H FF69 R -0.25)
+ (STOP)
+ )
+(CHARACTER H 65
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (COMMENT
+ (LIG H 67 H 69)
+ (KRN H 69 R -0.25)
+ (LIG H FF67 H FF69)
+ (KRN H FF69 R -0.25)
+ )
+ )
+(CHARACTER H 67
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (VARCHAR
+ (TOP H 65)
+ (MID H 65)
+ (BOT H 65)
+ (REP H 65)
+ )
+ )
+(CHARACTER H 69
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (NEXTLARGER H 65)
+ )
+(CHARACTER H FF65
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (COMMENT
+ (LIG H 67 H 69)
+ (KRN H 69 R -0.25)
+ (LIG H FF67 H FF69)
+ (KRN H FF69 R -0.25)
+ )
+ )
+(CHARACTER H FF67
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (VARCHAR
+ (TOP H FF65)
+ (MID H FF65)
+ (BOT H FF65)
+ (REP H FF67)
+ )
+ )
+(CHARACTER H FF69
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (NEXTLARGER H FF65)
+ )
+(CHARACTER H 10FF65
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (COMMENT
+ (LIG H 67 H 69)
+ (KRN H 69 R -0.25)
+ (LIG H FF67 H FF69)
+ (KRN H FF69 R -0.25)
+ )
+ )
+(CHARACTER H 10FF67
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (VARCHAR
+ (TOP H FF67)
+ (MID H FF67)
+ (BOT H FF67)
+ (REP H FF65)
+ )
+ )
+(CHARACTER H 10FF69
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (NEXTLARGER H FF65)
+ )
diff --git a/Build/source/texk/web2c/omegaware/tests/vrepeat1.ofm b/Build/source/texk/web2c/omegaware/tests/vrepeat1.ofm
new file mode 100644
index 00000000000..24cb1d02325
--- /dev/null
+++ b/Build/source/texk/web2c/omegaware/tests/vrepeat1.ofm
Binary files differ
diff --git a/Build/source/texk/web2c/omegaware/tests/vrepeat1.opl b/Build/source/texk/web2c/omegaware/tests/vrepeat1.opl
new file mode 100644
index 00000000000..e949f3335de
--- /dev/null
+++ b/Build/source/texk/web2c/omegaware/tests/vrepeat1.opl
@@ -0,0 +1,106 @@
+(OFMLEVEL H 1)
+(FONTDIR TL)
+(FAMILY UNSPECIFIED)
+(FACE F MRR)
+(CODINGSCHEME UNSPECIFIED)
+(DESIGNSIZE R 10.0)
+(COMMENT DESIGNSIZE IS IN POINTS)
+(COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)
+(CHECKSUM H B730A956)
+(SEVENBITSAFEFLAG FALSE)
+(LIGTABLE
+ (LABEL H 7E)
+ (LABEL H 7F)
+ (LABEL H FF7F)
+ (LABEL H 10FF7F)
+ (LIG H 80 H 81)
+ (KRN H 81 R -0.25)
+ (LIG H FF80 H FF81)
+ (KRN H FF81 R -0.25)
+ (STOP)
+ )
+(CHARREPEAT H 7E H 1
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (COMMENT
+ (LIG H 80 H 81)
+ (KRN H 81 R -0.25)
+ (LIG H FF80 H FF81)
+ (KRN H FF81 R -0.25)
+ )
+ )
+(CHARACTER H 80
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (VARCHAR
+ (TOP H 7F)
+ (MID H 7F)
+ (BOT H 7F)
+ (REP H 80)
+ )
+ )
+(CHARACTER H 81
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (NEXTLARGER H 7F)
+ )
+(CHARACTER H FF7F
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (COMMENT
+ (LIG H 80 H 81)
+ (KRN H 81 R -0.25)
+ (LIG H FF80 H FF81)
+ (KRN H FF81 R -0.25)
+ )
+ )
+(CHARACTER H FF80
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (VARCHAR
+ (TOP H FF7F)
+ (MID H FF7F)
+ (BOT H FF7F)
+ (REP H FF80)
+ )
+ )
+(CHARACTER H FF81
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (VARCHAR
+ (TOP H FF7F)
+ (MID H FF7F)
+ (BOT H FF7F)
+ (REP H FF80)
+ )
+ )
+(CHARACTER H FF82
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (NEXTLARGER H FF7F)
+ )
+(CHARACTER H 10FF7F
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (COMMENT
+ (LIG H 80 H 81)
+ (KRN H 81 R -0.25)
+ (LIG H FF80 H FF81)
+ (KRN H FF81 R -0.25)
+ )
+ )
+(CHARACTER H 10FF80
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (VARCHAR
+ (TOP H FF80)
+ (MID H FF80)
+ (BOT H FF80)
+ (REP H FF7F)
+ )
+ )
+(CHARREPEAT H 10FF81 H 1
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (NEXTLARGER H FF7F)
+ )
diff --git a/Build/source/texk/web2c/omegaware/tests/vrepeat1.ovf b/Build/source/texk/web2c/omegaware/tests/vrepeat1.ovf
new file mode 100644
index 00000000000..bf3e668b130
--- /dev/null
+++ b/Build/source/texk/web2c/omegaware/tests/vrepeat1.ovf
Binary files differ
diff --git a/Build/source/texk/web2c/omegaware/tests/vrepeat1.ovp b/Build/source/texk/web2c/omegaware/tests/vrepeat1.ovp
new file mode 100644
index 00000000000..f94f5e4caf6
--- /dev/null
+++ b/Build/source/texk/web2c/omegaware/tests/vrepeat1.ovp
@@ -0,0 +1,164 @@
+(VTITLE With repeated characters and tags)
+(OFMLEVEL H 1)
+(FONTDIR TL)
+(FAMILY UNSPECIFIED)
+(FACE F MRR)
+(CODINGSCHEME UNSPECIFIED)
+(DESIGNSIZE R 10.0)
+(COMMENT DESIGNSIZE IS IN POINTS)
+(COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)
+(CHECKSUM H B730A956)
+(SEVENBITSAFEFLAG FALSE)
+(MAPFONT D 0
+ (FONTNAME yrepeat0)
+ (FONTCHECKSUM H 33869C45)
+ (FONTAT R 1.0)
+ (FONTDSIZE R 10.0)
+ )
+(LIGTABLE
+ (LABEL H 7E)
+ (LABEL H 7F)
+ (LABEL H FF7F)
+ (LABEL H 10FF7F)
+ (LIG H 80 H 81)
+ (KRN H 81 R -0.25)
+ (LIG H FF80 H FF81)
+ (KRN H FF81 R -0.25)
+ (STOP)
+ )
+(CHARACTER H 7E
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (COMMENT
+ (LIG H 80 H 81)
+ (KRN H 81 R -0.25)
+ (LIG H FF80 H FF81)
+ (KRN H FF81 R -0.25)
+ )
+ (MAP
+ (SETCHAR H 65)
+ )
+ )
+(CHARACTER H 7F
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (COMMENT
+ (LIG H 80 H 81)
+ (KRN H 81 R -0.25)
+ (LIG H FF80 H FF81)
+ (KRN H FF81 R -0.25)
+ )
+ (MAP
+ (SETCHAR H 67)
+ )
+ )
+(CHARACTER H 80
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (VARCHAR
+ (TOP H 7F)
+ (MID H 7F)
+ (BOT H 7F)
+ (REP H 80)
+ )
+ (MAP
+ (SETCHAR H 67)
+ )
+ )
+(CHARACTER H 81
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (NEXTLARGER H 7F)
+ (MAP
+ (SETCHAR H 69)
+ )
+ )
+(CHARACTER H FF7F
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (COMMENT
+ (LIG H 80 H 81)
+ (KRN H 81 R -0.25)
+ (LIG H FF80 H FF81)
+ (KRN H FF81 R -0.25)
+ )
+ (MAP
+ (SETCHAR H FF65)
+ )
+ )
+(CHARACTER H FF80
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (VARCHAR
+ (TOP H FF7F)
+ (MID H FF7F)
+ (BOT H FF7F)
+ (REP H FF80)
+ )
+ (MAP
+ (SETCHAR H FF67)
+ )
+ )
+(CHARACTER H FF81
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (VARCHAR
+ (TOP H FF7F)
+ (MID H FF7F)
+ (BOT H FF7F)
+ (REP H FF80)
+ )
+ (MAP
+ (SETCHAR H FF67)
+ )
+ )
+(CHARACTER H FF82
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (NEXTLARGER H FF7F)
+ (MAP
+ (SETCHAR H FF69)
+ )
+ )
+(CHARACTER H 10FF7F
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (COMMENT
+ (LIG H 80 H 81)
+ (KRN H 81 R -0.25)
+ (LIG H FF80 H FF81)
+ (KRN H FF81 R -0.25)
+ )
+ (MAP
+ (SETCHAR H 10FF65)
+ )
+ )
+(CHARACTER H 10FF80
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (VARCHAR
+ (TOP H FF80)
+ (MID H FF80)
+ (BOT H FF80)
+ (REP H FF7F)
+ )
+ (MAP
+ (SETCHAR H 10FF67)
+ )
+ )
+(CHARACTER H 10FF81
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (NEXTLARGER H FF7F)
+ (MAP
+ (SETCHAR H 10FF69)
+ )
+ )
+(CHARACTER H 10FF82
+ (CHARWD R 0.75)
+ (CHARHT R 0.5)
+ (NEXTLARGER H FF7F)
+ (MAP
+ (SETCHAR H 10FF69)
+ )
+ )
diff --git a/Build/source/texk/web2c/omegaware/vrepeat.test b/Build/source/texk/web2c/omegaware/vrepeat.test
new file mode 100755
index 00000000000..0f33c01c91d
--- /dev/null
+++ b/Build/source/texk/web2c/omegaware/vrepeat.test
@@ -0,0 +1,43 @@
+#! /bin/sh
+
+# Copyright (C) 2014 Peter Breitenlohner <tex-live@tug.org>
+# You may freely use, modify and/or distribute this file.
+
+tests=omegaware/tests
+
+TEXMFCNF=$srcdir/../kpathsea
+OFMFONTS=".;./$tests"
+export TEXMFCNF OFMFONTS
+
+test -d $tests || mkdir -p $tests
+
+echo 'opl2ofm -verbose vrepeat0 yrepeat0'
+./opl2ofm -verbose $srcdir/$tests/vrepeat0 $tests/yrepeat0 && \
+ cmp $srcdir/$tests/vrepeat0.ofm $tests/yrepeat0.ofm && echo || exit 1
+
+echo 'ofm2opl -verbose yrepeat0 yrepeat0'
+./ofm2opl -verbose $tests/yrepeat0 $tests/yrepeat0 && \
+ diff -u $srcdir/$tests/vrepeat0.opl $tests/yrepeat0.opl && echo || exit 1
+
+echo 'ovp2ovf -verbose vrepeat1 yrepeat1'
+./ovp2ovf -verbose $srcdir/$tests/vrepeat1 $tests/yrepeat1 && \
+ cmp $srcdir/$tests/vrepeat1.ovf $tests/yrepeat1.ovf && \
+ cmp $srcdir/$tests/vrepeat1.ofm $tests/yrepeat1.ofm && echo || exit 1
+
+echo 'ovf2ovp -verbose yrepeat1 yrepeat1 yrepeat1'
+./ovf2ovp -verbose $tests/yrepeat1 yrepeat1 $tests/yrepeat1
+ diff -u $srcdir/$tests/vrepeat1.ovp $tests/yrepeat1.ovp && echo || exit 1
+
+echo 'ofm2opl -verbose yrepeat1 yrepeat1'
+./ofm2opl -verbose $tests/yrepeat1 $tests/yrepeat1 && \
+ diff -u $srcdir/$tests/vrepeat1.opl $tests/yrepeat1.opl && echo || exit 1
+
+echo 'opl2ofm -verbose vrepeat1 yrepeat2'
+./opl2ofm -verbose $srcdir/$tests/vrepeat1 $tests/yrepeat2 && \
+ cmp $srcdir/$tests/vrepeat1.ofm $tests/yrepeat2.ofm && echo || exit 1
+
+echo 'ofm2opl -verbose yrepeat2 yrepeat2'
+./ofm2opl -verbose $tests/yrepeat2 $tests/yrepeat2 && \
+ diff -u $srcdir/$tests/vrepeat1.opl $tests/yrepeat2.opl && echo || exit 1
+
+exit 0