diff options
Diffstat (limited to 'Build/source/texk/web2c/omegaware/opl2ofm.web')
-rw-r--r-- | Build/source/texk/web2c/omegaware/opl2ofm.web | 674 |
1 files changed, 309 insertions, 365 deletions
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); |