diff options
Diffstat (limited to 'obsolete/systems/knuth/unsupported/mf/mf.cms-changes')
-rw-r--r-- | obsolete/systems/knuth/unsupported/mf/mf.cms-changes | 1028 |
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 |