File: MF.changes
Pavel: October 31, 1985 4:20:44 pm PST
Note: In the changes below, (TRAP) indicates a change which should only be active for the TRAP test. (~TRAP) indicates a change which must not be active during the TRAP test.
001078: Arrange things so that listings of METAFONT only show changed modules.
@x
% Here is TeX material that gets inserted after \input webmac
@y
% Here is TeX material that gets inserted after \input webmac
\let\maybe=\iffalse
@z
006554: Change the banner line.
@x
@d banner=='This is METAFONT, Version 0.9999' {printed when \MF\ starts}
@y
@d banner=='This is METAFONT 0.9999, for Cedar 6.0' {printed when \MF\ starts}
@z
009530: Define macros for read←ln and write←ln that expand without the underscores.
@x
@f type==true {but `|type|' will not be treated as a reserved word}
@y
@f type==true {but `|type|' will not be treated as a reserved word}
@d write←ln==writeln {since our Tangle doesn't strip out "\←"}
@d read←ln==readln
@z
009833: Add external procedure declarations for things implemented in Cedar
@x
procedure initialize; {this procedure gets things started properly}
@y
@<External procedure declarations for things implemented directly in Cedar@>@/
procedure initialize; {this procedure gets things started properly}
@z
011873: Turn on debugging code.
@x
@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
@z
012050: Turn on statistics code.
@x
@d stat==@{ {change this to `$\\{stat}\equiv\null$' when gathering
usage statistics}
@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$' when gathering
usage statistics}
@z
015529: (TRAP) Set mem←max to 3000.
@x
@!mem←max=30000; {greatest index in \MF's internal |mem| array;
@y
@!mem←max=3000; {greatest index in \MF's internal |mem| array;
@z
015529: (~TRAP) Set mem←max to 50000.
@x
@!mem←max=30000; {greatest index in \MF's internal |mem| array;
@y
@!mem←max=50000; {greatest index in \MF's internal |mem| array;
@z
015764: (~TRAP) Up the buf←size, so that long input lines don't cause errors.
@x
@!buf←size=500; {maximum number of characters simultaneously present in
@y
@!buf←size=7500; {maximum number of characters simultaneously present in
@z
015899: (~TRAP) Set error←line and half𡤎rror←line small, but max←print←line very large.
@x
@!error←line=72; {width of context lines on terminal error messages}
@!half𡤎rror←line=42; {width of first lines of contexts in terminal
error messages; should be between 30 and |error←line-15|}
@!max←print←line=79; {width of longest text lines output; should be at least 60}
@y
@!error←line=64; {width of context lines on terminal error messages}
@!half𡤎rror←line=32; {width of first lines of contexts in terminal
error messages; should be between 30 and |error←line-15|}
@!max←print←line=30000; {width of longest text lines output; should be at least 60}
@z
015899: (TRAP) Set error←line and half𡤎rror←line small, and also max←print←line.
@x
@!error←line=72; {width of context lines on terminal error messages}
@!half𡤎rror←line=42; {width of first lines of contexts in terminal
error messages; should be between 30 and |error←line-15|}
@!max←print←line=79; {width of longest text lines output; should be at least 60}
@y
@!error←line=64; {width of context lines on terminal error messages}
@!half𡤎rror←line=32; {width of first lines of contexts in terminal
error messages; should be between 30 and |error←line-15|}
@!max←print←line=72; {width of longest text lines output; should be at least 60}
@z
016177: (~TRAP) Change screen←width and screen�pth to match Viewers setup
@x
@!screen←width=768; {number of pixels in each row of screen display}
@!screen�pth=1024; {number of pixels in each column of screen display}
@y
@!screen←width=1000; {number of pixels in each row of screen display}
@!screen�pth=700; {number of pixels in each column of screen display}
@z
016177: (TRAP) Change screen←width and screen�pth to 100 and 200
@x
@!screen←width=768; {number of pixels in each row of screen display}
@!screen�pth=1024; {number of pixels in each column of screen display}
@y
@!screen←width=100; {number of pixels in each row of screen display}
@!screen�pth=200; {number of pixels in each column of screen display}
@z
017012: (TRAP) Set gf𡤋uf←size ridiculously small.
@x
@!gf𡤋uf←size=800; {size of the output buffer, must be a multiple of 8}
@y
@!gf𡤋uf←size=8; {size of the output buffer, must be a multiple of 8}
@z
017084: Up the file←name←size to 127, enough for FS including version numbers.
@x
@!file←name←size=40; {file names shouldn't be longer than this}
@y
@!file←name←size=127; {file names shouldn't be longer than this}
@z
017148: Delete pool name, since that initialization will be done by an external proc.
@x
@!pool←name='MFbases:MF.POOL ';
{string of length |file←name←size|; tells where the string pool appears}
@.MFbases@>
@y
@z
018315: (~TRAP) Set mem←top to 50000.
@x
@d mem←top==30000 {largest index in the |mem| array dumped by \.{INIMF};
must be substantially larger than |mem←min|
and not greater than |mem←max|}
@y
@d mem←top==50000 {largest index in the |mem| array dumped by \.{INIMF};
must be substantially larger than |mem←min|
and not greater than |mem←max|}
@z
024575: Allow for eight-bit characters
@x
@d last←text𡤌har=127 {ordinal number of the largest element of |text𡤌har|}
@y
@d last←text𡤌har=255 {ordinal number of the largest element of |text𡤌har|}
@z
028547: Set up the character-code mapping to be the identity for now.
@x
for i:=1 to @'37 do xchr[i]:=' ';
@y
for i:=1 to @'37 do xchr[i]:=chr(i);
@z
033425: Replace Pascal-H extended file routines with external calls.
@x
@d reset←OK(#)==erstat(#)=0
@d rewrite←OK(#)==erstat(#)=0
@p function a←open←in(var @!f:alpha𡤏ile):boolean;
{open a text file for input}
begin reset(f,name←of𡤏ile,'/O'); a←open←in:=reset←OK(f);
end;
@#
function a←open←out(var @!f:alpha𡤏ile):boolean;
{open a text file for output}
begin rewrite(f,name←of𡤏ile,'/O'); a←open←out:=rewrite←OK(f);
end;
@#
function b←open←out(var @!f:byte𡤏ile):boolean;
{open a binary file for output}
begin rewrite(f,name←of𡤏ile,'/O'); b←open←out:=rewrite←OK(f);
end;
@#
function w←open←in(var @!f:word𡤏ile):boolean;
{open a word file for input}
begin reset(f,name←of𡤏ile,'/O'); w←open←in:=reset←OK(f);
end;
@#
function w←open←out(var @!f:word𡤏ile):boolean;
{open a word file for output}
begin rewrite(f,name←of𡤏ile,'/O'); w←open←out:=rewrite←OK(f);
end;
@y
@p function a←open←in(var f:alpha𡤏ile):boolean; external;
{open a text file for input}
@#
function a←open←out(var f:alpha𡤏ile):boolean; external;
{open a text file for output}
@#
function b←open←in(var f:byte𡤏ile):boolean; external;
{open a binary file for input}
@#
function b←open←out(var f:byte𡤏ile):boolean; external;
{open a binary file for output}
@#
function w←open←in(var f:word𡤏ile):boolean; external;
{open a word file for input}
@#
function w←open←out(var f:word𡤏ile):boolean; external;
{open a word file for output}
@z
034593: Also make close-operations external.
@x
@p procedure a𡤌lose(var @!f:alpha𡤏ile); {close a text file}
begin close(f);
end;
@#
procedure b𡤌lose(var @!f:byte𡤏ile); {close a binary file}
begin close(f);
end;
@#
procedure w𡤌lose(var @!f:word𡤏ile); {close a word file}
begin close(f);
end;
@y
@p procedure a𡤌lose(var @!f:alpha𡤏ile); external; {close a text file}
@#
procedure b𡤌lose(var @!f:byte𡤏ile); external; {close a binary file}
@#
procedure w𡤌lose(var @!f:word𡤏ile); external; {close a word file}
@z
039158: Terminal files are also external.
@x
@d t←open←in==reset(term←in,'TTY:','/O/I') {open the terminal for text input}
@d t←open←out==rewrite(term←out,'TTY:','/O') {open the terminal for text output}
@y
@d t←open←in==reset←term←in(term←in) {open the terminal for text input}
@d t←open←out==rewrite←term←out(term←out) {open the terminal for text output}
@z
040142: Remove break←in from clear←terminal
@x
@d clear←terminal == break←in(term←in,true) {clear the terminal input buffer}
@y
@d clear←terminal == {clear the terminal input buffer}
@z
043002: Read the tail of the command line as the first line of input
@y
const cmd𡤋lank = 0;
cmd←ok = 1;
cmd←overflow = -1;
var cmd←status:integer;
begin t←open←in;
cmd←status:=stuff←on𡤌md←line;
if cmd←status=cmd←overflow then overflow("buffer size",buf←size);
if cmd←status=cmd←ok then begin init←terminal:=true; return end;
@z
054491: Set up pool←name properly, filling out with blanks.
@x
name←of𡤏ile:=pool←name; {we needn't set |name←length|}
@z
072347: Set process priority back up to normal for error handling interactions.
@x
if interaction=error←stop←mode then @<Get user's advice and |return|@>;
@y
if interaction=error←stop←mode then
begin set←normal←priority; @<Get user's advice and |return|@>; end;
@z
072646: But set it back down to background when the interaction is over.
@y
exit: set�kground←priority; end;
@z
073758: (~TRAP) In Cedar, character counts are more useful than line numbers. My basic plan is to store character counts of the beginning of the lines in Knuth's "line" variables. To avoid confusion with zero, which Knuth uses as a special flag, I shall actually store (charPos+1) instead. This works out wonderfully, since the Position button in Tioga starts counting characters from one instead of from zero anyway.
@x
print(" at line "); print←int(line);
@y
print(" near character "); print←int(line);
@z
123633: Make life easy on the compiler, given that min←halfword=min←quarterword=0.
@x
@d ho(#)==#-min←halfword
{to take a sixteen-bit item from a halfword}
@d qo(#)==#-min←quarterword {to read eight bits from a quarterword}
@d qi(#)==#+min←quarterword {to store eight bits in a quarterword}
@y
@d ho(#)==# {to take a sixteen-bit item from a halfword}
@d qo(#)==# {to read eight bits from a quarterword}
@d qi(#)==# {to store eight bits in a quarterword}
@z
124117: Change tag fields in variant records to enumerated types.
@x
@!two𡤌hoices = 1..2; {used when there are two variants in a record}
@!three𡤌hoices = 1..3; {used when there are three variants in a record}
@!two←halves = packed record@;@/
@!rh:halfword;
case two𡤌hoices of
1: (@!lh:halfword);
2: (@!b0:quarterword; @!b1:quarterword);
end;
@!four←quarters = packed record@;@/
@!b0:quarterword;
@!b1:quarterword;
@!b2:quarterword;
@!b3:quarterword;
end;
@!memory←word = record@;@/
case three𡤌hoices of
1: (@!int:integer);
2: (@!hh:two←halves);
3: (@!qqqq:four←quarters);
end;
@y
@!two𡤌hoices = (c1of2, c2of2); {used when there are two variants in a record}
@!three𡤌hoices = (c1of3, c2of3, c3of3); {used when there are three variants in a record}
@!two←halves = packed record@;@/
@!rh:halfword;
case two𡤌hoices of
c1of2: (@!lh:halfword);
c2of2: (@!b0:quarterword; @!b1:quarterword);
end;
@!four←quarters = packed record@;@/
@!b0:quarterword;
@!b1:quarterword;
@!b2:quarterword;
@!b3:quarterword;
end;
@!memory←word = record@;@/
case three𡤌hoices of
c1of3: (@!int:integer);
c2of3: (@!hh:two←halves);
c3of3: (@!qqqq:four←quarters);
end;
@z
170045: Fix up fix�te𡤊nd←time
@x
begin internal[time]:=12*60*unity; {minutes since midnight}
internal[day]:=4*unity; {fourth day of the month}
internal[month]:=7*unity; {seventh month of the year}
internal[year]:=1776*unity; {Anno Domini}
end;
@y
var the←time, the�y, the←month, the←year:integer;
begin
read←the𡤌lock(the←time, the�y, the←month, the←year);
internal[time]:=the←time*unity; {minutes since midnight}
internal[day]:=the�y*unity; {day of the month}
internal[month]:=the←month*unity; {month of the year}
internal[year]:=the←year*unity; {Anno Domini}
end;
@z
171419: (~TRAP) Change "line" to "character" in error message.
@x
print(" at line "); print←int(line);
@y
print(" near character "); print←int(line);
@z
173750: Make tabs and form feed characters legal space characters.
@x
char𡤌lass[127]:=invalid𡤌lass;
@y
char𡤌lass[127]:=invalid𡤌lass;
char𡤌lass[9]:=space𡤌lass;
char𡤌lass[12]:=space𡤌lass;
@z
245041: (BUG) Remove unused variable r
@x
@!r,@!s,@!t:pointer; {registers for list traversal}
@y
@!s,@!t:pointer; {registers for list traversal}
@z
249628: (BUG) Remove unused variables sine and cosine
@x
procedure solve𡤌hoices(@!p,@!q:pointer;@!n:halfword);
label found,exit;
var @!k:0..path←size; {current knot number}
@!r,@!s,@!t:pointer; {registers for list traversal}
@!sine,@!cosine:fraction; {trig functions of various angles}
@y
procedure solve𡤌hoices(@!p,@!q:pointer;@!n:halfword);
label found,exit;
var @!k:0..path←size; {current knot number}
@!r,@!s,@!t:pointer; {registers for list traversal}
@z
347291: Break up procedure make←spec, using a nested procedure.
@x
@<Other local variables for |make←spec|@>@;
begin cur←spec:=h;
if tracing>0 then
print←path(cur←spec,", before subdivision into octants",true);
max𡤊llowed:=fraction←one-half←unit-1-safety←margin;
@<Truncate the values of all coordinates that exceed |max𡤊llowed|, and stamp
segment numbers in each |left←type| field@>;
quadrant←subdivide; {subdivide each cubic into pieces belonging to quadrants}
if internal[autorounding]>0 then xy←round;
octant←subdivide; {complete the subdivision}
if internal[autorounding]>unity then diag←round;
@<Remove dead cubics@>;
@<Insert octant boundaries and compute the turning number@>;
@y
@<Other local variables for |make←spec|@>@;
procedure m←s𡤋it;
begin @<Insert octant boundaries and compute the turning number@>;
end;
@#
begin cur←spec:=h;
if tracing>0 then
print←path(cur←spec,", before subdivision into octants",true);
max𡤊llowed:=fraction←one-half←unit-1-safety←margin;
@<Truncate the values of all coordinates that exceed |max𡤊llowed|, and stamp
segment numbers in each |left←type| field@>;
quadrant←subdivide; {subdivide each cubic into pieces belonging to quadrants}
if internal[autorounding]>0 then xy←round;
octant←subdivide; {complete the subdivision}
if internal[autorounding]>unity then diag←round;
@<Remove dead cubics@>;
m←s𡤋it;
@z
351986: Break up the procedure quadrant←subdivide using a nested procedure. The Cedar compiler is running out of space in a per-procedure data structure, so this will suffice.
@x
procedure quadrant←subdivide;
label continue,exit;
var @!p,@!q,@!r,@!s,@!pp,@!qq:pointer; {for traversing the lists}
@!first←x,@!first←y:scaled; {unnegated coordinates of node |cur←spec|}
@!del1,@!del2,@!del3,@!del,@!dmax:scaled; {proportional to the control
points of a quadratic derived from a cubic}
@!t:fraction; {where a quadratic crosses zero}
@!dest←x,@!dest←y:scaled; {final values of |x| and |y| in the current cubic}
@!constant←x:boolean; {is |x| constant between |p| and |q|?}
begin p:=cur←spec; first←x:=x𡤌oord(cur←spec); first←y:=y𡤌oord(cur←spec);
repeat continue: q:=link(p);
@<Subdivide the cubic between |p| and |q| so that the results travel
toward the right halfplane@>;
@<Subdivide all cubics between |p| and |q| so that the results travel
toward the first quadrant; but |return| or |goto continue| if the
cubic from |p| to |q| was dead@>;
p:=q;
until p=cur←spec;
exit:end;
@y
procedure quadrant←subdivide;
label continue,exit;
var @!p,@!q,@!r,@!s,@!pp,@!qq:pointer; {for traversing the lists}
@!first←x,@!first←y:scaled; {unnegated coordinates of node |cur←spec|}
@!del1,@!del2,@!del3,@!del,@!dmax:scaled; {proportional to the control
points of a quadratic derived from a cubic}
@!t:fraction; {where a quadratic crosses zero}
@!dest←x,@!dest←y:scaled; {final values of |x| and |y| in the current cubic}
@!constant←x:boolean; {is |x| constant between |p| and |q|?}
@#
procedure subdiv1;
begin @<Subdivide the cubic between |p| and |q| so that the results travel
toward the right halfplane@>;
end;
@#
begin p:=cur←spec; first←x:=x𡤌oord(cur←spec); first←y:=y𡤌oord(cur←spec);
repeat continue: q:=link(p);
subdiv1;
@<Subdivide all cubics between |p| and |q| so that the results travel
toward the first quadrant; but |return| or |goto continue| if the
cubic from |p| to |q| was dead@>;
p:=q;
until p=cur←spec;
exit:end;
@z
378217: Break up procedure diag←round using a nested procedure.
@x
procedure diag←round;
var @!p,@!q,@!pp:pointer; {list manipulation registers}
@!b,@!a,@!bb,@!aa,@!d,@!c,@!dd,@!cc:scaled; {before and after values}
@!pen�ge:scaled; {offset that governs rounding}
@!alpha,@!beta:fraction; {coefficients of linear transformation}
@!next𡤊:scaled; {|after[k]| before it might have changed}
@!all←safe:boolean; {does everything look OK so far?}
@!k:0..max←wiggle; {runs through before-and-after values}
@!first←x,@!first←y:scaled; {coordinates before rounding}
begin p:=cur←spec; cur←rounding←ptr:=0;
repeat q:=link(p);
@<If node |q| is a transition point between octants,
compute and save its before-and-after coordinates@>;
@y
procedure diag←round;
var @!p,@!q,@!pp:pointer; {list manipulation registers}
@!b,@!a,@!bb,@!aa,@!d,@!c,@!dd,@!cc:scaled; {before and after values}
@!pen�ge:scaled; {offset that governs rounding}
@!alpha,@!beta:fraction; {coefficients of linear transformation}
@!next𡤊:scaled; {|after[k]| before it might have changed}
@!all←safe:boolean; {does everything look OK so far?}
@!k:0..max←wiggle; {runs through before-and-after values}
@!first←x,@!first←y:scaled; {coordinates before rounding}
@#
procedure inner𡤍iag←round;
begin
@<If node |q| is a transition point between octants,
compute and save its before-and-after coordinates@>;
end;
@#
begin p:=cur←spec; cur←rounding←ptr:=0;
repeat q:=link(p);
inner𡤍iag←round;
@z
431357: Break up procedure fill𡤎nvelope using a nested procedure.
@x
@<Other local variables for |fill𡤎nvelope|@>@;
begin if internal[tracing�ges]>0 then begin�ge←tracing;
p:=spec←head; {we assume that |left←type(spec←head)=endpoint|}
repeat octant:=left←octant(p); h:=cur←pen+octant;
@<Set variable |q| to the node at the end of the current octant@>;
@<Determine the envelope's starting and ending
lattice points |(m0,n0)| and |(m1,n1)|@>;
@y
@<Other local variables for |fill𡤎nvelope|@>@;
@#
procedure inner𡤏ill;
begin @<Determine the envelope's starting and ending
lattice points |(m0,n0)| and |(m1,n1)|@>;
end;
@#
begin if internal[tracing�ges]>0 then begin�ge←tracing;
p:=spec←head; {we assume that |left←type(spec←head)=endpoint|}
repeat octant:=left←octant(p); h:=cur←pen+octant;
@<Set variable |q| to the node at the end of the current octant@>;
inner𡤏ill;
@z
481976: Break up the procedure cubic←intersection using several nested procedures.
@x
@p procedure cubic←intersection(@!p,@!pp:pointer);
label continue, not𡤏ound, exit;
var @!q,@!qq:pointer; {|link(p)|, |link(pp)|}
begin time←to←go:=max←patience;
@<Initialize for intersections at level zero@>;
loop@+ begin continue:
if delx-tol<=stack←max(x←packet(xy))-stack←min(u←packet(uv)) then
if delx+tol>=stack←min(x←packet(xy))-stack←max(u←packet(uv)) then
if dely-tol<=stack←max(y←packet(xy))-stack←min(v←packet(uv)) then
if dely+tol>=stack←min(y←packet(xy))-stack←max(v←packet(uv)) then
begin if cur←t>=two then {we've done 17 bisections}
begin cur←t:=half(cur←t+1); cur←tt:=half(cur←tt+1); return;
end;
@<Subdivide for a new level of intersection@>;
@y
@p procedure inter←subdivide;
@<Subdivide for a new level of intersection@>
begin c←i←subdiv1; c←i←subdiv2; c←i←subdiv3; c←i←subdiv4;
end;
@#
procedure cubic←intersection(@!p,@!pp:pointer);
label continue, not𡤏ound, exit;
var @!q,@!qq:pointer; {|link(p)|, |link(pp)|}
@<Initialize for intersections at level zero@>
begin time←to←go:=max←patience;
c←i←init1; c←i←init2;
loop@+ begin continue:
if delx-tol<=stack←max(x←packet(xy))-stack←min(u←packet(uv)) then
if delx+tol>=stack←min(x←packet(xy))-stack←max(u←packet(uv)) then
if dely-tol<=stack←max(y←packet(xy))-stack←min(v←packet(uv)) then
if dely+tol>=stack←min(y←packet(xy))-stack←max(v←packet(uv)) then
begin if cur←t>=two then {we've done 17 bisections}
begin cur←t:=half(cur←t+1); cur←tt:=half(cur←tt+1); return;
end;
inter←subdivide;
@z
483422: Here are some of the nested procedures which are part of the break up of cubic←intersection.
@x
@<Initialize for intersections at level zero@>=
q:=link(p); qq:=link(pp); bisect←ptr:=int←packets;@/
u1r:=right←x(p)-x𡤌oord(p); u2r:=left←x(q)-right←x(p);
u3r:=x𡤌oord(q)-left←x(q); set←min←max(ur←packet);@/
v1r:=right←y(p)-y𡤌oord(p); v2r:=left←y(q)-right←y(p);
v3r:=y𡤌oord(q)-left←y(q); set←min←max(vr←packet);@/
x1r:=right←x(pp)-x𡤌oord(pp); x2r:=left←x(qq)-right←x(pp);
x3r:=x𡤌oord(qq)-left←x(qq); set←min←max(xr←packet);@/
y1r:=right←y(pp)-y𡤌oord(pp); y2r:=left←y(qq)-right←y(pp);
y3r:=y𡤌oord(qq)-left←y(qq); set←min←max(yr←packet);@/
delx:=x𡤌oord(p)-x𡤌oord(pp); dely:=y𡤌oord(p)-y𡤌oord(pp);@/
tol:=0; uv:=r←packets; xy:=r←packets; three←l:=0; cur←t:=1; cur←tt:=1
@y
@<Initialize for intersections at level zero@>=
procedure c←i←init1;
begin
q:=link(p); qq:=link(pp); bisect←ptr:=int←packets;@/
u1r:=right←x(p)-x𡤌oord(p); u2r:=left←x(q)-right←x(p);
u3r:=x𡤌oord(q)-left←x(q); set←min←max(ur←packet);@/
v1r:=right←y(p)-y𡤌oord(p); v2r:=left←y(q)-right←y(p);
v3r:=y𡤌oord(q)-left←y(q); set←min←max(vr←packet);@/
end;
@#
procedure c←i←init2;
begin
x1r:=right←x(pp)-x𡤌oord(pp); x2r:=left←x(qq)-right←x(pp);
x3r:=x𡤌oord(qq)-left←x(qq); set←min←max(xr←packet);@/
y1r:=right←y(pp)-y𡤌oord(pp); y2r:=left←y(qq)-right←y(pp);
y3r:=y𡤌oord(qq)-left←y(qq); set←min←max(yr←packet);@/
delx:=x𡤌oord(p)-x𡤌oord(pp); dely:=y𡤌oord(p)-y𡤌oord(pp);@/
tol:=0; uv:=r←packets; xy:=r←packets; three←l:=0; cur←t:=1; cur←tt:=1
end;
@z
484100: And here are the other nested procedures for cubic←intersection.
@x
@ @<Subdivide for a new level of intersection@>=
stack𡤍x:=delx; stack𡤍y:=dely; stack←tol:=tol; stack←uv:=uv; stack←xy:=xy;
bisect←ptr:=bisect←ptr+int←increment;@/
double(cur←t); double(cur←tt);@/
u1l:=stack𡤁(u←packet(uv)); u3r:=stack𡤃(u←packet(uv));
u2l:=half(u1l+stack𡤂(u←packet(uv)));
u2r:=half(u3r+stack𡤂(u←packet(uv)));
u3l:=half(u2l+u2r); u1r:=u3l;
set←min←max(ul←packet); set←min←max(ur←packet);@/
v1l:=stack𡤁(v←packet(uv)); v3r:=stack𡤃(v←packet(uv));
v2l:=half(v1l+stack𡤂(v←packet(uv)));
v2r:=half(v3r+stack𡤂(v←packet(uv)));
v3l:=half(v2l+v2r); v1r:=v3l;
set←min←max(vl←packet); set←min←max(vr←packet);@/
x1l:=stack𡤁(x←packet(xy)); x3r:=stack𡤃(x←packet(xy));
x2l:=half(x1l+stack𡤂(x←packet(xy)));
x2r:=half(x3r+stack𡤂(x←packet(xy)));
x3l:=half(x2l+x2r); x1r:=x3l;
set←min←max(xl←packet); set←min←max(xr←packet);@/
y1l:=stack𡤁(y←packet(xy)); y3r:=stack𡤃(y←packet(xy));
y2l:=half(y1l+stack𡤂(y←packet(xy)));
y2r:=half(y3r+stack𡤂(y←packet(xy)));
y3l:=half(y2l+y2r); y1r:=y3l;
set←min←max(yl←packet); set←min←max(yr←packet);@/
uv:=l←packets; xy:=l←packets;
double(delx); double(dely);@/
tol:=tol-three←l+tol←step; double(tol); three←l:=three←l+tol←step
@y
@ @<Subdivide for a new level of intersection@>=
procedure c←i←subdiv1;
begin
stack𡤍x:=delx; stack𡤍y:=dely; stack←tol:=tol; stack←uv:=uv; stack←xy:=xy;
bisect←ptr:=bisect←ptr+int←increment;@/
double(cur←t); double(cur←tt);@/
u1l:=stack𡤁(u←packet(uv)); u3r:=stack𡤃(u←packet(uv));
u2l:=half(u1l+stack𡤂(u←packet(uv)));
u2r:=half(u3r+stack𡤂(u←packet(uv)));
u3l:=half(u2l+u2r); u1r:=u3l;
set←min←max(ul←packet); set←min←max(ur←packet);@/
end;
@#
procedure c←i←subdiv2;
begin
v1l:=stack𡤁(v←packet(uv)); v3r:=stack𡤃(v←packet(uv));
v2l:=half(v1l+stack𡤂(v←packet(uv)));
v2r:=half(v3r+stack𡤂(v←packet(uv)));
v3l:=half(v2l+v2r); v1r:=v3l;
set←min←max(vl←packet); set←min←max(vr←packet);@/
end;
@#
procedure c←i←subdiv3;
begin
x1l:=stack𡤁(x←packet(xy)); x3r:=stack𡤃(x←packet(xy));
x2l:=half(x1l+stack𡤂(x←packet(xy)));
x2r:=half(x3r+stack𡤂(x←packet(xy)));
x3l:=half(x2l+x2r); x1r:=x3l;
set←min←max(xl←packet); set←min←max(xr←packet);@/
end;
@#
procedure c←i←subdiv4;
begin
y1l:=stack𡤁(y←packet(xy)); y3r:=stack𡤃(y←packet(xy));
y2l:=half(y1l+stack𡤂(y←packet(xy)));
y2r:=half(y3r+stack𡤂(y←packet(xy)));
y3l:=half(y2l+y2r); y1r:=y3l;
set←min←max(yl←packet); set←min←max(yr←packet);@/
uv:=l←packets; xy:=l←packets;
double(delx); double(dely);@/
tol:=tol-three←l+tol←step; double(tol); three←l:=three←l+tol←step
end;
@z
489772: (TRAP) Make screen instructions be logged.
@x
@p function init←screen:boolean;
begin init←screen:=false;
end;
@y
@p function init←screen:boolean;
begin init←screen:=true;
end;
@z
489772: (~TRAP) Replace default definitions of screen functions with external references.
@x
@p function init←screen:boolean;
begin init←screen:=false;
end;
@#
procedure update←screen; {will be called only if |init←screen| returns |true|}
begin @!init wlog←ln('Calling UPDATESCREEN');@+tini {for testing only}
end;
@y
@p function init←screen:boolean; external;
procedure update←screen; external;
@z
491843: (~TRAP) Another screen routine.
@x
@p procedure blank←rectangle(@!left𡤌ol,@!right𡤌ol:screen𡤌ol;
@!top←row,@!bot←row:screen←row);
var @!r:screen←row;
@!c:screen𡤌ol;
begin @{@+for r:=top←row to bot←row-1 do
for c:=left𡤌ol to right𡤌ol-1 do
screen←pixel[r,c]:=white;@+@}@/
@!init wlog𡤌r; {this will be done only after |init←screen=true|}
wlog←ln('Calling BLANKRECTANGLE(',left𡤌ol:1,',',
right𡤌ol:1,',',top←row:1,',',bot←row:1,')');@+tini
end;
@y
@p procedure blank←rectangle(@!left𡤌ol,@!right𡤌ol:screen𡤌ol;
@!top←row,@!bot←row:screen←row); external;
@z
491843: (TRAP) Comment out unused variables r and c.
@x
@p procedure blank←rectangle(@!left𡤌ol,@!right𡤌ol:screen𡤌ol;
@!top←row,@!bot←row:screen←row);
var @!r:screen←row;
@!c:screen𡤌ol;
@y
@p procedure blank←rectangle(@!left𡤌ol,@!right𡤌ol:screen𡤌ol;
@!top←row,@!bot←row:screen←row);
@z
491843: (~TRAP) The last screen routine.
@x
@p procedure paint←row(@!r:screen←row;@!b:pixel𡤌olor;var @!a:trans←spec;
@!n:screen𡤌ol);
var @!k:screen𡤌ol; {an index into |a|}
@!c:screen𡤌ol; {an index into |screen←pixel|}
begin @{ k:=0; c:=a[0];
repeat incr(k);
repeat screen←pixel[r,c]:=b; incr(c);
until c=a[k];
b:=black-b; {$|black|\swap|white|$}
until k=n;@+@}@/
@!init wlog('Calling PAINTROW(',r:1,',',b:1,';');
{this is done only after |init←screen=true|}
for k:=0 to n do
begin wlog(a[k]:1); if k<>n then wlog(',');
end;
wlog←ln(')');@+tini
end;
@y
@p procedure paint←row(@!r:screen←row;@!b:pixel𡤌olor;var @!a:trans←spec;
@!n:screen𡤌ol); external;
@z
493108: (TRAP) Comment out unused variable c.
@x
@!c:screen𡤌ol; {an index into |screen←pixel|}
@y
@{@!c:screen𡤌ol; {an index into |screen←pixel|}@}
@z
545312: (~TRAP) Report error locations by character count rather than line number. In this particular case, I adjust the value of line in order to indicate the exact character at which the error happened.
@x
else begin print←nl("l."); print←int(line);
@y
else begin print←nl("c."); print←int(line+(loc-start));
@z
554108: (BUG) Remove unused variable s
@x
@p procedure back←input; {undoes one token of input}
var @!p:pointer; {a token list of length one}
@!s:0..param←size; {value of |param←start| on the current level}
@y
@p procedure back←input; {undoes one token of input}
var @!p:pointer; {a token list of length one}
@z
559523: (~TRAP) Change message from "line" to "character"
@x
else begin print𡤎rr("Incomplete if; all text was ignored after line ");
@y
else begin print𡤎rr("Incomplete if; all text was ignored after character ");
@z
563316: Add variable k←plus←one to fix signed/unsigned ambiguity below.
@x
var @!k:0..buf←size; {an index into |buffer|}
@y
var @!k:0..buf←size; {an index into |buffer|}
@!k←plus←one:halfword; {Fix for a signed/unsigned ambiguity in Cedar}
@z
566248: Fix for a signed/unsigned ambiguity in Cedar
@x
if loc=k+1 then cur←mod:=buffer[k]
@y
k←plus←one:=k+1;
if loc=k←plus←one then cur←mod:=buffer[k]
@z
570678: (~TRAP) Set "line" to character count rather than line number. Remember that we want to store (charPos+1) in "line", but the offset of plus one comes for free, since Pascal has read the first character of the new line behind our backs.
@x
begin incr(line); first:=start;
@y
begin line:=file←get←pos(cur𡤏ile); first:=start;
@z
623469: Default file directory
@x
@d MF𡤊rea=="MFinputs:"
@.MFinputs@>
@y
@<Glob...@>=
@!MF𡤊rea:str←number;
@.MFinputs@>
@z
623821: Adjust parsing of file names.
@x
else begin if (c=">")or(c=":") then
begin area�limiter:=pool←ptr; ext�limiter:=0;
end
else if (c=".")and(ext�limiter=0) then ext�limiter:=pool←ptr;
@y
else begin if (c=">")or(c="/")or(c="]") then
area�limiter:=pool←ptr
else if (c=".") then ext�limiter:=pool←ptr;
@z
625985: We shall generate base file names in Cedar, working from the default name in the user profile. Hence, we here replace three modules by dummies (to keep the numbering the same).
@x
@ A messier routine is also needed, since base file names must be scanned
before \MF's string mechanism has been initialized. We shall use the
global variable |MF�se�ult| to supply the text for default system areas
and extensions related to base files.
@^system dependencies@>
@d base�ult←length=18 {length of the |MF�se�ult| string}
@d base𡤊rea←length=8 {length of its area part}
@d base𡤎xt←length=5 {length of its `\.{.base}' part}
@<Glob...@>=
@!MF�se�ult:packed array[1..base�ult←length] of char;
@ @<Set init...@>=
MF�se�ult:='MFbases:plain.base';
@.MFbases@>
@.plain@>
@^system dependencies@>
@ @<Check the ``constant'' values for consistency@>=
if base�ult←length>file←name←size then bad:=41;
@y
@ This module is a dummy. The default name of the base file is dealt with directly in Cedar.
@ So is this one.
@ This one too.
@z
627224: Pack𡤋uffered←name in Pascal is replaced by three external relatives.
@x
@p procedure pack𡤋uffered←name(@!n:small←number;@!a,@!b:integer);
var @!k:integer; {number of positions filled in |name←of𡤏ile|}
@!c: ASCII𡤌ode; {character being packed}
@!j:integer; {index into |buffer| or |MF�se�ult|}
begin if n+b-a+1+base𡤎xt←length>file←name←size then
b:=a+file←name←size-n-1-base𡤎xt←length;
k:=0;
for j:=1 to n do append←to←name(xord[MF�se�ult[j]]);
for j:=a to b do append←to←name(buffer[j]);
for j:=base�ult←length-base𡤎xt←length+1 to base�ult←length do
append←to←name(xord[MF�se�ult[j]]);
if k<=file←name←size then name←length:=k@+else name←length:=file←name←size;
for k:=name←length+1 to file←name←size do name←of𡤏ile[k]:=' ';
end;
@y
Actually, in Cedar, we replace |pack𡤋uffered←name| in Pascal by three external relatives.
@p procedure pack𡤋uffered←name(@!a,@!b:integer); external;
procedure pack�ult𡤊rea(@!a,@!b:integer); external;
procedure pack𡤊ll�ult; external;
@z
628600: Change first call on pack𡤋uffered←name to a call on an external.
@x
pack𡤋uffered←name(0,loc,j-1); {try first without the system file area}
@y
pack𡤋uffered←name(loc,j-1); {try first without the system file area}
@z
628717: Change second call on pack𡤋uffered←name to a call on an external.
@x
pack𡤋uffered←name(base𡤊rea←length,loc,j-1);
@y
pack�ult𡤊rea(loc,j-1);
@z
628868: Change message to indicate that PLAIN isn't necessarily the default base file.
@x
wterm←ln('Sorry, I can''t find that base;',' will try PLAIN.');
@y
wterm←ln('Sorry, I can''t find that base;',' will try your default.');
@z
629053: Change third call on pack𡤋uffered←name to a call on an external.
@x
pack𡤋uffered←name(base�ult←length-base𡤎xt←length,1,0);
@z
629173: Change another message to indicate that PLAIN isn't necessarily the default base file.
@x
wterm←ln('I can''t find the PLAIN base file!');
@y
wterm←ln('I can''t find your default base file!');
@z
630161: Report full names of open files by calls to system dependent externals.
@x
function a←make←name←string(var @!f:alpha𡤏ile):str←number;
begin a←make←name←string:=make←name←string;
end;
function b←make←name←string(var @!f:byte𡤏ile):str←number;
begin b←make←name←string:=make←name←string;
end;
function w←make←name←string(var @!f:word𡤏ile):str←number;
begin w←make←name←string:=make←name←string;
end;
@y
function a←make←name←string(var @!f:alpha𡤏ile):str←number; external;
function b←make←name←string(var @!f:byte𡤏ile):str←number; external;
function w←make←name←string(var @!f:word𡤏ile):str←number; external;
@z
637118: Add variable to fix another signed/unsigned ambiguity.
@x
@p procedure start←input; {\MF\ will \.{input} something}
label done;
@y
@p procedure start←input; {\MF\ will \.{input} something}
label done;
var str←ptr←minus←one : halfword;
@z
638038: Make the signed/unsigned ambiguity fix.
@x
if name=str←ptr-1 then {we can conserve string pool space now}
@y
str←ptr←minus←one:=str←ptr-1;
if name=str←ptr←minus←one then {we can conserve string pool space now}
@z
638481: No change here, since it happens that 1 is correct value of (charPos+1) at the start of a file.
@x
buffer[limit]:="%"; first:=limit+1; loc:=start; line:=1;
@y
buffer[limit]:="%"; first:=limit+1; loc:=start; line:=1;
@z
667356: (~TRAP) Change "line" to "character" in yet another error message.
@x
begin print𡤎rr("A group begun on line ");
@y
begin print𡤎rr("A group begun near character ");
@z
684330: (BUG) Variables q and r are not used.
@x
procedure scan←secondary;
label restart,continue;
var @!p,@!q,@!r:pointer; {for list manipulation}
@y
procedure scan←secondary;
label restart,continue;
var @!p:pointer; {for list manipulation}
@z
794464: (BUG) Variable t is not used.
@x
procedure do�←to;
label done, not𡤏ound;
var @!lhs,@!rhs:pointer; {variable on left, path on right}
@!t:small←number; {variant of |with←option|}
@y
procedure do�←to;
label done, not𡤏ound;
var @!lhs,@!rhs:pointer; {variable on left, path on right}
@z
887525: Replace ready𡤊lready by the new boolean start←like←inimf.
@x
should also be provided for commonly used bases.
@:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
@.cmbase@>
@.plain@>
@<Glob...@>=
@!ready𡤊lready:integer; {a sacrifice of purity for economy}
@y
should also be provided for commonly used bases.
@:METAFONTbook}{\sl The {\logos METAFONT\/}book@>
@.cmbase@>
@.plain@>
In Cedar, we can't do any preloading, more's the pity, but we can and must combine the two versions of \MF\ (\.{INIMF} and \.{VIRMF}) into a single program. To do so, we add this new |boolean| variable.
@<Glob...@>=
@!start←like←inimf:boolean; {otherwise, we start up like \MF}
@z
887934: Wrap up the main code into a procedure body.
@x
@p begin @!{|start←here|}
@y
In Cedar, we must encapsulate the main program in a procedure so that we can fit it into a module.
@p procedure the←real←mf;
begin @!{|start←here|}
@z
888070: Delete test on ready𡤊lready; instead, set process priority down to background.
@x
if ready𡤊lready=314159 then goto start←of←MF;
@z
888369: Only intialize tables, strings and primitives if we are to start←like←inimf; else, reading the format will take care of these initializations.
@x
@!init if not get←strings←started then goto final𡤎nd;
init←tab; {initialize the tables}
init←prim; {call |primitive| for each primitive}
tini@/
@y
if start←like←inimf then
begin
if not get←strings←started then goto final𡤎nd;
init←tab; {initialize the tables}
init←prim; {call |primitive| for each primitive}
end;
@z
888514: Delete set of ready𡤊lready.
@y
@z
888976: Delete other set of ready𡤊lready.
@x
final𡤎nd: ready𡤊lready:=0;
@z
889005: End the new procedure the←real←mf, and put in the actual main body code, a call to an eternal proc that will register the two tex commands "mf" and "inimf".
@y
end;
begin
register←mf𡤌ommands;
end.
@z
889448: Add two internal procedures to break up |close𡤏iles𡤊nd←terminate|.
@x
procedure close𡤏iles𡤊nd←terminate;
var @!k:integer; {all-purpose index}
@!lh:integer; {the length of the \.{TFM} header, in words}
@!p:pointer; {runs through a list of \.{TFM} dimensions}
@!x:scaled; {a |tfm←width| value being output to the \.{GF} file}
begin
@y
procedure close𡤏iles𡤊nd←terminate;
var @!k:integer; {all-purpose index}
@!lh:integer; {the length of the \.{TFM} header, in words}
@!p:pointer; {runs through a list of \.{TFM} dimensions}
@!x:scaled; {a |tfm←width| value being output to the \.{GF} file}
@#
procedure tfm𡤏inish←up←the𡤏ile;
begin @<Finish the \.{TFM} file@>;
end;
@#
procedure gf𡤏inish←up←the𡤏ile;
begin @<Finish the \.{GF} file@>;
end;
@#
begin
@z
890040: Add a final carriage-return to the terminal output.
@x
print(log←name); print𡤌har(".");
@y
print(log←name); print𡤌har("."); print←ln;
@z
890492: Call the internal procedures we've made.
@x
@<Finish the \.{TFM} and \.{GF} files@>=
if (gf←prev←ptr>0)or(internal[fontmaking]>0) then
begin @<Make the dynamic memory into one big available node@>;
@<Massage the \.{TFM} widths@>;
fix�sign←size; fix𡤌heck←sum;
if internal[fontmaking]>0 then
begin @<Massage the \.{TFM} heights, depths, and italic corrections@>;
@<Finish the \.{TFM} file@>;
end;
if gf←prev←ptr>0 then @<Finish the \.{GF} file@>;
end
@y
@<Finish the \.{TFM} and \.{GF} files@>=
if (gf←prev←ptr>0)or(internal[fontmaking]>0) then
begin @<Make the dynamic memory into one big available node@>;
@<Massage the \.{TFM} widths@>;
fix�sign←size; fix𡤌heck←sum;
if internal[fontmaking]>0 then
begin @<Massage the \.{TFM} heights, depths, and italic corrections@>;
tfm𡤏inish←up←the𡤏ile;
end;
if gf←prev←ptr>0 then gf𡤏inish←up←the𡤏ile;
end
@z
892806: (~TRAP) Change "line" to "character" in one last error message.
@x
begin print(" on line "); print←int(if←line);
@y
begin print(" near character "); print←int(if←line);
@z
893292: Fix piece of unreachable code.
@x
begin @!init store�se𡤏ile; return;@+tini@/
print←nl("(dump is performed only by INIMF)"); return;
@.dump...only by INIMF@>
end;
@y
begin
if start←like←inimf then
begin
store�se𡤏ile;
return;
end
else
begin
print←nl("(dump is performed only by INIMF)");
@.dump...only by INIMF@>
return;
end;
end;
@z
894521: Read the default directories from the user profile; strings must be started by now, and we can't wait any longer since the next line might call start←input
@x
if loc<limit then if buffer[loc]<>"\" then start←input; {\&{input} assumed}
@y
read←profile𡤏or𡤍irectories;
if loc<limit then if buffer[loc]<>"\" then start←input; {\&{input} assumed}
@z
897432: Add in the external procedure declarations.
@x
itself will get a new section number.
@^system dependencies@>
@y
itself will get a new section number.
@^system dependencies@>
@<External procedure declarations for things implemented directly in Cedar@>=
procedure reset←term←in(var f: alpha𡤏ile); external;
{set up for input from terminal}
procedure rewrite←term←out(var f: alpha𡤏ile); external;
{set up for output to terminal}
procedure read←the𡤌lock(var ttime,dday,mmonth,yyear:integer); external;
function file←get←pos(var f: alpha𡤏ile):integer; external; {return character count}
procedure set←pool←name; external;
procedure read←profile𡤏or𡤍irectories; external;
procedure set←normal←priority; external;
procedure set�kground←priority; external;
function stuff←on𡤌md←line:integer; external;
procedure register←mf𡤌ommands; external;
@z