diff options
22 files changed, 1769 insertions, 1376 deletions
diff --git a/Build/source/texk/web2c/Makefile.in b/Build/source/texk/web2c/Makefile.in index f10f67018be..89702058494 100644 --- a/Build/source/texk/web2c/Makefile.in +++ b/Build/source/texk/web2c/Makefile.in @@ -1962,6 +1962,9 @@ EXTRA_DIST = PROJECTS cftests cpascal.h help.h w2c/config.h \ omegaware/tests/repeat.opl omegaware/tests/repeated.opl \ omegaware/tests/sample.out omegaware/tests/sample.ovp \ omegaware/tests/sample0-h.opl omegaware/tests/specialhex.ovp \ + omegaware/tests/vrepeat0.ofm omegaware/tests/vrepeat0.opl \ + omegaware/tests/vrepeat1.ofm omegaware/tests/vrepeat1.opl \ + omegaware/tests/vrepeat1.ovf omegaware/tests/vrepeat1.ovp \ $(aleph_web_srcs) $(aleph_ch_srcs) alephdir/ChangeLog \ alephdir/aleph.defines alephdir/aleph.version $(aleph_tests) \ synctexdir/ChangeLog synctexdir/README.txt \ @@ -2042,8 +2045,9 @@ DISTCLEANFILES = $(EXTRA_LIBRARIES) CXXLD.sh tangle.c tangle.h \ omegaware/tests/sample*.ovf omegaware/tests/sample1-h.opl \ omegaware/tests/xsample*.out omegaware/tests/specialhex.ofm \ omegaware/tests/specialhex.opl omegaware/tests/specialhex.ovf \ - omegaware/tests/xspecialhex.* $(nodist_aleph_SOURCES) \ - aleph.web aleph.ch aleph-web2c aleph.p aleph.pool aleph-tangle + omegaware/tests/xspecialhex.* omegaware/tests/yrepeat* \ + $(nodist_aleph_SOURCES) aleph.web aleph.ch aleph-web2c aleph.p \ + aleph.pool aleph-tangle CLEANFILES = TRIPTRAP_CLEAN = $(am__append_9) $(am__append_17) $(am__append_26) \ $(am__append_31) $(am__append_37) $(am__append_43) \ @@ -2973,7 +2977,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 al_tangle = WEBINPUTS=.:$(srcdir) AM_V_P=$(AM_V_P) $(SHELL) ./tangle-sh $@ $(OTANGLE) 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 Binary files differnew file mode 100644 index 00000000000..0be734c9ecb --- /dev/null +++ b/Build/source/texk/web2c/omegaware/tests/vrepeat0.ofm 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 Binary files differnew file mode 100644 index 00000000000..24cb1d02325 --- /dev/null +++ b/Build/source/texk/web2c/omegaware/tests/vrepeat1.ofm 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 Binary files differnew file mode 100644 index 00000000000..bf3e668b130 --- /dev/null +++ b/Build/source/texk/web2c/omegaware/tests/vrepeat1.ovf 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 |