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