% 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