summaryrefslogtreecommitdiff
path: root/obsolete/systems/knuth/unsupported/mf/mf.cms-changes
diff options
context:
space:
mode:
Diffstat (limited to 'obsolete/systems/knuth/unsupported/mf/mf.cms-changes')
-rw-r--r--obsolete/systems/knuth/unsupported/mf/mf.cms-changes1028
1 files changed, 1028 insertions, 0 deletions
diff --git a/obsolete/systems/knuth/unsupported/mf/mf.cms-changes b/obsolete/systems/knuth/unsupported/mf/mf.cms-changes
new file mode 100644
index 0000000000..6c569d67d6
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/mf/mf.cms-changes
@@ -0,0 +1,1028 @@
+% Change file for IBM VM/CMS and Pascal/VS created by
+% Bernd Schulze at University of Bonn. Updated for
+% Metafont 1.0 by Alan Spragens at Stanford
+% Linear Accelerator Center 16 May 1986.
+%
+Metafont 1.0 WEB source line 26
+
+@x
+\def\PASCAL{Pascal}
+\def\ph{\hbox{Pascal-H}}
+@y
+\def\PASCAL{Pascal}
+\def\ph{\hbox{Pascal-H}}
+\def\pvs{\hbox{Pascal/VS}}
+@z
+
+Metafont 1.0 WEB source line 55
+@x
+\pageno=3
+@y
+\pageno=3
+\let\maybe=\iffalse
+\def\title{\MF\ changes for VM/CMS}
+@z
+
+%line 133
+%
+%section x
+@x banner
+@d banner=='This is METAFONT, Version 1.0' {printed when \MF\ starts}
+@y
+@d banner=='This is METAFONT, VM/CMS Version 1.0'
+{printed when \MF\ starts}
+@z
+%
+%line 196
+%
+%section xx
+@x
+procedure initialize; {this procedure gets things started properly}
+@y
+@<VM/CMS stuff@>
+@#
+procedure initialize; {this procedure gets things started properly}
+@z
+%
+%line 238
+%
+%section x
+@x
+@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
+@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
+@y
+@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
+@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
+@z
+%
+%line 243
+%
+%section x
+@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}
+@y
+@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
+%
+%line 258
+%
+%section x
+@x init ... tini
+@d init== {change this to `$\\{init}\equiv\.{@@\{}$' in the production version}
+@d tini== {change this to `$\\{tini}\equiv\.{@@\}}$' in the production version}
+@y
+@d init==@{
+@d tini==@}
+@z
+%
+%line 273
+%
+%section x
+@x compiler directives
+@<Compiler directives@>=
+@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead}
+@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging}
+@y
+@<Compiler directives@>=
+@z
+%
+%line 306
+%
+%section x
+@x othercases, termin, termout
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@y
+@d othercases == otherwise {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@d term_in == INTERM {terminal input}
+@d term_out == OUTTERM {terminal output}
+@z
+%
+%line 318
+%
+%section xx
+@x
+@!mem_max=30000; {greatest index in \MF's internal |mem| array;
+@y
+@!mem_max=65534; {greatest index in \MF's internal |mem| array;
+@z
+%
+%line 341
+%
+%section xx
+@x
+@!gf_buf_size=800; {size of the output buffer, must be a multiple of 8}
+@!file_name_size=40; {file names shouldn't be longer than this}
+@!pool_name='MFbases:MF.POOL ';
+@y
+@!gf_buf_size=2048; {size of the output buffer, must be a multiple of 8}
+@!len_byte_block=1024; {must be half of |gf_buf_size|}
+@!len_word_block=256; {base file buffer length}
+@!file_name_size=19; {file names shouldn't be longer than this}
+{19 = filename(8)+blank+filemode(8)+blank+filetype(1)}
+@!pool_name='MF.POOL.* ';
+@z
+%
+%line 366
+%
+%section xxx
+@x
+@d mem_top==30000 {largest index in the |mem| array dumped by \.{INIMF};
+@y
+@d mem_top==65534 {largest index in the |mem| array dumped by \.{INIMF};
+@z
+%
+%line 462
+%
+%section xxx
+@x packed
+@!ASCII_code=0..127; {seven-bit numbers}
+@y
+@!ASCII_code=packed 0..127; {seven-bit numbers}
+@z
+%
+%line 492
+%
+%section xx
+@x EBCDIC
+@d last_text_char=127 {ordinal number of the largest element of |text_char|}
+@y
+@d last_text_char=255 {ordinal number of the largest element of |text_char|}
+@z
+%
+%line 683
+%
+%section xx
+@x text files, packed
+for us to specify simple operations on word files before they are defined.
+
+@<Types...@>=
+@!eight_bits=0..255; {unsigned one-byte quantity}
+@!alpha_file=packed file of text_char; {files that contain textual data}
+@!byte_file=packed file of eight_bits; {files that contain binary data}
+@y
+for us to specify simple operations on word files before they are defined.
+
+@d alpha_file==@= text@>
+@d ccat==@=||@>
+
+@<Types...@>=
+@!eight_bits=packed 0..255; {unsigned one-byte quantity}
+@z
+%
+%line 736
+%
+%section xx
+% To open a text file for input, the implementor has to make a choice:
+% either he specifies RECFM, LRECL, and BLKSIZE, then PASCAL will not
+% give an error message if the file does not exist, but all input files
+% will have to conform to these specifications,
+% or, he does not specify these parameters, then he will get an error
+% message for non-existing files, but if the file does exist, it may
+% have fixed or varying length.
+@x
+begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f);
+@y
+var i,ipoint:integer;
+begin okstatus;
+ipoint:= 0;
+for i:= 1 to name_length do
+ if name_of_file(.i.)='.' then ipoint:=ipoint+1;
+if ipoint=1
+ then reset(f,'NAME='ccat trim(str(name_of_file))ccat '.*' ccat
+ ',RECFM=V,LRECL=256,BLKSIZE=260')
+ else reset(f,'NAME='ccat trim(str(name_of_file)) ccat
+ ',RECFM=V,LRECL=256,BLKSIZE=260');
+ a_open_in:=status;
+@z
+%
+%line 741
+%
+%section xx
+@x
+begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f);
+@y
+begin okstatus;
+rewrite(f,'RECFM=V,LRECL=1024,NAME='ccat trim(str(name_of_file)));
+ a_open_out:=status;
+@z
+%
+%line 746
+%
+%section xx
+@x
+begin rewrite(f,name_of_file,'/O'); b_open_out:=rewrite_OK(f);
+@y
+begin okstatus; rewrite(f,'NAME='ccat trim(str(name_of_file)));
+ b_open_out:=status;
+@z
+%
+%line 751
+%
+%section xx
+@x
+begin reset(f,name_of_file,'/O'); w_open_in:=reset_OK(f);
+@y
+var i,ipoint:integer;
+begin okstatus;
+ipoint:= 0;
+for i:= 1 to name_length do
+ if name_of_file(.i.)='.' then ipoint:=ipoint+1;
+if ipoint=1
+ then reset(f,'NAME='ccat trim(str(name_of_file))ccat '.*')
+ else reset(f,'NAME='ccat trim(str(name_of_file)));
+ w_open_in:=status;
+@z
+%
+%line 756
+%
+%section xx
+@x
+begin rewrite(f,name_of_file,'/O'); w_open_out:=rewrite_OK(f);
+@y
+begin okstatus; rewrite(f,'NAME='ccat trim(str(name_of_file)));
+ w_open_out:=status;
+@z
+%
+%line 846
+%
+%section xx
+@x file pointer is @
+ buffer[last]:=xord[f^]; get(f); incr(last);
+@y
+ buffer[last]:=xord[f@@]; get(f); incr(last);
+@z
+%
+%line 867
+%
+%section xx
+@x open terminal i/o
+@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==@= TERMIN@>(term_in) {open the terminal for text input}
+@d t_open_out==@= TERMOUT@>(term_out){open the terminal for text output}
+@z
+%
+
+%line 883
+%
+%section xx
+@x update terminal
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@d clear_terminal == break_in(term_in,true) {clear the terminal input buffer}
+@y
+@d update_terminal == do_nothing {empty the terminal output buffer}
+@d clear_terminal == do_nothing {clear the terminal input buffer}
+@z
+
+%line 948
+@x
+@p function init_terminal:boolean; {gets the terminal input started}
+label exit;
+begin t_open_in;
+loop@+begin wake_up_terminal; write(term_out,'**'); update_terminal;
+@y
+@p function init_terminal:boolean; {gets the terminal input started}
+label exit;
+begin t_open_in;
+loop@+begin wake_up_terminal; write_ln(term_out,'**'); update_terminal;
+@z
+
+Metafont 1.0 WEB source line 1506
+@x
+@p procedure term_input; {gets a line from the terminal}
+var @!k:0..buf_size; {index into |buffer|}
+begin update_terminal; {Now the user sees the prompt for sure}
+@y
+@p procedure term_input; {gets a line from the terminal}
+var @!k:0..buf_size; {index into |buffer|}
+begin update_terminal; {Now the user sees the prompt for sure}
+write_ln(term_out); {Now really for sure no doubt about it}
+@z
+
+%
+%line 1908
+%
+%section xxx
+@x
+interrupt:=0; OK_to_interrupt:=true;
+@y
+interrupt:=0; OK_to_interrupt:=true;
+term_attn(interrupt);
+@z
+%
+%line 3076
+%
+%section xxx
+@x optimization
+@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
+%
+%line 3087
+%
+%section xxx
+@x packed!
+@!quarterword = min_quarterword..max_quarterword; {1/4 of a word}
+@!halfword=min_halfword..max_halfword; {1/2 of a word}
+@!two_choices = 1..2; {used when there are two variants in a record}
+@!three_choices = 1..3; {used when there are three variants in a record}
+@y
+@!quarterword = packed min_quarterword..max_quarterword;
+ {1/4 of a word}
+@!halfword = packed min_halfword..max_halfword; {1/2 of a word}
+@!two_choices = packed 1..2;
+ {used when there are two variants in a record}
+@!three_choices = packed 1..3;
+ {used when there are three variants in a record}
+@z
+%
+%line 3109
+%
+%section xxx
+@x blocking of fmt file
+@!word_file = file of memory_word;
+@y
+@!word_block = packed array (.0..len_word_block-1.) of memory_word;
+@!word_file = packed file of word_block;
+@!byte_block = packed array [0..len_byte_block-1] of quarterword;
+@!byte_file = packed file of byte_block;
+@z
+%
+%line 4154
+%
+%section xxx
+@x date and time
+@p procedure fix_date_and_time;
+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
+@p procedure fix_date_and_time;
+ var sysdate,systime:alfa;
+ h,mi,t,y,d,mo:integer;
+begin
+ datetime(sysdate,systime);
+ readstr(str(systime),h:3,mi);
+ t:=60*h+mi; {minutes since midnight}
+ readstr(str(sysdate),mo:3,d:3,y);
+ { next line must be changed in the year 2084 }
+ if y<85 then y:=y+2000 else y:=y+1900;
+ internal(.time.):=t*unity;
+ internal(.month.):=mo*unity;
+ internal(.day .):=d*unity;
+ internal(.year.):=y*unity
+end;
+@z
+%line 11477
+%
+%section xxx
+@x pascal/vs problem (procedure size)
+@p procedure cubic_intersection(@!p,@!pp:pointer);
+label continue, not_found, exit;
+var @!q,@!qq:pointer; {|link(p)|, |link(pp)|}
+begin time_to_go:=max_patience; max_t:=2;
+@<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>=max_t then
+ begin if max_t=two then {we've done 17 bisections}
+ begin cur_t:=half(cur_t+1); cur_tt:=half(cur_tt+1); return;
+ end;
+ double(max_t); appr_t:=cur_t; appr_tt:=cur_tt;
+ end;
+ @<Subdivide for a new level of intersection@>;
+ goto continue;
+ end;
+ if time_to_go>0 then decr(time_to_go)
+ else begin while appr_t<unity do
+ begin double(appr_t); double(appr_tt);
+ end;
+ cur_t:=appr_t; cur_tt:=appr_tt; return;
+ end;
+ @<Advance to the next pair |(cur_t,cur_tt)|@>;
+ end;
+exit:end;
+@y
+@p procedure cubic_intersection(@!p,@!pp:pointer);
+label continue, exit;
+var @!q,@!qq:pointer; {|link(p)|, |link(pp)|}
+procedure init_i_1;
+begin
+@<Initialize for intersections at level zero (first half)@>;
+end;
+procedure init_i_2;
+begin
+@<Initialize for intersections at level zero (second half)@>;
+end;
+procedure sub_new_1;
+begin
+@<Subdivide for a new level of intersection (first fifth)@>;
+end;
+procedure sub_new_2;
+begin
+@<Subdivide for a new level of intersection (second fifth)@>;
+end;
+procedure sub_new_3;
+begin
+@<Subdivide for a new level of intersection (third fifth)@>;
+end;
+procedure sub_new_4;
+begin
+@<Subdivide for a new level of intersection (fourth fifth)@>;
+end;
+procedure sub_new_5;
+begin
+@<Subdivide for a new level of intersection (fifth fifth)@>;
+end;
+procedure advance_next;
+label not_found;
+begin
+@<Advance to the next pair |(cur_t,cur_tt)|@>;
+end;
+begin time_to_go:=max_patience; max_t:=2;
+init_i_1; init_i_2;
+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>=max_t then
+ begin if max_t=two then {we've done 17 bisections}
+ begin cur_t:=half(cur_t+1); cur_tt:=half(cur_tt+1); return;
+ end;
+ double(max_t); appr_t:=cur_t; appr_tt:=cur_tt;
+ end;
+ sub_new_1;
+ sub_new_2;
+ sub_new_3;
+ sub_new_4;
+ sub_new_5;
+ goto continue;
+ end;
+ if time_to_go>0 then decr(time_to_go)
+ else begin while appr_t<unity do
+ begin double(appr_t); double(appr_tt);
+ end;
+ cur_t:=appr_t; cur_tt:=appr_tt; return;
+ end;
+ advance_next;
+ end;
+exit:end;
+@z
+%
+%line 11735
+%
+%section xxx
+@x
+@<Initialize for intersections at level zero@>=
+q:=link(p); qq:=link(pp); bisect_ptr:=int_packets;@/
+u1r:=right_x(p)-x_coord(p); u2r:=left_x(q)-right_x(p);
+u3r:=x_coord(q)-left_x(q); set_min_max(ur_packet);@/
+v1r:=right_y(p)-y_coord(p); v2r:=left_y(q)-right_y(p);
+v3r:=y_coord(q)-left_y(q); set_min_max(vr_packet);@/
+x1r:=right_x(pp)-x_coord(pp); x2r:=left_x(qq)-right_x(pp);
+x3r:=x_coord(qq)-left_x(qq); set_min_max(xr_packet);@/
+y1r:=right_y(pp)-y_coord(pp); y2r:=left_y(qq)-right_y(pp);
+y3r:=y_coord(qq)-left_y(qq); set_min_max(yr_packet);@/
+delx:=x_coord(p)-x_coord(pp); dely:=y_coord(p)-y_coord(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 (first half)@>=
+q:=link(p); qq:=link(pp); bisect_ptr:=int_packets;@/
+u1r:=right_x(p)-x_coord(p); u2r:=left_x(q)-right_x(p);
+u3r:=x_coord(q)-left_x(q); set_min_max(ur_packet);@/
+v1r:=right_y(p)-y_coord(p); v2r:=left_y(q)-right_y(p);
+v3r:=y_coord(q)-left_y(q); set_min_max(vr_packet);@/
+
+@ @<Initialize for intersections at level zero (second half)@>=
+x1r:=right_x(pp)-x_coord(pp); x2r:=left_x(qq)-right_x(pp);
+x3r:=x_coord(qq)-left_x(qq); set_min_max(xr_packet);@/
+y1r:=right_y(pp)-y_coord(pp); y2r:=left_y(qq)-right_y(pp);
+y3r:=y_coord(qq)-left_y(qq); set_min_max(yr_packet);@/
+delx:=x_coord(p)-x_coord(pp); dely:=y_coord(p)-y_coord(pp);@/
+tol:=0; uv:=r_packets; xy:=r_packets; three_l:=0; cur_t:=1; cur_tt:=1
+@z
+%
+%line 11523
+%
+%section xxx
+@x
+@ @<Subdivide for a new level of intersection@>=
+stack_dx:=delx; stack_dy:=dely; stack_tol:=tol; stack_uv:=uv; stack_xy:=xy;
+bisect_ptr:=bisect_ptr+int_increment;@/
+double(cur_t); double(cur_tt);@/
+u1l:=stack_1(u_packet(uv)); u3r:=stack_3(u_packet(uv));
+u2l:=half(u1l+stack_2(u_packet(uv)));
+u2r:=half(u3r+stack_2(u_packet(uv)));
+u3l:=half(u2l+u2r); u1r:=u3l;
+set_min_max(ul_packet); set_min_max(ur_packet);@/
+v1l:=stack_1(v_packet(uv)); v3r:=stack_3(v_packet(uv));
+v2l:=half(v1l+stack_2(v_packet(uv)));
+v2r:=half(v3r+stack_2(v_packet(uv)));
+v3l:=half(v2l+v2r); v1r:=v3l;
+set_min_max(vl_packet); set_min_max(vr_packet);@/
+x1l:=stack_1(x_packet(xy)); x3r:=stack_3(x_packet(xy));
+x2l:=half(x1l+stack_2(x_packet(xy)));
+x2r:=half(x3r+stack_2(x_packet(xy)));
+x3l:=half(x2l+x2r); x1r:=x3l;
+set_min_max(xl_packet); set_min_max(xr_packet);@/
+y1l:=stack_1(y_packet(xy)); y3r:=stack_3(y_packet(xy));
+y2l:=half(y1l+stack_2(y_packet(xy)));
+y2r:=half(y3r+stack_2(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 (first fifth)@>=
+stack_dx:=delx; stack_dy:=dely; stack_tol:=tol; stack_uv:=uv; stack_xy:=xy;
+bisect_ptr:=bisect_ptr+int_increment;@/
+double(cur_t); double(cur_tt);@/
+u1l:=stack_1(u_packet(uv)); u3r:=stack_3(u_packet(uv));
+u2l:=half(u1l+stack_2(u_packet(uv)));
+u2r:=half(u3r+stack_2(u_packet(uv)));
+u3l:=half(u2l+u2r); u1r:=u3l;
+set_min_max(ul_packet); set_min_max(ur_packet);@/
+
+@ @<Subdivide for a new level of intersection (second fifth)@>=
+v1l:=stack_1(v_packet(uv)); v3r:=stack_3(v_packet(uv));
+v2l:=half(v1l+stack_2(v_packet(uv)));
+v2r:=half(v3r+stack_2(v_packet(uv)));
+v3l:=half(v2l+v2r); v1r:=v3l;
+set_min_max(vl_packet); set_min_max(vr_packet);@/
+
+@ @<Subdivide for a new level of intersection (third fifth)@>=
+x1l:=stack_1(x_packet(xy)); x3r:=stack_3(x_packet(xy));
+x2l:=half(x1l+stack_2(x_packet(xy)));
+x2r:=half(x3r+stack_2(x_packet(xy)));
+x3l:=half(x2l+x2r); x1r:=x3l;
+set_min_max(xl_packet); set_min_max(xr_packet);@/
+
+@ @<Subdivide for a new level of intersection (fourth fifth)@>=
+y1l:=stack_1(y_packet(xy)); y3r:=stack_3(y_packet(xy));
+y2l:=half(y1l+stack_2(y_packet(xy)));
+y2r:=half(y3r+stack_2(y_packet(xy)));
+y3l:=half(y2l+y2r); y1r:=y3l;
+set_min_max(yl_packet); set_min_max(yr_packet);@/
+
+@ @<Subdivide for a new level of intersection (fifth fifth)@>=
+uv:=l_packets; xy:=l_packets;
+double(delx); double(dely);@/
+tol:=tol-three_l+tol_step; double(tol); three_l:=three_l+tol_step
+@z
+%
+%line 15112
+%
+%section xxx
+@x file names
+@d MF_area=="MFinputs:"
+@y
+@d MF_area==".*"
+@z
+%
+%line 15125
+%
+%section xxx
+%
+CMS filenames consist of 3 parts: filename, filetype, filemode.
+filename and filetype are 8 chars long, filemode only 1.
+filename will be the original name, filetype the original extension
+and filemode the original area (be careful to interchange
+area and extension!)
+There are a lot of funny characters allowed in CMS filenames, but
+PASCAL/VS 2.1 doesn't accept them, so we have commented them out.
+@x file names
+@p function more_name(@!c:ASCII_code):boolean;
+begin if c=" " then more_name:=false
+else begin if (c=">")or(c=":") then
+ begin area_delimiter:=pool_ptr; ext_delimiter:=0;
+ end
+ else if (c=".")and(ext_delimiter=0) then ext_delimiter:=pool_ptr;
+ str_room(1); append_char(c); {contribute |c| to the current string}
+ more_name:=true;
+ end;
+end;
+@y
+@p function more_name(@!c:ASCII_code):boolean;
+begin
+if ((c>="0") and (c<="9")) or ((c>="a") and (c<="z"))
+ or ((c>="A") and (c<="Z"))
+ {|or (c="@@") or (c="#") or (c="$") or (c="_")
+ or (c="+") or (c=":") or (c="-")|}
+ or (c=".")
+ then begin {contribute |c| to the current string}
+ if (c=".")
+ then if ext_delimiter=0
+ then ext_delimiter:=pool_ptr
+ else if area_delimiter=0
+ then area_delimiter:=pool_ptr;
+ more_name:=true;
+ str_room(1); append_char(c);
+ end
+ else more_name:=false;
+end;
+@z
+%
+%line 15146
+%
+%section xxx
+@x file names
+if area_delimiter=0 then cur_area:=""
+else begin cur_area:=str_ptr; incr(str_ptr);
+ str_start[str_ptr]:=area_delimiter+1;
+ end;
+if ext_delimiter=0 then
+ begin cur_ext:=""; cur_name:=make_string;
+ end
+else begin cur_name:=str_ptr; incr(str_ptr);
+ str_start[str_ptr]:=ext_delimiter; cur_ext:=make_string;
+ end;
+end;
+@y
+if ext_delimiter=0 then begin cur_area:=""; cur_ext:="";
+ cur_name:=make_string; end
+else begin cur_name:=str_ptr; incr(str_ptr);
+ str_start[str_ptr]:=ext_delimiter;
+ if area_delimiter=0 then
+ begin cur_area:=""; cur_ext:=make_string;
+ end
+ else begin cur_ext:=str_ptr; incr(str_ptr);
+ str_start[str_ptr]:=area_delimiter; cur_area:=make_string;
+ end;
+ end;
+ if length(cur_name)=0 then cur_name:="NULL";
+ if length(cur_area)=1 then cur_name:=""; {just .}
+ if length(cur_ext )=1 then cur_name:=""; {just .}
+end;
+@z
+%line 15165
+%
+%section xxx
+@x file names
+begin print(a); print(n); print(e);
+@y
+begin print(n); print(e); print(a);
+@z
+%
+%line 15182
+%
+%section xxx
+@x file names, order of fn/ft/fm, length
+for j:=str_start[a] to str_start[a+1]-1 do append_to_name(str_pool[j]);
+for j:=str_start[n] to str_start[n+1]-1 do append_to_name(str_pool[j]);
+for j:=str_start[e] to str_start[e+1]-1 do append_to_name(str_pool[j]);
+@y e and a already start with a . !
+for j:=str_start[n] to str_start[n] + min(8,length(n))-1
+ do append_to_name(str_pool[j]);
+for j:=str_start[e] to str_start[e] + min(9,length(e))-1
+ do append_to_name(str_pool[j]);
+for j:=str_start[a] to str_start[a] + min(2,length(a))-1
+ do append_to_name(str_pool[j]);
+@z
+%
+%line 15195
+%
+%section xxx
+@x file names
+@d base_default_length=18 {length of the |MF_base_default| string}
+@d base_area_length=8 {length of its area part}
+@d base_ext_length=5 {length of its `\.{.base}' part}
+@y
+@d base_default_length=12 {length of the |MF_base_default| string}
+@d base_area_length=0 {length of its area part}
+@d base_ext_length=7 {length of its `\.{.base}' part}
+@z
+%
+%line 15471
+%
+%section xxx
+@x file names (attention: area-ext not consistent with rest)
+MF_base_default:='MFbases:plain.base';
+@y
+MF_base_default:='PLAIN.BASE.*';
+@z
+%
+%line 15229
+%
+%section xxx
+@x file names
+for j:=1 to n do append_to_name(xord[MF_base_default[j]]);
+for j:=a to b do append_to_name(buffer[j]);
+@y
+for j:=a to b do append_to_name(buffer[j]);
+for j:=1 to n do append_to_name(xord[MF_base_default[j]]);
+@z
+%
+%line 156xx
+%
+%section xxx
+@x log file name
+pack_job_name(".log");
+@y
+pack_job_name(".mflog");
+@z
+%
+%line 156xx
+%
+%section xxx
+@x log file name
+prompt_file_name("transcript file name",".log");
+@y
+prompt_file_name("transcript file name",".mflog");
+@z
+%
+%line 20154
+%
+%section xxx
+
+@!tfm_file:byte_file; {the font metric output goes here}
+
+@!tfm_file:byte_file; {the font metric output goes here}
+@!tfm_buf:byte_block;
+
+%
+%line 20922
+%
+%section xxx
+@x
+@d tfm_out(#)==write(tfm_file,#) {output one byte to |tfm_file|}
+@y
+@d tfm_out(#)==put_tfm(#) {output one byte to |tfm_file|}
+@z
+%
+%line 20948
+%
+%section xxx
+@x
+while not b_open_out(tfm_file) do
+@y
+tfm_count:=0;
+while not b_open_out(tfm_file) do
+@z
+
+Metafont 1.0 WEB source line 21286
+@x
+print_nl("Font metrics written on "); print(metric_file_name);
+@.Font metrics written...@>
+b_close(tfm_file)
+@y
+while tfm_count>0 do put_tfm(0);
+print_nl("Font metrics written on "); print(metric_file_name);
+@.Font metrics written...@>
+b_close(tfm_file)
+@z
+
+%
+%line 21393
+%
+%section xxx
+@x
+@ Some systems may find it more efficient to make |gf_buf| a |packed|
+array, since output of four bytes at once may be facilitated.
+@^system dependencies@>
+
+@<Glob...@>=
+@!gf_buf:array[gf_index] of eight_bits; {buffer for \.{GF} output}
+@y
+@ We play a trick with variant records so that we can fill up the
+|gf_buf| array byte by byte, but write it out in one swell foop.
+@^system dependencies@>
+@d gf_buf==g_buffer.b {buffer for \.{GF} output}
+
+@<Glob...@>=
+@!g_buffer: packed record
+ case boolean of
+ false:(b:packed array (.gf_index.) of eight_bits);
+ true: (l:byte_block; r:byte_block);
+ end;
+@z
+%
+%line 21412
+%
+%section xxx
+@x
+@ The actual output of |gf_buf[a..b]| to |gf_file| is performed by calling
+|write_gf(a,b)|. It is safe to assume that |a| and |b+1| will both be
+multiples of 4 when |write_gf(a,b)| is called; therefore it is possible on
+many machines to use efficient methods to pack four bytes per word and to
+output an array of words with one system call.
+@^system dependencies@>
+
+@<Declare generic font output procedures@>=
+procedure write_gf(@!a,@!b:gf_index);
+var k:gf_index;
+begin for k:=a to b do write(gf_file,gf_buf[k]);
+end;
+@y
+@ The actual output of |gf_buf(.a..b.)| to |dvi_file| is performed by calling
+|write| on the other variant of the |gf_buf| record. Thus, we had
+better be sure things line up properly.
+@^system dependencies@>
+@^inner loop@>
+@^defecation@>
+
+@<Check the ``constant''...@>=
+if gf_buf_size<>2*len_byte_block then bad:=223;
+@z
+%
+%line 21435
+%
+%section xxx
+@x
+ begin write_gf(0,half_buf-1); gf_limit:=half_buf;
+@y
+ begin write(gf_file,g_buffer.l); gf_limit:=half_buf;
+@z
+%
+%line 21438
+%
+%section xxx
+@x
+else begin write_gf(half_buf,gf_buf_size-1); gf_limit:=gf_buf_size;
+@y
+else begin write(gf_file,g_buffer.r); gf_limit:=gf_buf_size;
+@z
+%
+%line 21446
+%
+%section xxx
+@x
+if gf_limit=half_buf then write_gf(half_buf,gf_buf_size-1);
+if gf_ptr>0 then write_gf(0,gf_ptr-1)
+@y
+if gf_limit=half_buf then write(gf_file,g_buffer.r);
+for k:=gf_ptr to gf_buf_size do gf_buf(.k.):=223; {bug is |k| ok?}
+if gf_ptr>0 then write(gf_file,g_buffer.l);
+if gf_ptr>half_buf then write(gf_file,g_buffer.r);
+@z
+%
+%line 21852
+%
+%section xx
+@x file pointer, blocking of base file
+@d dump_wd(#)==begin base_file^:=#; put(base_file);@+end
+@d dump_int(#)==begin base_file^.int:=#; put(base_file);@+end
+@d dump_hh(#)==begin base_file^.hh:=#; put(base_file);@+end
+@d dump_qqqq(#)==begin base_file^.qqqq:=#; put(base_file);@+end
+@y
+@d base_word==base_file@@(.base_count.)
+
+@d dump_wd(#)==begin base_word:=#; put_base;@+end
+@d dump_int(#)==begin base_word.int:=#; put_base;@+end
+@d dump_hh(#)==begin base_word.hh:=#; put_base;@+end
+@d dump_qqqq(#)==begin base_word.qqqq:=#; put_base;@+end
+@z
+%
+%line 20654
+%
+%section xxxx
+@x base file blocking
+@d undump_wd(#)==begin get(base_file); #:=base_file^;@+end
+@d undump_int(#)==begin get(base_file); #:=base_file^.int;@+end
+@d undump_hh(#)==begin get(base_file); #:=base_file^.hh;@+end
+@d undump_qqqq(#)==begin get(base_file); #:=base_file^.qqqq;@+end
+@y
+@d undump_wd(#)==begin get_base; #:=base_word;@+end
+@d undump_int(#)==begin get_base; #:=base_word.int;@+end
+@d undump_hh(#)==begin get_base; #:=base_word.hh;@+end
+@d undump_qqqq(#)==begin get_base; #:=base_word.qqqq;@+end
+@z
+%
+%line 21879
+%
+%section nnn
+@x blocking of fmt file
+@<Dump constants for consistency check@>=
+@y
+@<Dump constants for consistency check@>=
+base_count:=0;
+@z
+%
+%line 21894
+%
+%section xxxx
+@x file pointer, blocking of base file
+x:=base_file^.int;
+@y
+base_count:=0;
+x:=base_word.int;
+@z
+%
+%line 22350
+%
+%section xxxx
+@x blocking of fmt file
+dump_int(bg_loc); dump_int(eg_loc); dump_int(serial_no); dump_int(69069);
+@y
+dump_int(bg_loc); dump_int(eg_loc); dump_int(serial_no); dump_int(69069);
+while base_count >0 do dump_int(0); {flush out the buffer}
+@z
+%
+%line 22450
+%
+%section xxxx
+@x
+@p begin @!{|start_here|}
+history:=fatal_error_stop; {in case we quit during initialization}
+t_open_out; {open the terminal for output}
+if ready_already=314159 then goto start_of_MF;
+@y
+@p begin @!{|start_here|}
+history:=fatal_error_stop; {in case we quit during initialization}
+t_open_out; {open the terminal for output}
+@z
+%
+%line 22456
+%
+%section xxxx
+@x
+ begin wterm_ln('Ouch---my internal constants have been clobbered!',
+ '---case ',bad:1);
+@y
+ begin wterm_ln('Ouch---my internal constants have been clobbered!',
+ '---case ',bad:1);
+ ret_code(100+bad);
+@z
+%
+%line 22147
+%
+%section xxxx
+@x
+final_end: ready_already:=0;
+@y
+final_end: ret_code(history*4);
+interrupt:=-1;
+term_attn(interrupt);
+@z
+%
+%line 22377
+%
+%section xxxx
+@x additions
+itself will get a new section number.
+@^system dependencies@>
+@y
+itself will get a new section number.
+@^system dependencies@>
+
+@ @<Glob...@>=
+@!tfm_count: 0..len_byte_block;
+@!base_count: integer;
+@!status: boolean; {did the last |reset| or |rewrite| succede?}
+
+@ @<VM/CMS...@>=
+procedure term_attn(var interrupt: integer); fortran;
+procedure okstatus; begin status:=true; end;
+@/@\@=%INCLUDE ONERROR;@>@\
+@#
+procedure onerror; begin
+if @= FERROR @> in [41,48] then begin
+ status:=false;
+ @= FACTION@>:=[@=XDECERR@>]; end;
+if @= FERROR@>=30 then interrupt:=1;
+end;
+
+procedure put_tfm(@!x:eight_bits);
+begin
+ tfm_file@@[tfm_count]:=x;
+ incr(tfm_count);
+ if tfm_count=len_byte_block then
+ begin put(tfm_file); tfm_count:=0; end;
+end;
+
+procedure put_base;
+begin
+ incr(base_count);
+ if base_count=len_word_block then
+ begin put(base_file); base_count:=0; end;
+end;
+
+procedure get_base;
+begin
+ incr(base_count);
+ if base_count=len_word_block then
+ begin get(base_file); base_count:=0; end;
+end;
+@z