1% mf.ch for C compilation with web2c, derived from various other change 2% files: INITEX.CH for Berkeley Unix TeX 1.1 (by Howard Trickey and 3% Pavel Curtis), by Paul Richards. web2c modifications by Tim Morgan, et al. 4% 5% (more recent changes in ChangeLog) 6% Revision 2.0 90/3/27 20:20:00 ken To version 2.0. 7% Revision 1.9 90/1/20 09:05:32 karl To version 1.9. 8% Revision 1.8 89/11/30 09:08:16 karl To version 1.8. 9% Revision 1.7 88/12/27 15:02:24 mackay Cosmetic upgrade for version 1.7 10% Revision 1.6 88/12/11 15:59:15 morgan Brought up to MF version 1.6 11% Revision 1.5 88/03/02 13:25:44 morgan More C changes 12% Revision 1.4 87/12/09 12:50:00 hesse Changes for C version 13% Revision 1.3 87/03/07 21:15:21 mackay 14% Minor changes found on archive version on SCORE 15% Revision 1.2 86/09/29 21:46:43 mackay 16% Made no-debug the default, and changed version number 17% to correspond with improved mf.web file 18% (Got rid of debug code to avoid bug in range check 19% code of VAX4.3 BSD and SUN3 version 3.1 Os pc interpreter) 20% Revision 1.0 86/01/31 15:46:08 richards 21% Incorporates: New binary I/O library, separate optimized 22% arithmetic for takefraction/makefraction, new graphics interface. 23 24@x [0] WEAVE: print changes only. 25\def\botofcontents{\vskip 0pt plus 1fil minus 1.5in} 26@y 27\def\botofcontents{\vskip 0pt plus 1fil minus 1.5in} 28\let\maybe=\iffalse 29\def\title{\MF\ changes for C} 30\def\glob{13}\def\gglob{20, 25} % these are defined in module 1 31@z 32 33@x [1.7] Convert `debug..gubed' and `stat..tats' into #ifdefs. 34@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging} 35@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging} 36@y 37@d debug==ifdef('TEXMF_DEBUG') 38@d gubed==endif('TEXMF_DEBUG') 39@z 40 41@x 42@d stat==@{ {change this to `$\\{stat}\equiv\null$' when gathering 43 usage statistics} 44@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$' when gathering 45 usage statistics} 46@y 47@d stat==ifdef('STAT') 48@d tats==endif('STAT') 49@z 50 51@x [1.8] Same, for `init..tini'. 52@d init== {change this to `$\\{init}\equiv\.{@@\{}$' in the production version} 53@d tini== {change this to `$\\{tini}\equiv\.{@@\}}$' in the production version} 54@y 55@d init==ifdef('INIMF') 56@d tini==endif('INIMF') 57@z 58 59% [1.11] Compile-time constants. Although we only change a few of 60% these, listing them all makes the patch file for a big Metafont simpler. 61% 16K for BSD I/O; file_name_size is set from the system constant. 62@x 63@<Constants...@>= 64@!mem_max=30000; {greatest index in \MF's internal |mem| array; 65 must be strictly less than |max_halfword|; 66 must be equal to |mem_top| in \.{INIMF}, otherwise |>=mem_top|} 67@!max_internal=100; {maximum number of internal quantities} 68@!buf_size=500; {maximum number of characters simultaneously present in 69 current lines of open files; must not exceed |max_halfword|} 70@!error_line=72; {width of context lines on terminal error messages} 71@!half_error_line=42; {width of first lines of contexts in terminal 72 error messages; should be between 30 and |error_line-15|} 73@!max_print_line=79; {width of longest text lines output; should be at least 60} 74@!screen_width=768; {number of pixels in each row of screen display} 75@!screen_depth=1024; {number of pixels in each column of screen display} 76@!stack_size=30; {maximum number of simultaneous input sources} 77@!max_strings=2000; {maximum number of strings; must not exceed |max_halfword|} 78@!string_vacancies=8000; {the minimum number of characters that should be 79 available for the user's identifier names and strings, 80 after \MF's own error messages are stored} 81@!pool_size=32000; {maximum number of characters in strings, including all 82 error messages and help texts, and the names of all identifiers; 83 must exceed |string_vacancies| by the total 84 length of \MF's own strings, which is currently about 22000} 85@!move_size=5000; {space for storing moves in a single octant} 86@!max_wiggle=300; {number of autorounded points per cycle} 87@!gf_buf_size=800; {size of the output buffer, must be a multiple of 8} 88@!file_name_size=40; {file names shouldn't be longer than this} 89@!pool_name='MFbases:MF.POOL '; 90 {string of length |file_name_size|; tells where the string pool appears} 91@.MFbases@> 92@!path_size=300; {maximum number of knots between breakpoints of a path} 93@!bistack_size=785; {size of stack for bisection algorithms; 94 should probably be left at this value} 95@!header_size=100; {maximum number of \.{TFM} header words, times~4} 96@!lig_table_size=5000; {maximum number of ligature/kern steps, must be 97 at least 255 and at most 32510} 98@!max_kerns=500; {maximum number of distinct kern amounts} 99@!max_font_dimen=50; {maximum number of \&{fontdimen} parameters} 100@y 101@d file_name_size == maxint 102@d ssup_error_line = 255 103@d ssup_screen_width = 32767 104@d ssup_screen_depth = 32767 105 106@<Constants...@>= 107@!max_internal=300; {maximum number of internal quantities} 108@!stack_size=300; {maximum number of simultaneous input sources} 109@!max_strings=7500; {maximum number of strings; must not exceed |max_halfword|} 110@!string_vacancies=74000; {the minimum number of characters that should be 111 available for the user's identifier names and strings, 112 after \MF's own error messages are stored} 113@!pool_size=100000; {maximum number of characters in strings, including all 114 error messages and help texts, and the names of all identifiers; 115 must exceed |string_vacancies| by the total 116 length of \MF's own strings, which is currently about 22000} 117@!move_size=20000; {space for storing moves in a single octant} 118@!max_wiggle=1000; {number of autorounded points per cycle} 119@!pool_name=TEXMF_POOL_NAME; 120 {string that tells where the string pool appears} 121@!engine_name=TEXMF_ENGINE_NAME; {the name of this engine} 122@!path_size=1000; {maximum number of knots between breakpoints of a path} 123@!bistack_size=1500; {size of stack for bisection algorithms; 124 should probably be left at this value} 125@!header_size=100; {maximum number of \.{TFM} header words, times~4} 126@!lig_table_size=15000; {maximum number of ligature/kern steps, must be 127 at least 255 and at most 32510} 128@!max_kerns=2500; {maximum number of distinct kern amounts} 129@!max_font_dimen=60; {maximum number of \&{fontdimen} parameters} 130@# 131@!inf_main_memory = 3000; 132@!sup_main_memory = 8000000; 133 134@!inf_buf_size = 500; 135@!sup_buf_size = 30000000; 136@z 137 138@x [1.12] Constants defined as WEB macros. 139@d mem_min=0 {smallest index in the |mem| array, must not be less 140 than |min_halfword|} 141@d mem_top==30000 {largest index in the |mem| array dumped by \.{INIMF}; 142 must be substantially larger than |mem_min| 143 and not greater than |mem_max|} 144@d hash_size=2100 {maximum number of symbolic tokens, 145 must be less than |max_halfword-3*param_size|} 146@d hash_prime=1777 {a prime number equal to about 85\pct! of |hash_size|} 147@d max_in_open=6 {maximum number of input files and error insertions that 148 can be going on simultaneously} 149@d param_size=150 {maximum number of simultaneous macro parameters} 150@y 151@d mem_min=0 {smallest index in the |mem| array, must not be less 152 than |min_halfword|} 153@d hash_size=9500 {maximum number of symbolic tokens, 154 must be less than |max_halfword-3*param_size|} 155@d hash_prime=7919 {a prime number equal to about 85\pct! of |hash_size|} 156@d max_in_open=15 {maximum number of input files and error insertions that 157 can be going on simultaneously} 158@d param_size=150 {maximum number of simultaneous macro parameters} 159@z 160 161@x [1.13] Global parameters that can be changed in texmf.cnf. 162@<Glob...@>= 163@!bad:integer; {is some ``constant'' wrong?} 164@y 165@<Glob...@>= 166@!bad:integer; {is some ``constant'' wrong?} 167@# 168@!init 169@!ini_version:boolean; {are we \.{INIMF}? Set in \.{lib/texmfmp.c}} 170@!dump_option:boolean; {was the dump name option used?} 171@!dump_line:boolean; {was a \.{\%\AM base} line seen?} 172tini@/ 173@# 174@!dump_name:const_cstring; {base name for terminal display} 175@# 176@!bound_default:integer; {temporary for setup} 177@!bound_name:const_cstring; {temporary for setup} 178@# 179@!main_memory:integer; {total memory words allocated in initex} 180@!mem_top:integer; {largest index in the |mem| array dumped by \.{INIMF}; 181 must be substantially larger than |mem_bot|, 182 equal to |mem_max| in \.{INIMF}, else not greater than |mem_max|} 183@!mem_max:integer; {greatest index in \MF's internal |mem| array; 184 must be strictly less than |max_halfword|; 185 must be equal to |mem_top| in \.{INIMF}, otherwise |>=mem_top|} 186@!buf_size:integer; {maximum number of characters simultaneously present in 187 current lines of open files; must not exceed |max_halfword|} 188@!error_line:integer; {width of context lines on terminal error messages} 189@!half_error_line:integer; {width of first lines of contexts in terminal 190 error messages; should be between 30 and |error_line-15|} 191@!max_print_line:integer; {width of longest text lines output; 192 should be at least 60} 193@!screen_width:integer; {number of pixels in each row of screen display} 194@!screen_depth:integer; {number of pixels in each column of screen display} 195@!gf_buf_size:integer; {size of the output buffer, must be a multiple of 8} 196@!parse_first_line_p:c_int_type; {parse the first line for options} 197@!file_line_error_style_p:c_int_type; {output file:line:error style errors.} 198@!eight_bit_p:c_int_type; {make all characters printable by default} 199@!halt_on_error_p:c_int_type; {stop at first error} 200@!quoted_filename:boolean; {current filename is quoted} 201@z 202 203@x [1.16] Use C macros for `incr' and `decr'. 204@d incr(#) == #:=#+1 {increase a variable by unity} 205@d decr(#) == #:=#-1 {decrease a variable by unity} 206@y 207@z 208 209% [2.19] The text_char type is used as an array index into xord. The 210% default type `char' produces signed integers, which are bad array 211% indices in C. 212@x 213@d text_char == char {the data type of characters in text files} 214@y 215@d text_char == ASCII_code {the data type of characters in text files} 216@z 217 218@x [2.22] Allow any character as input. 219@^character set dependencies@> 220@^system dependencies@> 221 222@<Set init...@>= 223for i:=0 to @'37 do xchr[i]:=' '; 224for i:=@'177 to @'377 do xchr[i]:=' '; 225@y 226@^character set dependencies@> 227@^system dependencies@> 228 229@d tab = @'11 { ASCII horizontal tab } 230@d form_feed = @'14 { ASCII form feed } 231 232@<Set init...@>= 233{Initialize |xchr| to the identity mapping.} 234for i:=0 to @'37 do xchr[i]:=i; 235for i:=@'177 to @'377 do xchr[i]:=i; 236@z 237 238@x [2.24] 239for i:=0 to @'176 do xord[xchr[i]]:=i; 240@y 241for i:=0 to @'176 do xord[xchr[i]]:=i; 242{Set |xprn| for printable ASCII, unless |eight_bit_p| is set.} 243for i:=0 to 255 do xprn[i]:=(eight_bit_p or ((i>=" ")and(i<="~"))); 244 245{The idea for this dynamic translation comes from the patch by 246 Libor Skarvada \.{<libor@@informatics.muni.cz>} 247 and Petr Sojka \.{<sojka@@informatics.muni.cz>}. I didn't use any of the 248 actual code, though, preferring a more general approach.} 249 250{This updates the |xchr|, |xord|, and |xprn| arrays from the provided 251 |translate_filename|. See the function definition in \.{texmfmp.c} for 252 more comments.} 253if translate_filename then read_tcx_file; 254@z 255 256% [3.25] Declare name_of_file as a C string. See comments in tex.ch for 257% why we change the element type to text_char. 258@x 259@!name_of_file:packed array[1..file_name_size] of char;@;@/ 260 {on some systems this may be a \&{record} variable} 261@y 262@!name_of_file:^text_char; 263@z 264 265@x [3.26] Do file opening in C. 266@ The \ph\ compiler with which the present version of \MF\ was prepared has 267extended the rules of \PASCAL\ in a very convenient way. To open file~|f|, 268we can write 269$$\vbox{\halign{#\hfil\qquad&#\hfil\cr 270|reset(f,@t\\{name}@>,'/O')|&for input;\cr 271|rewrite(f,@t\\{name}@>,'/O')|&for output.\cr}}$$ 272The `\\{name}' parameter, which is of type `\ignorespaces|packed 273array[@t\<\\{any}>@>] of text_char|', stands for the name of 274the external file that is being opened for input or output. 275Blank spaces that might appear in \\{name} are ignored. 276 277The `\.{/O}' parameter tells the operating system not to issue its own 278error messages if something goes wrong. If a file of the specified name 279cannot be found, or if such a file cannot be opened for some other reason 280(e.g., someone may already be trying to write the same file), we will have 281|@!erstat(f)<>0| after an unsuccessful |reset| or |rewrite|. This allows 282\MF\ to undertake appropriate corrective action. 283@:PASCAL H}{\ph@> 284@^system dependencies@> 285 286\MF's file-opening procedures return |false| if no file identified by 287|name_of_file| could be opened. 288 289@d reset_OK(#)==erstat(#)=0 290@d rewrite_OK(#)==erstat(#)=0 291 292@p function a_open_in(var @!f:alpha_file):boolean; 293 {open a text file for input} 294begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f); 295end; 296@# 297function a_open_out(var @!f:alpha_file):boolean; 298 {open a text file for output} 299begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f); 300end; 301@# 302function b_open_out(var @!f:byte_file):boolean; 303 {open a binary file for output} 304begin rewrite(f,name_of_file,'/O'); b_open_out:=rewrite_OK(f); 305end; 306@# 307function w_open_in(var @!f:word_file):boolean; 308 {open a word file for input} 309begin reset(f,name_of_file,'/O'); w_open_in:=reset_OK(f); 310end; 311@# 312function w_open_out(var @!f:word_file):boolean; 313 {open a word file for output} 314begin rewrite(f,name_of_file,'/O'); w_open_out:=rewrite_OK(f); 315end; 316@y 317@ All of the file opening functions are defined in C. 318@z 319 320@x [3.27] Do file closing in C. 321@ Files can be closed with the \ph\ routine `|close(f)|', which 322@:PASCAL H}{\ph@> 323@^system dependencies@> 324should be used when all input or output with respect to |f| has been completed. 325This makes |f| available to be opened again, if desired; and if |f| was used for 326output, the |close| operation makes the corresponding external file appear 327on the user's area, ready to be read. 328 329@p procedure a_close(var @!f:alpha_file); {close a text file} 330begin close(f); 331end; 332@# 333procedure b_close(var @!f:byte_file); {close a binary file} 334begin close(f); 335end; 336@# 337procedure w_close(var @!f:word_file); {close a word file} 338begin close(f); 339end; 340@y 341@ And all the file closing routines as well. 342@z 343 344@x [3.29] Array size of input buffer is determined at runtime. 345@!buffer:array[0..buf_size] of ASCII_code; {lines of characters being read} 346@y 347@!buffer:^ASCII_code; {lines of characters being read} 348@z 349 350@x [3.30] Do `input_ln' in C. 351Standard \PASCAL\ says that a file should have |eoln| immediately 352before |eof|, but \MF\ needs only a weaker restriction: If |eof| 353occurs in the middle of a line, the system function |eoln| should return 354a |true| result (even though |f^| will be undefined). 355 356@p function input_ln(var @!f:alpha_file;@!bypass_eoln:boolean):boolean; 357 {inputs the next line or returns |false|} 358var @!last_nonblank:0..buf_size; {|last| with trailing blanks removed} 359begin if bypass_eoln then if not eof(f) then get(f); 360 {input the first character of the line into |f^|} 361last:=first; {cf.\ Matthew 19\thinspace:\thinspace30} 362if eof(f) then input_ln:=false 363else begin last_nonblank:=first; 364 while not eoln(f) do 365 begin if last>=max_buf_stack then 366 begin max_buf_stack:=last+1; 367 if max_buf_stack=buf_size then 368 @<Report overflow of the input buffer, and abort@>; 369 end; 370 buffer[last]:=xord[f^]; get(f); incr(last); 371 if buffer[last-1]<>" " then last_nonblank:=last; 372 end; 373 last:=last_nonblank; input_ln:=true; 374 end; 375end; 376@y 377We define |input_ln| in C, for efficiency. Nevertheless we quote the module 378`Report overflow of the input buffer, and abort' here in order to make 379\.{WEAVE} happy. 380 381@p @{ @<Report overflow of the input buffer, and abort@> @} 382@z 383 384@x [3.31] `term_in' and `term_out' are standard input and output. 385@<Glob...@>= 386@!term_in:alpha_file; {the terminal as an input file} 387@!term_out:alpha_file; {the terminal as an output file} 388@y 389@d term_in==stdin {the terminal as an input file} 390@d term_out==stdout {the terminal as an output file} 391@z 392 393@x [3.32] We don't need to open the terminal files. 394@ Here is how to open the terminal files 395in \ph. The `\.{/I}' switch suppresses the first |get|. 396@:PASCAL H}{\ph@> 397@^system dependencies@> 398 399@d t_open_in==reset(term_in,'TTY:','/O/I') {open the terminal for text input} 400@d t_open_out==rewrite(term_out,'TTY:','/O') 401 {open the terminal for text output} 402@y 403@ Here is how to open the terminal files. |t_open_out| does nothing. 404|t_open_in|, on the other hand, does the work of ``rescanning,'' or getting 405any command line arguments the user has provided. It's defined in C. 406 407@d t_open_out == {output already open for text output} 408@z 409 410@x [3.33] Flushing output. 411these operations can be specified in \ph: 412@:PASCAL H}{\ph@> 413@^system dependencies@> 414 415@d update_terminal == break(term_out) {empty the terminal output buffer} 416@d clear_terminal == break_in(term_in,true) {clear the terminal input buffer} 417@y 418these operations can be specified with {\mc UNIX}. |update_terminal| 419does an |fflush|. |clear_terminal| is redefined 420to do nothing, since the user should control the terminal. 421@^system dependencies@> 422 423@d update_terminal == fflush(term_out) 424@d clear_terminal == do_nothing 425@z 426 427@x [3.36] Reading the command line. 428@ The following program does the required initialization 429without retrieving a possible command line. 430It should be clear how to modify this routine to deal with command lines, 431if the system permits them. 432@^system dependencies@> 433 434@p function init_terminal:boolean; {gets the terminal input started} 435label exit; 436begin t_open_in; 437loop@+begin wake_up_terminal; write(term_out,'**'); update_terminal; 438@.**@> 439 if not input_ln(term_in,true) then {this shouldn't happen} 440 begin write_ln(term_out); 441 write(term_out,'! End of file on the terminal... why?'); 442@.End of file on the terminal@> 443 init_terminal:=false; return; 444 end; 445 loc:=first; 446 while (loc<last)and(buffer[loc]=" ") do incr(loc); 447 if loc<last then 448 begin init_terminal:=true; 449 return; {return unless the line was all blank} 450 end; 451 write_ln(term_out,'Please type the name of your input file.'); 452 end; 453exit:end; 454@y 455@ The following program does the required initialization. 456Iff anything has been specified on the command line, then |t_open_in| 457will return with |last > first|. 458@^system dependencies@> 459 460@p 461function init_terminal:boolean; {gets the terminal input started} 462label exit; 463begin 464 t_open_in; 465 if last > first then begin 466 loc := first; 467 while (loc < last) and (buffer[loc]=' ') do 468 incr(loc); 469 if loc < last then begin 470 init_terminal := true; 471 goto exit; 472 end; 473 end; 474 loop@+begin 475 wake_up_terminal; write(term_out, '**'); update_terminal; 476@.**@> 477 if not input_ln(term_in,true) then begin {this shouldn't happen} 478 write_ln(term_out); 479 write_ln(term_out, '! End of file on the terminal... why?'); 480@.End of file on the terminal@> 481 init_terminal:=false; 482 return; 483 end; 484 485 loc:=first; 486 while (loc<last)and(buffer[loc]=" ") do 487 incr(loc); 488 489 if loc<last then begin 490 init_terminal:=true; 491 return; {return unless the line was all blank} 492 end; 493 write_ln(term_out, 'Please type the name of your input file.'); 494 end; 495exit: 496end; 497@z 498 499@x [4.49] l.1239 -- change documentation (probably needed in more places) 500would like string @'32 to be the single character @'32 instead of the 501@y 502would like string @'32 to be printed as the single character @'32 instead 503of the 504@z 505 506% [4.51] Open the pool file using a path, and can't do string 507% assignments directly. (`strcpy' and `strlen' work here because 508% `pool_name' is a constant string, and thus ends in a null and doesn't 509% start with a space.) 510@x 511name_of_file:=pool_name; {we needn't set |name_length|} 512if a_open_in(pool_file) then 513@y 514name_length := strlen (pool_name); 515name_of_file := xmalloc_array (ASCII_code, 1 + name_length); 516strcpy (stringcast(name_of_file+1), pool_name); {copy the string} 517if a_open_in (pool_file, kpse_mfpool_format) then 518@z 519 520@x [4.51,52,53] Make `MF.POOL' lowercase, and change how it's read. 521else bad_pool('! I can''t read MF.POOL.') 522@y 523else bad_pool('! I can''t read ', pool_name, '; bad path?') 524@z 525@x 526begin if eof(pool_file) then bad_pool('! MF.POOL has no check sum.'); 527@.MF.POOL has no check sum@> 528read(pool_file,m,n); {read two digits of string length} 529@y 530begin if eof(pool_file) then bad_pool('! ', pool_name, ' has no check sum.'); 531@.MF.POOL has no check sum@> 532read(pool_file,m); read(pool_file,n); {read two digits of string length} 533@z 534@x 535 bad_pool('! MF.POOL line doesn''t begin with two digits.'); 536@y 537 bad_pool('! ', pool_name, ' line doesn''t begin with two digits.'); 538@z 539@x 540 bad_pool('! MF.POOL check sum doesn''t have nine digits.'); 541@y 542 bad_pool('! ', pool_name, ' check sum doesn''t have nine digits.'); 543@z 544@x 545done: if a<>@$ then bad_pool('! MF.POOL doesn''t match; TANGLE me again.'); 546@y 547done: if a<>@$ then 548 bad_pool('! ', pool_name, ' doesn''t match; tangle me again (or fix the path).'); 549@z 550 551@x [5.54] error_line is a variable, so can't be a subrange array bound 552@!trick_buf:array[0..error_line] of ASCII_code; {circular buffer for 553@y 554@!trick_buf:array[0..ssup_error_line] of ASCII_code; {circular buffer for 555@z 556 557@x [5.58] Do not expand printable characters. 558if (s<256)and(selector>pseudo) then print_char(s) 559@y 560if (s<256)and((selector>pseudo)or xprn[s]) then print_char(s) 561@z 562 563@x [5.59] Do not expand printable characters. 564if (s<256)and(selector>pseudo) then print_char(s) 565@y 566if (s<256)and((selector>pseudo) or xprn[s])then print_char(s) 567@z 568 569@x [5.61] Print rest of banner. 570wterm(banner); 571if base_ident=0 then wterm_ln(' (no base preloaded)') 572else begin slow_print(base_ident); print_ln; 573 end; 574@y 575wterm (banner); 576wterm (version_string); 577if base_ident=0 then wterm_ln(' (preloaded base=',dump_name,')') 578else begin slow_print(base_ident); print_ln; 579 end; 580if translate_filename then begin 581 wterm('('); 582 fputs(translate_filename, stdout); 583 wterm_ln(')'); 584end; 585@z 586 587@x [6.68] l.1603 - Add unspecified_mode. 588@d error_stop_mode=3 {stops at every opportunity to interact} 589@y 590@d error_stop_mode=3 {stops at every opportunity to interact} 591@d unspecified_mode=4 {extra value for command-line switch} 592@z 593 594@x [6.68] l.1605 - file:line:error style messages. 595 print_nl("! "); print(#); 596@y 597 if (file_line_error_style_p and not terminal_input) then 598 begin 599 print_nl (""); 600 print (full_source_filename_stack[in_open]); 601 print (":"); print_int (line); print (": "); 602 print (#); 603 end 604 else begin print_nl("! "); print(#) end; 605@z 606 607@x [6.68] l.1610 - Add interaction_option. 608@!interaction:batch_mode..error_stop_mode; {current level of interaction} 609@y 610@!interaction:batch_mode..error_stop_mode; {current level of interaction} 611@!interaction_option:batch_mode..unspecified_mode; {set from command line} 612@z 613 614@x [6.69] l.1612 - Allow override by command line switch. 615@ @<Set init...@>=interaction:=error_stop_mode; 616@y 617@ @<Set init...@>=if interaction_option=unspecified_mode then 618 interaction:=error_stop_mode 619else 620 interaction:=interaction_option; 621@z 622 623@x [6.76] Eliminate non-local goto. 624@<Error hand...@>= 625procedure jump_out; 626begin goto end_of_MF; 627end; 628@y 629@d do_final_end==begin 630 update_terminal; 631 ready_already:=0; 632 if (history <> spotless) and (history <> warning_issued) then 633 uexit(1) 634 else 635 uexit(0); 636 end 637@<Error hand...@>= 638noreturn procedure jump_out; 639begin 640close_files_and_terminate; 641do_final_end; 642end; 643@z 644 645@x [6.77] l.1736 -- halt on error? 646print_char("."); show_context; 647@y 648print_char("."); show_context; 649if (halt_on_error_p) then begin 650 history:=fatal_error_stop; jump_out; 651end; 652@z 653 654@x [6.79] Handle the switch-to-editor option. 655line ready to be edited. But such an extension requires some system 656wizardry, so the present implementation simply types out the name of the 657file that should be 658edited and the relevant line number. 659@^system dependencies@> 660 661There is a secret `\.D' option available when the debugging routines haven't 662been commented~out. 663@^debugging@> 664@y 665line ready to be edited. 666We do this by calling the external procedure |call_edit| with a pointer to 667the filename, its length, and the line number. 668However, here we just set up the variables that will be used as arguments, 669since we don't want to do the switch-to-editor until after \MF\ has closed 670its files. 671@^system dependencies@> 672 673There is a secret `\.D' option available when the debugging routines have 674not been commented out. 675@^debugging@> 676@d edit_file==input_stack[file_ptr] 677@z 678@x 679"E": if file_ptr>0 then 680 begin print_nl("You want to edit file "); 681@.You want to edit file x@> 682 slow_print(input_stack[file_ptr].name_field); 683 print(" at line "); print_int(line);@/ 684 interaction:=scroll_mode; jump_out; 685@y 686"E": if file_ptr>0 then 687 begin 688 edit_name_start:=str_start[edit_file.name_field]; 689 edit_name_length:=str_start[edit_file.name_field+1] - 690 str_start[edit_file.name_field]; 691 edit_line:=line; 692 jump_out; 693@z 694 695@x [6.88] Declare fatal_error as noreturn. 696procedure fatal_error(@!s:str_number); {prints |s|, and that's it} 697@y 698noreturn procedure fatal_error(@!s:str_number); {prints |s|, and that's it} 699@z 700 701@x [6.89] Declare overflow as noreturn. 702procedure overflow(@!s:str_number;@!n:integer); {stop due to finiteness} 703@y 704noreturn procedure overflow(@!s:str_number;@!n:integer); {stop due to finiteness} 705@z 706 707@x [6.90] Declare confusion as noreturn. 708procedure confusion(@!s:str_number); 709@y 710noreturn procedure confusion(@!s:str_number); 711@z 712 713@x [7.96] Do half in cpascal.h. And add halfp as in MetaPost for speed. 714@d half(#)==(#) div 2 715@y 716@z 717 718@x [102] Use halfp. 719round_decimals:=half(a+1); 720@y 721round_decimals:=halfp(a+1); 722@z 723 724@x [7.107-7.115] Optionally replace make_fraction etc. with external routines 725@p function make_fraction(@!p,@!q:integer):fraction; 726@y 727In the C version, there are external routines that use double precision 728floating point to simulate functions such as |make_fraction|. This is 729carefully done to be virtually machine-independent and it gives up to 12 730times speed-up on machines with hardware floating point. Since some 731machines do not have fast double-precision floating point, we provide a 732C preprocessor switch that allows selecting the standard versions given 733below. (There's no configure option to select FIXPT, however, since I 734don't expect anyone will actually notice.) 735 736@p ifdef('FIXPT')@/ 737function make_fraction(@!p,@!q:integer):fraction; 738@z 739@x 740 if negative then make_fraction:=-(f+n)@+else make_fraction:=f+n; 741 end; 742end; 743@y 744 if negative then make_fraction:=-(f+n)@+else make_fraction:=f+n; 745 end; 746end;@/ 747endif('FIXPT') 748@z 749@x 750@p function take_fraction(@!q:integer;@!f:fraction):integer; 751@y 752@p ifdef('FIXPT')@/ 753function take_fraction(@!q:integer;@!f:fraction):integer; 754@z 755@x 756else take_fraction:=n+p; 757end; 758@y 759else take_fraction:=n+p; 760end;@/ 761endif('FIXPT') 762@z 763 764@x [111] 765@<Compute $p=\lfloor qf/2^{28}+{1\over2}\rfloor-q$@>= 766p:=fraction_half; {that's $2^{27}$; the invariants hold now with $k=28$} 767if q<fraction_four then 768 repeat if odd(f) then p:=half(p+q)@+else p:=half(p); 769 f:=half(f); 770 until f=1 771else repeat if odd(f) then p:=p+half(q-p)@+else p:=half(p); 772 f:=half(f); 773 until f=1 774@y 775@<Compute $p=\lfloor qf/2^{28}+{1\over2}\rfloor-q$@>= 776p:=fraction_half; {that's $2^{27}$; the invariants hold now with $k=28$} 777if q<fraction_four then 778 repeat if odd(f) then p:=halfp(p+q)@+else p:=halfp(p); 779 f:=halfp(f); 780 until f=1 781else repeat if odd(f) then p:=p+halfp(q-p)@+else p:=halfp(p); 782 f:=halfp(f); 783 until f=1 784@z 785 786@x 787@p function take_scaled(@!q:integer;@!f:scaled):integer; 788@y 789@p ifdef('FIXPT')@/ 790function take_scaled(@!q:integer;@!f:scaled):integer; 791@z 792@x 793else take_scaled:=n+p; 794end; 795@y 796else take_scaled:=n+p; 797end;@/ 798endif('FIXPT') 799@z 800 801@x [113] 802@ @<Compute $p=\lfloor qf/2^{16}+{1\over2}\rfloor-q$@>= 803p:=half_unit; {that's $2^{15}$; the invariants hold now with $k=16$} 804@^inner loop@> 805if q<fraction_four then 806 repeat if odd(f) then p:=half(p+q)@+else p:=half(p); 807 f:=half(f); 808 until f=1 809else repeat if odd(f) then p:=p+half(q-p)@+else p:=half(p); 810 f:=half(f); 811 until f=1 812@y 813@ @<Compute $p=\lfloor qf/2^{16}+{1\over2}\rfloor-q$@>= 814p:=half_unit; {that's $2^{15}$; the invariants hold now with $k=16$} 815@^inner loop@> 816if q<fraction_four then 817 repeat if odd(f) then p:=halfp(p+q)@+else p:=halfp(p); 818 f:=halfp(f); 819 until f=1 820else repeat if odd(f) then p:=p+halfp(q-p)@+else p:=halfp(p); 821 f:=halfp(f); 822 until f=1 823@z 824 825@x 826operands are positive. \ (This procedure is not used especially often, 827so it is not part of \MF's inner loop.) 828 829@p function make_scaled(@!p,@!q:integer):scaled; 830@y 831operands are positive. \ (This procedure is not used especially often, 832so it is not part of \MF's inner loop, but we might as well allow for 833an external C routine.) 834 835@p ifdef('FIXPT')@/ 836function make_scaled(@!p,@!q:integer):scaled; 837@z 838@x 839 if negative then make_scaled:=-(f+n)@+else make_scaled:=f+n; 840 end; 841end; 842@y 843 if negative then make_scaled:=-(f+n)@+else make_scaled:=f+n; 844 end; 845end;@/ 846endif('FIXPT') 847@z 848 849@x [7.119] Do floor_scaled, floor_unscaled, round_unscaled, round_fraction in C. 850@p function floor_scaled(@!x:scaled):scaled; 851 {$2^{16}\lfloor x/2^{16}\rfloor$} 852var @!be_careful:integer; {temporary register} 853begin if x>=0 then floor_scaled:=x-(x mod unity) 854else begin be_careful:=x+1; 855 floor_scaled:=x+((-be_careful) mod unity)+1-unity; 856 end; 857end; 858@# 859function floor_unscaled(@!x:scaled):integer; 860 {$\lfloor x/2^{16}\rfloor$} 861var @!be_careful:integer; {temporary register} 862begin if x>=0 then floor_unscaled:=x div unity 863else begin be_careful:=x+1; floor_unscaled:=-(1+((-be_careful) div unity)); 864 end; 865end; 866@# 867function round_unscaled(@!x:scaled):integer; 868 {$\lfloor x/2^{16}+.5\rfloor$} 869var @!be_careful:integer; {temporary register} 870begin if x>=half_unit then round_unscaled:=1+((x-half_unit) div unity) 871else if x>=-half_unit then round_unscaled:=0 872else begin be_careful:=x+1; 873 round_unscaled:=-(1+((-be_careful-half_unit) div unity)); 874 end; 875end; 876@# 877function round_fraction(@!x:fraction):scaled; 878 {$\lfloor x/2^{12}+.5\rfloor$} 879var @!be_careful:integer; {temporary register} 880begin if x>=2048 then round_fraction:=1+((x-2048) div 4096) 881else if x>=-2048 then round_fraction:=0 882else begin be_careful:=x+1; 883 round_fraction:=-(1+((-be_careful-2048) div 4096)); 884 end; 885end; 886@y 887@z 888 889@x [121] 890 square_rt:=half(q); 891@y 892 square_rt:=halfp(q); 893@z 894 895@x [126] 896@p function pyth_sub(@!a,@!b:integer):integer; 897label done; 898var @!r:fraction; {register used to transform |a| and |b|} 899@!big:boolean; {is the input dangerously near $2^{31}$?} 900begin a:=abs(a); b:=abs(b); 901if a<=b then @<Handle erroneous |pyth_sub| and set |a:=0|@> 902else begin if a<fraction_four then big:=false 903 else begin a:=half(a); b:=half(b); big:=true; 904 end; 905 @<Replace |a| by an approximation to $\psqrt{a^2-b^2}$@>; 906 if big then a:=a+a; 907 end; 908pyth_sub:=a; 909end; 910@y 911@p function pyth_sub(@!a,@!b:integer):integer; 912label done; 913var @!r:fraction; {register used to transform |a| and |b|} 914@!big:boolean; {is the input dangerously near $2^{31}$?} 915begin a:=abs(a); b:=abs(b); 916if a<=b then @<Handle erroneous |pyth_sub| and set |a:=0|@> 917else begin if a<fraction_four then big:=false 918 else begin a:=halfp(a); b:=halfp(b); big:=true; 919 end; 920 @<Replace |a| by an approximation to $\psqrt{a^2-b^2}$@>; 921 if big then a:=a+a; 922 end; 923pyth_sub:=a; 924end; 925@z 926 927@x [133] 928@ @<Increase |k| until |x| can...@>= 929begin z:=((x-1) div two_to_the[k])+1; {$z=\lceil x/2^k\rceil$} 930while x<fraction_four+z do 931 begin z:=half(z+1); k:=k+1; 932 end; 933y:=y+spec_log[k]; x:=x-z; 934end 935@y 936@ @<Increase |k| until |x| can...@>= 937begin z:=((x-1) div two_to_the[k])+1; {$z=\lceil x/2^k\rceil$} 938while x<fraction_four+z do 939 begin z:=halfp(z+1); k:=k+1; 940 end; 941y:=y+spec_log[k]; x:=x-z; 942end 943@z 944 945@x [142] 946@<Set variable |z| to the arg...@>= 947while x>=fraction_two do 948 begin x:=half(x); y:=half(y); 949 end; 950z:=0; 951if y>0 then 952 begin while x<fraction_one do 953 begin double(x); double(y); 954 end; 955 @<Increase |z| to the arg of $(x,y)$@>; 956 end 957@y 958@<Set variable |z| to the arg...@>= 959while x>=fraction_two do 960 begin x:=halfp(x); y:=halfp(y); 961 end; 962z:=0; 963if y>0 then 964 begin while x<fraction_one do 965 begin double(x); double(y); 966 end; 967 @<Increase |z| to the arg of $(x,y)$@>; 968 end 969@z 970 971@x [150] 972@p procedure init_randoms(@!seed:scaled); 973var @!j,@!jj,@!k:fraction; {more or less random integers} 974@!i:0..54; {index into |randoms|} 975begin j:=abs(seed); 976while j>=fraction_one do j:=half(j); 977k:=1; 978for i:=0 to 54 do 979 begin jj:=k; k:=j-k; j:=jj; 980 if k<0 then k:=k+fraction_one; 981 randoms[(i*21)mod 55]:=j; 982 end; 983new_randoms; new_randoms; new_randoms; {``warm up'' the array} 984end; 985@y 986@p procedure init_randoms(@!seed:scaled); 987var @!j,@!jj,@!k:fraction; {more or less random integers} 988@!i:0..54; {index into |randoms|} 989begin j:=abs(seed); 990while j>=fraction_one do j:=halfp(j); 991k:=1; 992for i:=0 to 54 do 993 begin jj:=k; k:=j-k; j:=jj; 994 if k<0 then k:=k+fraction_one; 995 randoms[(i*21)mod 55]:=j; 996 end; 997new_randoms; new_randoms; new_randoms; {``warm up'' the array} 998end; 999@z 1000 1001@x [9.153] Increase memory size. 1002@d min_quarterword=0 {smallest allowable value in a |quarterword|} 1003@d max_quarterword=255 {largest allowable value in a |quarterword|} 1004@d min_halfword==0 {smallest allowable value in a |halfword|} 1005@d max_halfword==65535 {largest allowable value in a |halfword|} 1006@y 1007@d min_quarterword=0 {smallest allowable value in a |quarterword|} 1008@d max_quarterword=255 {largest allowable value in a |quarterword|} 1009@d min_halfword==0 {smallest allowable value in a |halfword|} 1010@d max_halfword==@"FFFFFFF {largest allowable value in a |halfword|} 1011@z 1012 1013@x [9.155] Don't bother to subtract zero. 1014@d ho(#)==#-min_halfword 1015 {to take a sixteen-bit item from a halfword} 1016@d qo(#)==#-min_quarterword {to read eight bits from a quarterword} 1017@d qi(#)==#+min_quarterword {to store eight bits in a quarterword} 1018@y 1019@d ho(#)==# 1020@d qo(#)==# 1021@d qi(#)==# 1022@z 1023 1024@x [9.156] memory_word is defined externally. 1025@!two_halves = packed record@;@/ 1026 @!rh:halfword; 1027 case two_choices of 1028 1: (@!lh:halfword); 1029 2: (@!b0:quarterword; @!b1:quarterword); 1030 end; 1031@!four_quarters = packed record@;@/ 1032 @!b0:quarterword; 1033 @!b1:quarterword; 1034 @!b2:quarterword; 1035 @!b3:quarterword; 1036 end; 1037@!memory_word = record@;@/ 1038 case three_choices of 1039 1: (@!int:integer); 1040 2: (@!hh:two_halves); 1041 3: (@!qqqq:four_quarters); 1042 end; 1043@y 1044@=#include "texmfmem.h";@> 1045@z 1046 1047@x [10.159] mem is dynamically allocated. 1048@!mem : array[mem_min..mem_max] of memory_word; {the big dynamic storage area} 1049@y 1050@!mem : ^memory_word; {the big dynamic storage area} 1051@z 1052 1053% [11.178] Change the word `free' so that it doesn't conflict with the 1054% standard C library routine of the same name. Also change arrays that 1055% use mem_max, since that's a variable now, effectively disabling the feature. 1056@x 1057are debugging.) 1058 1059@<Glob...@>= 1060@!debug @!free: packed array [mem_min..mem_max] of boolean; {free cells} 1061@t\hskip1em@>@!was_free: packed array [mem_min..mem_max] of boolean; 1062@y 1063are debugging.) 1064 1065@d free==free_arr 1066@<Glob...@>= 1067@!debug @!free: packed array [0..1] of boolean; {free cells; this loses} 1068@t\hskip1em@>@!was_free: packed array [0..1] of boolean; {this loses too} 1069@z 1070 1071@x [11.182] Eliminate unsigned comparisons to zero. 1072repeat if (p>=lo_mem_max)or(p<mem_min) then clobbered:=true 1073 else if (rlink(p)>=lo_mem_max)or(rlink(p)<mem_min) then clobbered:=true 1074@y 1075repeat if (p>=lo_mem_max) then clobbered:=true 1076 else if (rlink(p)>=lo_mem_max) then clobbered:=true 1077@z 1078 1079@x [12.194] Do `fix_date_and_time' in C. 1080@ The following procedure, which is called just before \MF\ initializes its 1081input and output, establishes the initial values of the date and time. 1082@^system dependencies@> 1083Since standard \PASCAL\ cannot provide such information, something special 1084is needed. The program here simply specifies July 4, 1776, at noon; but 1085users probably want a better approximation to the truth. 1086 1087Note that the values are |scaled| integers. Hence \MF\ can no longer 1088be used after the year 32767. 1089 1090@p procedure fix_date_and_time; 1091begin internal[time]:=12*60*unity; {minutes since midnight} 1092internal[day]:=4*unity; {fourth day of the month} 1093internal[month]:=7*unity; {seventh month of the year} 1094internal[year]:=1776*unity; {Anno Domini} 1095end; 1096@y 1097@ The following procedure, which is called just before \MF\ initializes its 1098input and output, establishes the initial values of the date and time. 1099It is calls an externally defined |date_and_time|, even though it could 1100be done from Pascal. 1101The external procedure also sets up interrupt catching. 1102@^system dependencies@> 1103 1104Note that the values are |scaled| integers. Hence \MF\ can no longer 1105be used after the year 32767. 1106 1107@p procedure fix_date_and_time; 1108begin 1109 date_and_time(internal[time],internal[day],internal[month],internal[year]); 1110 internal[time] := internal[time] * unity; 1111 internal[day] := internal[day] * unity; 1112 internal[month] := internal[month] * unity; 1113 internal[year] := internal[year] * unity; 1114end; 1115@z 1116 1117@x [12.198] Change class to c_class to avoid C++ keyword. 1118@d max_class=20 {the largest class number} 1119@y 1120@d max_class=20 {the largest class number} 1121@d class==c_class 1122@z 1123 1124@x [12.199] Allow tab and form feed as input. 1125for k:=127 to 255 do char_class[k]:=invalid_class; 1126@y 1127for k:=127 to 255 do char_class[k]:=invalid_class; 1128char_class[tab]:=space_class; 1129char_class[form_feed]:=space_class; 1130@z 1131 1132@x [232] Use halfp. 1133@p procedure init_big_node(@!p:pointer); 1134var @!q:pointer; {the new node} 1135@!s:small_number; {its size} 1136begin s:=big_node_size[type(p)]; q:=get_node(s); 1137repeat s:=s-2; @<Make variable |q+s| newly independent@>; 1138name_type(q+s):=half(s)+x_part_sector; link(q+s):=null; 1139until s=0; 1140link(q):=p; value(p):=q; 1141end; 1142@y 1143@p procedure init_big_node(@!p:pointer); 1144var @!q:pointer; {the new node} 1145@!s:small_number; {its size} 1146begin s:=big_node_size[type(p)]; q:=get_node(s); 1147repeat s:=s-2; @<Make variable |q+s| newly independent@>; 1148name_type(q+s):=halfp(s)+x_part_sector; link(q+s):=null; 1149until s=0; 1150link(q):=p; value(p):=q; 1151end; 1152@z 1153 1154 [20.329] |valid_range| uses |abs|, which we have defined as a C 1155% macro. Some C preprocessors cannot expand the giant argument here. 1156% So we add a temporary. 1157@x 1158@p procedure edge_prep(@!ml,@!mr,@!nl,@!nr:integer); 1159var @!delta:halfword; {amount of change} 1160@y 1161@p procedure edge_prep(@!ml,@!mr,@!nl,@!nr:integer); 1162var @!delta:halfword; {amount of change} 1163temp:integer; 1164@z 1165 1166@x 1167if not valid_range(m_min(cur_edges)+m_offset(cur_edges)-zero_field) or@| 1168 not valid_range(m_max(cur_edges)+m_offset(cur_edges)-zero_field) then 1169@y 1170temp := m_offset (cur_edges) - zero_field; 1171if not valid_range (m_min (cur_edges) + temp) 1172 or not valid_range (m_max (cur_edges) + temp) 1173then 1174@z 1175 1176@x [442] Use halfp. 1177@<Compute a good coordinate at a diagonal transition@>= 1178begin if cur_pen=null_pen then pen_edge:=0 1179else if cur_path_type=double_path_code then @<Compute a compromise |pen_edge|@> 1180else if right_type(q)<=switch_x_and_y then pen_edge:=diag_offset(right_type(q)) 1181else pen_edge:=-diag_offset(right_type(q)); 1182if odd(right_type(q)) then a:=good_val(b,pen_edge+half(cur_gran)) 1183else a:=good_val(b-1,pen_edge+half(cur_gran)); 1184end 1185@y 1186@<Compute a good coordinate at a diagonal transition@>= 1187begin if cur_pen=null_pen then pen_edge:=0 1188else if cur_path_type=double_path_code then @<Compute a compromise |pen_edge|@> 1189else if right_type(q)<=switch_x_and_y then pen_edge:=diag_offset(right_type(q)) 1190else pen_edge:=-diag_offset(right_type(q)); 1191if odd(right_type(q)) then a:=good_val(b,pen_edge+halfp(cur_gran)) 1192else a:=good_val(b-1,pen_edge+halfp(cur_gran)); 1193end 1194@z 1195 1196@x [24.509] i18n fix 1197print(" ("); print_int(info(h)); print(" offset"); 1198if info(h)<>1 then print_char("s"); 1199@y 1200print(" ("); print_int(info(h)); 1201if info(h)<>1 then print(" offsets") 1202else print(" offset"); 1203@z 1204 1205% [25.530] |make_fraction| and |take_fraction| arguments are too long for 1206% some preprocessors, when they were defined as macros, just as in the 1207% previous change. 1208@x 1209 alpha:=take_fraction(take_fraction(major_axis, 1210 make_fraction(gamma,beta)),n_cos)@| 1211 -take_fraction(take_fraction(minor_axis, 1212 make_fraction(delta,beta)),n_sin); 1213 alpha:=(alpha+half_unit) div unity; 1214 gamma:=pyth_add(take_fraction(major_axis,n_cos), 1215 take_fraction(minor_axis,n_sin)); 1216@y 1217 alpha := make_fraction (gamma, beta); 1218 alpha := take_fraction (major_axis, alpha); 1219 alpha := take_fraction (alpha, n_cos); 1220 alpha := (alpha+half_unit) div unity; 1221 gamma := take_fraction (minor_axis, n_sin); 1222 gamma := pyth_add (take_fraction (major_axis, n_cos), gamma); 1223@z 1224 1225@x [556] 1226@p procedure cubic_intersection(@!p,@!pp:pointer); 1227label continue, not_found, exit; 1228var @!q,@!qq:pointer; {|link(p)|, |link(pp)|} 1229begin time_to_go:=max_patience; max_t:=2; 1230@<Initialize for intersections at level zero@>; 1231loop@+ begin continue: 1232 if delx-tol<=stack_max(x_packet(xy))-stack_min(u_packet(uv)) then 1233 if delx+tol>=stack_min(x_packet(xy))-stack_max(u_packet(uv)) then 1234 if dely-tol<=stack_max(y_packet(xy))-stack_min(v_packet(uv)) then 1235 if dely+tol>=stack_min(y_packet(xy))-stack_max(v_packet(uv)) then 1236 begin if cur_t>=max_t then 1237 begin if max_t=two then {we've done 17 bisections} 1238 begin cur_t:=half(cur_t+1); cur_tt:=half(cur_tt+1); return; 1239 end; 1240 double(max_t); appr_t:=cur_t; appr_tt:=cur_tt; 1241 end; 1242 @<Subdivide for a new level of intersection@>; 1243 goto continue; 1244 end; 1245 if time_to_go>0 then decr(time_to_go) 1246 else begin while appr_t<unity do 1247 begin double(appr_t); double(appr_tt); 1248 end; 1249 cur_t:=appr_t; cur_tt:=appr_tt; return; 1250 end; 1251 @<Advance to the next pair |(cur_t,cur_tt)|@>; 1252 end; 1253exit:end; 1254@y 1255@p procedure cubic_intersection(@!p,@!pp:pointer); 1256label continue, not_found, exit; 1257var @!q,@!qq:pointer; {|link(p)|, |link(pp)|} 1258begin time_to_go:=max_patience; max_t:=2; 1259@<Initialize for intersections at level zero@>; 1260loop@+ begin continue: 1261 if delx-tol<=stack_max(x_packet(xy))-stack_min(u_packet(uv)) then 1262 if delx+tol>=stack_min(x_packet(xy))-stack_max(u_packet(uv)) then 1263 if dely-tol<=stack_max(y_packet(xy))-stack_min(v_packet(uv)) then 1264 if dely+tol>=stack_min(y_packet(xy))-stack_max(v_packet(uv)) then 1265 begin if cur_t>=max_t then 1266 begin if max_t=two then {we've done 17 bisections} 1267 begin cur_t:=halfp(cur_t+1); cur_tt:=halfp(cur_tt+1); return; 1268 end; 1269 double(max_t); appr_t:=cur_t; appr_tt:=cur_tt; 1270 end; 1271 @<Subdivide for a new level of intersection@>; 1272 goto continue; 1273 end; 1274 if time_to_go>0 then decr(time_to_go) 1275 else begin while appr_t<unity do 1276 begin double(appr_t); double(appr_tt); 1277 end; 1278 cur_t:=appr_t; cur_tt:=appr_tt; return; 1279 end; 1280 @<Advance to the next pair |(cur_t,cur_tt)|@>; 1281 end; 1282exit:end; 1283@z 1284 1285@x [561] 1286@ @<Descend to the previous level...@>= 1287begin cur_t:=half(cur_t); cur_tt:=half(cur_tt); 1288if cur_t=0 then return; 1289bisect_ptr:=bisect_ptr-int_increment; three_l:=three_l-tol_step; 1290delx:=stack_dx; dely:=stack_dy; tol:=stack_tol; uv:=stack_uv; xy:=stack_xy;@/ 1291goto not_found; 1292end 1293@y 1294@ @<Descend to the previous level...@>= 1295begin cur_t:=halfp(cur_t); cur_tt:=halfp(cur_tt); 1296if cur_t=0 then return; 1297bisect_ptr:=bisect_ptr-int_increment; three_l:=three_l-tol_step; 1298delx:=stack_dx; dely:=stack_dy; tol:=stack_tol; uv:=stack_uv; xy:=stack_xy;@/ 1299goto not_found; 1300end 1301@z 1302 1303@x [27.564] The window functions are defined externally, in C. 1304@p function init_screen:boolean; 1305begin init_screen:=false; 1306end; 1307@# 1308procedure update_screen; {will be called only if |init_screen| returns |true|} 1309begin @!init wlog_ln('Calling UPDATESCREEN');@+tini {for testing only} 1310end; 1311@y 1312{These functions/procedures are defined externally in C.} 1313@z 1314 1315@x [27.565] screen_row, screen_col are variables, so can't be subrange array bounds. 1316@!screen_row=0..screen_depth; {a row number on the screen} 1317@!screen_col=0..screen_width; {a column number on the screen} 1318@!trans_spec=array[screen_col] of screen_col; {a transition spec, see below} 1319@y 1320@!screen_row=0..ssup_screen_depth; {a row number on the screen} 1321@!screen_col=0..ssup_screen_width; {a column number on the screen} 1322@!trans_spec=^screen_col; {a transition spec, see below} 1323@z 1324 1325@x [27.567] 1326@p procedure blank_rectangle(@!left_col,@!right_col:screen_col; 1327 @!top_row,@!bot_row:screen_row); 1328var @!r:screen_row; 1329@!c:screen_col; 1330begin @{@+for r:=top_row to bot_row-1 do 1331 for c:=left_col to right_col-1 do 1332 screen_pixel[r,c]:=white;@+@}@/ 1333@!init wlog_cr; {this will be done only after |init_screen=true|} 1334wlog_ln('Calling BLANKRECTANGLE(',left_col:1,',', 1335 right_col:1,',',top_row:1,',',bot_row:1,')');@+tini 1336end; 1337@y 1338{Same thing.} 1339@z 1340 1341@x [27.568] 1342@p procedure paint_row(@!r:screen_row;@!b:pixel_color;var @!a:trans_spec; 1343 @!n:screen_col); 1344var @!k:screen_col; {an index into |a|} 1345@!c:screen_col; {an index into |screen_pixel|} 1346begin @{ k:=0; c:=a[0]; 1347repeat incr(k); 1348 repeat screen_pixel[r,c]:=b; incr(c); 1349 until c=a[k]; 1350 b:=black-b; {$|black|\swap|white|$} 1351 until k=n;@+@}@/ 1352@!init wlog('Calling PAINTROW(',r:1,',',b:1,';'); 1353 {this is done only after |init_screen=true|} 1354for k:=0 to n do 1355 begin wlog(a[k]:1); if k<>n then wlog(','); 1356 end; 1357wlog_ln(')');@+tini 1358end; 1359@y 1360{Same thing} 1361@z 1362 1363@x [596] Use halfp. 1364@ @<Contribute a term from |q|, multiplied by~|f|@>= 1365begin if tt=dependent then v:=take_fraction(f,value(q)) 1366else v:=take_scaled(f,value(q)); 1367if abs(v)>half(threshold) then 1368 begin s:=get_node(dep_node_size); info(s):=qq; value(s):=v; 1369 if abs(v)>=coef_bound then if watch_coefs then 1370 begin type(qq):=independent_needing_fix; fix_needed:=true; 1371 end; 1372 link(r):=s; r:=s; 1373 end; 1374q:=link(q); qq:=info(q); 1375end 1376@y 1377@ @<Contribute a term from |q|, multiplied by~|f|@>= 1378begin if tt=dependent then v:=take_fraction(f,value(q)) 1379else v:=take_scaled(f,value(q)); 1380if abs(v)>halfp(threshold) then 1381 begin s:=get_node(dep_node_size); info(s):=qq; value(s):=v; 1382 if abs(v)>=coef_bound then if watch_coefs then 1383 begin type(qq):=independent_needing_fix; fix_needed:=true; 1384 end; 1385 link(r):=s; r:=s; 1386 end; 1387q:=link(q); qq:=info(q); 1388end 1389@z 1390 1391@x [31.631] l.13346 - Add datastructures for file:line:error. 1392@!line_stack : array[1..max_in_open] of integer; 1393@y 1394@!line_stack : array[1..max_in_open] of integer; 1395@!source_filename_stack : ^str_number; 1396@!full_source_filename_stack : ^str_number; 1397@z 1398 1399@x [38.768] Area and extension rules. 1400@ The file names we shall deal with for illustrative purposes have the 1401following structure: If the name contains `\.>' or `\.:', the file area 1402consists of all characters up to and including the final such character; 1403otherwise the file area is null. If the remaining file name contains 1404`\..', the file extension consists of all such characters from the first 1405remaining `\..' to the end, otherwise the file extension is null. 1406@^system dependencies@> 1407 1408We can scan such file names easily by using two global variables that keep track 1409of the occurrences of area and extension delimiters: 1410 1411@<Glob...@>= 1412@!area_delimiter:pool_pointer; {the most recent `\.>' or `\.:', if any} 1413@!ext_delimiter:pool_pointer; {the relevant `\..', if any} 1414@y 1415@ The file names we shall deal with for illustrative purposes have the 1416following structure: If the name contains `\./', the file area 1417consists of all characters up to and including the final such character; 1418otherwise the file area is null. If the remaining file name contains 1419`\..', the file extension consists of all such characters from the first 1420remaining `\..' to the end, otherwise the file extension is null. 1421@^system dependencies@> 1422 1423We can scan such file names easily by using two global variables that keep 1424track of the occurrences of area and extension delimiters: 1425 1426@<Glob...@>= 1427@!area_delimiter:pool_pointer; {the most recent `\./', if any} 1428@!ext_delimiter:pool_pointer; {the most recent `\..', if any} 1429@z 1430 1431@x [38.769] MF area directories. 1432@d MF_area=="MFinputs:" 1433@.MFinputs@> 1434@y 1435In C, the default paths are specified separately. 1436@z 1437 1438@x [38.770] filenames: quoted 1439begin area_delimiter:=0; ext_delimiter:=0; 1440@y 1441begin area_delimiter:=0; ext_delimiter:=0; quoted_filename:=false; 1442@z 1443 1444@x [38.771] more_name 1445begin if c=" " then more_name:=false 1446else begin if (c=">")or(c=":") then 1447@y 1448begin 1449if c="""" then begin 1450 quoted_filename:=not quoted_filename; 1451 more_name:=true; 1452 end 1453else if ((c=" ")or(c=tab)) and stop_at_space and (not quoted_filename) then 1454 more_name:=false 1455else begin 1456 if IS_DIR_SEP (c) then 1457@z 1458 1459@x [38.771] more_name 1460 else if (c=".")and(ext_delimiter=0) then ext_delimiter:=pool_ptr; 1461@y 1462 else if c="." then ext_delimiter:=pool_ptr; 1463@z 1464 1465@x [38.772] end_name: quote if spaces in names. 1466@p procedure end_name; 1467@y 1468@d pool_seq_check(#) == {set |s:=str_start[str_ptr]| and |t:=#|, 1469 then check if sequence of pool bytes |s<=j<t| needs quoting} 1470 must_quote:=false; 1471 s:=str_start[str_ptr]; 1472 t:=#; 1473 j:=s; 1474 while (not must_quote) and (j<t) do begin 1475 must_quote:=str_pool[j]=" "; incr(j); 1476 end 1477@d pool_seq_quote_move == {quote sequence of pool bytes |s<=j<t|, 1478 first moving up pool bytes |t<=j<pool_ptr|} 1479 for j:=pool_ptr-1 downto t do str_pool[j+2]:=str_pool[j]; 1480 pool_seq_quote 1481@d pool_seq_quote == {quote sequence of pool bytes |s<=j<t|} 1482 str_pool[t+1]:=""""; 1483 for j:=t-1 downto s do str_pool[j+1]:=str_pool[j]; 1484 str_pool[s]:=""""; 1485 pool_ptr:=pool_ptr+2 1486 1487@p procedure end_name; 1488var must_quote:boolean; {whether we need to quote a string} 1489@!j,@!s,@!t: pool_pointer; {running indices} 1490@z 1491 1492@x [38.772] end_name: quote if spaces in names. 1493if area_delimiter=0 then cur_area:="" 1494else begin cur_area:=str_ptr; incr(str_ptr); 1495 str_start[str_ptr]:=area_delimiter+1; 1496 end; 1497if ext_delimiter=0 then 1498 begin cur_ext:=""; cur_name:=make_string; 1499 end 1500else begin cur_name:=str_ptr; incr(str_ptr); 1501 str_start[str_ptr]:=ext_delimiter; cur_ext:=make_string; 1502 end; 1503@y 1504str_room(6); {room for quotes, if they are needed} 1505if area_delimiter=0 then cur_area:="" 1506else begin {maybe quote |cur_area|} 1507 pool_seq_check(area_delimiter+1); 1508 if must_quote then begin 1509 pool_seq_quote_move; 1510 area_delimiter:=area_delimiter+2; 1511 if ext_delimiter<>0 then ext_delimiter:=ext_delimiter+2; 1512 end; 1513 cur_area:=str_ptr; incr(str_ptr); 1514 str_start[str_ptr]:=area_delimiter+1; 1515 end; 1516if ext_delimiter=0 then cur_ext:="" 1517else begin {maybe quote |cur_name| followed by |cur_ext|} 1518 pool_seq_check(ext_delimiter); 1519 if must_quote then begin 1520 pool_seq_quote_move; 1521 ext_delimiter:=ext_delimiter+2; 1522 end; 1523 cur_name:=str_ptr; incr(str_ptr); 1524 str_start[str_ptr]:=ext_delimiter; 1525 end; 1526{maybe quote |cur_ext| if present or |cur_name| otherwise} 1527pool_seq_check(pool_ptr); 1528if must_quote then begin 1529 pool_seq_quote; 1530 end; 1531if ext_delimiter=0 then cur_name:=make_string 1532else cur_ext:=make_string; 1533@z 1534 1535@x [38.773] print_file_name: quote if spaces in names. 1536@<Basic printing...@>= 1537procedure print_file_name(@!n,@!a,@!e:integer); 1538begin slow_print(a); slow_print(n); slow_print(e); 1539@y 1540@d string_check(#) == {check if string |#| needs quoting} 1541 if #<>0 then begin 1542 j:=str_start[#]; 1543 while (not must_quote) and (j<str_start[#+1]) do begin 1544 must_quote:=str_pool[j]=" "; incr(j); 1545 end; 1546 end 1547@d print_quoted(#) == {print string |#|, omitting quotes} 1548 if #<>0 then 1549 for j:=str_start[#] to str_start[#+1]-1 do 1550 if so(str_pool[j])<>"""" then 1551 print(so(str_pool[j])) 1552 1553@<Basic printing...@>= 1554procedure print_file_name(@!n,@!a,@!e:integer); 1555var must_quote: boolean; {whether to quote the filename} 1556@!j:pool_pointer; {index into |str_pool|} 1557begin 1558must_quote:=false; 1559string_check(a); string_check(n); string_check(e); 1560if must_quote then slow_print(""""); 1561print_quoted(a); print_quoted(n); print_quoted(e); 1562if must_quote then slow_print(""""); 1563@z 1564 1565@x [38.774] have append_to_name skip quotes. 1566@d append_to_name(#)==begin c:=#; incr(k); 1567 if k<=file_name_size then name_of_file[k]:=xchr[c]; 1568 end 1569@y 1570@d append_to_name(#)==begin c:=#; if not (c="""") then begin incr(k); 1571 if k<=file_name_size then name_of_file[k]:=xchr[c]; 1572 end end 1573@z 1574 1575@x [38.774] (pack_file_name) malloc and null terminate name_of_file. 1576for j:=str_start[a] to str_start[a+1]-1 do append_to_name(so(str_pool[j])); 1577@y 1578if name_of_file then libc_free (name_of_file); 1579name_of_file := xmalloc_array (ASCII_code, length(a)+length(n)+length(e)+1); 1580for j:=str_start[a] to str_start[a+1]-1 do append_to_name(so(str_pool[j])); 1581@z 1582@x 1583for k:=name_length+1 to file_name_size do name_of_file[k]:=' '; 1584@y 1585name_of_file[name_length + 1] := 0; 1586@z 1587 1588@x [38.775] The default base. 1589@d base_default_length=18 {length of the |MF_base_default| string} 1590@d base_area_length=8 {length of its area part} 1591@y 1592@d base_area_length=0 {no fixed area in C} 1593@z 1594 1595@x [38.776] Where `plain.base' is. 1596@!MF_base_default:packed array[1..base_default_length] of char; 1597 1598@ @<Set init...@>= 1599MF_base_default:='MFbases:plain.base'; 1600@y 1601@!base_default_length: integer; 1602@!MF_base_default: cstring; 1603 1604@ We set the name of the default format file and the length of that name 1605in \.{texmfmp.c}, since we want them to depend on the name of the 1606program. 1607@z 1608 1609@x [38.778] Change to pack_buffered_name as with pack_file_name. 1610for j:=1 to n do append_to_name(xord[MF_base_default[j]]); 1611for j:=a to b do append_to_name(buffer[j]); 1612for j:=base_default_length-base_ext_length+1 to base_default_length do 1613 append_to_name(xord[MF_base_default[j]]); 1614if k<=file_name_size then name_length:=k@+else name_length:=file_name_size; 1615for k:=name_length+1 to file_name_size do name_of_file[k]:=' '; 1616@y 1617if name_of_file then libc_free (name_of_file); 1618name_of_file := xmalloc_array (ASCII_code, n + (b-a+1) + base_ext_length + 1); 1619for j:=1 to n do append_to_name(xord[ucharcast(MF_base_default[j])]); 1620for j:=a to b do append_to_name(buffer[j]); 1621for j:=base_default_length-base_ext_length+1 to base_default_length do 1622 append_to_name(xord[ucharcast(MF_base_default[j])]); 1623if k<=file_name_size then name_length:=k@+else name_length:=file_name_size; 1624name_of_file[name_length + 1] := 0; 1625@z 1626 1627@x [38.779] Base file opening: do path searching for the default, not plain. 1628 pack_buffered_name(0,loc,j-1); {try first without the system file area} 1629 if w_open_in(base_file) then goto found; 1630 pack_buffered_name(base_area_length,loc,j-1); 1631 {now try the system base file area} 1632 if w_open_in(base_file) then goto found; 1633@y 1634 pack_buffered_name(0,loc,j-1); 1635 if w_open_in(base_file) then goto found; 1636@z 1637@x 1638 wterm_ln('Sorry, I can''t find that base;',' will try PLAIN.'); 1639@y 1640 wterm ('Sorry, I can''t find the base `'); 1641 fputs (stringcast(name_of_file + 1), stdout); 1642 wterm ('''; will try `'); 1643 fputs (MF_base_default + 1, stdout); 1644 wterm_ln ('''.'); 1645@z 1646@x 1647 wterm_ln('I can''t find the PLAIN base file!'); 1648@.I can't find PLAIN...@> 1649@y 1650 wterm ('I can''t find the base file `'); 1651 fputs (MF_base_default + 1, stdout); 1652 wterm_ln ('''!'); 1653@.I can't find the base...@> 1654@z 1655 1656@x [38.780] make_name_string 1657 make_name_string:=make_string; 1658 end; 1659@y 1660 make_name_string:=make_string; 1661 end; 1662 {At this point we also set |cur_name|, |cur_ext|, and |cur_area| to 1663 match the contents of |name_of_file|.} 1664 k:=1; 1665 begin_name; 1666 stop_at_space:=false; 1667 while (k<=name_length)and(more_name(name_of_file[k])) do 1668 incr(k); 1669 stop_at_space:=true; 1670 end_name; 1671@z 1672 1673@x [38.781] Make scan_file_name ignore leading tabs as well as spaces. 1674while buffer[loc]=" " do incr(loc); 1675@y 1676while (buffer[loc]=" ")or(buffer[loc]=tab) do incr(loc); 1677@z 1678 1679@x [38.782] `logname' is declared in <unistd.h> on some systems. 1680`\.{.base}' and `\.{.tfm}' in the names of \MF's output files. 1681@y 1682`\.{.base}' and `\.{.tfm}' in the names of \MF's output files. 1683@d log_name == texmf_log_name 1684@z 1685 1686@x [38.786] prompt_file_name: avoid empty filenames. 1687var @!k:0..buf_size; {index into |buffer|} 1688@y 1689var @!k:0..buf_size; {index into |buffer|} 1690@!saved_cur_name:str_number; {to catch empty terminal input} 1691@z 1692 1693@x [38.786] prompt_file_name: avoid empty filenames. 1694clear_terminal; prompt_input(": "); @<Scan file name in the buffer@>; 1695if cur_ext="" then cur_ext:=e; 1696@y 1697saved_cur_name:=cur_name; 1698clear_terminal; prompt_input(": "); @<Scan file name in the buffer@>; 1699if cur_ext="" then cur_ext:=e; 1700if length(cur_name)=0 then cur_name:=saved_cur_name; 1701@z 1702 1703@x [38.787] <Scan file name...> needs similar leading tab treatment. 1704while (buffer[k]=" ")and(k<last) do incr(k); 1705@y 1706while ((buffer[k]=" ")or(buffer[k]=tab))and(k<last) do incr(k); 1707@z 1708 1709@x [38.788] Adjust for C string conventions. 1710@!months:packed array [1..36] of char; {abbreviations of month names} 1711@y 1712@!months:const_cstring; 1713@z 1714 1715@x [38.788] Set correct filename for recorder. 1716if job_name=0 then job_name:="mfput"; 1717@.mfput@> 1718pack_job_name(".log"); 1719@y 1720if job_name=0 then job_name:=get_job_name("mfput"); 1721@.mfput@> 1722pack_job_name(".fls"); 1723recorder_change_filename(stringcast(name_of_file+1)); 1724pack_job_name(".log"); 1725@z 1726 1727@x [38.790] 1728begin wlog(banner); 1729slow_print(base_ident); print(" "); 1730print_int(round_unscaled(internal[day])); print_char(" "); 1731months:='JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'; 1732@y 1733begin wlog(banner); 1734wlog (version_string); 1735slow_print(base_ident); print(" "); 1736print_int(round_unscaled(internal[day])); print_char(" "); 1737months := ' JANFEBMARAPRMAYJUNJULAUGSEPOCTNOVDEC'; 1738@z 1739 1740@x [38.790] l.15898 - Print TCX name, if given. 1741end 1742@y 1743if translate_filename then begin 1744 wlog_cr; 1745 wlog('('); 1746 fputs(translate_filename, log_file); 1747 wlog(')'); 1748end; 1749end 1750@z 1751 1752@x [38.793] (start_input) a_open_in of input file needs path specifier. 1753begin @<Put the desired file name in |(cur_name,cur_ext,cur_area)|@>; 1754if cur_ext="" then cur_ext:=".mf"; 1755pack_cur_name; 1756loop@+ begin begin_file_reading; {set up |cur_file| and new level of input} 1757 if a_open_in(cur_file) then goto done; 1758 if cur_area="" then 1759 begin pack_file_name(cur_name,MF_area,cur_ext); 1760 if a_open_in(cur_file) then goto done; 1761 end; 1762@y Don't assume a single . in filenames. 1763begin @<Put the desired file name in |(cur_name,cur_ext,cur_area)|@>; 1764pack_cur_name; 1765loop@+begin 1766 begin_file_reading; {set up |cur_file| and new level of input} 1767 if cur_ext = ".mf" then begin 1768 cur_ext := ""; 1769 pack_cur_name; 1770 end; 1771 {Kpathsea tries all the various ways to get the file.} 1772 if kpse_in_name_ok(stringcast(name_of_file+1)) 1773 and a_open_in(cur_file, kpse_mf_format) then 1774 goto done; 1775@z 1776 1777@x [38.793] l.15938 - The job name may have been given on the command line. 1778 begin job_name:=cur_name; open_log_file; 1779@y 1780 begin job_name:=get_job_name(cur_name); open_log_file; 1781@z 1782 1783@x [38.793] Can't return name to string pool because of editor option? 1784if name=str_ptr-1 then {we can conserve string pool space now} 1785 begin flush_string(name); name:=cur_name; 1786 end; 1787@y 1788@z 1789 1790@x [866] Use halfp. 1791@<Change node |q|...@>= 1792begin tx:=x_coord(q); ty:=y_coord(q); 1793txx:=left_x(q)-tx; tyx:=left_y(q)-ty; 1794txy:=right_x(q)-tx; tyy:=right_y(q)-ty; 1795a_minus_b:=pyth_add(txx-tyy,tyx+txy); a_plus_b:=pyth_add(txx+tyy,tyx-txy); 1796major_axis:=half(a_minus_b+a_plus_b); minor_axis:=half(abs(a_plus_b-a_minus_b)); 1797if major_axis=minor_axis then theta:=0 {circle} 1798else theta:=half(n_arg(txx-tyy,tyx+txy)+n_arg(txx+tyy,tyx-txy)); 1799free_node(q,knot_node_size); 1800q:=make_ellipse(major_axis,minor_axis,theta); 1801if (tx<>0)or(ty<>0) then @<Shift the coordinates of path |q|@>; 1802end 1803@y 1804@<Change node |q|...@>= 1805begin tx:=x_coord(q); ty:=y_coord(q); 1806txx:=left_x(q)-tx; tyx:=left_y(q)-ty; 1807txy:=right_x(q)-tx; tyy:=right_y(q)-ty; 1808a_minus_b:=pyth_add(txx-tyy,tyx+txy); a_plus_b:=pyth_add(txx+tyy,tyx-txy); 1809major_axis:=halfp(a_minus_b+a_plus_b); minor_axis:=halfp(abs(a_plus_b-a_minus_b)); 1810if major_axis=minor_axis then theta:=0 {circle} 1811else theta:=half(n_arg(txx-tyy,tyx+txy)+n_arg(txx+tyy,tyx-txy)); 1812free_node(q,knot_node_size); 1813q:=make_ellipse(major_axis,minor_axis,theta); 1814if (tx<>0)or(ty<>0) then @<Shift the coordinates of path |q|@>; 1815end 1816@z 1817 1818@x [44.1023] if batchmode, MakeTeX... scripts should be silent. 1819mode_command: begin print_ln; interaction:=cur_mod; 1820@y 1821mode_command: begin print_ln; interaction:=cur_mod; 1822if interaction = batch_mode 1823then kpse_make_tex_discard_errors := 1 1824else kpse_make_tex_discard_errors := 0; 1825@z 1826 1827% [45.1120] `threshold' is both a function and a variable. Since the 1828% function is used much less often than the variable, we'll change that 1829@x 1830@p function threshold(@!m:integer):scaled; 1831var @!d:scaled; {lower bound on the smallest interval size} 1832begin excess:=min_cover(0)-m; 1833if excess<=0 then threshold:=0 1834else begin repeat d:=perturbation; 1835 until min_cover(d+d)<=m; 1836 while min_cover(d)>m do d:=perturbation; 1837 threshold:=d; 1838@y 1839@p function threshold_fn(@!m:integer):scaled; 1840var @!d:scaled; {lower bound on the smallest interval size} 1841begin excess:=min_cover(0)-m; 1842if excess<=0 then threshold_fn:=0 1843else begin repeat d:=perturbation; 1844 until min_cover(d+d)<=m; 1845 while min_cover(d)>m do d:=perturbation; 1846 threshold_fn:=d; 1847@z 1848 1849@x [45.1121] Change the call to the threshold function. 1850begin d:=threshold(m); perturbation:=0; 1851@y 1852begin d:=threshold_fn(m); perturbation:=0; 1853@z 1854 1855@x [1122] 1856@ @<Replace an interval...@>= 1857begin repeat p:=link(p); info(p):=m; 1858decr(excess);@+if excess=0 then d:=0; 1859until value(link(p))>l+d; 1860v:=l+half(value(p)-l); 1861if value(p)-v>perturbation then perturbation:=value(p)-v; 1862r:=q; 1863repeat r:=link(r); value(r):=v; 1864until r=p; 1865link(q):=p; {remove duplicate values from the current list} 1866end 1867@y 1868@ @<Replace an interval...@>= 1869begin repeat p:=link(p); info(p):=m; 1870decr(excess);@+if excess=0 then d:=0; 1871until value(link(p))>l+d; 1872v:=l+halfp(value(p)-l); 1873if value(p)-v>perturbation then perturbation:=value(p)-v; 1874r:=q; 1875repeat r:=link(r); value(r):=v; 1876until r=p; 1877link(q):=p; {remove duplicate values from the current list} 1878end 1879@z 1880 1881@x [45.1133] Use C macros to do the TFM writing, to avoid casting(?) problems. 1882@d tfm_out(#)==write(tfm_file,#) {output one byte to |tfm_file|} 1883 1884@p procedure tfm_two(@!x:integer); {output two bytes to |tfm_file|} 1885begin tfm_out(x div 256); tfm_out(x mod 256); 1886end; 1887@# 1888procedure tfm_four(@!x:integer); {output four bytes to |tfm_file|} 1889begin if x>=0 then tfm_out(x div three_bytes) 1890else begin x:=x+@'10000000000; {use two's complement for negative values} 1891 x:=x+@'10000000000; 1892 tfm_out((x div three_bytes) + 128); 1893 end; 1894x:=x mod three_bytes; tfm_out(x div unity); 1895x:=x mod unity; tfm_out(x div @'400); 1896tfm_out(x mod @'400); 1897end; 1898@# 1899procedure tfm_qqqq(@!x:four_quarters); {output four quarterwords to |tfm_file|} 1900@y 1901The default definitions for |tfm_two| and |tfm_four| don't work. 1902I don't know why not. Some casting problem? 1903 1904@d tfm_out(#) == put_byte (#, tfm_file) 1905@d tfm_two(#) == put_2_bytes (tfm_file, #) 1906@d tfm_four(#) == put_4_bytes (tfm_file, #) 1907 1908@p procedure tfm_qqqq(@!x:four_quarters); {output four quarterwords to |tfm_file|} 1909@z 1910 1911@x [47.1134] print_file_name 1912print_nl("Font metrics written on "); slow_print(metric_file_name); 1913@y 1914print_nl("Font metrics written on "); print_file_name(0,metric_file_name,0); 1915@z 1916 1917@x [47.1152] declare gf_buf as a pointer, for dynamic allocated 1918@!gf_buf:array[gf_index] of eight_bits; {buffer for \.{GF} output} 1919@y 1920@!gf_buf:^eight_bits; {dynamically-allocated buffer for \.{GF} output} 1921@z 1922 1923@x [47.1154] omit write_gf 1924@<Declare generic font output procedures@>= 1925procedure write_gf(@!a,@!b:gf_index); 1926var k:gf_index; 1927begin for k:=a to b do write(gf_file,gf_buf[k]); 1928end; 1929@y 1930In C, we use a macro to call |fwrite| or |write| directly, writing all 1931the bytes to be written in one shot. Much better than writing four 1932bytes at a time. 1933@z 1934 1935@x [47.1155] check gf file size 1936each time, we use the macro |gf_out|. 1937@y 1938each time, we use the macro |gf_out|. 1939 1940The length of |gf_file| should not exceed |@"7FFFFFFF|; we set 1941|gf_prev_ptr:=0| to prevent further \.{GF} output causing infinite 1942recursion. 1943@z 1944 1945@x [47.1155] gf_swap: check gf file size 1946begin if gf_limit=gf_buf_size then 1947@y 1948begin if gf_ptr>(@"7FFFFFFF-gf_offset) then 1949 begin gf_prev_ptr:=0; 1950 fatal_error("gf length exceeds ""7FFFFFFF"); 1951@.gf length exceeds...@> 1952 end; 1953if gf_limit=gf_buf_size then 1954@z 1955 1956@x [47.1156] empty the last bytes: check gf file size 1957if gf_ptr>0 then write_gf(0,gf_ptr-1) 1958@y 1959if gf_ptr>(@"7FFFFFFF-gf_offset) then 1960 begin gf_prev_ptr:=0; 1961 fatal_error("gf length exceeds ""7FFFFFFF"); 1962@.gf length exceeds...@> 1963 end; 1964if gf_ptr>0 then write_gf(0,gf_ptr-1) 1965@z 1966 1967@x [47.1163] C needs k to be 0..256 instead of 0..255. 1968procedure init_gf; 1969var @!k:eight_bits; {runs through all possible character codes} 1970@y 1971procedure init_gf; 1972var @!k:0..256; {runs through all possible character codes} 1973@z 1974 1975@x [47.1182] print_file_name 1976print_nl("Output written on "); slow_print(output_file_name); 1977@y 1978print_nl("Output written on "); print_file_name(0,output_file_name,0); 1979@z 1980 1981@x [47.1182] i18n fix 1982print(" ("); print_int(total_chars); print(" character"); 1983if total_chars<>1 then print_char("s"); 1984@y 1985print(" ("); print_int(total_chars); 1986if total_chars<>1 then print(" characters") 1987else print(" character"); 1988@z 1989 1990@x [48.1185] INI = VIR. 1991base_ident:=" (INIMF)"; 1992@y 1993if ini_version then base_ident:=" (INIMF)"; 1994@z 1995 1996@x [48.1186] Add base_engine. 1997@!w: four_quarters; {four ASCII codes} 1998@y 1999@!w: four_quarters; {four ASCII codes} 2000@!base_engine: ^text_char; 2001@z 2002 2003@x [48.1187] Add base_engine. 2004@!w: four_quarters; {four ASCII codes} 2005@y 2006@!w: four_quarters; {four ASCII codes} 2007@!base_engine: ^text_char; 2008@!dummy_xord: ASCII_code; 2009@!dummy_xchr: text_char; 2010@!dummy_xprn: ASCII_code; 2011@z 2012 2013@x [48.1188] Reading and writing of `base_file' is done in C. 2014@d dump_wd(#)==begin base_file^:=#; put(base_file);@+end 2015@d dump_int(#)==begin base_file^.int:=#; put(base_file);@+end 2016@d dump_hh(#)==begin base_file^.hh:=#; put(base_file);@+end 2017@d dump_qqqq(#)==begin base_file^.qqqq:=#; put(base_file);@+end 2018@y 2019@z 2020 2021@x [48.1189] 2022@d undump_wd(#)==begin get(base_file); #:=base_file^;@+end 2023@d undump_int(#)==begin get(base_file); #:=base_file^.int;@+end 2024@d undump_hh(#)==begin get(base_file); #:=base_file^.hh;@+end 2025@d undump_qqqq(#)==begin get(base_file); #:=base_file^.qqqq;@+end 2026@y 2027@z 2028 2029@x [48.1190] Dump engine name. 2030dump_int(@$);@/ 2031@y 2032dump_int(@"57324D46); {Web2C \MF's magic constant: "W2MF"} 2033{Align engine to 4 bytes with one or more trailing NUL} 2034x:=strlen(engine_name); 2035base_engine:=xmalloc_array(text_char,x+4); 2036strcpy(stringcast(base_engine), engine_name); 2037for k:=x to x+3 do base_engine[k]:=0; 2038x:=x+4-(x mod 4); 2039dump_int(x);dump_things(base_engine[0], x); 2040libc_free(base_engine);@/ 2041dump_int(@$);@/ 2042@<Dump |xord|, |xchr|, and |xprn|@>; 2043@z 2044 2045@x [48.1191] Avoid Pascal file convention. 2046x:=base_file^.int; 2047if x<>@$ then goto off_base; {check that strings are the same} 2048undump_int(x); 2049if x<>mem_min then goto off_base; 2050undump_int(x); 2051if x<>mem_top then goto off_base; 2052@y 2053undump_int(x); 2054if x<>@"57324D46 then goto off_base; {not a base file} 2055undump_int(x); 2056if (x<0) or (x>256) then goto off_base; {corrupted base file} 2057base_engine:=xmalloc_array(text_char, x); 2058undump_things(base_engine[0], x); 2059base_engine[x-1]:=0; {force string termination, just in case} 2060if strcmp(engine_name, stringcast(base_engine)) then 2061 begin wake_up_terminal; 2062 wterm_ln('---! ', stringcast(name_of_file+1), ' was written by ', stringcast(base_engine)); 2063 libc_free(base_engine); 2064 goto off_base; 2065end; 2066libc_free(base_engine); 2067undump_int(x); 2068if x<>@$ then begin {check that strings are the same} 2069 wake_up_terminal; 2070 wterm_ln('---! ', stringcast(name_of_file+1), ' doesn''t match ', pool_name); 2071 goto off_base; 2072end; 2073@<Undump |xord|, |xchr|, and |xprn|@>; 2074undump_int(x); 2075if x<>mem_min then goto off_base; 2076{Now we deal with dynamically allocating the memory. We don't provide 2077 all the fancy features \.{tex.ch} does---all that matters is enough to 2078 run the trap test with a memory size of 3000.} 2079@+init 2080if ini_version then begin 2081 {We allocated this at start-up, but now we need to reallocate.} 2082 libc_free (mem); 2083end; 2084@+tini 2085undump_int (mem_top); {Overwrite whatever we had.} 2086if mem_max < mem_top then mem_max:=mem_top; {Use at least what we dumped.} 2087if mem_min+1100>mem_top then goto off_base; 2088mem:=xmalloc_array (memory_word, mem_max - mem_min + 1); 2089@z 2090 2091@x [48.1199] l.22750 - Allow command line to override dumped value. 2092undump(batch_mode)(error_stop_mode)(interaction); 2093@y 2094undump(batch_mode)(error_stop_mode)(interaction); 2095if interaction_option<>unspecified_mode then interaction:=interaction_option; 2096@z 2097 2098@x [48.1199] l.22755 - Test for end-of-file already done by undump. 2099undump_int(x);@+if (x<>69069)or eof(base_file) then goto off_base 2100@y 2101undump_int(x);@+if x<>69069 then goto off_base 2102@z 2103 2104@x [49.1204] Dynamic allocation. 2105@p begin @!{|start_here|} 2106@y 2107@d const_chk(#) == begin if # < inf@&# then # := inf@&# else 2108 if # > sup@&# then # := sup@&# end 2109{|setup_bound_var| stuff duplicated in \.{tex.ch}.} 2110@d setup_bound_var(#) == bound_default := #; setup_bound_var_end 2111@d setup_bound_var_end(#) == bound_name := #; setup_bound_var_end_end 2112@d setup_bound_var_end_end(#) == 2113 setup_bound_variable (address_of (#), bound_name, bound_default) 2114 2115@p begin @!{|start_here|} 2116 {See comments in \.{tex.ch} for why the name has to be duplicated.} 2117 setup_bound_var (250000)('main_memory')(main_memory); 2118 {|memory_word|s for |mem| in \.{INIMF}} 2119 setup_bound_var (3000)('buf_size')(buf_size); 2120 setup_bound_var (79)('error_line')(error_line); 2121 setup_bound_var (50)('half_error_line')(half_error_line); 2122 setup_bound_var (79)('max_print_line')(max_print_line); 2123 setup_bound_var (768)('screen_width')(screen_width); 2124 setup_bound_var (1024)('screen_depth')(screen_depth); 2125 setup_bound_var (16384)('gf_buf_size')(gf_buf_size); 2126 if error_line > ssup_error_line then error_line := ssup_error_line; 2127 if screen_width > ssup_screen_width then screen_width := ssup_screen_width; 2128 if screen_depth > ssup_screen_depth then screen_depth := ssup_screen_depth; 2129 2130 const_chk (main_memory); 2131 {|mem_top| is an index, |main_memory| is a size} 2132 mem_top := mem_min + main_memory - 1; 2133 mem_max := mem_top; 2134 const_chk (buf_size); 2135 2136 buffer:=xmalloc_array (ASCII_code, buf_size); 2137 row_transition:=xmalloc_array (screen_col, screen_width); 2138 gf_buf:=xmalloc_array (eight_bits, gf_buf_size); 2139 source_filename_stack:=xmalloc_array (str_number, max_in_open); 2140 full_source_filename_stack:=xmalloc_array (str_number, max_in_open); 2141 2142@+init 2143if ini_version then begin 2144 mem:=xmalloc_array (memory_word, mem_top - mem_min + 1); 2145end; 2146@+tini 2147@z 2148 2149@x [49.1204] Only do get_strings_started if ini. 2150@!init if not get_strings_started then goto final_end; 2151init_tab; {initialize the tables} 2152init_prim; {call |primitive| for each primitive} 2153init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr;@/ 2154max_str_ptr:=str_ptr; max_pool_ptr:=pool_ptr; fix_date_and_time; 2155tini@/ 2156@y 22833 2157@!init 2158if ini_version then begin 2159if not get_strings_started then goto final_end; 2160init_tab; {initialize the tables} 2161init_prim; {call |primitive| for each primitive} 2162init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr;@/ 2163max_str_ptr:=str_ptr; max_pool_ptr:=pool_ptr; fix_date_and_time; 2164end; 2165tini@/ 2166@z 2167 2168@x 2169end_of_MF: close_files_and_terminate; 2170final_end: ready_already:=0; 2171@y 2172close_files_and_terminate; 2173final_end: do_final_end; 2174@z 2175 2176% [49.1205] close_files_and_terminate: Print new line before 2177% termination; switch to editor if necessary. 2178@x 2179 slow_print(log_name); print_char("."); 2180 end; 2181 end; 2182@y 2183 print_file_name(0,log_name,0); print_char("."); 2184 end; 2185 end; 2186print_ln; 2187if (edit_name_start<>0) and (interaction>batch_mode) then 2188 call_edit(str_pool,edit_name_start,edit_name_length,edit_line); 2189@z 2190 2191@x [49.1209] Only do dump if ini. 2192 begin @!init store_base_file; return;@+tini@/ 2193@y 2194 begin 2195 @!init if ini_version then begin store_base_file; return;end;@+tini@/ 2196@z 2197 2198%@x [49.1211] l.23002 - Handle %&base line. 2199%if (base_ident=0)or(buffer[loc]="&") then 2200%@y 2201%if (base_ident=0)or(buffer[loc]="&")or dump_line then 2202%@z 2203 2204@x [51.1214] Add editor-switch variable to globals. 2205This section should be replaced, if necessary, by any special 2206modifications of the program 2207that are necessary to make \MF\ work at a particular installation. 2208It is usually best to design your change file so that all changes to 2209previous sections preserve the section numbering; then everybody's version 2210will be consistent with the published program. More extensive changes, 2211which introduce new sections, can be inserted here; then only the index 2212itself will get a new section number. 2213@^system dependencies@> 2214@y 2215Here are the variables used to hold ``switch-to-editor'' information. 2216@^system dependencies@> 2217 2218@<Global...@>= 2219@!edit_name_start: pool_pointer; 2220@!edit_name_length,@!edit_line: integer; 2221@!xprn: array[ASCII_code] of ASCII_code; {use \.{\^\^} notation?} 2222@!stop_at_space: boolean; {whether |more_name| returns false for space} 2223 2224@ The |edit_name_start| will be set to point into |str_pool| somewhere after 2225its beginning if \MF\ is supposed to switch to an editor on exit. 2226 2227@<Set init...@>= 2228edit_name_start:=0; 2229stop_at_space:=true; 2230 2231@ Dumping the |xord|, |xchr|, and |xprn| arrays. We dump these always 2232in the format, so a TCX file loaded during format creation can set a 2233default for users of the format. 2234 2235@<Dump |xord|, |xchr|, and |xprn|@>= 2236dump_things(xord[0], 256); 2237dump_things(xchr[0], 256); 2238dump_things(xprn[0], 256); 2239 2240@ Undumping the |xord|, |xchr|, and |xprn| arrays. This code is more 2241complicated, because we want to ensure that a TCX file specified on 2242the command line will override whatever is in the format. Since the 2243tcx file has already been loaded, that implies throwing away the data 2244in the format. Also, if no |translate_filename| is given, but 2245|eight_bit_p| is set we have to make all characters printable. 2246 2247@<Undump |xord|, |xchr|, and |xprn|@>= 2248if translate_filename then begin 2249 for k:=0 to 255 do undump_things(dummy_xord, 1); 2250 for k:=0 to 255 do undump_things(dummy_xchr, 1); 2251 for k:=0 to 255 do undump_things(dummy_xprn, 1); 2252 end 2253else begin 2254 undump_things(xord[0], 256); 2255 undump_things(xchr[0], 256); 2256 undump_things(xprn[0], 256); 2257 if eight_bit_p then 2258 for k:=0 to 255 do 2259 xprn[k]:=1; 2260end; 2261@z 2262