summaryrefslogtreecommitdiff
path: root/obsolete/systems/knuth/unsupported
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /obsolete/systems/knuth/unsupported
Initial commit
Diffstat (limited to 'obsolete/systems/knuth/unsupported')
-rw-r--r--obsolete/systems/knuth/unsupported/mf/mf.cms-changes1028
-rw-r--r--obsolete/systems/knuth/unsupported/mf/mf.tops20-changes1267
-rw-r--r--obsolete/systems/knuth/unsupported/mf/mf.vms-changes1261
-rw-r--r--obsolete/systems/knuth/unsupported/mfware/gfread.tops20-changes172
-rw-r--r--obsolete/systems/knuth/unsupported/mfware/gfread.web1157
-rw-r--r--obsolete/systems/knuth/unsupported/mfware/gftodvi.cms-changes598
-rw-r--r--obsolete/systems/knuth/unsupported/mfware/gftodvi.tops20-changes205
-rw-r--r--obsolete/systems/knuth/unsupported/mfware/gftodvi.vms-changes465
-rw-r--r--obsolete/systems/knuth/unsupported/mfware/gftopk.tops20-changes177
-rw-r--r--obsolete/systems/knuth/unsupported/mfware/gftopxl.cms-changes438
-rw-r--r--obsolete/systems/knuth/unsupported/mfware/gftopxl.tops20-changes27
-rw-r--r--obsolete/systems/knuth/unsupported/mfware/gftopxl.vms-changes409
-rw-r--r--obsolete/systems/knuth/unsupported/mfware/gftopxl.web1551
-rw-r--r--obsolete/systems/knuth/unsupported/mfware/gftype.cms-changes223
-rw-r--r--obsolete/systems/knuth/unsupported/mfware/gftype.tops20-changes99
-rw-r--r--obsolete/systems/knuth/unsupported/mfware/gftype.vms-changes301
-rw-r--r--obsolete/systems/knuth/unsupported/mfware/pktogf.tops20-changes153
-rw-r--r--obsolete/systems/knuth/unsupported/mfware/pktogf.web1727
-rw-r--r--obsolete/systems/knuth/unsupported/mfware/pktopx.tops20-changes199
-rw-r--r--obsolete/systems/knuth/unsupported/mfware/pktopx.web1150
-rw-r--r--obsolete/systems/knuth/unsupported/mfware/pktype.tops20-changes66
-rw-r--r--obsolete/systems/knuth/unsupported/mfware/pktype.web1156
-rw-r--r--obsolete/systems/knuth/unsupported/mfware/pxtopk.tops20-changes345
-rw-r--r--obsolete/systems/knuth/unsupported/mfware/pxtopk.web1648
-rw-r--r--obsolete/systems/knuth/unsupported/patgen/patgen.web1978
-rw-r--r--obsolete/systems/knuth/unsupported/tex/tex.cms-changes1855
-rw-r--r--obsolete/systems/knuth/unsupported/tex/tex.mvs-changes663
-rw-r--r--obsolete/systems/knuth/unsupported/tex/tex.tops10-changes1034
-rw-r--r--obsolete/systems/knuth/unsupported/tex/tex.tops20-changes1308
-rw-r--r--obsolete/systems/knuth/unsupported/tex/tex.vms-changes1092
-rw-r--r--obsolete/systems/knuth/unsupported/texware/dviimp.tops20-changes406
-rw-r--r--obsolete/systems/knuth/unsupported/texware/dviimp.web4261
-rw-r--r--obsolete/systems/knuth/unsupported/texware/dvitype.cms-changes378
-rw-r--r--obsolete/systems/knuth/unsupported/texware/dvitype.tops10-changes98
-rw-r--r--obsolete/systems/knuth/unsupported/texware/dvitype.tops20-changes72
-rw-r--r--obsolete/systems/knuth/unsupported/texware/dvitype.vms-changes469
-rw-r--r--obsolete/systems/knuth/unsupported/texware/pltotf.cms-changes61
-rw-r--r--obsolete/systems/knuth/unsupported/texware/pltotf.tops10-changes5
-rw-r--r--obsolete/systems/knuth/unsupported/texware/pltotf.tops20-changes34
-rw-r--r--obsolete/systems/knuth/unsupported/texware/pltotf.vms-changes186
-rw-r--r--obsolete/systems/knuth/unsupported/texware/pooltype.cms-changes20
-rw-r--r--obsolete/systems/knuth/unsupported/texware/pooltype.vms-changes152
-rw-r--r--obsolete/systems/knuth/unsupported/texware/tftopl.cms-changes86
-rw-r--r--obsolete/systems/knuth/unsupported/texware/tftopl.tops10-changes5
-rw-r--r--obsolete/systems/knuth/unsupported/texware/tftopl.tops20-changes34
-rw-r--r--obsolete/systems/knuth/unsupported/texware/tftopl.vms-changes203
-rw-r--r--obsolete/systems/knuth/unsupported/web/tangle.changes20
-rw-r--r--obsolete/systems/knuth/unsupported/web/tangle.cms-changes162
-rw-r--r--obsolete/systems/knuth/unsupported/web/tangle.cmspas780
-rw-r--r--obsolete/systems/knuth/unsupported/web/tangle.pas783
-rw-r--r--obsolete/systems/knuth/unsupported/web/tangle.tops20-changes30
-rw-r--r--obsolete/systems/knuth/unsupported/web/tangle.vms-changes346
-rw-r--r--obsolete/systems/knuth/unsupported/web/weave.cms-changes187
-rw-r--r--obsolete/systems/knuth/unsupported/web/weave.tops20-changes22
-rw-r--r--obsolete/systems/knuth/unsupported/web/weave.vms-changes315
55 files changed, 32867 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
diff --git a/obsolete/systems/knuth/unsupported/mf/mf.tops20-changes b/obsolete/systems/knuth/unsupported/mf/mf.tops20-changes
new file mode 100644
index 0000000000..45b415bf8b
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/mf/mf.tops20-changes
@@ -0,0 +1,1267 @@
+This change file is for the TOPS-20 version of MetaFont.
+
+Copyright (C) 1985 by Tomas Rokicki. All rights are reserved.
+Based on the TeX change file by David Fuchs.
+
+Problem areas are marked with `fix me'. Please report any bugs to
+ROKICKI@SU-SCORE.
+
+This file makes an INIMF. To get a production MF, change the INIT and
+TINI macros to @{ and @}, respectively, and re-TANGLE. You may wish to do
+the same for DEBUG and GUBED, and perhaps even STAT and TATS.
+
+
+@x [0] Tell WEAVE to print only the changes:
+ \def\?##1]{\hbox to 1in{\hfil##1.\ }}
+ }
+@y
+ \def\?##1]{\hbox{Changes to \hbox to 1em{\hfil##1}.\ }}
+ }
+\let\maybe=\iffalse
+\def\ttw{{\mc TOPS-20}}
+\def\title{\MF\ changes for \ttw}
+@z
+
+@x [1] TOPS-20's banner:
+@d banner=='This is METAFONT, Version 1.5' {printed when \MF\ starts}
+@y
+
+Comments on the \ttw\ implementation (based on David Fuchs' \tex\ change
+file) of \MF\ follow:
+@^Fuchs, David Raymond@>
+
+Firstly, input files are considered to have pages, which are delimited with
+form-feeds. All error messages give the page number, along with the line
+number on that page (if the page number is one, then the page number is
+not printed, to avoid confusing people who do not use form-feeds).
+
+Secondly, the area \.{mfbases:} is where \MF\ looks for it's \.{.pool} file.
+
+Thirdly, \MF\ reads your \ttw\ command line that invoked it, and uses
+everything after the command name as input. For instance, you might say
+`\.{mf\ foo}' to \ttw, and \MF\ will act the same as if you had
+started it and then said `\.{foo}' to the initial \.{**} prompt. You can
+also say more complicated things,
+like `\.{mf\ \&myfmt\ \\input bar}'.
+Moreover, \MF\ tries to remember your entire incantation,
+so that the next time you can simply say `\.{mf}', and \MF\ will pretend
+you had repeated the stuff you said last time. Note that if you give a
+new, nonempty command line, it will be paid attention to, and the new
+command line will then be remembered for next time. If you want to get a
+\MF\ that ignores any previous command line, say `\.{mf\ \\}' to \ttw,
+and \MF\ will totally forget any old command line you gave it.
+The command line memory is implemented with logical names
+$\hbox{mfmem}x,\,x\in\{0,1,\ldots\}$,
+so when you log out, the memory fades.
+
+Fourthly, the interrupt feature is activated by typing control-g.
+
+Fifthly, \MF\ will suggest a spooling command when it is done with
+your job. It will `sti' the line `\.{mfspool:\ foo.gf.1}' if it wrote
+said dvi file; thus users can send their output by default to their
+favorite device by appropriatly defining \.{mfspool:}.
+
+Sixthly, \MF\ allows you to use logical names where file names
+normally go; for instance you can say `\.{mf foo:}' when you've
+already done a \.{define foo: bar} or \.{def foo: adisk:<me>x.mf}
+or even \.{def foo: bar:} followed by \.{def bar: <you>x}. Don't
+expect \.{mf foo:.x} to work, though.
+
+Lastly, \MF\ tries to be smart about swapping to your favorite editor
+when you reply `e' to one of its error messages. Unfortunatly, there is
+no good system interface for doing this sort of thing, so the technique is
+both fallible, and special code needs to be added for each editor supported
+(currently, emacs, edit, tvedit and zed). \MF\ looks at the
+logical name \.{editor:} and tries to figure out which one you've got so that it
+can \.{sti} the appropriate commands.
+
+@d banner=='This is METAFONT, Tops-20 Version 1.5'
+@d max_TOPS20_file_name_length = 300 {That ought to be big enough}
+@z
+
+@x [1] Switches for debugging and statistics:
+@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
+@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
+@f debug==begin
+@f gubed==end
+@#
+@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}
+@f stat==begin
+@f tats==end
+@y
+@d debug==
+@d gubed==
+@f debug==begin
+@f gubed==end
+@#
+@d stat==
+@d tats==
+@f stat==begin
+@f tats==end
+@z
+
+@x [1] The INIMF switch:
+@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
+
+@x [1] 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 The space after the B is due to a compiler bug.
+@{@&$C-,A+,D-,P:510000@&B@= @>@}
+ {no range check, catch arithmetic overflow, no debug overhead,
+ move the code up to make room for the global data in production}
+@!debug @{@&$C+,D+,X+,P:400000@&B@= @>@}@+ gubed
+ {we turn everything on when debugging and we use extended addressing
+ (otherwise there's not enough room with all the debug stuff)}
+@z
+
+@x [1] Compile-time constants:
+@!mem_max=30000; {greatest index in \MF's internal |mem| array;
+ must be strictly less than |max_halfword|;
+ must be equal to |mem_top| in \.{INIMF}, otherwise |>=mem_top|}
+@!max_internal=100; {maximum number of internal quantities}
+@!buf_size=500; {maximum number of characters simultaneously present in
+ current lines of open files; must not exceed |max_halfword|}
+@!error_line=72; {width of context lines on terminal error messages}
+@!half_error_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}
+@!screen_width=768; {number of pixels in each row of screen display}
+@!screen_depth=1024; {number of pixels in each column of screen display}
+@!stack_size=30; {maximum number of simultaneous input sources}
+@!max_strings=2000; {maximum number of strings; must not exceed |max_halfword|}
+@!string_vacancies=8000; {the minimum number of characters that should be
+ available for the user's identifier names and strings,
+ after \MF's own error messages are stored}
+@!pool_size=32000; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all identifiers;
+ must exceed |string_vacancies| by the total
+ length of \MF's own strings, which is currently about 22000}
+@!move_size=5000; {space for storing moves in a single octant}
+@!max_wiggle=300; {number of autorounded points per cycle}
+@!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 ';
+ {string of length |file_name_size|; tells where the string pool appears}
+@.MFbases@>
+@!path_size=300; {maximum number of knots between breakpoints of a path}
+@!bistack_size=785; {size of stack for bisection algorithms;
+ should probably be left at this value}
+@!header_size=100; {maximum number of \.{TFM} header words, times~4}
+@!lig_table_size=300; {maximum number of ligature/kern steps}
+@!max_font_dimen=50; {maximum number of \&{fontdimen} parameters}
+@y
+@!mem_max=58000; {greatest index in \MF's internal |mem| array;
+ must be strictly less than |max_halfword|;
+ must be equal to |mem_top| in \.{INIMF}, otherwise |>=mem_top|}
+@!max_internal=100; {maximum number of internal quantities}
+@!buf_size=500; {maximum number of characters simultaneously present in
+ current lines of open files; must not exceed |max_halfword|}
+@!error_line=72; {width of context lines on terminal error messages}
+@!half_error_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}
+@!screen_width=768; {number of pixels in each row of screen display}
+@!screen_depth=1024; {number of pixels in each column of screen display}
+@!stack_size=30; {maximum number of simultaneous input sources}
+@!max_strings=2000; {maximum number of strings; must not exceed |max_halfword|}
+@!string_vacancies=8000; {the minimum number of characters that should be
+ available for the user's identifier names and strings,
+ after \MF's own error messages are stored}
+@!pool_size=32000; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all identifiers;
+ must exceed |string_vacancies| by the total
+ length of \MF's own strings, which is currently about 22000}
+@!move_size=5000; {space for storing moves in a single octant}
+@!max_wiggle=300; {number of autorounded points per cycle}
+@!gf_buf_size=800; {size of the output buffer, must be a multiple of 8}
+@!file_name_size=69; {file names shouldn't be longer than this}
+@!pool_name=
+ 'MFbases:MF.POOL ';
+ {string of length |file_name_size|; tells where the string pool appears}
+@.MFbases@>
+@!path_size=300; {maximum number of knots between breakpoints of a path}
+@!bistack_size=785; {size of stack for bisection algorithms;
+ should probably be left at this value}
+@!header_size=100; {maximum number of \.{TFM} header words, times~4}
+@!lig_table_size=300; {maximum number of ligature/kern steps}
+@!max_font_dimen=50; {maximum number of \&{fontdimen} parameters}
+@!max_rescan=500; {maximum length of the rescan buffer}
+@z
+
+@x [1] TANGLE-time constants:
+@d mem_min=0 {smallest index in the |mem| array, must not be less
+ than |min_halfword|}
+@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|}
+@d hash_size=2100 {maximum number of symbolic tokens,
+ must be less than |max_halfword-3*param_size|}
+@d hash_prime=1777 {a prime number equal to about 85\% of |hash_size|}
+@d max_in_open=6 {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@d param_size=150 {maximum number of simultaneous macro parameters}
+@^system dependencies@>
+@y
+@d mem_min=0 {smallest index in the |mem| array, must not be less
+ than |min_halfword|}
+@d mem_top==58000 {largest index in the |mem| array dumped by \.{INIMF};
+ must be substantially larger than |mem_min|
+ and not greater than |mem_max|}
+@d hash_size=2100 {maximum number of symbolic tokens,
+ must be less than |max_halfword-3*param_size|}
+@d hash_prime=1777 {a prime number equal to about 85\% of |hash_size|}
+@d max_in_open=6 {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@d param_size=150 {maximum number of simultaneous macro parameters}
+@^system dependencies@>
+@z
+
+@x [2] System-dependent character set changes:
+@^character set dependencies@>
+@^system dependencies@>
+
+@<Set init...@>=
+for i:=1 to @'37 do xchr[i]:=' ';
+@y
+@^character set dependencies@>
+@^system dependencies@>
+
+The code shown here is intended to be used on \ttw\ systems,
+and at other installations where only the printable ASCII set, plus
+|carriage_return|, |tab|, and |form_feed| will show up in text files.
+All |line_feed| and |null| characters are skipped.
+
+Note that |form_feed|'s are considered to be page delimiters, and this version
+of \TeX\ will keep track of which page of input it is on, for use in error
+messages, as well as in swapping to various editors.
+
+@d form_feed=@'14 {ASCII code used at end of a page}
+@d carriage_return=@'15 {ASCII code used at end of a line}
+@d tab=@'11
+
+@<Set initial values...@>=
+for i:=1 to @'37 do xchr[i]:=' ';
+xchr[form_feed]:=chr(form_feed);
+xchr[tab]:=chr(tab);
+@z
+
+@x [3] Opening files:
+@d reset_OK(#)==erstat(#)=0
+@d rewrite_OK(#)==erstat(#)=0
+
+@p function a_open_in(var @!f:alpha_file):boolean;
+ {open a text file for input}
+begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f);
+end;
+@#
+function a_open_out(var @!f:alpha_file):boolean;
+ {open a text file for output}
+begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f);
+end;
+@#
+function b_open_out(var @!f:byte_file):boolean;
+ {open a binary file for output}
+begin rewrite(f,name_of_file,'/O'); b_open_out:=rewrite_OK(f);
+end;
+@#
+function w_open_in(var @!f:word_file):boolean;
+ {open a word file for input}
+begin reset(f,name_of_file,'/O'); w_open_in:=reset_OK(f);
+end;
+@#
+function w_open_out(var @!f:word_file):boolean;
+ {open a word file for output}
+begin rewrite(f,name_of_file,'/O'); w_open_out:=rewrite_OK(f);
+end;
+@y
+@d reset_OK(#)==(erstat(#)=0) or (erstat(#)=@'0600220) {empty file}
+@d rewrite_OK(#)==erstat(#)=0
+
+@p function erstat(var f:file):integer; extern; {in the runtime library}
+
+function a_open_in(var f:alpha_file):boolean;
+ {open a text file for input}
+begin reset(f,name_of_file,'/E/O');
+ {the \.{/E} switch distinguishes |form_feed| from |carriage_return|;
+ the \.{/O} switch gives error control to us}
+a_open_in:=reset_OK(f);
+end;
+@#
+function a_open_out(var f:alpha_file):boolean;
+ {open a text file for output}
+begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f);
+end;
+@#
+function b_open_out(var f:byte_file):boolean;
+ {open a binary file for output}
+begin rewrite(f,name_of_file,'/B:8/O'); b_open_out:=rewrite_OK(f);
+end;
+@#
+function w_open_in(var f:word_file):boolean;
+ {open a word file for input}
+begin reset(f,name_of_file,'/O'); w_open_in:=reset_OK(f);
+end;
+@#
+function w_open_out(var f:word_file):boolean;
+ {open a word file for output}
+begin rewrite(f,name_of_file,'/O'); w_open_out:=rewrite_OK(f);
+end;
+@z
+
+@x [3] New input_ln:
+representing the beginning and ending of a line of text.
+
+@<Glob...@>=
+@y
+representing the beginning and ending of a line of text.
+
+We will read the lines first into an auxiliary buffer, in order to
+save the running time of procedure-call overhead. This uses a nice
+feature of \ph\ that Knuth chose not to mention in \TeX82.
+@^Knuth, Donald Ervin@>
+
+On \ttw\ we want to recognize page marks (indicated by |form_feed|
+characters), and keep track of the current page number. EDIT-type
+line number are skipped over automatically.
+
+@d aux_buf_len=80 {length of the auxiliary buffer}
+
+@<Glob...@>=
+@!aux_buf:array[0..aux_buf_len-1] of text_char; {where the characters go first}
+@^system dependencies@>
+@z
+
+@x
+@p function input_ln(var @!f:alpha_file;@!bypass_eoln:boolean):boolean;
+ {inputs the next line or returns |false|}
+var @!last_nonblank:0..buf_size; {|last| with trailing blanks removed}
+begin if bypass_eoln then if not eof(f) then get(f);
+ {input the first character of the line into |f^|}
+last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
+if eof(f) then input_ln:=false
+else begin last_nonblank:=first;
+ while not eoln(f) do
+ begin if last>=max_buf_stack then
+ begin max_buf_stack:=last+1;
+ if max_buf_stack=buf_size then
+ overflow("buffer size",buf_size);
+@:METAFONT capacity exceeded buffer size}{\quad buffer size@>
+ end;
+ buffer[last]:=xord[f^]; get(f); incr(last);
+ if buffer[last-1]<>" " then last_nonblank:=last;
+ end;
+ last:=last_nonblank; input_ln:=true;
+ end;
+end;
+@y
+On \ttw, we do just that, using |aux_buf|.
+
+@p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean;
+ {inputs the next line or returns |false|}
+label 1,done;
+var n: integer;
+@!k,@!m: 0..buf_size; {indices into |buffer|}
+@!more: boolean; {is there more on the line that didn't get into |aux_buf|?}
+begin if bypass_eoln then {input the first character of the line into |f^|}
+ begin if not eof(f) then get(f);
+ if not eof(f) then if f^=chr(@'12) then get(f); {skip past a |line_feed|}
+ end;
+last:=first;
+if eof(f) then input_ln:=false
+else begin
+ read(f,aux_buf:n);
+ more:=n=aux_buf_len+1;
+ if more then n:=aux_buf_len;
+1: if last+n>max_buf_stack then
+ if last+n>=buf_size then
+ begin max_buf_stack:=buf_size;
+ overflow("buffer size",buf_size);
+@:METAFONT capacity exceeded buffer size}{\quad buffer size@>
+ end
+ else max_buf_stack:=last+n;
+ if n>0 then
+ begin m:=last;
+ last:=m+n;
+ for k:=m to last-1 do buffer[k]:=xord[aux_buf[k-m]];
+ if more then begin
+ read(f,aux_buf:n);
+ more:=n=aux_buf_len+1;
+ if more then n:=aux_buf_len;
+ goto 1;
+ end;
+ end;
+ if (f^<>chr(carriage_return)) and (not eof(f)) then begin
+ if f^=chr(form_feed) then begin page:=page+1; line:=0; end;
+ aux_buf[0]:=f^; n:=1; more:=true; get(f); goto 1;
+ end;
+ loop@+ begin if last=first then goto done;
+ if buffer[last-1]<>" " then goto done;
+ decr(last);
+ end;
+done: input_ln:=true;
+ end;
+end;
+@^system dependencies@>
+@z
+
+@x [3] Terminal I/O:
+is considered an output file the file variable is |term_out|.
+@^system dependencies@>
+
+@<Glob...@>=
+@!term_in:alpha_file; {the terminal as an input file}
+@!term_out:alpha_file; {the terminal as an output file}
+
+@ Here is how to open the terminal files
+in \ph. The `\.{/I}' switch suppresses the first |get|.
+@^system dependencies@>
+
+@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
+is considered an output file the file variable is |term_out|.
+On \ttw, this point is moot, since we use the built-in |TTY| file.
+@^system dependencies@>
+
+@d term_in==TTY {the terminal as an input file}
+@d term_out==TTY {the terminal as an output file}
+
+@ Here is how to open the terminal files on \ttw: we don't do anything,
+since |TTY| is always open. Note that |eoln(term_in)| is initially |true|.
+(Acutally, some very picky people might want to be able to distinguish
+between different |eoln| characters on terminal input, so we have to
+re-reset the |term_in| file with a few magic switches)
+
+@^system dependencies@>
+
+@d t_open_in == reset(term_in,'','/I/E') {distinguish |eoln| characters}
+@d t_open_out==do_nothing {open the terminal for text output}
+@z
+
+@x [3] Special terminal controls:
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@d clear_terminal == break_in(term_in,true) {clear the terminal input buffer}
+@d wake_up_terminal == do_nothing {cancel the user's cancellation of output}
+@y
+@d CFIBF=@'100 {Clear File Input BuFfer JSYS}
+@d PRIIN=@'100 {PRImary INput JFN JSYS}
+@d PRIOUT=@'101 {PRImary OUTput JFN JSYS}
+@d RFMOD=@'107 {Return File MODe word JSYS}
+@d SFMOD=@'110 {Set File MODe word JSYS}
+@#
+@d update_terminal == {the terminal output buffer is always emptied}
+@d clear_terminal == jsys(CFIBF;PRIIN) {clear the terminal input buffer}
+@d wake_up_terminal == begin {cancel the user's cancellation of output}
+ jsys(RFMOD;PRIOUT;wake_up_junk,wake_up_junk);
+ wake_up_junk:=wake_up_junk-[0]; {turn off TT\%OSP}
+ jsys(SFMOD;PRIOUT,wake_up_junk);
+ end
+@^system dependencies@>
+
+@<Glob...@>=
+@!wake_up_junk: set of 0..35;
+@z
+
+@x [3] Initializing the terminal:
+@ The following program does the required initialization
+without retrieving a possible command line.
+It should be clear how to modify this routine to deal with command lines,
+if the system permits them.
+@^system dependencies@>
+
+@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;
+@.**@>
+ if not input_ln(term_in,true) then {this shouldn't happen}
+ begin write_ln(term_out);
+ write(term_out,'! End of file on the terminal... why?');
+@.End of file on the terminal@>
+ init_terminal:=false; return;
+ end;
+ loc:=first;
+ while (loc<last)and(buffer[loc]=" ") do incr(loc);
+ if loc<last then
+ begin init_terminal:=true;
+ return; {return unless the line was all blank}
+ end;
+ write_ln(term_out,'Please type the name of your input file.');
+ end;
+exit:end;
+@y
+@ The following program does the required initialization
+and accepts interrupts and also retrieves a possible command line, using
+a fair bit of system stuff to get and remember them.
+@^system dependencies@>
+
+@p function init_terminal:boolean; {gets the terminal input started}
+label exit,done; {|done| is for the command line code}
+var @<Command line variables@>@/
+@!line_found:boolean; {is there a spceial command line?}
+begin t_open_in;
+@<Set up Control-G@>;
+last:=first; {|buffer| empty}
+@<Process possible command line@>;
+line_found:=(last>first); {did we put anything into |buffer|?}
+loop@+ begin loc:=first;
+ while (loc<last)and(buffer[loc]=" ") do incr(loc);
+ if loc<last then
+ begin init_terminal:=true;
+ return; {return unless the line was all blank}
+ end;
+ if line_found then
+ write_ln(term_out,'Please type the name of your input file.');
+ wake_up_terminal;
+ write(term_out,'**'); update_terminal;
+@.**@>
+ if not input_ln(term_in,true) then {this shouldn't happen}
+ begin write_ln(term_out);
+ write(term_out,'! End of file on the terminal... why?');
+@.End of file on the terminal@>
+ init_terminal:=false; return;
+ end;
+ line_found:=true;
+ end;
+exit:end;
+@z
+
+@x [6] The `E' option:
+line ready to be edited. But such an extension requires some system
+wizardry, so the present implementation simply types out what file should be
+edited and the relevant line number.
+@y
+line ready to be edited. The present implementation does this by loading
+the line editor with the appropriate call to the editor. We treat `\.T'
+the same as `\.E', because other programs invoke the editor when the user
+says `\.T'.
+@z
+
+@x
+"E": if file_ptr>0 then
+ begin print_nl("You want to edit file ");
+@.You want to edit file x@>
+ print(input_stack[file_ptr].name_field);
+ print(" at line "); print_int(line);
+ interaction:=scroll_mode; jump_out;
+ end;
+@y
+"E","T": if file_ptr>0 then
+ begin
+ set_pseudo_to_edit_commands;
+ jump_out;
+ end;
+@z
+
+@x [8] Changes for 36-bit machines:
+The values defined here are recommended for most 32-bit computers.
+
+@d min_quarterword=0 {smallest allowable value in a |quarterword|}
+@d max_quarterword=255 {largest allowable value in a |quarterword|}
+@d min_halfword==0 {smallest allowable value in a |halfword|}
+@d max_halfword==65535 {largest allowable value in a |halfword|}
+@y
+The values defined here are recommended for most 36-bit computers.
+
+@d min_quarterword=0 {smallest allowable value in a |quarterword|}
+@d max_quarterword=511 {largest allowable value in a |quarterword|}
+@d min_halfword==0 {smallest allowable value in a |halfword|}
+@d max_halfword==262143 {largest allowable value in a |halfword|}
+@z
+
+@x [6] Eliminating addition/subtraction of zero:
+@ The operation of subtracting |min_halfword| occurs rather frequently in
+\MF, so it is convenient to abbreviate this operation by using the macro
+|ho| defined here. \MF\ will run faster with respect to compilers that
+don't optimize the expression `|x-0|', if this macro is simplified in the
+obvious way when |min_halfword=0|. Similarly, |qi| and |qo| are used for
+input to and output from quarterwords.
+@^system dependencies@>
+
+@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
+@ The operation of subtracting |min_halfword| occurs rather frequently in
+\MF, so it is convenient to abbreviate this operation by using the macro
+|ho| defined here. \MF\ will run faster with respect to compilers that
+don't optimize the expression `|x-0|', if this macro is simplified in the
+obvious way when |min_halfword=0|. Similarly, |qi| and |qo| are used for
+input to and output from quarterwords. For \ttw, we simplify them for the
+compiler.
+@^system dependencies@>
+
+@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
+
+@x [17] Date and time:
+Since standard \PASCAL\ cannot provide such information, something special
+is needed. The program here simply specifies July 4, 1776, at noon; but
+users probably want a better approximation to the truth.
+
+Note that the values are |scaled| integers. Hence \MF\ can no longer
+be used after the year 32767.
+
+@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
+It uses a \ttw\ monitor call that returns various data and time
+information in three variables.
+
+@d ODCNV=@'222 {Output Date and time CoNVersion JSYS}
+
+@p procedure fix_date_and_time;
+var y,d,t:integer; {raw year/month, day and time}
+g:integer; {garbage}
+begin jsys(ODCNV;0,-1,0,0;g,y,d,t);
+internal[year]:=y div @'1000000 * unity; {year in left half-word}
+internal[month]:=((y mod @'1000000)+1) * unity;
+ {month in right half-word, zero means January}
+internal[day]:=((d div @'1000000)+1) * unity;
+ {day in left half-word, zero means the first of the month}
+internal[time]:=((t+@'377777*@'1000000) mod @'1000000) div 60 * unity;
+ {sign bit was on}
+end;
+@^system dependencies@>
+@z
+
+@x [12] Special form_feed initialization:
+char_class[127]:=invalid_class;
+@y
+char_class[127]:=invalid_class;
+char_class[form_feed]:=space_class;
+char_class[tab]:=space_class;
+@z
+
+;@x ONLY FOR RUNNING TRAP TEST
+begin init_screen:=false;
+;@y
+begin init_screen:=true;
+;@z
+
+@x [31] Page number maintenance:
+If more information about the input state is needed, it can be
+included in small arrays like those shown here. For example,
+the current page or segment number in the input file might be
+put into a variable |@!page|, maintained for enclosing levels in
+`\ignorespaces|@!page_stack:array[1..max_in_open] of integer|\unskip'
+by analogy with |line_stack|.
+@y
+Similarly, we maintain a global variable |page| and a corresponding
+|page_stack|.
+@z
+@x
+@!line_stack : array[1..max_in_open] of integer;
+@y
+@!line_stack : array[1..max_in_open] of integer;
+@!page : integer; {current page number in the current source file}
+@!page_stack : array[1..max_in_open] of integer;
+@z
+
+@x [22] Printing the page number:
+else begin print_nl("l."); print_int(line);
+@y
+else begin if page>1 then
+ begin print_nl("p."); print_int(page); print(",l.");
+ end
+ else print_nl("l.");
+ print_int(line);
+@z
+
+@x [23] More page number maintenance:
+or |limit| or |line|.
+@y
+or |limit| or |line| or |page|.
+@z
+
+@x
+line_stack[index]:=line; start:=first;
+@y
+line_stack[index]:=line; start:=first;
+page_stack[index]:=page;
+@z
+
+@x
+begin first:=start; line:=line_stack[index];
+@y
+begin first:=start; page:=page_stack[index]; line:=line_stack[index];
+@z
+
+@x [29] Logical name translation:
+@ The third.
+@^system dependencies@>
+
+@p procedure end_name;
+begin if str_ptr+3>max_str_ptr then
+ begin if str_ptr+3>max_strings then
+ overflow("number of strings",max_strings-init_str_ptr);
+@:METAFONT capacity exceeded number of strings}{\quad number of strings@>
+ max_str_ptr:=str_ptr+3;
+ end;
+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
+@ The third. We have to check to see if a logical name has been
+referred to, and if so, translate it.
+@^system dependencies@>
+
+@d LNMST=@'504 {convert Logical NaMe to STring JSYS}
+
+@p procedure end_name;
+label restart,exit;
+var s,t:packed array[1..max_TOPS20_file_name_length+1] of char;
+@!LNMST_return: integer; {which skip return did the LNMST jsys take?}
+@!i:pool_pointer;
+begin
+restart:
+if (str_pool[area_delimiter]=":") and (pool_ptr=area_delimiter+1) then
+ begin
+ cur_area:=make_string;
+ for i:=1 to length(cur_area)-1 do
+ s[i]:=xchr[str_pool[str_start[cur_area]+i-1]];
+ s[length(cur_area)]:=chr(0); {ASCIZ it}
+ jsys(LNMST,-2,LNMST_return;0,s,t); {job-wide}
+ if LNMST_return<>2 then
+ jsys(LNMST,-2,LNMST_return;1,s,t); {system-wide}
+ if LNMST_return<>2 then begin
+ cur_ext:=""; cur_name:=""; {silly case}
+ return;
+ end;
+ flush_string(cur_area); {needn't remember logical name in |cur_area|}
+ begin_name;
+ i:=1;
+ while ord(t[i])>0 do
+ if more_name(xord[t[i]]) then incr(i)
+ else goto restart;
+ goto restart; {heavy!}
+ end;
+if str_ptr+3>max_str_ptr then
+ begin if str_ptr+3>max_strings then
+ overflow("number of strings",max_strings-init_str_ptr);
+@:METAFONT capacity exceeded number of strings}{\quad number of strings@>
+ max_str_ptr:=str_ptr+3;
+ end;
+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;
+exit:
+end;
+@z
+
+@x [29] The real file names:
+@ Operating systems often make it possible to determine the exact name (and
+possible version number) of a file that has been opened. The following routine,
+which simply makes a \MF\ string from the value of |name_of_file|, should
+ideally be changed to deduce the full name of file~|f|, which is the file
+most recently opened, if it is possible to do this in a \PASCAL\ program.
+@^system dependencies@>
+
+This routine might be called after string memory has overflowed, hence
+we dare not use `|str_room|'.
+
+@p function make_name_string:str_number;
+var @!k:1..file_name_size; {index into |name_of_file|}
+begin if (pool_ptr+name_length>pool_size)or(str_ptr=max_strings) then
+ make_name_string:="?"
+else begin for k:=1 to name_length do append_char(xord[name_of_file[k]]);
+ make_name_string:=make_string;
+ end;
+end;
+function a_make_name_string(var @!f:alpha_file):str_number;
+begin a_make_name_string:=make_name_string;
+end;
+function b_make_name_string(var @!f:byte_file):str_number;
+begin b_make_name_string:=make_name_string;
+end;
+function w_make_name_string(var @!f:word_file):str_number;
+begin w_make_name_string:=make_name_string;
+end;
+@y
+@ Operating systems often make it possible to determine the exact name (and
+possible version number) of a file that has been opened. The following routine
+shows how to deduce the full name of file~|f| using \ttw\ system calls.
+@^system dependencies@>
+
+This routine might be called after string memory has overflowed, hence
+we dare not use `|str_room|'.
+
+@d JFNS=@'30 {translage JFN to String JSYS}
+
+@p function make_name_string(var f:f@&i@&l@&e):str_number;
+var s:packed array[1..max_TOPS20_file_name_length+1] of char;
+@!j,k:1..max_TOPS20_file_name_length;
+begin jsys(JFNS;s,0:f,@'111110:1);
+j:=1; while (ord(s[j+1])<>0) and (j<max_TOPS20_file_name_length) do incr(j);
+str_room(j);
+for k:=1 to j do append_char(xord[s[k]]);
+make_name_string:=make_string;
+end;
+function a_make_name_string(var @!f:alpha_file):str_number;
+begin a_make_name_string:=make_name_string(f);
+end;
+function b_make_name_string(var @!f:byte_file):str_number;
+begin b_make_name_string:=make_name_string(f);
+end;
+function w_make_name_string(var @!f:word_file):str_number;
+begin w_make_name_string:=make_name_string(f);
+end;
+@z
+
+@x [29] LST instead of LOG:
+@p procedure pack_job_name(@!s:str_number); {|s = ".log"|, |".gf"|, or
+@y
+@p procedure pack_job_name(@!s:str_number); {|s = ".lst"|, |".gf"|, or
+@z
+
+@x
+pack_job_name(".log");
+@y
+pack_job_name(".lst");
+@z
+
+@x
+prompt_file_name("transcript file name",".log");
+@y
+prompt_file_name("transcript file name",".lst");
+@z
+
+@x [29] Start page number at 1:
+buffer[limit]:="%"; first:=limit+1; loc:=start; line:=1;
+@y
+buffer[limit]:="%"; first:=limit+1; loc:=start; line:=1; page:=1;
+@z
+
+@x [32] Pack gf_buf
+@!gf_buf:array[gf_index] of eight_bits; {buffer for \.{GF} output}
+@y
+@!gf_buf:packed array [gf_index] of eight_bits; {buffer for \.{GF} output}
+@z
+
+@x [32] "TeXspool":
+b_close(gf_file);
+@y
+b_close(gf_file);
+if pseudo_typein=0 then
+ begin k:=selector; selector:=new_string;
+ pool_ptr:=str_start[str_ptr];
+ print("MFspool: "); print(output_file_name);
+ selector:=k;
+ if (pool_ptr<pool_size) and (str_ptr<max_strings) then
+ {|overflow| can't occur}
+ pseudo_typein:=make_string;
+ end;
+@z
+
+@x [51] The endgame:
+
+@ Here we do whatever is needed to complete \MF's job gracefully on the
+local operating system. The code here might come into play after a fatal
+error; it must therefore consist entirely of ``safe'' operations that
+cannot produce error messages. For example, it would be a mistake to call
+|str_room| or |make_string| at this time, because a call on |overflow|
+might lead to an infinite loop.
+@^system dependencies@>
+
+This program doesn't bother to close the input files that may still be open.
+
+@<Last-minute...@>=
+procedure close_files_and_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
+@!stat if internal[tracing_stats]>0 then
+ @<Output statistics about this job@>;@;@+tats@/
+wake_up_terminal; @<Finish the \.{TFM} and \.{GF} files@>;
+if job_name>0 then
+ begin wlog_cr;
+ a_close(log_file); selector:=selector-2;
+ if selector=term_only then
+ begin print_nl("Transcript written on ");
+@.Transcript written...@>
+ print(log_name); print_char(".");
+ end;
+ end;
+end;
+@y
+@ Here we do whatever is needed to complete \MF's job gracefully on the
+local operating system. The code here might come into play after a fatal
+error; it must therefore consist entirely of ``safe'' operations that
+cannot produce error messages. For example, it would be a mistake to call
+|str_room| or |make_string| at this time, because a call on |overflow|
+might lead to an infinite loop.
+@^system dependencies@>
+
+@d STI=@'114 {Simulate Terminal Input JSYS}
+@d SIBE=@'102 {See If Buffer Empty JSYS}
+
+@<Last-minute...@>=
+procedure close_files_and_terminate;
+var @!j,@!k:integer; {all-purpose indices}
+@!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}
+@!SIBE_return: integer; {did the SIBE skip?}
+@!temp_file: alpha_file; {read unbuffered from |term_in|}
+@!old_mode,@!new_mode:set of 0..35; {a word by the bits}
+begin
+@!stat if internal[tracing_stats]>0 then
+ @<Output statistics about this job@>;@;@+tats@/
+wake_up_terminal; @<Finish the \.{TFM} and \.{GF} files@>;
+if job_name>0 then
+ begin wlog_cr; a_close(log_file); selector:=selector-2;
+ if selector=term_only then
+ begin print_nl("Transcript written on ");
+@.Transcript written...@>
+ print(log_name); print_char(".");
+ end;
+ end;
+{note we don't use |xchr[str_pool[k]]| here because of ESC and CR characters}
+if (pseudo_typein<>0) and (interaction>batch_mode) then
+ begin
+ j:=str_start[pseudo_typein+1]-1; {last character to STI}
+ jsys(SIBE,2,SIBE_return;PRIIN);
+ if SIBE_return<>1 then goto done;
+ reset(temp_file,'tty:','/I/M:1'); {read unbuffered from the terminal}
+ jsys(RFMOD;PRIIN;old_mode); {get terminal mode}
+ new_mode:=old_mode-[24]; {TT\%ECO bit}
+ jsys(SFMOD;PRIIN;new_mode); {turn off echo}
+ while SIBE_return=1 do begin
+ get(temp_file); {there must be user input}
+ incr(j);
+ if eoln(temp_file) then str_pool[j]:=13
+ else str_pool[j]:=ord(temp_file^);
+ jsys(SIBE,2,SIBE_return;PRIIN);
+ end;
+ done:
+ jsys(SFMOD;PRIIN;old_mode); {turn echo back on}
+ for k:=str_start[pseudo_typein] to j do jsys(STI;PRIIN,str_pool[k]);
+ end;
+end;
+@z
+
+@x [54] Final system-dependent changes:
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \MF\ work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the published program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@y
+Here are the remaining things needed to make the implementation
+complete on \ttw.
+@^system dependencies@>
+
+@d ESC=@'33
+@d CR=@'15
+@d control_R=@'22
+@d control_Z=@'32
+
+@<Basic printing...@>=
+procedure@?set_pseudo_to_edit_commands; forward;@t\2@>@/
+
+@ The |pseudo_typein| variable is set nonzero if the |error| routine
+uses the `\.E' option to exit and edit.
+
+@<Glob...@>=
+@!pseudo_typein:str_number;
+
+@ @<Set init...@>=
+pseudo_typein:=0; page:=0;
+
+@ This procedure gets called when the user wants to set up to swap to the
+editor upon seeing an error. It figures out which editor the user wants,
+and then prints the proper command to start up that editor on the correct
+file at the correct position.
+
+@d edit_file==input_stack[file_ptr] {file to edit}
+
+@<Last-minute procedures@>=
+procedure set_pseudo_to_edit_commands;
+label done;
+var @!LNMST_return: integer; {which skip return did the LNMST jsys take?}
+@!edit_name: packed array[1..max_TOPS20_file_name_length] of ASCII_code;
+@!short_name: str_number; {|edit_name| with directory, etc. removed}
+@!from_here, @!to_there, @!i: integer; {help turn |edit_name| into |shorname|}
+begin
+selector:=new_string; pool_ptr:=str_start[str_ptr];
+@<Set |edit_name| to the full file name of user's favorite editor@>;
+@<Make |from_here| and |to_there| delimit the short editor name@>;
+@<Put the name of the editor into |short_name|@>;
+with edit_file do {avoid typeing |edit_file| alot}
+if str_vs_str(short_name,"EMACS")=0 then @<Print EMACS startup commands@>
+else if str_vs_str(short_name,"TVEDIT")=0 then
+ @<Print TVEDIT startup commands@>
+else if str_vs_str(short_name,"EDIT")=0 then @<Print EDIT startup commands@>
+else if str_vs_str(short_name,"ZED")=0 then @<Print ZED startup commands@>
+else @<Print unfound editor message@>;
+done:
+pseudo_typein:=make_string;
+selector:=term_and_log; interaction:=scroll_mode;
+end;
+
+@ There is a bug here is the logical name for the editor points to
+another logical name which then points to the real editor name.
+
+@<Set |edit_name| to the full file name of user's favorite editor@>=
+logical_name:='EDITOR '; logical_name[7]:=chr(0); {ASCIZ it}
+jsys(LNMST,-2,LNMST_return;0,logical_name,edit_name); {job-wide}
+if LNMST_return<>2 then
+ jsys(LNMST,-2,LNMST_return;1,logical_name,edit_name);
+ {system-wide}
+if LNMST_return<>2 then begin
+ print("; You must DEFINE EDITOR: before METAFONT knows who to swap to.");
+ print_char(CR); goto done;
+ end;
+
+@ @<Make |from_here| and |to_there|...@>=
+from_here:=1;
+i:=1;
+while edit_name[i]>0 do begin
+ if (edit_name[i]=":") or (edit_name[i]=">") then from_here:=i+1;
+ incr(i);
+ end;
+decr(i);
+to_there:=i;
+while i>from_here do begin
+ if edit_name[i]="." then to_there:=i-1;
+ decr(i);
+ end;
+
+@ @<Put the name of the editor...@>=
+str_room(to_there-from_here+1);
+for i:=from_here to to_there do append_char(edit_name[i]);
+short_name:=make_string;
+
+@ @<Print unfound editor message@>=
+begin
+print("; Sorry, but METAFONT doesn't know about EDITOR: ");
+print(short_name);
+print_char(CR);
+print("; You want to edit file ");
+print(name_field);
+print(" on page ");
+print_int(page);
+print(", line ");
+print_int(line);
+print_char(".");
+print_char(CR);
+end
+
+@ @<Print EMACS startup commands@>=
+begin
+print("EDIT"); print_char(CR);
+print_char(control_Z); print("x^r execute minibuffer"); print_char(CR);
+print("mmFind file"); print_char(ESC);
+jsys(JFNS;edit_name,0:input_file[index_field],@'221100:1);
+{Get file name without device and directory if possible, and no version number}
+i:=1; while edit_name[i]>0 do begin print_char(edit_name[i]); incr(i); end;
+print_char(ESC); print_char(CR);
+print_int(curpos(input_file[index_field])-(limit_field-loc_field)-1);
+print_char("j"); print_char(control_Z); print_char(control_Z);
+end
+
+@ @<Print ZED startup commands@>=
+begin
+print("EDIT "); print(name_field); print_char(CR);
+print("XTECO"); print_char(ESC);
+print_int(curpos(input_file[index_field])-(limit_field-loc_field)-1);
+print_char("j"); print_char(control_R); print_char(control_Z);
+end
+
+@ @<Print TVEDIT startup commands@>=
+begin
+print("EDIT "); print(name_field); print_char(CR);
+print_char(ESC); print_char(ESC); print_int(page); print_char(".");
+ print_int(line); print_char("G"); {diabolical!}
+if loc_field>start_field then begin
+ print_char(ESC); print_char(ESC);
+ print_int(loc_field-start_field); print_char(" ");
+ end;
+end
+
+@ @<Print EDIT startup commands@>=
+begin
+print("EDIT "); print(name_field); print_char(CR);
+{fix me -- there's a bug if EDIT decides to split a very large page}
+print("P^+"); print_int(line-1);
+if page>1 then begin
+ print_char("/"); print_int(page);
+ end;
+print_char(CR);
+end
+
+@ This is the actual Control-G interrupt routine, and two system routines
+used to enable it. We have to put them somewhere, so pardon the little
+lie\dots
+
+@<Basic printing...@>=
+procedure cntl_G; begin interrupt:=interrupt+1; end; {non-interruptable}
+procedure psidefine(chan,level:integer;procedure p); extern; @t\2@>@;
+procedure psienable(chan:integer); extern; @t\2@>@;
+
+@ This code sets things up such that each time the user types control-G,
+the procedure |cntl_G| gets called, and |interrupt| gets incremented.
+The program can change |interrupt| whenever it wants to,
+but |interrupt| had better be a global variable.
+
+@d ATI=@'137 {Assign Terminal code to Interrupt channel JSYS}
+@d cntl_G_chan=34 {Channel for Control-G interrupts}
+
+@<Set up Control-G@>=
+begin
+psidefine(cntl_G_chan,1,cntl_G); {call |cntl_G| on interrupt, level 1}
+psienable(cntl_G_chan); {turn on those interrupts}
+jsys(ATI;7:cntl_G_chan); {assign control-G to channel}
+end
+
+@ Here is the code that does all the command line system magic.
+@d RSCAN=@'500 {ReSCAN buffer JSYS}
+@d CRLNM=@'502 {CReate Logical NaMe JSYS}
+
+@<Command line variables@>=
+@!ac1: integer; {AC1 from Rescan}
+@!rescan: packed array[1..max_rescan] of char; {rescan buffer}
+@!rescan_len: integer; {amount of |rescan| used}
+@!definition: packed array [1..79] of char; {ASCIZ, with control-V's}
+@!i,@!j: integer; {temporary}
+
+@ The array |logical_name| holds the logical name that we use to implement
+\TeX's memory from run to run. Actually, we may have to use a series of
+logical names, since we only get to save 39 characters in each one.
+
+@d next_logical_name==logical_name[6]:=chr(ord(logical_name[6])+1)
+
+@<Glob...@>=
+@!logical_name: packed array[1..8] of char; {ASCIZ ``MFMEMx'', x=0,1,etc.}
+
+@ @<Set init...@>=
+logical_name:='MFMEM0 '; logical_name[7]:=chr(0); {ASCIZ it}
+
+@ \ttw\ puts the user command line into the so-called rescan buffer.
+Actually, we have to use a real hack to see if it's a bogus Execute,
+Start, Continue, Debug, etc.\ command, in which case we should pretend
+there was no command line, since the command line that was there was
+not intended for \TeX.
+
+@<Get the |rescan| buffer and check that it's for us@>=
+jsys(RSCAN,1,i;0;ac1); {put the command line into the |TTY| input buffer}
+if (i<>2) or (ac1<=0) then goto done; {RSCAN failed, somehow}
+if eoln(term_in) then read_ln(term_in); {for some TOPS-20's}
+read(term_in,rescan:rescan_len); {read in rescan buffer}
+if rescan_len>max_rescan then begin
+ write_ln(term_out,'Command line longer than ',max_rescan:0,
+ 'characters, so I''m ignoring it');
+ read_ln(term_in); goto done; end;
+@/{The following line is based upon experimentation with \ttw!}
+if rescan_len=ac1-2 then goto done; {EX, ST, DEB commands}
+
+
+@ Now that we have a command line, we have to strip off the TeX command
+and see if there is a lone backslash (which means that the user wanted
+us to ignore the stuff in the logical name memory.
+
+@<Make |i| point to the actual command text@>=
+i:=1; while rescan[i]>' ' do incr(i); {skip the command name, presumably TeX}@/
+while (i<=rescan_len) and (rescan[i]=' ') do incr(i); {skip spaces}@/
+if (i=rescan_len) and (rescan[i]='\') then
+ begin @<Unremember logical names@>;
+ goto done; end; {escape to ignore memory}
+
+@ Here's where we actually do the command line stuff. Various parts of the
+code go to the label |done| if they realize that no special command line
+processing should happen.
+
+@<Process possible command line@>=
+@<Get the |rescan| buffer...@>;
+@<Make |i| point to the actual command text@>;
+if i<=rescan_len then @<We got command text@>
+else @<Use the memorized command text, if any@>;
+done:
+
+@ We get here if there was command text for \MF. It gets put into |buffer|
+and into the logical name(s). We need to intersperse the characters with
+Control-V's so that they don't get capitalized and so that non-alphabetic
+characters get remembered properly. `Why doesn't \ttw\ have variables
+that can be defined?' you may ask; and well you may.
+
+@<We got command text@>=
+begin
+j:=1;
+while i<=rescan_len do begin
+ buffer[last]:=xord[rescan[i]]; incr(last);
+ definition[j]:=chr(@'26); {control-V}
+ incr(j);
+ definition[j]:=rescan[i];
+ incr(j);
+ incr(i);
+ if (j=79) or (i>rescan_len) then begin
+ definition[j]:=chr(0);
+ jsys(CRLNM,2,j;4,logical_name,definition;ac1);
+ if j=1 then write_ln(term_out,'CRLNM returned ',ac1:12:O);
+ j:=1;
+ next_logical_name;
+ end;
+ end;
+@<Unremember...@>; {In case the old one was longer than this one.}
+end
+
+@ We get here if we should put the memorized command line into |buffer|.
+
+@<Use the memorized command text, if any@>=
+loop@+begin
+ jsys(LNMST,2,j;0,logical_name,definition);
+ if j<>2 then goto done;
+ j:=1;
+ while (definition[j]<>chr(0)) do begin
+ buffer[last]:=xord[definition[j]];
+ incr(last); incr(j);
+ end;
+ next_logical_name;
+ end
+
+@ This code makes \MF\ wipe out all logical names beginnig with the current
+one.
+
+@<Unremember...@>=
+repeat
+ jsys(CRLNM,2,j;0,logical_name);
+ next_logical_name;
+until j<>2
+
+@z
diff --git a/obsolete/systems/knuth/unsupported/mf/mf.vms-changes b/obsolete/systems/knuth/unsupported/mf/mf.vms-changes
new file mode 100644
index 0000000000..46d9b347b8
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/mf/mf.vms-changes
@@ -0,0 +1,1261 @@
+This change file is for the Vax/VMS version of Metafont.
+It is based in part on the Vax/VMS change file for TeX written by David Fuchs.
+Jane Colman, October 1984
+
+July 1985 - Added support for online graphics output for various Tektronix
+ emulators.
+
+@x
+\def\gglob{20, 26} % this should be the next two sections of "<Global...>"
+@y
+\def\gglob{20, 26} % this should be the next two sections of "<Global...>"
+\let\maybe=\iftrue
+@z
+
+@x
+@d banner=='This is METAFONT, Version 1.0' {printed when \MF\ starts}
+@y
+@d banner=='This is METAFONT, Vax/VMS Version 1.0' {printed when \MF\ starts}
+@z
+
+@x
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+ begin @<Set initial values of key variables@>@/
+@y
+@<Vax/VMS procedures@>@/
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+ begin
+ @<Set initial values of key variables@>@/
+@z
+
+@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
+
+@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
+
+@x
+@d init== {change this to `$\\{init}\equiv\.{@@\{}$' in the production version}
+@d tini== {change this to `$\\{tini}\equiv\.{@@\}}$' in the production version}
+@f init==begin
+@f tini==end
+@y
+Online graphics output will be useful only in the production version,
+so we will use the codewords `$|graph|\ldots|hparg|$' to delimit code
+used to produce it.
+
+@d init==
+@d tini==
+@f init==begin
+@f tini==end
+@d graph==@{ {change this to `$\\{graph}\equiv\.{@@\{}$' when not using
+ online graphics output}
+@d hparg==@} {change this to `$\\{hparg}\equiv\.{@@\}}$' when not using
+ online graphics output}
+@f graph==begin
+@f hparg==end
+@z
+
+@x
+@<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
+On Vax/VMS, there are no compiler directives that can be introduced in this
+way, but we take this opportunity to include a few system dependent goodies.
+
+@d VAX_text==@= text @>
+@d VAX_new==@= new @>
+@d VAX_none==@= none @>
+@d VAX_word==@= word @>
+@d VAX_error==@= error @>
+@d VAX_length==@= length @>
+@d VAX_record_length==@= record_length @>
+@d VAX_syi_sid==@= syi$_sid @>
+@d VAX_continue==@= continue @>
+@d VAX_external==@= external @>
+@d VAX_readonly==@= readonly @>
+@d VAX_volatile==@= volatile @>
+@d VAX_aligned==@= aligned @>
+@d VAX_unsigned==@= unsigned @>
+@d VAX_carriage_control==@= carriage_control @>
+@d VAX_io_setmode==@= io$_setmode @>
+@d VAX_iom_ctrlcast==@= io$m_ctrlcast @>
+@d VAX_immed==@= %immed @>
+@d VAX_stdescr==@= %stdescr @>
+@d VAX_ref==@= %ref @>
+@d VAX_assign==@= $assign @>
+@d VAX_qiow==@= $qiow @>
+@d VAX_numtim==@= $numtim @>
+@d VAX_getsyi==@= $getsyi @>
+@d VAX_lib_get_foreign==@= lib$get_foreign @>
+@d VAX_disposition==@= disposition @>
+@d VAX_delete==@= delete @>
+@d VAX_save==@= save @>
+
+@d VAX_trnlog==@= $trnlog @>
+@d VAX_ss_normal==@= ss$_normal @>
+@d VAX_user_action==@=user_action@>
+@d VAX_create==@=$create@>
+@d VAX_connect==@=$connect@>
+@d VAX_open==@=$open@>
+@d VAX_FAB_type==@= FAB$type @>
+@d VAX_RAB_type==@= RAB$type @>
+@d VAX_NAM_type==@= NAM$type @>
+@d VAX_PAS_FAB==@= PAS$FAB @>
+@d VAX_PAS_RAB==@= PAS$RAB @>
+@d VAX_FAB_L_NAM== @=FAB$L_NAM@>
+@d VAX_NAM_B_RSL== @=NAM$B_RSL@>
+@d VAX_NAM_L_RSA== @=NAM$L_RSA@>
+
+@d VAX_lognam==@= lognam @>
+@d VAX_rslbuf==@= rslbuf @>
+
+@<Compiler directives@>=
+@\@=[inherit('sys$library:starlet')]@>@\
+ {allows us to use system symbols and routines}
+@z
+
+@x
+@d othercases == others: {default for cases not listed explicitly}
+@y
+@d othercases == otherwise {default for cases not listed explicitly}
+@z
+
+@x
+@<Constants...@>=
+@!mem_max=30000; {greatest index in \MF's internal |mem| array;
+ must be strictly less than |max_halfword|;
+ must be equal to |mem_top| in \.{INIMF}, otherwise |>=mem_top|}
+@!max_internal=100; {maximum number of internal quantities}
+@!buf_size=500; {maximum number of characters simultaneously present in
+ current lines of open files; must not exceed |max_halfword|}
+@!error_line=72; {width of context lines on terminal error messages}
+@!half_error_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}
+@!screen_width=768; {number of pixels in each row of screen display}
+@!screen_depth=1024; {number of pixels in each column of screen display}
+@!stack_size=30; {maximum number of simultaneous input sources}
+@!max_strings=2000; {maximum number of strings; must not exceed |max_halfword|}
+@!string_vacancies=8000; {the minimum number of characters that should be
+ available for the user's identifier names and strings,
+ after \MF's own error messages are stored}
+@!pool_size=32000; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all identifiers;
+ must exceed |string_vacancies| by the total
+ length of \MF's own strings, which is currently about 22000}
+@!move_size=5000; {space for storing moves in a single octant}
+@!max_wiggle=300; {number of autorounded points per cycle}
+@!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 ';
+ {string of length |file_name_size|; tells where the string pool appears}
+@.MFbases@>
+@!path_size=300; {maximum number of knots between breakpoints of a path}
+@!bistack_size=785; {size of stack for bisection algorithms;
+ should probably be left at this value}
+@!header_size=100; {maximum number of \.{TFM} header words, times~4}
+@!lig_table_size=300; {maximum number of ligature/kern steps}
+@!max_font_dimen=50; {maximum number of \&{fontdimen} parameters}
+@y
+@<Constants...@>=
+@!mem_max=30000; {greatest index in \MF's internal |mem| array;
+ must be strictly less than |max_halfword|;
+ must be equal to |mem_top| in \.{INIMF}, otherwise |>=mem_top|}
+@!max_internal=100; {maximum number of internal quantities}
+@!buf_size=500; {maximum number of characters simultaneously present in
+ current lines of open files; must not exceed |max_halfword|}
+@!error_line=72; {width of context lines on terminal error messages}
+@!half_error_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}
+@!screen_width=512; {number of pixels in each row of screen display}
+@!screen_depth=336; {number of pixels in each column of screen display}
+@!stack_size=30; {maximum number of simultaneous input sources}
+@!max_strings=2000; {maximum number of strings; must not exceed |max_halfword|}
+@!string_vacancies=8000; {the minimum number of characters that should be
+ available for the user's identifier names and strings,
+ after \MF's own error messages are stored}
+@!pool_size=32000; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all identifiers;
+ must exceed |string_vacancies| by the total
+ length of \MF's own strings, which is currently about 22000}
+@!move_size=5000; {space for storing moves in a single octant}
+@!max_wiggle=300; {number of autorounded points per cycle}
+@!gf_buf_size=1024; {size of the output buffer, must be a multiple of 8}
+@!VAX_block_length=512; {must be half |gf_buf_size| on Vax/VMS}
+@!file_name_size=40; {file names shouldn't be longer than this}
+@!pool_name='MF$bases:MF.POO ';
+ {string of length |file_name_size|; tells where the string pool appears}
+@.MFbases@>
+@!path_size=300; {maximum number of knots between breakpoints of a path}
+@!bistack_size=785; {size of stack for bisection algorithms;
+ should probably be left at this value}
+@!header_size=100; {maximum number of \.{TFM} header words, times~4}
+@!lig_table_size=300; {maximum number of ligature/kern steps}
+@!max_font_dimen=50; {maximum number of \&{fontdimen} parameters}
+@z
+
+@x
+@d mem_min=0 {smallest index in the |mem| array, must not be less
+ than |min_halfword|}
+@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|}
+@d hash_size=2100 {maximum number of symbolic tokens,
+ must be less than |max_halfword-3*param_size|}
+@d hash_prime=1777 {a prime number equal to about 85\% of |hash_size|}
+@d max_in_open=6 {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@d param_size=150 {maximum number of simultaneous macro parameters}
+@y
+@d mem_min=0 {smallest index in the |mem| array, must not be less
+ than |min_halfword|}
+@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|}
+@d hash_size=2100 {maximum number of symbolic tokens,
+ must be less than |max_halfword-3*param_size|}
+@d hash_prime=1777 {a prime number equal to about 85\% of |hash_size|}
+@d max_in_open=6 {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@d param_size=150 {maximum number of simultaneous macro parameters}
+@z
+
+@x
+for i:=1 to @'37 do xchr[i]:=' ';
+@y
+for i:=1 to @'37 do xchr[i]:=' ';
+xchr[@'11]:=chr(@'11);
+xchr[@'14]:=chr(@'14);
+@z
+
+@x
+@!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
+@!alpha_file=VAX_text; {files that contain textual data}
+@!byte_block=packed array [0..VAX_block_length-1] of eight_bits;
+@!byte_file=packed file of byte_block; {files that contain binary data}
+@z
+
+@x
+@d reset_OK(#)==erstat(#)=0
+@d rewrite_OK(#)==erstat(#)=0
+
+@p function a_open_in(var @!f:alpha_file):boolean;
+@y
+@p function user_reset
+ (var FAB:VAX_FAB_type;
+ var RAB:VAX_RAB_type;
+ var F:unsafe_file):integer;
+var status:integer; NAM:NAM_ptr; p:chrptr; i:integer;
+begin
+last_length:=0;
+status:=VAX_open(FAB);
+if odd(status) then status:=VAX_connect(RAB);
+if odd(status) then begin
+ NAM:=FAB.VAX_FAB_L_NAM::NAM_ptr;
+ if NAM<>nil then last_length:=NAM^.VAX_NAM_B_RSL;
+ for i:=1 to last_length do begin
+ p:=(NAM^.VAX_NAM_L_RSA::integer+i-1)::chrptr;
+ last_name[i]:=p^;
+ end;
+ end;
+user_reset:=status;
+end;
+@#
+function user_rewrite
+ (var FAB:VAX_FAB_type;
+ var RAB:VAX_RAB_type;
+ var F:unsafe_file):integer;
+var status:integer; NAM:NAM_ptr; p:chrptr; i:integer;
+begin
+status:=VAX_create(FAB);
+if odd(status) then status:=VAX_connect(RAB);
+if odd(status) then begin
+ NAM:=FAB.VAX_FAB_L_NAM::NAM_ptr;
+ if NAM<>nil then last_length:=NAM^.VAX_NAM_B_RSL;
+ for i:=1 to last_length do begin
+ p:=(NAM^.VAX_NAM_L_RSA::integer+i-1)::chrptr;
+ last_name[i]:=p^;
+ end;
+ end;
+user_rewrite:=status;
+end;
+@#
+function a_open_in(var @!f:alpha_file):boolean;
+@z
+
+@x
+begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f);
+@y
+begin
+@= open@>(f,name_of_file,VAX_readonly,VAX_user_action:=user_reset,
+ VAX_error:=VAX_continue);
+if status(f)>0 then a_open_in:=false
+else begin
+ reset(f,VAX_error:=VAX_continue);
+ a_open_in:=status(f)<=0;
+ end;
+@z
+
+@x
+begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f);
+@y
+begin
+@= open@>(f,name_of_file,VAX_new,16383,VAX_disposition:=VAX_delete,
+ VAX_user_action:=user_rewrite,VAX_error:=VAX_continue);
+if status(f)>0 then a_open_out:=false
+else begin
+ linelimit(f,maxint);
+ rewrite(f,VAX_error:=VAX_continue);
+ a_open_out:=status(f)<=0;
+ end;
+@z
+
+@x
+begin rewrite(f,name_of_file,'/O'); b_open_out:=rewrite_OK(f);
+@y
+begin
+@= open@>(f,name_of_file,VAX_new,VAX_disposition:=VAX_delete,
+ VAX_user_action:=user_rewrite,VAX_error:=VAX_continue);
+if status(f)>0 then b_open_out:=false
+else begin
+ rewrite(f,VAX_error:=VAX_continue);
+ b_open_out:=status(f)<=0;
+ end;
+@z
+
+@x
+begin reset(f,name_of_file,'/O'); w_open_in:=reset_OK(f);
+@y
+begin
+@= open@>(f,name_of_file,VAX_readonly,VAX_user_action:=user_reset,
+ VAX_error:=VAX_continue);
+if status(f)>0 then w_open_in:=false
+else begin
+ reset(f,VAX_error:=VAX_continue);
+ w_open_in:=status(f)<=0;
+ end;
+base_count:=0; {hack}
+@z
+
+@x
+begin rewrite(f,name_of_file,'/O'); w_open_out:=rewrite_OK(f);
+@y
+begin
+@= open@>(f,name_of_file,VAX_new,VAX_disposition:=VAX_delete,
+ VAX_user_action:=user_rewrite,VAX_error:=VAX_continue);
+if status(f)>0 then w_open_out:=false
+else begin
+ rewrite(f,VAX_error:=VAX_continue);
+ w_open_out:=status(f)<=0;
+ end;
+base_count:=0; {hack}
+@z
+
+@x [3] file closing
+begin close(f);
+@y
+begin close(f,VAX_disposition:=VAX_save,VAX_error:=VAX_continue);
+@z
+
+@x
+begin close(f);
+@y
+begin close(f,VAX_disposition:=VAX_save,VAX_error:=VAX_continue);
+@z
+
+@x
+begin close(f);
+@y
+begin close(f,VAX_disposition:=VAX_save,VAX_error:=VAX_continue);
+@z
+
+@x [3] read into auxiliary buffer first
+representing the beginning and ending of a line of text.
+
+@<Glob...@>=
+@y
+representing the beginning and ending of a line of text.
+
+On Vax/VMS, we will read the lines first into an auxiliary buffer, in
+order to save the running time of procedure-call overhead. We have
+to be very careful to handle lines longer than the arbitrarily chosen
+length of the |aux_buf|.
+
+@<Glob...@>=
+@!aux_buf:varying [133] of char; {where the characters go first}
+@z
+
+@x
+@p function input_ln(var @!f:alpha_file;@!bypass_eoln:boolean):boolean;
+ {inputs the next line or returns |false|}
+var @!last_nonblank:0..buf_size; {|last| with trailing blanks removed}
+begin if bypass_eoln then if not eof(f) then get(f);
+ {input the first character of the line into |f^|}
+last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
+if eof(f) then input_ln:=false
+else begin last_nonblank:=first;
+ while not eoln(f) do
+ begin if last>=max_buf_stack then
+ begin max_buf_stack:=last+1;
+ if max_buf_stack=buf_size then
+ overflow("buffer size",buf_size);
+@:METAFONT capacity exceeded buffer size}{\quad buffer size@>
+ end;
+ buffer[last]:=xord[f^]; get(f); incr(last);
+ if buffer[last-1]<>" " then last_nonblank:=last;
+ end;
+ last:=last_nonblank; input_ln:=true;
+ end;
+end;
+@y
+@p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean;
+ {inputs the next line or returns |false|}
+label found;
+var @!len:integer; {length of line input}
+@!k:0..buf_size; {index into |buffer|}
+begin
+last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
+if status(f)<>0 then input_ln:=false
+else begin
+ while not eoln(f) do
+ begin read(f,aux_buf,VAX_error:=VAX_continue);
+ len:=VAX_length(aux_buf);
+ if last+len>=max_buf_stack then
+ begin
+ if last+len<buf_size then max_buf_stack:=last+len
+ else overflow("buffer size",buf_size);
+ end;
+ for k:=last to last+len-1 do buffer[k]:=xord[aux_buf[k-last+1]];
+ last:=last+len;
+ end;
+ found: if last>first then if buffer[last-1]=" " then begin
+ decr(last); goto found; end;
+ input_ln:=true;
+ read_ln(f,VAX_error:=VAX_continue);
+ end;
+end;
+@z
+
+@x [3] terminal file opening
+@ Here is how to open the terminal files
+in \ph. The `\.{/I}' switch suppresses the first |get|.
+@^system dependencies@>
+
+@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
+@ Here is how to open the terminal files
+under Vax/VMS.
+@^system dependencies@>
+
+@d t_open_in==begin
+ @= open@>(term_in,'SYS$INPUT');
+ reset(term_in);
+ in_FAB:=VAX_PAS_FAB(term_in);
+ in_RAB:=VAX_PAS_RAB(term_in);
+ end {open the terminal for text input}
+@d t_open_out==begin
+ @= open@>(term_out,'SYS$OUTPUT',VAX_carriage_control:=VAX_none,
+ VAX_record_length:=511);
+ linelimit(term_out,maxint);
+ rewrite(term_out);
+ out_FAB:=VAX_PAS_FAB(term_out);
+ out_RAB:=VAX_PAS_RAB(term_out);
+ end {open the terminal for text output}
+@z
+
+@x [3] terminal hacks: clear and update
+these operations can be specified in \ph:
+@^system dependencies@>
+
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@d clear_terminal == break_in(term_in,true) {clear the terminal input buffer}
+@d wake_up_terminal == do_nothing {cancel the user's cancellation of output}
+@y
+these operations can be specified in Vax/VMS Pascal:
+@^system dependencies@>
+
+@d update_terminal == write_ln(term_out) {empty the terminal output buffer}
+@d clear_terminal == in_RAB^.@=RAB$V_PTA@>:=true
+ {clear the terminal input buffer}
+@.PTA@>
+@d wake_up_terminal == begin
+ out_RAB^.@=RAB$V_CCO@>:=true;
+ write_ln(term_out);
+ out_RAB^.@=RAB$V_CCO@>:=false;
+ end {cancel the user's cancellation of output}
+@.CCO@>
+@d crlf == chr(13),chr(10)
+@z
+
+@x
+@ The following program does the required initialization
+without retrieving a possible command line.
+It should be clear how to modify this routine to deal with command lines,
+if the system permits them.
+@^system dependencies@>
+
+@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;
+@.**@>
+ if not input_ln(term_in,true) then {this shouldn't happen}
+ begin write_ln(term_out);
+ write(term_out,'! End of file on the terminal... why?');
+@.End of file on the terminal@>
+ init_terminal:=false; return;
+ end;
+ loc:=first;
+ while (loc<last)and(buffer[loc]=" ") do incr(loc);
+ if loc<last then
+ begin init_terminal:=true;
+ return; {return unless the line was all blank}
+ end;
+ write_ln(term_out,'Please type the name of your input file.');
+ end;
+exit:end;
+@y
+@ The following program does the required initialization
+by retrieving a possible command line, and if none exists,
+prompting the user for the first line of input.
+@^system dependencies@>
+
+@p
+[VAX_external] function VAX_lib_get_foreign(
+ VAX_stdescr cmdlin:[VAX_volatile] packed array [$l1..$u1:integer] of char
+ :=VAX_immed 0;
+ VAX_stdescr prompt:[VAX_volatile] packed array [$l2..$u2:integer] of char
+ :=VAX_immed 0;
+ var len : [VAX_volatile] sixteen_bits := VAX_immed 0;
+ var flag : [VAX_volatile] integer := VAX_immed 0)
+ :integer; extern;
+
+function init_terminal:boolean; {gets the terminal input started}
+label exit;
+var cmd_line: packed array[1..300] of char;
+@!len: sixteen_bits;
+@!i: integer;
+begin t_open_in;
+i:=0;
+VAX_lib_get_foreign(cmd_line,,len,i);
+i:=1; while (i<=len) and (cmd_line[i]=' ') do incr(i);
+if i<=len then begin
+ loc:=first;
+ last:=first;
+ while i<=len do begin
+ buffer[last]:=xord[cmd_line[i]];
+ if (buffer[last]>="A") and (buffer[last]<="Z")
+ then buffer[last]:=buffer[last]+"a"-"A";
+ incr(last); incr(i);
+ end;
+ init_terminal:=true; return;
+ end;
+loop@+begin wake_up_terminal; write(term_out,'**'); update_terminal;
+@.**@>
+ if not input_ln(term_in,true) then {this shouldn't happen}
+ begin write(term_out,crlf);
+ write_ln(term_out,'! End of file on the terminal... why?',crlf);
+@.End of file on the terminal@>
+ init_terminal:=false; return;
+ end;
+ loc:=first;
+ while (loc<last)and(buffer[loc]=" ") do incr(loc);
+ if loc<last then
+ begin init_terminal:=true;
+ return; {return unless the line was all blank}
+ end;
+ write_ln(term_out,'Please type the name of your input file.',crlf);
+ end;
+exit:end;
+@z
+
+@x [5] real crlf for terminal
+@d wterm(#)==write(term_out,#)
+@d wterm_ln(#)==write_ln(term_out,#)
+@d wterm_cr==write_ln(term_out)
+@y
+@d wterm(#)==write_ln(term_out,#)
+@d wterm_ln(#)==write_ln(term_out,#,crlf)
+@d wterm_cr==write_ln(term_out,crlf)
+@z
+
+@x
+@d check_interrupt==begin if interrupt<>0 then pause_for_instructions;
+ end
+
+@<Global...@>=
+@!interrupt:integer; {should \MF\ pause for instructions?}
+@y
+@d check_interrupt==begin if interrupt<>0 then pause_for_instructions;
+ end
+@d enable_control_C==
+VAX_qiow(,tt_chan,VAX_io_setmode+VAX_iom_ctrlcast,,,,
+ VAX_immed ctrlc_rout,,VAX_immed 3,,,);
+
+@<Global...@>=
+@!interrupt:[VAX_volatile]integer; {should \MF\ pause for instructions?}
+@z
+
+@x
+interrupt:=0; OK_to_interrupt:=true;
+@y
+interrupt:=0; OK_to_interrupt:=true;
+if VAX_assign('TT',tt_chan,,)=1 then enable_control_C;
+@z
+
+@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(#)==#
+@d qo(#)==#
+@d qi(#)==#
+@z
+
+@x [8] block up word files
+@!word_file = file of memory_word;
+@y
+@!word_block = packed array [0..VAX_block_length-1] of memory_word;
+@!word_file = packed file of word_block;
+@z
+
+@x
+Since standard \PASCAL\ cannot provide such information, something special
+is needed. The program here simply specifies July 4, 1776, at noon; but
+users probably want a better approximation to the truth.
+@y
+@z
+
+@x
+@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}
+@y
+@p procedure fix_date_and_time;
+var t:array[1..7] of signed_halfword; {raw year, month, day and time}
+begin VAX_numtim(t);
+internal[year]:=t[1]*unity;
+internal[month]:=t[2]*unity;
+internal[day]:=t[3]*unity;
+internal[time]:=(t[4]*60+t[5])*unity; {minutes since midnight}
+@z
+
+@x Treat tab and formfeed as blanks
+char_class[127]:=invalid_class;
+@y
+char_class[127]:=invalid_class;
+char_class[9]:=space_class;
+char_class[12]:=space_class;
+@z
+
+@x VAX/VMS PASCAL COMPILER BUG!
+begin if odd(octant_before)=odd(octant_after) then cur_x:=x
+ else cur_x:=-x;
+if (octant_before>negate_y)=(octant_after>negate_y) then cur_y:=y
+@y
+begin if (odd(octant_before) and odd(octant_after))
+ or (not odd(octant_before) and not odd(octant_after))
+ then cur_x:=x
+ else cur_x:=-x;
+if ((octant_before>negate_y)and(octant_after>negate_y))
+ or ((octant_before<=negate_y)and(octant_after<=negate_y))
+ then cur_y:=y
+@z
+
+@x VAX/VMS PASCAL COMPILER BUG!
+if odd(right_type(p))<>odd(right_type(q)) then
+@y
+if (odd(right_type(p)) and not odd(right_type(q)))
+ or (not odd(right_type(p)) and odd(right_type(q))) then
+@z
+
+@x
+The \PASCAL\ code here is a minimum version of |init_screen| and
+|update_screen|, usable on \MF\ installations that don't
+support screen output. If |init_screen| is changed to return |true|
+instead of |false|, the other routines will simply log the fact
+that they have been called; they won't really display anything.
+The standard test routines for \MF\ use this log information to check
+that \MF\ is working properly, but the |wlog| instructions should be
+removed from production versions of \MF.
+
+@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;
+
+@ The user's screen is assumed to be a rectangular area, |screen_width|
+@y
+The user's screen is assumed to be a rectangular area, |screen_width|
+@z
+
+@x Code definitions for Tektronix and GraphOn
+@d white=0 {background pixels}
+@d black=1 {visible pixels}
+
+@<Types...@>=
+@!screen_row=0..screen_depth; {a row number on the screen}
+@!screen_col=0..screen_width; {a column number on the screen}
+@!trans_spec=array[screen_col] of screen_col; {a transition spec, see below}
+@!pixel_color=white..black; {specifies one of the two pixel values}
+
+@ We'll illustrate the |blank_rectangle| and |paint_row| operations by
+pretending to declare a screen buffer called |screen_pixel|. This code
+is actually commented out, but it does specify the intended effects.
+
+@<Glob...@>=
+@{@!screen_pixel:array[screen_row,screen_col] of pixel_color;@+@}
+@y
+The remaining definitions are for the graph mode codes to specify
+coordinates on a Tektronix emulator. The codes for x and y coordinates,
+clearing the screen,
+and writing |white| are standard Tektronix codes. The |white_code|
+is also used for entering graphics mode. The codes used to blank a
+rectangle are specific for the particular terminals supported; other Tektronix
+emulators should have analogous ways of blanking out a rectangle.
+
+@d GraphOn=1 {screen type is GraphOn 140}
+@d Tektronix=2 {screen type is Tektronix 4105}
+@d GraphicsPlus=3 {screen type is Northwest Digital Graphics Plus}
+@d white=0 {background pixels}
+@d black=1 {visible pixels}
+@d white_code==chr(29) {Enter Tektronix Graph mode; next vector is white}
+@d GP_area_erase==chr(30) {Next vector specifies area erase on GraphicsPlus}
+@d GO_esc==chr(27) {Must precede the next 5 codes}
+@d erase_screen==chr(12) {erase entire screen}
+@d GO_data_on==chr(1) {Set data color to black on GraphOn}
+@d GO_data_off==chr(16) {Set data color to white on GraphOn}
+@d GO_block_enable==chr(2) {Next vector specifies rectangular block}
+@d GO_block_disable==chr(3) {Next vector is a line}
+@d GO_window_height=55 {Left for characters at bottom of screen;
+ should be 782-|screen_depth|}
+@d GO_screen_depth=391 {Number of pixels in column on GraphOn screen}
+@d wTek(#)==begin incr(Tek_bufptr); Tek_buffer[Tek_bufptr]:=#; end
+@d clear_Tek==begin Tek_hy := chr(0); Tek_hx := chr(0);
+ Tek_buffer.LENGTH := 512; Tek_bufptr := 0;
+ wTek(white_code); wTek(GO_esc); wTek(erase_screen); end
+
+@<Types...@>=
+@!screen_row=0..GO_screen_depth; {a row number on the screen}
+@!screen_col=0..screen_width; {a column number on the screen}
+@!trans_spec=array[screen_col] of screen_col; {a transition spec, see below}
+@!pixel_color=white..black; {specifies one of the two pixel values}
+
+@ The |init_screen| function is used to determine if the terminal being
+used will support screen output. In VMS, this is determined by checking
+the value of the logical name \.{MF\$TERM}, which should be set to |go140|
+if the terminal is a GraphOn. |init_screen| also clears the terminal's
+graph mode screen.
+
+The |update_screen| procedure dumps the graphics output buffer if there's
+anything in it. We also use it to clear a space for
+non-graphics characters at the
+base of the screen, since a Tektronix terminal in alpha mode will just
+write wherever the cursor is positioned and over whatever is there without
+erasing it, making characters unreadable very quickly.
+
+@<Glob...@>=
+@!screen_type: integer;
+@!VAX_termtype: packed array[1..63] of char;
+@!Tek_buffer: varying[512] of char;
+@!Tek_bufptr: integer; { Counts number of char output since last cr }
+@!Tek_hy: char; { Graphic memory of Tektronix (for output compression) }
+@!Tek_ly: char;
+@!Tek_hx: char;
+@!Tek_lx: char;
+
+@ @p @!graph procedure wTek_coor( x : screen_col; y : screen_row );
+ { output tektronix coordinates compressing bytes that don't change }
+ var new_hy, new_ly, new_hx, new_lx : char;
+ begin
+ x := x*2; y := y*2;
+ new_hy := chr(y div 32 + 32); new_ly := chr(y mod 32 + 96);
+ new_hx := chr(x div 32 + 32); new_lx := chr(x mod 32 + 64);
+ if (Tek_hy <> new_hy) then
+ begin
+ Tek_hy := new_hy;
+ wTek( Tek_hy );
+ end;
+ if (Tek_ly <> new_ly) or (Tek_hx <> new_hx) then
+ begin
+ Tek_ly := new_ly;
+ wTek( Tek_ly );
+ if (Tek_hx <> new_hx) then
+ begin
+ Tek_hx := new_hx;
+ wTek( Tek_hx );
+ end;
+ end;
+ Tek_lx := new_lx;
+ wTek( Tek_lx );
+ end;@+hparg
+@#
+function init_screen:boolean;
+begin
+ @!graph
+ VAX_trnlog( VAX_lognam:='MF$TERM',VAX_rslbuf:=VAX_termtype);
+ if (VAX_termtype[1]='g') and (VAX_termtype[2]='o') and (VAX_termtype[3]='1')
+ and (VAX_termtype[4]='4') and (VAX_termtype[5]='0')
+ then begin {clear the graphics screen}
+ screen_type:=GraphOn;
+ clear_Tek;
+ init_screen:=true;
+ end else if (VAX_termtype[1]='t') and (VAX_termtype[2]='e')
+ and (VAX_termtype[3]='k')
+ then begin {clear the graphics screen}
+ screen_type:=Tektronix;
+ clear_Tek;
+ wTek(GO_esc); wTek('M'); wTek('P'); wTek('0'); {select blank fill color}
+ init_screen:=true;
+ end else if (VAX_termtype[1]='g') and (VAX_termtype[2]='p')
+ then begin {clear the graphics screen}
+ screen_type:=GraphicsPlus;
+ clear_Tek;
+ init_screen:=true;
+ end else @+hparg init_screen:=false;
+@!init init_screen:=true;@+tini
+end;
+@#
+procedure update_screen; {will be called only if |init_screen| returns |true|}
+begin
+ @!init wlog_ln('Calling UPDATESCREEN');@+tini {for testing only}
+ @!graph
+ case screen_type of
+ GraphOn: begin
+ wTek(white_code); wTek(GO_esc); wTek(GO_data_off);
+ wTek(GO_esc); wTek(GO_block_enable);
+ wTek_coor(screen_width-1,0);
+ wTek_coor(0,GO_window_height);
+ wTek(GO_esc); wTek(GO_block_disable); wTek(GO_esc); wTek(GO_data_on);
+ end;
+ Tektronix: begin
+ wTek(GO_esc); wTek('M'); wTek('L'); {set line color blank}
+ wTek(GO_esc); wTek('L'); wTek('P'); {begin panel}
+ wTek_coor(0,GO_window_height);
+ wTek(white_code);
+ wTek_coor(screen_width-1,GO_window_height);
+ wTek_coor(screen_width-1,0);
+ wTek_coor(0,0);
+ wTek(GO_esc); wTek('L'); wTek('E'); {end panel}
+ wTek(GO_esc); wTek('M'); wTek('L'); wTek('1'); {set line color}
+ Tek_hy:=chr(0); Tek_hx:=chr(0); {no compression next set of coordinates}
+ end;
+ GraphicsPlus: begin
+ wTek(white_code); wTek_coor(screen_width-1,0);
+ wTek(GP_area_erase); wTek_coor(0,GO_window_height);
+ end;
+ othercases do_nothing
+ endcases;
+ if Tek_bufptr > 0 then
+ begin
+ Tek_buffer.LENGTH := Tek_bufptr;
+ wterm_ln(Tek_buffer);
+ Tek_bufptr := 0;
+ Tek_buffer.LENGTH := 512;
+ end;
+ @+hparg
+end;
+@z
+
+@x
+The commented-out code in the following procedure is for illustrative
+purposes only.
+@y
+@z
+
+@x Blank_rectangle for the GraphOn Tektronix emulator
+begin @{@+for r:=top_row to bot_row-1 do
+ for c:=left_col to right_col-1 do
+ screen_pixel[r,c]:=white;@+@}@/
+@y
+begin
+ @!graph
+ if Tek_bufptr > 450 then
+ begin
+ Tek_buffer.LENGTH := Tek_bufptr;
+ wterm_ln(Tek_buffer);
+ Tek_bufptr := 0;
+ Tek_buffer.LENGTH := 512;
+ end;
+ case screen_type of
+ GraphOn: begin
+ wTek(white_code);
+ wTek(GO_esc); wTek(GO_data_off); wTek(GO_esc); wTek(GO_block_enable);
+ wTek_coor(right_col-1, GO_screen_depth-bot_row+1);
+ wTek_coor(left_col, GO_screen_depth-top_row);
+ wTek(GO_esc); wTek(GO_block_disable); wTek(GO_esc); wTek(GO_data_on);@/
+ end;
+ Tektronix: begin
+ wTek(GO_esc); wTek('M'); wTek('L'); {set line color blank}
+ wTek(GO_esc); wTek('L'); wTek('P'); {begin panel}
+ wTek_coor(left_col, GO_screen_depth-top_row);
+ wTek(white_code);
+ wTek_coor(right_col-1, GO_screen_depth-top_row);
+ wTek_coor(right_col-1, GO_screen_depth-bot_row+1);
+ wTek_coor(left_col, GO_screen_depth-bot_row+1);
+ wTek(GO_esc); wTek('L'); wTek('E'); {end panel}
+ wTek(GO_esc); wTek('M'); wTek('L'); wTek('1'); {set line color}
+ Tek_hy:=chr(0); Tek_hx:=chr(0); {no compression next set of coordinates}
+ end;
+ GraphicsPlus: begin
+ wTek(white_code); wTek_coor(right_col-1, GO_screen_depth-bot_row+1);
+ wTek(GP_area_erase); wTek_coor(left_col, GO_screen_depth-top_row);
+ end;
+ othercases do_nothing
+ endcases;
+ @+hparg
+@z
+
+@x
+program (see the commented-out code below).
+@y
+program.
+@z
+
+@x Paint-row for the Tektronix
+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;@+@}@/
+@y
+begin @!graph k:=0; c:=a[0];
+r:=GO_screen_depth-r; {because Tektronix has 0 at bottom of screen}
+{ move to starting point }
+wTek(white_code);
+wTek_coor(c,r);
+repeat incr(k);
+ if b<>black then wTek(white_code);
+ wTek_coor(a[k]-1, r);
+ b:=black-b; {$|black|\swap|white|$}
+ if Tek_bufptr > 450 then
+ begin
+ Tek_buffer.LENGTH := Tek_bufptr;
+ wterm(Tek_buffer);
+ Tek_bufptr := 0;
+ Tek_buffer.LENGTH := 512;
+ end;
+ until k=n;@+hparg@/
+@z
+
+@x
+following structure: If the name contains `\.>' or `\.:', the file area
+@y
+following structure: If the name contains `\.]' or `\.:', the file area
+@z
+
+@x
+@!area_delimiter:pool_pointer; {the most recent `\.>' or `\.:', if any}
+@y
+@!area_delimiter:pool_pointer; {the most recent `\.]' or `\.:', if any}
+@z
+
+@x
+@d MF_area=="MFinputs:"
+@.MFinputs@>
+@y
+@d MF_area=="MF$inputs:"
+@.MFinputs@>
+@.MF{\$}inputs@>
+@z
+
+@x
+else begin if (c=">")or(c=":") then
+@y
+else begin if (c="]") or (c=":") then
+@z
+
+@x
+@d base_area_length=8 {length of its area part}
+@d base_ext_length=5 {length of its `\.{.base}' part}
+@y
+@d base_area_length=9 {length of its area part}
+@d base_ext_length=4 {length of its `\.{.bas}' part}
+@z
+
+@x
+MF_base_default:='MFbases:plain.base';
+@.MFbases@>
+@y
+MF_base_default:='MF$bases:plain.bas';
+@.MF{\$}bases@>
+@z
+
+@x [28] get file name from system
+begin if (pool_ptr+name_length>pool_size)or(str_ptr=max_strings) then
+ make_name_string:="?"
+else begin for k:=1 to name_length do append_char(xord[name_of_file[k]]);
+ make_name_string:=make_string;
+ end;
+@y
+begin if (pool_ptr+last_length>pool_size)or(str_ptr=max_strings) then
+ make_name_string:="?"
+else begin for k:=1 to last_length do append_char(xord[last_name[k]]);
+ make_name_string:=make_string;
+ end;
+@z
+
+@x
+@p procedure pack_job_name(@!s:str_number); {|s = ".log"|, |".gf"|, or
+ |".base"|}
+@y
+@p procedure pack_job_name(@!s:str_number); {|s = ".lis"|, |".gf"|, or
+ |".bas"|}
+@z
+
+@x
+pack_job_name(".log");
+@y
+pack_job_name(".lis");
+@z
+
+@x
+prompt_file_name("transcript file name",".log");
+@y
+prompt_file_name("transcript file name",".lis");
+@z
+
+@x
+@d tfm_out(#)==write(tfm_file,#) {output one byte to |tfm_file|}
+@y
+@d tfm_out(#)==begin tfm_file^[tfm_count]:=#; {output one byte to |tfm_file|}
+ incr(tfm_count);
+ if tfm_count=VAX_block_length then begin
+ put(tfm_file,VAX_error:=VAX_continue); tfm_count:=0; end
+ end
+@z
+
+@x
+while not b_open_out(tfm_file) do
+ prompt_file_name("file name for font metrics",".tfm");
+@y
+while not b_open_out(tfm_file) do
+ prompt_file_name("file name for font metrics",".tfm");
+tfm_count:=0;
+@z
+
+@x
+b_close(tfm_file)
+@y
+while tfm_count>0 do tfm_out(0); {flush out the buffer}
+b_close(tfm_file)
+@z
+
+@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
+@ Some systems may find it more efficient to make |gf_buf| a |packed|
+array, since output of four bytes at once may be facilitated.
+On Vax/VMS, we get even more complicated than that, for efficiency.
+
+@d gf_buf==g_buffer.b {buffer for \.{GF} output}
+
+@<Glob...@>=
+@!g_buffer: [VAX_volatile,VAX_aligned(9)] packed record
+ case boolean of
+ false: (b:packed array[gf_index] of eight_bits);
+ true: (l:byte_block; r:byte_block; j:eight_bits);
+ end;
+@z
+
+@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 |gf_file| is performed by calling
+|write| on the other variant of the |gf_buf| record. Thus, we have to be
+sure that things line up properly.
+@^system dependencies@>
+
+@<Check the ``co...@>=
+if gf_buf_size<>2*VAX_block_length then bad:=223;
+@z
+
+@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
+
+@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
+
+@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;
+if gf_ptr>0 then write(gf_file,g_buffer.l);
+if gf_ptr>half_buf then write(gf_file,g_buffer.r);
+@z
+
+@x Fix for VMS V3.x only; should work as is in V4.x
+if internal[hppp]<=0 then gf_ext:=".gf"
+else begin old_setting:=selector; selector:=new_string; print_char(".");
+ print_int(make_scaled(internal[hppp],59429463));
+ {$2^{32}/72.27\approx59429463.07$}
+ print("gf"); gf_ext:=make_string; selector:=old_setting;
+ end
+@y
+gf_ext:=".gf"
+@z
+
+@x
+@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_put==begin incr(base_count);
+ if base_count=VAX_block_length then begin
+ put(base_file,VAX_error:=VAX_continue); base_count:=0; end
+ end
+@d base_word==base_file^[base_count]
+
+@d dump_wd(#)==begin base_word:=#; base_put;@+end
+@d dump_int(#)==begin base_word.int:=#; base_put;@+end
+@d dump_hh(#)==begin base_word.hh:=#; base_put;@+end
+@d dump_qqqq(#)==begin base_word.qqqq:=#; base_put;@+end
+@z
+
+@x
+@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 base_get==begin incr(base_count);
+ if base_count=VAX_block_length then begin
+ get(base_file,VAX_error:=VAX_continue); base_count:=0; end
+ end
+@d undump_wd(#)==begin base_get; #:=base_word;@+end
+@d undump_int(#)==begin base_get; #:=base_word.int;@+end
+@d undump_hh(#)==begin base_get; #:=base_word.hh;@+end
+@d undump_qqqq(#)==begin base_get; #:=base_word.qqqq;@+end
+@z
+
+@x
+x:=base_file^.int;
+@y
+x:=base_word.int;
+@z
+
+@x
+pack_job_name(".base");
+while not w_open_out(base_file) do prompt_file_name("base file name",".base");
+@y
+pack_job_name(".bas");
+while not w_open_out(base_file) do prompt_file_name("base file name",".bas");
+@z
+
+@x
+w_close(base_file)
+@y
+while base_count>0 do dump_int(0); {flush out the buffer}
+w_close(base_file)
+@z
+
+@x
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \MF\ work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the published program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@y
+Here are the remaining changes to the program
+that are necessary to make \.{MF} work on Vax/VMS.
+
+@ Here are the things we need for |byte_file| and |word_file| files:
+
+@<Glob...@>=
+@!gf_count: 0..VAX_block_length;
+@!tfm_count:0..VAX_block_length;
+@!base_count:0..VAX_block_length;
+
+@ Here's the interrupt stuff.
+
+@<Types...@>=
+@!signed_halfword=[VAX_word] -32768..32767;
+@!sixteen_bits=[VAX_word] 0..65535;
+
+@ @<Glob...@>=
+@!itm: array [1..4] of VAX_unsigned;
+@!res:[VAX_volatile] integer;
+@!tt_chan: [VAX_volatile] signed_halfword;
+
+@ @<Vax/VMS procedures@>=
+[asynchronous] procedure @!ctrlc_rout;
+begin
+interrupt:=1;
+enable_control_C;
+end;
+
+@ Here is the stuff for magic file operations.
+@<Types...@>=
+unsafe_file = [unsafe] file of char;
+FAB_ptr = ^VAX_FAB_type;
+RAB_ptr = ^VAX_RAB_type;
+NAM_ptr = ^VAX_NAM_type;
+chrptr = ^char;
+
+@ @<Vax/VMS procedures@>=
+function VAX_PAS_FAB(var foobar:unsafe_file):FAB_ptr; extern;
+function VAX_PAS_RAB(var foobar:unsafe_file):RAB_ptr; extern;
+
+@ @<Glob...@>=
+in_FAB,out_FAB,fyl_FAB: FAB_ptr;
+in_RAB,out_RAB,fyl_RAB: RAB_ptr;
+last_length: integer;
+last_name:packed array [1..file_name_size] of char;
+@z
diff --git a/obsolete/systems/knuth/unsupported/mfware/gfread.tops20-changes b/obsolete/systems/knuth/unsupported/mfware/gfread.tops20-changes
new file mode 100644
index 0000000000..c98bd1886f
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/mfware/gfread.tops20-changes
@@ -0,0 +1,172 @@
+% TOPS-20 Change file for GFread by Tomas Rokicki. Send bug reports to
+% ROKICKI@SU-SCORE.
+
+@x [1] Tell WEAVE to print only the changes:
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\ttw{{\mc TOPS-20}}
+\def\title{GFread changes for \ttw}
+@z
+
+@x
+@d banner=='This is GFread, Version 1.1' {printed when the program starts}
+@y
+@d banner=='This is GFread, TOPS-20 Version 1.1' {printed at startup}
+@z
+
+@x
+@d debug==@{
+@d gubed==@t@>@}@/
+@y
+@d debug==@{
+@d gubed==@t@>@}
+@z
+
+@x
+@d eebug==@{
+@d gubee==@t@>@}@/
+@y
+@d eebug==@{
+@d gubee==@t@>@}
+@z
+
+@x
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+@d print_nl==write_ln
+@y
+@d print(#)==write(tty,#)
+@d print_ln(#)==write_ln(tty,#)
+@d print_nl==write_ln(tty)
+@z
+
+@x
+@p program GFread(@!gf_file,@!pxl_file,@!output);
+@y
+@p program GFread;
+@z
+
+@x
+@<Constants...@>=
+@!line_length=79; {bracketed lines of output will be at most this long}
+@!terminal_line_length=150; {maximum number of characters input in a single
+ line of input from the terminal}
+@!mem_max=4000; {largest index in the main |mem| array}
+@y
+@<Constants...@>=
+@!line_length=79; {bracketed lines of output will be at most this long}
+@!terminal_line_length=150; {maximum number of characters input in a single
+ line of input from the terminal}
+@!mem_max=4000; {largest index in the main |mem| array}
+@!name_length=80; {longest name}
+@!max_rescan=200; {longest command line}
+@z
+
+@x
+begin reset(gf_file);
+@y
+begin reset(gf_file,gf_name,'/O/B:8');
+if eof(gf_file) then abort('GF file does not exist!');
+@z
+
+@x
+begin rewrite(pxl_file);
+@y
+begin rewrite(pxl_file,pxl_name,'/O/B:8');
+@z
+
+@x
+@!pxl_loc:integer; {where we are about to write, in |pxl_file|}
+@y
+@!pxl_loc:integer; {where we are about to write, in |pxl_file|}
+@!gf_name,@!pxl_name: packed array[1..name_length] of char ;
+@z
+
+@x
+ initialize ;
+@y
+ initialize ;
+ startup := true ;
+ @<Get command line and check for file name@> ;
+ if not startup then begin
+ print('GF File Name: ') ;
+ read(tty, gf_name) ;
+ read_ln(tty) ;
+ print('PXL File Name: ') ;
+ read(tty, pxl_name) ;
+ read_ln(tty) ;
+ end ;
+@z
+
+@x
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{GFread} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@y
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{GFread} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+We call a system procedure to put the command line into the input buffer.
+We then read it in, skipping over the program name to the first blank.
+
+@d RSCAN=@'500 {ReSCAN buffer JSYS}
+
+@<Get command line and check for file name@>=
+jsys(RSCAN,1,i;0;j); {get the command line}
+if (i<>2) or (j<=0) then startup := false
+else begin
+ if eoln(tty) then read_ln(tty); {for some TOPS-20's}
+ read(tty,rescan_buffer:rescan_len); {read in rescan buffer}
+ if rescan_len>max_rescan then abort('command line too long!');
+ read_ln(tty);
+ if rescan_len=j-2 then startup := false
+ else begin
+ i:=1; while rescan_buffer[i]>' 'do incr(i); {skip invocation}
+ while(i<=rescan_len) and (rescan_buffer[i]=' ')do incr(i); {skip spaces}
+ if i>rescan_len then startup := false
+ else begin
+ for j := 1 to name_length do begin
+ gf_name[j] := ' ' ; pxl_name[j] := ' ' ;
+ end ;
+ j := 1 ;
+ last_ext := -1 ;
+ while ( i <= rescan_len ) and ( rescan_buffer[i] <> ' ' ) do begin
+ gf_name[j] := rescan_buffer[i] ;
+ pxl_name[j] := rescan_buffer[i] ;
+ if (rescan_buffer[i] = '.') and (last_ext = -1) then last_ext := j ;
+ if rescan_buffer[i] in [':',']','>'] then last_ext := -1 ;
+ incr(j) ; incr(i) ;
+ end ;
+ if last_ext = -1 then begin
+ last_ext := j ;
+ gf_name[j] := '.' ; gf_name[j+1] := 'g' ; gf_name[j+2] := 'f' ;
+ end ;
+ pxl_name[last_ext] := '.' ; pxl_name[last_ext+1] := 'p' ;
+ pxl_name[last_ext+2] := 'x' ; pxl_name[last_ext+3] := 'l' ;
+ for i := last_ext+4 to name_length do pxl_name[i] := ' ' ;
+ end ;
+ end ;
+end
+
+@ @<Glob...@>=
+@!rescan_buffer:packed array[1..max_rescan] of char;
+@!rescan_len:integer;
+@!i, @!j : integer ; {general purpose indices}
+@!startup : boolean ; {did we have a file name?}
+@!last_ext : integer ; {where was the dot?}
+@z
diff --git a/obsolete/systems/knuth/unsupported/mfware/gfread.web b/obsolete/systems/knuth/unsupported/mfware/gfread.web
new file mode 100644
index 0000000000..10cde08bb9
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/mfware/gfread.web
@@ -0,0 +1,1157 @@
+% This program is by Tomas Rokicki. Various routines were borrowed from
+% GFtoPXL by Arthur Samuel.
+
+% Version 0.0 (development) started 20 July 1985 TGR.
+% Version 1.0 finished 29 July 1985 TGR.
+% Version 1.1 fixed 0 width problem 11 July 1988 TGR.
+\def\versiondate{11 July 1988}
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\noindent\ignorespaces}
+\def\textindent#1{\hangindent2.5em\noindent\hbox to2.5em{\hss#1 }\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\font\tenss=cmss10 % for `The METAFONTbook'
+\def\PASCAL{Pascal}
+\def\ph{{\mc PASCAL-H}}
+\font\logo=logo10 % font used for the METAFONT logo
+\def\MF{{\logo META}\-{\logo FONT}}
+\def\<#1>{$\langle#1\rangle$}
+\def\section{\mathhexbox278}
+\let\swap=\leftrightarrow
+\def\round{\mathop{\rm round}\nolimits}
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index via @@:sort key}{entry@@>
+
+\def\title{GFread}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont GFread} processor}
+ \vskip 15pt
+ \centerline{(Version 1.1, \versiondate)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ The preparation of this report
+ was supported in part by the National Science
+ Foundation under grants IST-8201926 and MCS-8300984,
+ and by the System Development Foundation. `\TeX' is a
+ trademark of the American Mathematical Society.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+This program is intended to be a model of generic-font (``\.{GF}'') file
+reading software, especially for drivers that currently read pixel
+(``\.{PXL}'') files. It is intended that the relevant parts of this
+program might be copied verbatim into an existing driver such that only
+a modicum of glue code need be added to make the driver read \.{GF} files
+rather than \.{PXL} files. Since \.{PXL} files are being replaced by
+\.{GF} files, largely due to the lack of some relevant information in the
+\.{PXL} files, there is a large number of drivers which must be updated.
+This code should ease the transition.
+
+As this software is intended to be a part of production drivers, every effort
+has been made to make this software both general enough for easy incorporation
+into existing programs, and efficient enough for common use. To this extent,
+the individual characters are never reduced to absolute individual pixels,
+but rather strings of pixels are calculated at one time. Code is included
+to skip individual character definitions (for unused characters, for instance)
+and the data structures used in this program are hidden by macros, which can
+be easily redefined for a particular environment.
+
+For the lack of a better task, the program currently produces a pixel file as
+its output. It is relatively simple to modify the program to create the pixel
+file entirely in memory, thereby making it appear that a pixel file was loaded
+instead of a \.{GF} file. Care must be taken with this approach, however, to
+insure that the pixel width of each character is taken from the \.{GF} file,
+rather than rounded from the \.{PXL} file as is typically done. The \.{TFM}
+widths must still be scaled exactly as they are from the \.{PXL} file.
+
+The |banner| string defined here should be changed whenever \.{GFread}
+gets modified.
+
+@d banner=='This is GFread, Version 1.1' {printed when the program starts}
+
+@ Some of the code below is intended to be used only during debugging aspects
+of this program, and possibly its integration with various drivers.
+Such code will not normally be compiled; it is
+delimited by the codewords `$|debug|\ldots|gubed|$', with apologies
+to people who wish to preserve the purity of English. For even more
+output, the codewords |eebug| and |gubee| can be used.
+@^debugging@>
+
+@d debug==@{
+@d gubed==@t@>@}@/
+@f debug==begin
+@f gubed==end
+@d eebug==@{
+@d gubee==@t@>@}@/
+@f eebug==begin
+@f gubee==end
+
+@ This program is written in standard \PASCAL, except where it is
+necessary to use extensions; for example, one extension is to use a
+default |case| as in \.{TANGLE}, \.{WEAVE}, etc. All places where
+nonstandard constructions are used should be listed in the index under
+``system dependencies.''
+@!@^system dependencies@>
+
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+
+@ The binary input comes from |gf_file|, and the output font is written
+on |pxl_file|. All text output is written on \PASCAL's standard |output|
+file. The term |print| is used instead of |write| when this program writes
+on |output|, so that all such output could easily be redirected if desired.
+
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+@d print_nl==write_ln
+
+@p program GFread(@!gf_file,@!pxl_file,@!output);
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ begin print_ln(banner);@/
+ @<Set initial values@>@/
+ end;
+
+@ If the program has to stop prematurely, it goes to the
+`|final_end|'.
+
+@d final_end=9999 {label for the end of it all}
+
+@<Labels...@>=final_end;
+
+@ The following parameters can be changed at compile time to extend or
+reduce \.{GFread}'s capacity. Actually, as the data structures will be
+modified to fit a particular driver, and |line_length| and
+|terminal_line_length| are standard \.{WEB} macros, they will probably be
+eliminated altogether when integrated with a driver.
+
+@<Constants...@>=
+@!line_length=79; {bracketed lines of output will be at most this long}
+@!terminal_line_length=150; {maximum number of characters input in a single
+ line of input from the terminal}
+@!mem_max=4000; {largest index in the main |mem| array}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+
+@ If the \.{GF} file is badly malformed, the whole process must be aborted;
+\.{GFread} will give up, after issuing an error message about the symptoms
+that were noticed.
+
+Such errors might be discovered inside of subroutines inside of subroutines,
+so a procedure called |jump_out| has been introduced. This procedure, which
+simply transfers control to the label |final_end| at the end of the program,
+contains the only non-local |goto| statement in \.{GFread}.
+@^system dependencies@>
+
+@d abort(#)==begin print(' ',#); jump_out;
+ end
+@d bad_gf(#)==abort('Bad GF file: ',#,'!')
+@.Bad GF file@>
+
+@p procedure jump_out;
+begin goto final_end;
+end;
+
+@* Generic font file format.
+The most important output produced by a typical run of \MF\ is the
+``generic font'' (\.{GF}) file that specifies the bit patterns of the
+characters that have been drawn. The term {\sl generic\/} indicates that
+this file format doesn't match the conventions of any name-brand manufacturer;
+but it is easy to convert \.{GF} files to the special format required by
+almost all digital phototypesetting equipment. There's a strong analogy
+between the \.{DVI} files written by \TeX\ and the \.{GF} files written
+by \MF; and, in fact, the file formats have a lot in common.
+
+A \.{GF} file is a stream of 8-bit bytes that may be
+regarded as a series of commands in a machine-like language. The first
+byte of each command is the operation code, and this code is followed by
+zero or more bytes that provide parameters to the command. The parameters
+themselves may consist of several consecutive bytes; for example, the
+`|boc|' (beginning of character) command has six parameters, each of
+which is four bytes long. Parameters are usually regarded as nonnegative
+integers; but four-byte-long parameters can be either positive or
+negative, hence they range in value from $-2^{31}$ to $2^{31}-1$.
+As in \.{TFM} files, numbers that occupy
+more than one byte position appear in BigEndian order,
+and negative numbers appear in two's complement notation.
+
+A \.{GF} file consists of a ``preamble,'' followed by a sequence of one or
+more ``characters,'' followed by a ``postamble.'' The preamble is simply a
+|pre| command, with its parameters that introduce the file; this must come
+first. Each ``character'' consists of a |boc| command, followed by any
+number of other commands that specify ``black'' pixels,
+followed by an |eoc| command. The characters appear in the order that \MF\
+generated them. If we ignore no-op commands (which are allowed between any
+two commands in the file), each |eoc| command is immediately followed by a
+|boc| command, or by a |post| command; in the latter case, there are no
+more characters in the file, and the remaining bytes form the postamble.
+Further details about the postamble will be explained later.
+
+Some parameters in \.{GF} commands are ``pointers.'' These are four-byte
+quantities that give the location number of some other byte in the file;
+the first file byte is number~0, then comes number~1, and so on.
+
+@ The \.{GF} format is intended to be both compact and easily interpreted
+by a machine. Compactness is achieved by making most of the information
+relative instead of absolute. When a \.{GF}-reading program reads the
+commands for a character, it keeps track of two quantities: (a)~the current
+column number,~|m|; and (b)~the current row number,~|n|. These are 32-bit
+signed integers, although most actual font formats produced from \.{GF}
+files will need to curtail this vast range because of practical
+limitations. (\MF\ output will never allow $\vert m\vert$ or $\vert
+n\vert$ to get extremely large, but the \.{GF} format tries to be more
+general.)
+
+How do \.{GF}'s row and column numbers correspond to the conventions
+of \TeX\ and \MF? Well, the ``reference point'' of a character, in \TeX's
+view, is considered to be at the lower left corner of the pixel in row~0
+and column~0. This point is the intersection of the baseline with the left
+edge of the type; it corresponds to location $(0,0)$ in \MF\ programs.
+Thus the pixel in \.{GF} row~0 and column~0 is \MF's unit square, comprising
+the region of the plane whose coordinates both lie between 0 and~1. The
+pixel in \.{GF} row~|n| and column~|m| consists of the points whose \MF\
+coordinates |(x,y)| satisfy |m<=x<=m+1| and |n<=y<=n+1|. Negative values of
+|m| and~|x| correspond to columns of pixels {\sl left\/} of the reference
+point; negative values of |n| and~|y| correspond to rows of pixels {\sl
+below\/} the baseline.
+
+Besides |m| and |n|, there's also a third aspect of the current
+state, namely the @!|paint_switch|, which is always either \\{black} or
+\\{white}. Each \\{paint} command advances |m| by a specified amount~|d|,
+and blackens the intervening pixels if |paint_switch=black|; then
+the |paint_switch| changes to the opposite state. \.{GF}'s commands are
+designed so that |m| will never decrease within a row, and |n| will never
+increase within a character; hence there is no way to whiten a pixel that
+has been blackened.
+
+@ Here is a list of all the commands that may appear in a \.{GF} file. Each
+command is specified by its symbolic name (e.g., |boc|), its opcode byte
+(e.g., 67), and its parameters (if any). The parameters are followed
+by a bracketed number telling how many bytes they occupy; for example,
+`|d[2]|' means that parameter |d| is two bytes long.
+
+\yskip\hang|paint_0| 0. This is a \\{paint} command with |d=0|; it does
+nothing but change the |paint_switch| from \\{black} to \\{white} or
+vice~versa.
+
+\yskip\hang\\{paint\_1} through \\{paint\_63} (opcodes 1 to 63).
+These are \\{paint} commands with |d=1| to~63, defined as follows: If
+|paint_switch=black|, blacken |d|~pixels of the current row~|n|,
+in columns |m| through |m+d-1| inclusive. Then, in any case,
+complement the |paint_switch| and advance |m| by~|d|.
+
+\yskip\hang|paint1| 64 |d[1]|. This is a \\{paint} command with a specified
+value of~|d|; \MF\ uses it to paint when |64<=d<256|.
+
+\yskip\hang|@!paint2| 65 |d[2]|. Same as |paint1|, but |d|~can be as high
+as~65535.
+
+\yskip\hang|@!paint3| 66 |d[3]|. Same as |paint1|, but |d|~can be as high
+as $2^{24}-1$. \MF\ never needs this command, and it is hard to imagine
+anybody making practical use of it; surely a more compact encoding will be
+desirable when characters can be this large. But the command is there,
+anyway, just in case.
+
+\yskip\hang|boc| 67 |c[4]| |p[4]| |min_m[4]| |max_m[4]| |min_n[4]|
+|max_n[4]|. Beginning of a character: Here |c| is the character code, and
+|p| points to the previous character beginning (if any) for characters having
+this code number modulo 256. (The pointer |p| is |-1| if there was no
+prior character with an equivalent code.) The values of registers |m| and |n|
+defined by the instructions that follow for this character must
+satisfy |min_m<=m<=max_m| and |min_n<=n<=max_n|. (The values of |max_m| and
+|min_n| need not be the tightest bounds possible.) When a \.{GF}-reading
+program sees a |boc|, it can use |min_m|, |max_m|, |min_n|, and |max_n| to
+initialize the bounds of an array. Then it sets |m:=min_m|, |n:=max_n|, and
+|paint_switch:=white|.
+
+\yskip\hang|boc1| 68 |c[1]| |@!del_m[1]| |max_m[1]| |@!del_n[1]| |max_n[1]|.
+Same as |boc|, but |p| is assumed to be~$-1$; also |del_m=max_m-min_m|
+and |del_n=max_n-min_n| are given instead of |min_m| and |min_n|.
+The one-byte parameters must be between 0 and 255, inclusive.
+\ (This abbreviated |boc| saves 19~bytes per character, in common cases.)
+
+\yskip\hang|eoc| 69. End of character: All pixels blackened so far
+constitute the pattern for this character. In particular, a completely
+blank character might have |eoc| immediately following |boc|.
+
+\yskip\hang|skip0| 70. Decrease |n| by 1 and set |m:=min_m|,
+|paint_switch:=white|. \ (This finishes one row and begins another,
+ready to whiten the leftmost pixel in the new row.)
+
+\yskip\hang|skip1| 71 |d[1]|. Decrease |n| by |d+1|, set |m:=min_m|, and set
+|paint_switch:=white|. This is a way to produce |d| all-white rows.
+
+\yskip\hang|@!skip2| 72 |d[2]|. Same as |skip1|, but |d| can be as large
+as 65535.
+
+\yskip\hang|@!skip3| 73 |d[3]|. Same as |skip1|, but |d| can be as large
+as $2^{24}-1$. \MF\ obviously never needs this command.
+
+\yskip\hang|new_row_0| 74. Decrease |n| by 1 and set |m:=min_m|,
+|paint_switch:=black|. \ (This finishes one row and begins another,
+ready to {\sl blacken\/} the leftmost pixel in the new row.)
+
+\yskip\hang|@!new_row_1| through |@!new_row_164| (opcodes 75 to 238). Same as
+|new_row_0|, but with |m:=min_m+1| through |min_m+164|, respectively.
+
+\yskip\hang|xxx1| 239 |k[1]| |x[k]|. This command is undefined in
+general; it functions as a $(k+2)$-byte |no_op| unless special \.{GF}-reading
+programs are being used. \MF\ generates \\{xxx} commands when encountering
+a \&{special} string; this occurs in the \.{GF} file only between
+characters, after the preamble, and before the postamble. However,
+\\{xxx} commands might appear anywhere in \.{GF} files generated by other
+processors. It is recommended that |x| be a string having the form of a
+keyword followed by possible parameters relevant to that keyword.
+
+\yskip\hang|@!xxx2| 240 |k[2]| |x[k]|. Like |xxx1|, but |0<=k<65536|.
+
+\yskip\hang|xxx3| 241 |k[3]| |x[k]|. Like |xxx1|, but |0<=k<@t$2^{24}$@>|.
+\MF\ uses this when sending a \&{special} string whose length exceeds~255.
+
+\yskip\hang|@!xxx4| 242 |k[4]| |x[k]|. Like |xxx1|, but |k| can be
+ridiculously large; |k| mustn't be negative.
+
+\yskip\hang|yyy| 243 |y[4]|. This command is undefined in general;
+it functions as a 5-byte |no_op| unless special \.{GF}-reading programs
+are being used. \MF\ puts |scaled| numbers into |yyy|'s, as a
+result of \&{numspecial} commands; the intent is to provide numeric
+parameters to \\{xxx} commands that immediately precede.
+
+\yskip\hang|no_op| 244. No operation, do nothing. Any number of |no_op|'s
+may occur between \.{GF} commands, but a |no_op| cannot be inserted between
+a command and its parameters or between two parameters.
+
+\yskip\hang|char_loc| 245 |c[1]| |dx[4]| |dy[4]| |w[4]| |p[4]|.
+This command will appear only in the postamble, which will be explained
+shortly.
+
+\yskip\hang|@!char_loc0| 246 |c[1]| |@!dm[1]| |w[4]| |p[4]|.
+Same as |char_loc|, except that |dy| is assumed to be zero, and the value
+of~|dx| is taken to be |65536*dm|, where |0<=dm<256|.
+
+\yskip\hang|pre| 247 |i[1]| |k[1]| |x[k]|.
+Beginning of the preamble; this must come at the very beginning of the
+file. Parameter |i| is an identifying number for \.{GF} format, currently
+131. The other information is merely commentary; it is not given
+special interpretation like \\{xxx} commands are. (Note that \\{xxx}
+commands may immediately follow the preamble, before the first |boc|.)
+
+\yskip\hang|post| 248. Beginning of the postamble, see below.
+
+\yskip\hang|post_post| 249. Ending of the postamble, see below.
+
+\yskip\noindent Commands 250--255 are undefined at the present time.
+
+@d gf_id_byte=131 {identifies the kind of \.{GF} files described here}
+
+@ Here are the opcodes that \.{GFread} actually refers to.
+
+@d paint_0=0 {beginning of the \\{paint} commands}
+@d paint1=64 {move right a given number of columns, then
+ black${}\swap{}$white}
+@d boc=67 {beginning of a character}
+@d boc1=68 {abbreviated |boc|}
+@d eoc=69 {end of a character}
+@d skip0=70 {skip no blank rows}
+@d skip1=71 {skip over blank rows}
+@d new_row_0=74 {move down one row and then right}
+@d max_new_row=238 {move down one row and then right}
+@d no_op=247 {noop}
+@d xxx1=239 {for \&{special} strings}
+@d yyy=243 {for \&{numspecial} numbers}
+@d nop=244 {no operation}
+@d char_loc=245 {character locators in the postamble}
+@d char_loc0=246 {character locators in the postamble}
+@d pre=247 {preamble}
+@d post=248 {postamble beginning}
+@d post_post=249 {postamble ending}
+@d undefined_commands==250,251,252,253,254,255
+
+@ The last character in a \.{GF} file is followed by `|post|'; this command
+introduces the postamble, which summarizes important facts that \MF\ has
+accumulated. The postamble has the form
+$$\vbox{\halign{\hbox{#\hfil}\cr
+ |post| |p[4]| |@!ds[4]| |@!cs[4]| |@!hppp[4]| |@!vppp[4]|
+ |@!min_m[4]| |@!max_m[4]| |@!min_n[4]| |@!max_n[4]|\cr
+ $\langle\,$character locators$\,\rangle$\cr
+ |post_post| |q[4]| |i[1]| 223's$[{\G}4]$\cr}}$$
+Here |p| is a pointer to the byte following the final |eoc| in the file
+(or to the byte following the preamble, if there are no characters);
+it can be used to locate the beginning of \\{xxx} commands
+that might have preceded the postamble. The |ds| and |cs| parameters
+@^design size@> @^check sum@>
+give the design size and check sum, respectively, which are exactly the
+values put into the header of any \.{TFM} file that shares information with
+this \.{GF} file. Parameters |hppp| and |vppp| are the ratios of
+pixels per point, horizontally and vertically, expressed as |scaled| integers
+(i.e., multiplied by $2^{16}$); they can be used to correlate the font
+with specific device resolutions, magnifications, and ``at sizes.'' Then
+come |min_m|, |max_m|, |min_n|, and |max_n|, which bound the values that
+registers |m| and~|n| assume in all characters in this \.{GF} file.
+(These bounds need not be the best possible; |max_m| and |min_n| may, on the
+other hand, be tighter than the similar bounds in |boc| commands. For
+example, some character may have |min_n=-100| in its |boc|, but it might
+turn out that |n| never gets lower than |-50| in any character; then
+|min_n| can have any value |<=-50|. If there are no characters in the file,
+it's possible to have |min_m>max_m| and/or |min_n>max_n|.)
+
+@ Character locators are introduced by |char_loc| commands,
+which specify a character residue~|c|, character escapements (|dx,dy|),
+a character width~|w|, and a pointer~|p|
+to the beginning of that character. (If two or more characters have the
+same code~|c| modulo 256, only the last will be indicated; the others can be
+located by following backpointers. Characters whose codes differ by a
+multiple of 256 are assumed to share the same font metric information,
+hence the \.{TFM} file contains only residues of character codes modulo~256.
+This convention is intended for oriental languages, when there are many
+character shapes but few distinct widths.)
+@^oriental characters@>@^Chinese characters@>@^Japanese characters@>
+
+The character escapements (|dx,dy|) are the values of \MF's \&{chardx}
+and \&{chardy} parameters; they are in units of |scaled| pixels;
+i.e., |dx| is in horizontal pixel units times $2^{16}$, and |dy| is in
+vertical pixel units times $2^{16}$. This is the intended amount of
+displacement after typesetting the character; for \.{DVI} files, |dy|
+should be zero, but other document file formats allow nonzero vertical
+escapement.
+
+The character width~|w| duplicates the information in the \.{TFM} file; it
+is $2^{24}$ times the ratio of the true width to the font's design size.
+
+The backpointer |p| points to the character's |boc|, or to the first of
+a sequence of consecutive \\{xxx} or |yyy| or |no_op| commands that
+immediately precede the |boc|, if such commands exist; such ``special''
+commands essentially belong to the characters, while the special commands
+after the final character belong to the postamble (i.e., to the font
+as a whole). This convention about |p| applies also to the backpointers
+in |boc| commands, even though it wasn't explained in the description
+of~|boc|. @^backpointers@>
+
+Pointer |p| might be |-1| if the character exists in the \.{TFM} file
+but not in the \.{GF} file. This unusual situation can arise in \MF\ output
+if the user had |proofing<0| when the character was being shipped out,
+but then made |proofing>=0| in order to get a \.{GF} file.
+
+@ The last part of the postamble, following the |post_post| byte that
+signifies the end of the character locators, contains |q|, a pointer to the
+|post| command that started the postamble. An identification byte, |i|,
+comes next; this currently equals~131, as in the preamble.
+
+The |i| byte is followed by four or more bytes that are all equal to
+the decimal number 223 (i.e., @'337 in octal). \MF\ puts out four to seven of
+these trailing bytes, until the total length of the file is a multiple of
+four bytes, since this works out best on machines that pack four bytes per
+word; but any number of 223's is allowed, as long as there are at least four
+of them. In effect, 223 is a sort of signature that is added at the very end.
+@^Fuchs, David Raymond@>
+
+This curious way to finish off a \.{GF} file makes it feasible for
+\.{GF}-reading programs to find the postamble first, on most computers,
+even though \MF\ wants to write the postamble last. Most operating
+systems permit random access to individual words or bytes of a file, so
+the \.{GF} reader can start at the end and skip backwards over the 223's
+until finding the identification byte. Then it can back up four bytes, read
+|q|, and move to byte |q| of the file. This byte should, of course,
+contain the value 248 (|post|); now the postamble can be read, so the
+\.{GF} reader can discover all the information needed for individual
+characters.
+
+Unfortunately, however, standard \PASCAL\ does not include the ability to
+@^system dependencies@>
+access a random position in a file, or even to determine the length of a file.
+Almost all systems nowadays provide the necessary capabilities, so \.{GF}
+format has been designed to work most efficiently with modern operating
+systems. However, \.{GFread} reads the \.{GF} file from front to back, as it
+can get the necessary information this way in just one pass, and it simplifies
+the code somewhat.
+
+@* Pixel file format.
+A \.{PXL} file is an expanded raster description of a single font at a
+particular resolution and contains essentially the same information as
+that contained in a \.{GF} file. \.{PXL} files are used by many existing
+device-driver programs for dot matrix devices. By convention, \.{PXL} files
+are for 200 pixels per inch. \.{GFread} will report the magnification
+over the design point size that will occur if the \.{PXL} file is
+used on a 200 pixel per inch output device, and include this information in
+the name of the pixel file. For instance, a pixel file at magstep one for
+a 300 dot per inch device would be named \.{foo.1800pxl}.
+
+All words in a \.{PXL} files are in 32-bit format, with the four lower
+bits zero on 36-bit machines. The raster information is contained in a
+sequence of binary words which record white pixels as zeros and black
+pixels as ones.
+
+The first word of the \.{PXL} file and the last word contain the \.{PXL~ID}
+which is currently equal to 1001.
+
+This first word is followed by a sequence of raster information words
+where each line of pixels in the glyphs is represented by one or more
+words of binary information. The number of words used to represent each
+row of pixels for any particular glyph is fixed and it is set by the value
+of |max_m-min_m+1| for that particular glyph. Each white pixel is represented
+by a zero and each black pixel is represented by a one in the corresponding bit
+positions (the first 32 only of each word on 36-bit machines).
+ The unused bit positions
+toward the end of each set of words for each row of pixels are filled with
+zeros. It sould be noted that this representation is more wasteful of
+space than it needs to be, but it may possibly simplify the
+subsequent use of the information by a device-driver program.
+
+The font directory follows, occupying a fixed position with respect to the
+end of the file (in words 517 through 6 from this end), and assigns 4
+words for each of the potential 128 different glyphs that could be
+contained in this particular font in the order of their ascending ascii
+values (not in the order that the glyphs appear in the raster section,
+which may be entirely arbitrary). This means that the first four words are
+for the ascii zero glyph. All four words reserved for any missing glyphs
+are set to zero.
+
+The first word of each glyph's directory information contains the Pixel
+Width in the left half-word (the leftmost 16 bits) and the Pixel Height in
+the right half-word (the next 16 bits). These dimensions are those of the
+smallest bounding-box, measured in pixels, and they have nothing
+necessarily to do with the width and height figures that appear in the
+\.{TFM} file. The \.{TFM} width, measured in \.{FIXes}, where 1 \.{FIX}
+is $1/(2^{20})$ times the design size, is listed in the fourth word of the
+glyph's directory information.
+
+The second word of the glyph's directory information contains the offset
+of the glyph's reference point from its upper-left-hand corner of the
+bounding box, measured in pixels, with the X-Offset in the left half-word
+and the Y-Offset in the right half-word. These numbers may be negative,
+and two's complement representation is used. Remember that the positive x
+direction means `rightward' and positive y is `downward' on the page.
+
+The third word of a glyph's directory information contains the number of the
+word in this \.{PXL} file where the Raster Description for this particular
+glyph begins, measured from the first word which is numbered zero.
+
+As mentioned earlier, the fourth word of directory information for each
+glyph contains the \.{TFM} width.
+
+The final five words in the \.{PXL} file contain information relation to
+the entire file.
+
+ The first of these five words is a checksum which should
+match the checksum contained in the \.{TFM} file that \TeX\ used in
+reference to this font, although, if this checksum is zero, no validity
+checking will be done.
+
+The second of these five words is an integer that is 1000 times the
+magnification factor at which this font was produced.
+
+The third word contains the design sige of the font measured in \.{FIXes}
+($2^{-20}$ unmagnified points).
+
+The fourth word contains a pointer to the first word of the font directory.
+
+The fifth and last word of the entire file contains a duplicate of the
+\.{PXL} ID as contained in the first word of the file.
+
+@d pxl_id=1001 {current version of \.{PXL} format}
+
+@* Input and output for binary files.
+We have seen that a \.{GF} file is a sequence of 8-bit bytes. The bytes
+appear physically in what is called a `|packed file of 0..255|'
+in \PASCAL\ lingo.
+
+Packing is system dependent, and many \PASCAL\ systems fail to implement
+such files in a sensible way (at least, from the viewpoint of producing
+good production software). For example, some systems treat all
+byte-oriented files as text, looking for end-of-line marks and such
+things. Therefore some system-dependent code is often needed to deal with
+binary files, even though most of the program in this section of
+\.{GFread} is written in standard \PASCAL.
+@^system dependencies@>
+
+We shall stick to simple \PASCAL\ in this program, for reasons of clarity,
+even if such simplicity is sometimes unrealistic.
+
+@<Types...@>=
+@!eight_bits=0..255; {unsigned one-byte quantity}
+@!byte_file=packed file of eight_bits; {files that contain binary data}
+
+@ The program deals with two binary file variables: |gf_file| is the
+input file that we are translating into \.{PXL} format, to be written
+on |pxl_file|.
+
+@<Glob...@>=
+@!gf_file:byte_file; {the stuff we are \.{GFread}ing}
+@!pxl_file:byte_file; {the stuff we have \.{GFread}ed}
+
+@ To prepare the |gf_file| for input, we |reset| it.
+
+@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|}
+begin reset(gf_file);
+end;
+
+@ To prepare the |pxl_file| for output, we |rewrite| it.
+
+@p procedure open_pxl_file; {prepares to write packed bytes in |pxl_file|}
+begin rewrite(pxl_file);
+pxl_loc := 0 ;
+end;
+
+@ |pxl_loc| contains the number of the byte about to
+be written to the |pxl_file|.
+
+@<Glob...@>=
+@!pxl_loc:integer; {where we are about to write, in |pxl_file|}
+
+@ We shall use two simple functions to read the next byte or
+bytes from |gf_file|. We either need to get an individual byte or a
+set of four bytes.
+@^system dependencies@>
+
+@p function gf_byte:integer; {returns the next byte, unsigned}
+var b:eight_bits;
+begin if eof(gf_file) then bad_gf('Unexpected end of file!')
+else begin read(gf_file,b); gf_byte:=b;
+ end;
+end;
+@#
+function gf_signed_quad:integer; {returns the next four bytes, signed}
+var a,@!b,@!c,@!d:eight_bits;
+begin read(gf_file,a); read(gf_file,b); read(gf_file,c); read(gf_file,d);
+if a<128 then gf_signed_quad:=((a*256+b)*256+c)*256+d
+else gf_signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+end;
+
+@ Most info in the |pxl_file| comes in words, but we have to write it
+as halfwords occasionally. These routines are used to do all
+pixel file output, and are hidden as described later in this report, so
+they can be eliminated when incorporating this program into a driver.
+
+@d pxl_byte(#)==begin write(pxl_file,#); incr(pxl_loc); end
+
+@p procedure pxl_halfword(@!w:integer);
+begin
+if w<0 then w:=w+@"10000;
+pxl_byte(w div @"100);
+pxl_byte(w mod @"100);
+end;
+@#
+procedure pxl_word(@!w:integer);
+begin
+if w>=0 then pxl_byte(w div @"1000000)
+else begin
+ w:=w+@"40000000;
+ w:=w+@"40000000;
+ pxl_byte((w div @"1000000) + 128);
+ end;
+pxl_byte((w div @"10000) mod @"100);
+pxl_byte((w div @"100) mod @"100);
+pxl_byte(w mod @"100);
+end;
+
+@* Data structures and their camouflage.
+As this program was meant to be integrated into existing software with ease,
+all major data structures are hidden behind macros. In addition, only one
+major array is used, called (surprisingly) |mem|. This is an array of 32-bit
+integers, but various parts only need be sixteen-bit integers.
+
+First, the |mem| array usage will be described, followed by a description of
+how the macros may be used to incorporate this program into drivers.
+
+As the raster information for each character is being gleaned from the \.{GF}
+file, there are five pieces of information that need to be saved for the
+\.{PXL} directory. These pieces are the bit-map height and width, the
+x- and y-offset, and the raster pointer. Since pixel files only support 128
+characters, we reserve the first $128*5$ or 640 elements of the |mem| array
+to hold these values, and declare the macros appropriately.
+The variable |gf_ch| holds the current character number we are working with.
+It will be defined when we define the |load_gf_file| procedure.
+
+@d gf_c_width==mem[gf_ch] {where we store the width of the bit map}
+@d gf_c_height==mem[gf_ch+128] {where we store the height of the bit map}
+@d gf_x_offset==mem[gf_ch+256] {where we store the x-offset of the bits}
+@d gf_y_offset==mem[gf_ch+384] {where we store the y-offset of the bits}
+@d gf_raster==mem[gf_ch+512] {where we store the raster pointers}
+
+@ We initialize these all to zero. Note that here the |gf_ch| character is
+not used, so this needs to be rewritten if the above macros are changed.
+
+@<Set init...@>=
+for i := 0 to 639 do mem[i] := 0 ;
+
+@ We also need a place to store the bit-map counts of each row in each
+character. This array must have enough storage for
+$$1+\sum_{\hbox{rows}} 2*nwb+1$$
+where |nwb| is the number of white-to-black transitions in the row, including
+one for the beginning if the left-most pixel is black. A minimum would be
+about 3000 for moderately large characters.
+
+@d row_counts(#)==mem[#+640] {where to store the row counts}
+@d end_of_row==65535 {flag to indicate the end of a row}
+@d end_of_char==65534 {flag to indicate the end of a character}
+
+@ These row counts contain the number of contiguous black and white pixels.
+They always start with a white count. Each row is terminated by the
+|end_of_row| flag, and the character is terminated by an |end_of_char|
+flag. An empty row has no row counts---only an |end_of_row| flag. No zero
+counts are allowed except for the first (white) count in each row. Once
+these counts are gleaned from the \.{GF} file, the actual character is
+constructed.
+
+Unfortunately, because the |min_m| and |max_m| counts can be arbitrarly
+larger than the character proper, we cannot send out any raster information
+until we have scanned the entire character, in order to insure that we have
+the minimum bounding box in which the character will fit.
+
+That completes our data structures. There is only one array.
+
+@<Glob...@>=
+@!mem : array [0..mem_max] of integer ; {our working array}
+
+@ It should be quite obvious that the above macros make this program easy
+to modify for a particular machine. The |gf_c_width|, etc. arrays
+usually correspond to real arrays in the driver itself, so a simple
+macro re-definition should suffice to fill these arrays. The |row_counts|
+array should be a fairly large scratch array. For those drivers that
+actually load the raster information, that array should be fine.
+
+For instance, if there is an array called |char_rasters|, and the next free
+location is |next_raster|, you might use the following simple scheme.
+First, calculate the maximum number of integers that the character could
+possibly take by |(max_m-min_m+1+31) div 32 * (max_n-min_n+1)|. Then,
+|row_counts| might be defined as |char_rasters[next_raster+max_char_size+#]|.
+
+@ The output to the pixel file of the raster information is done sixteen-bits
+at a time. (Sixteen bit chunks are used in the bit manipulation portion of
+the code to eliminate sign problems.) A simple macro takes care of this:
+
+@d send_raster_16(#)==pxl_halfword(#)
+
+@* Plan of attack.
+Our approach to the problem of turning the \.{GF} description into a raster
+description is done in two steps. The first step sets up the |row_counts|
+array as described above. During this step, we also calculate the
+tightest bounds of the array. The second step takes these row counts and
+actually creates a raster description of the character from it, using
+simple bit manipulations. (This is why an area in |char_rasters| might
+need to be reserved---we certainly don't want to destroy the |row_counts|
+as we are building the character!) This way, if some strange raster format
+were need for a particular device, the first code for the first step,
+which interprets the \.{GF} format, would remain essentially the same,
+and only the second step would need to be rewritten.
+
+The first step---that of interpreting the \.{GF} file format, is
+essentially quite simple. There are only a limited number of commands
+that can occur outside a character definition in the \.{GF} file.
+Therefore, we start by defining the procedure which will actually do
+an entire \.{GF} font.
+
+@p procedure load_gf_file;
+var
+ @!gf_ch:integer; {what character are we looking at?}
+ @!i, @!j, @!k : integer ; {general purpose indices}
+ @!gf_com : integer ; {current gf command}
+ @<Locals to |load_gf_file|@>
+begin
+ open_gf_file ;
+ if gf_byte <> pre then bad_gf('First byte is not preamble');
+ if gf_byte <> gf_id_byte then
+ bad_gf('Identification byte is incorrect');
+ i := gf_byte ;
+ for j := 1 to i do k := gf_byte ;
+ repeat
+ gf_com := gf_byte ;
+ case gf_com of
+ boc, boc1 : @<Interpret character@> ;
+ @<Specials and |no_op| cases@> ;
+ post : ; {we will actually do the work for this one later}
+ othercases bad_gf('Unexpected ',gf_com:1,' command between characters') ;
+ endcases ;
+ until gf_com = post ;
+ @<Interpret postamble@> ;
+end ;
+
+@ We need a few easy macros to expand some case statements:
+
+@d four_cases(#)==#,#+1,#+2,#+3
+@d sixteen_cases(#)==four_cases(#),four_cases(#+4),four_cases(#+8),
+ four_cases(#+12)
+@d sixty_four_cases(#)==sixteen_cases(#),sixteen_cases(#+16),
+ sixteen_cases(#+32),sixteen_cases(#+48)
+@d one_sixty_five_cases(#)==sixty_four_cases(#),sixty_four_cases(#+64),
+ sixteen_cases(#+128),sixteen_cases(#+144),four_cases(#+160),#+164
+
+@ That is certainly simple enough! In this programs, all special commands
+and the |no_op| are ignored, so we write some code to skip over these:
+
+@<Specials and |no_op| cases@>=
+four_cases(xxx1) : begin
+ i := 0 ; for j := 0 to gf_com - xxx1 do i := i * 256 + gf_byte ;
+ for j := 1 to i do k := gf_byte ; end ;
+yyy : k := gf_signed_quad ;
+no_op :
+
+@ Now we need the routine that handles the character commands. Again,
+only a subset of the gf commands are permissible inside character
+definitions, so we only look for these. Also, for the pixel files, we
+only interpret characters less than 128. For drivers, this code might
+be modified to skip any characters that are not actually used.
+
+@<Interpret character@>=
+begin
+ if gf_com = boc then begin
+ gf_ch := gf_signed_quad ;
+ i := gf_signed_quad ; {dispose of back pointer}
+ min_m := gf_signed_quad ;
+ max_m := gf_signed_quad ;
+ min_n := gf_signed_quad ;
+ max_n := gf_signed_quad ;
+ end else begin
+ gf_ch := gf_byte ;
+ i := gf_byte ;
+ max_m := gf_byte ;
+ min_m := max_m - i ;
+ i := gf_byte ;
+ max_n := gf_byte ;
+ min_n := max_n - i ;
+ end ;
+debug print_ln('Character ',gf_ch:1) ; gubed
+ if gf_ch > 127 then {we skip the character}
+ repeat
+ gf_com := gf_byte ;
+ case gf_com of
+sixty_four_cases(paint_0), eoc, skip0, one_sixty_five_cases(new_row_0) : ;
+@<Specials and |no_op| cases@> ;
+paint1, skip1 : i := gf_byte ;
+paint1+1, skip1+1 : begin i := gf_byte ; i := gf_byte ; end ;
+paint1+2, skip1+2 : begin i := gf_byte ; i := gf_byte ; i := gf_byte ; end ;
+othercases bad_gf('Unexpected ',gf_com:1,' while skipping character') ;
+ endcases ;
+ until gf_com = eoc
+ else @<Convert character to raster form@> ;
+end
+
+@ We declare a few more locals:
+
+@<Locals to |load_gf_file|@>=
+@!min_m,@!max_m : integer ; {the maximum and minimum horizontal counters}
+@!min_n,@!max_n : integer ; {the maximum and minimum vertical values}
+@!rows : integer ; {the current row counter value}
+
+@ Now we are at the beginning of a character that we need the raster for.
+Before we get into the complexities of decoding the |paint|, |skip|, and
+|new_row| commands, let's define a macro that will help us fill up the
+|row_counts| array. Note that we check that |rows| never exceeds |max_rows|;
+|max_rows| should be set to the highest number the |rows| index can take,
+and is dependent on how the program is integrated into a driver. Instead of
+calling |bad_gf| directly, as this macro is repeated eight times, we simply
+set the |bad| flag true.
+
+@d put_in_rows(#)==begin if rows > max_rows then bad := true else begin
+row_counts(rows):=#; incr(rows); end ; end
+
+@ Now we have the procedure that decodes the various commands and puts counts
+into the |row_counts| array. This would be a trivial procedure, except for
+the |paint_0| command. Because the |paint_0| command exists, it is possible
+to have a sequence like |paint| 42, |paint_0|, |paint| 38, |paint_0|,
+|paint_0|, |paint_0|, |paint| 33, |skip_0|. This would be an entirely empty
+row, but if we left the zeros in the |row_counts| array, it would be difficult
+to recognize the row as empty.
+
+This type of situation probably would never
+occur in practice, but it is defined by the \.{GF} format, so we must be able
+to handle it. The extra code is really quite simple, just difficult to
+understand; and it does not cut down the speed appreciably. Our goal is
+this: to collapse sequences like |paint| 42, |paint_0|, |paint| 32 to a single
+count of 74, and to insure that the last count of a row is a black count rather
+than a white count. A buffer variable |extra|, and two state flags, |on| and
+|state|, enable us to accomplish this.
+
+The |on| variable is essentially the |paint_switch| described in the \.{GF}
+description. If it is true, then we are currently painting black pixels.
+The |extra| variable holds a count that is about to be placed into the
+|row_counts| array. We hold it in this array until we get a |paint| command
+of the opposite color that is greater than 0. If we get a |paint_0| command,
+then the |state| flag is turned on, indicating that the next count we receive
+can be added to the |extra| variable as it is the same color.
+
+@<Convert character to raster form@>=
+begin
+ max_rows := mem_max - 640 ;
+ bad := false ;
+ rows := 0 ;
+ on := false ;
+ extra := 0 ;
+ state := true ;
+ repeat
+ gf_com := gf_byte ;
+ case gf_com of
+paint_0 : begin
+ state := not state ;
+ on := not on ;
+end ;
+sixty_four_cases(paint_0+1),paint1+1,paint1+2 : begin
+ if gf_com < paint1 then i := gf_com - paint_0
+ else begin
+ i := 0 ; for j := 0 to gf_com - paint1 do i := i * 256 + gf_byte ;
+ end ;
+ if state then begin
+ extra := extra + i ;
+ state := false ;
+ end else begin
+ put_in_rows(extra) ;
+ extra := i ;
+ end ;
+ on := not on ;
+end ;
+four_cases(skip0) : begin
+ i := 0 ; for j := 1 to gf_com - skip0 do i := i * 256 + gf_byte ;
+ if not on and ( extra > 0 ) then put_in_rows(extra) ;
+ for j := 0 to i do put_in_rows(end_of_row) ;
+ on := false ; extra := 0 ; state := true ;
+end ;
+one_sixty_five_cases(new_row_0) : begin
+ if not on and ( extra > 0 ) then put_in_rows(extra) ;
+ put_in_rows(end_of_row) ;
+ on := true ; extra := gf_com - new_row_0 ; state := false ;
+end ;
+@<Specials and |no_op| cases@> ;
+eoc : begin
+ if bad then abort('Ran out of internal memory for row counts!') ;
+ if not on and ( extra > 0 ) then put_in_rows(extra) ;
+ if ( rows > 0 ) and ( row_counts(rows - 1) <> end_of_row) then
+ put_in_rows(end_of_row) ;
+ put_in_rows(end_of_char) ;
+ @<Scan for bounding box and dump raster@> ;
+end ;
+othercases bad_gf('Unexpected ',gf_com:1,' character in character definition');
+ endcases ;
+ until gf_com = eoc ;
+end
+
+@ A few more locals used above and below:
+
+@<Locals to |load_gf_file|@>=
+@!on : boolean ; {indicates whether we are white or black}
+@!state : boolean ; {a state variable---is the next count the same race as
+ the one in the |extra| buffer?}
+@!extra : integer ; {where we pool our counts}
+@!bad : boolean ; {did we run out of space?}
+@!max_rows : integer ; {the highest our |rows| counter can go}
+
+@ Now we have the row counts in our |row_counts| array. First, we determine
+the minimum bounding box. To find the real |max_n|, we look for the first
+non-|end_of_row| value in the |row_counts|. If it is an |end_of_char|,
+the entire character is blank. Otherwise, we first eliminate all of the blank
+rows at the end of the character. Next, for each remaining row, we check the
+first white count for a new |min_m|, and the total length of the row
+for a new |max_m|. Note that we give a raster pointer for the character
+whether or not is has any raster bits, because there might be a blank character
+with a real \.{TFM} width. The raster pointer might need to be changed
+depending on how your driver is set up.
+
+@<Scan for bounding box and dump raster@>=
+i := 0 ; decr(rows) ; gf_raster := pxl_loc div 4 ;
+while row_counts(i) = end_of_row do incr(i) ;
+if row_counts(i) <> end_of_char then begin
+ max_n := max_n - i ;
+ while row_counts(rows - 2) = end_of_row do begin
+ decr(rows) ; row_counts(rows) := end_of_char ;
+ end ;
+ min_n := max_n + 1 ;
+ extra := max_m - min_m + 1 ;
+ max_m := 0 ;
+ j := i ;
+ while row_counts(j) <> end_of_char do begin
+ decr(min_n) ;
+ if row_counts(j) <> end_of_row then begin
+ k := row_counts(j) ;
+ if k < extra then extra := k ;
+ incr(j) ;
+ while row_counts(j) <> end_of_row do begin
+ k := k + row_counts(j) ; incr(j) ;
+ end ;
+ if max_m < k then max_m := k ;
+ end ;
+ incr(j) ;
+ end ;
+ min_m := min_m + extra ;
+ max_m := min_m + max_m - 1 ;
+ gf_c_height := max_n - min_n + 1 ;
+ gf_c_width := max_m - min_m + 1 ;
+ gf_x_offset := - min_m ;
+ gf_y_offset := max_n ;
+debug
+ print_ln('W ',gf_c_width:1,' H ',gf_c_height:1,' X ',gf_x_offset:1,' Y ',
+ gf_y_offset:1);
+gubed
+ @<Dump raster@> ;
+end
+
+@ Now we can actually dump the raster representation of the character. We
+start at |i| in the |row_counts| array, which was left pointing to the first
+non-blank row. Each row has |gf_c_width| pixels. We do the count to raster
+conversion sixteen bits at a time.
+This way, there is no messy business with the sign bit. The conversion of
+the counts to pixels is very straightforward, requiring care only when we
+go over the bounds of a word.
+
+@<Dump raster@>=
+word_width := ( max_m - min_m + 1 + 31 ) div 32 * 2 ;
+while row_counts(i) <> end_of_char do begin
+ j := 0 ;
+ word := 0 ;
+ bit := 16 ;
+ on := false ;
+ count := row_counts(i) - extra ;
+ while count <> end_of_row do begin
+ incr(i) ;
+eebug
+ if on then for k := 1 to count do print('*')
+ else for k := 1 to count do print(' ') ;
+gubee
+ while count > 0 do begin
+ if count >= bit then begin
+ if on then word := word + power[bit] - 1 ;
+ count := count - bit ;
+ send_raster_16(word) ;
+ incr(j) ;
+ word := 0 ; bit := 16 ;
+ end else begin
+ if on then word := word + power[bit] - power[bit - count] ;
+ bit := bit - count ;
+ count := 0 ;
+ end ;
+ end ;
+ on := not on ; count := row_counts(i) ;
+ end ;
+ while j < word_width do begin
+ send_raster_16(word) ;
+ word := 0 ;
+ incr(j) ;
+ end ;
+eebug print_nl ; gubee
+ incr(i) ;
+end
+
+@ I suppose you noticed all of the locals still undefined?
+
+@<Locals to |load_gf_file|@>=
+@!word_width : integer ; {the width of the words to send}
+@!word : integer ; {the word to send out}
+@!count : integer ; {the number of bits to send}
+@!bit : integer ; {the bit position to next set}
+@!hppp, @!vppp : integer ; {horizontal and vertical pixels per point}
+@!dx, @!dy : integer ; {escapements for the character}
+
+@ And we still need the power array.
+
+@<Glob...@>=
+@!power : array [0..16] of integer ; {powers of two}
+
+@ @<Set init...@>=
+power[0] := 1 ;
+for i := 1 to 16 do power[i] := power[i-1] * 2 ;
+
+@ Our last remaining task is to interpret the postamble commands. The only
+things that may appear in the postamble are |post_post|, |char_loc|,
+|char_loc0|, and the special commands. We use the |row_counts| array to
+store the \.{TFM} widths of the characters. We must make sure to clear out
+this array before using it. Insure that you use the
+horizontal displacement from the character locaters in your driver, rather
+than the rounded |tfm_width|. (This was not possible with the \.{PXL} files,
+which is one of the reasons they are being discontinued.)
+
+@d tfm_width==row_counts(gf_ch)
+
+@<Interpret postamble@>=
+for gf_ch := 0 to 127 do tfm_width := 0 ; {clear out tfm widths}
+i := gf_signed_quad ; {skip over junk}
+design_size := gf_signed_quad ;
+check_sum := gf_signed_quad ;
+hppp := gf_signed_quad ;
+vppp := gf_signed_quad ;
+if hppp <> vppp then print_ln('Odd aspect ratio!') ;
+pxl_mag := round ( ( ( 5 * hppp ) * 72.27 ) / 65536.0 ) ;
+debug print_ln('PXL mag = ',pxl_mag:1); gubed
+i := gf_signed_quad ; i := gf_signed_quad ; {skip over junk}
+i := gf_signed_quad ; i := gf_signed_quad ;
+repeat
+ gf_com := gf_byte ;
+ case gf_com of
+char_loc, char_loc0 : begin
+ gf_ch := gf_byte ;
+ if gf_com = char_loc then begin
+ dx := gf_signed_quad ;
+ dy := gf_signed_quad ;
+ end else begin
+ dx := gf_byte * 65536 ;
+ dy := 0 ;
+ end ;
+ tfm_width := gf_signed_quad ;
+ i := gf_signed_quad ;
+end ;
+@<Specials and |no_op| cases@> ;
+post_post : ;
+othercases bad_gf('Unexpected ',gf_com:1,' in postamble') ;
+ endcases ;
+until gf_com = post_post ;
+
+@ Now we have the main program. We do much of the pixel file output here
+so it can be removed easily. The |load_gf_file| procedure does all of the
+work of the program.
+
+@p begin
+ initialize ;
+ open_pxl_file ;
+ pxl_word(pxl_id) ;
+ load_gf_file ;
+ dir_ptr := pxl_loc div 4 ;
+ for gf_ch := 0 to 127 do begin
+ pxl_halfword(gf_c_width) ;
+ pxl_halfword(gf_c_height) ;
+ pxl_halfword(gf_x_offset) ;
+ pxl_halfword(gf_y_offset) ;
+ pxl_word(gf_raster) ;
+ pxl_word(tfm_width) ;
+ end ;
+ pxl_word(check_sum) ;
+ pxl_word(pxl_mag) ;
+ pxl_word(design_size) ;
+ pxl_word(dir_ptr) ;
+ pxl_word(pxl_id) ;
+final_end : end .
+
+@ A few more globals. (Note that there is both a global |gf_ch| and a
+local |gf_ch|. This is so the same macros can be used for both.
+
+@<Glob...@>=
+@!gf_ch : integer ; {which character are we looking at?}
+@!check_sum : integer ; {the checksum of the file}
+@!dir_ptr : integer ; {where does the directory information start?}
+@!design_size : integer ; {the design size of the font}
+@!pxl_mag : integer ; {the pixel magnification, based on 200 dots per inch}
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{GFread} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@* Index.
+Pointers to error messages appear here together with the section numbers
+where each ident\-i\-fier is used.
diff --git a/obsolete/systems/knuth/unsupported/mfware/gftodvi.cms-changes b/obsolete/systems/knuth/unsupported/mfware/gftodvi.cms-changes
new file mode 100644
index 0000000000..4eea68bc19
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/mfware/gftodvi.cms-changes
@@ -0,0 +1,598 @@
+% This is GFtoDVI.CHGCMS in text format, as of jul 11, 1986
+% (change file for IBM CMS PASCAL/VS, created by B.SCHULZE, Univ. Bonn)
+%
+%
+%line numbers correspond to version 1.7 of GFtoDVI (of may 5, 1986)
+%
+%line 59
+%
+%module x
+@x
+@d banner=='This is GFtoDVI, Version 1.7' {printed when the program starts}
+@y
+@d banner=='This is GFtoDVI, CMS Version 1.7'
+ {printed when the program starts}
+@z
+%
+%line 72
+%
+%module x
+@x
+@d othercases == others: {default for cases not listed explicitly}
+@y
+@d othercases == otherwise {default for cases not listed explicitly}
+@d term_in == INTERM {terminal input}
+@d term_out == OUTTERM {terminal output}
+@z
+%
+%line 88
+%
+%module x
+@x
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+@d print_nl(#)==begin write_ln; write(#);
+@y
+@d print(#)==write(term_out,#)
+@d print_ln(#)==write_ln(term_out,#)
+@d print_nl(#)==begin write_ln(term_out); write(term_out,#);
+@z
+%
+%line 99
+%
+%module x
+@x
+ var @!i,@!j,@!m,@!n:integer; {loop indices for initializations}
+ begin print_ln(banner);@/
+ @<Set initial values@>@/
+@y
+ var @!i,@!j,@!k,@!m,@!n:integer; {loop indices for initializations}
+ begin
+ @= termin@>(term_in);
+ @= termout@>(term_out);
+ print_ln(banner);@/
+ @<Set initial values@>@/
+@z
+%
+%line 120
+%
+%module x
+@x
+@!file_name_size=50; {a file name shouldn't be longer than this}
+@!font_mem_size=1000; {space for font metric data}
+@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8}
+@y
+@!file_name_size=20; {a file name shouldn't be longer than this}
+@!font_mem_size=1000; {space for font metric data}
+@!dvi_buf_size=4096; {size of the output buffer; must be a multiple of 8}
+@!dvi_blck_size=2048;
+@!max_gf_size=4096;
+@!max_tfm_size=4096;
+@z
+%
+%line 219
+%
+%module x
+@x
+@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 222
+%
+%module x
+@x
+@!text_file=packed file of text_char;
+@y
+@!text_file=text;
+@z
+%
+%line 356
+%
+%module x
+@x
+@d update_terminal == break(output) {empty the terminal output buffer}
+@y
+@d update_terminal ==
+@z
+%
+%line 360
+%
+%module x
+@x
+@!term_in:text_file; {the terminal, considered as an input file}
+@y
+@!term_in:text_file; {the terminal, considered as an input file}
+@!term_out:text_file; {the terminal, considered as an output file}
+@z
+%
+%line 366
+%
+%module x
+@x
+@p procedure input_ln; {inputs a line from the terminal}
+begin update_terminal; reset(term_in);
+if eoln(term_in) then read_ln(term_in);
+line_length:=0;
+while (line_length<terminal_line_length)and not eoln(term_in) do
+ begin buffer[line_length]:=xord[term_in^]; incr(line_length); get(term_in);
+ end;
+end;
+@y
+@p procedure input_ln; {inputs a line from the terminal}
+var k:0..terminal_line_length;
+ il: string(terminal_line_length);
+begin update_terminal;
+read_ln(term_in,il);
+k:=0;
+while (k<@=length@>(il)) do
+ begin
+ buffer(.k.):=xord(.il(.k+1.).); incr(k);
+ end;
+buffer[k]:=" ";
+end;
+@z
+%
+%line 1512
+%
+%module x
+@x
+@!eight_bits=0..255; {unsigned one-byte quantity}
+@y
+@!eight_bits=packed 0..255; {unsigned one-byte quantity}
+@!type_dvi_blck=packed array(.1..dvi_blck_size.) of eight_bits;
+@z
+%
+%line 1522
+%
+%module x
+@x
+@!gf_file:byte_file; {the character data we are reading}
+@!dvi_file:byte_file; {the typesetting instructions we are writing}
+@!tfm_file:byte_file; {a font metric file}
+@y
+@!gf_file:text;
+@!dvi_file:file of type_dvi_blck;
+@!tfm_file:text;
+@!dvi_block:type_dvi_blck; {file to write: fixed}
+@!gf_rec:string(max_gf_size); {file to read: varying}
+@!tfm_rec:string(max_tfm_size); {file to read: varying}
+@!gf_count:integer; {current position in gf record}
+@!gf_length:integer; {length of current gf record}
+@!tfm_count:integer; {current position in tfm record}
+@!tfm_length:integer; {length of current tfm record}
+@!eof_gf_file:boolean;
+@!eof_tfm_file:boolean;
+@z
+%
+%line 1534
+%
+%module x
+@x
+@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|}
+begin reset(gf_file,name_of_file);
+cur_loc:=0;
+end;
+@#
+procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|}
+begin reset(tfm_file,name_of_file);
+end;
+@#
+procedure open_dvi_file; {prepares to write packed bytes in |dvi_file|}
+begin rewrite(dvi_file,name_of_file);
+end;
+@y
+@d ccat==@=||@>
+@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|}
+begin
+gf_count:=max_gf_size + 1;
+gf_length:=0;
+eof_gf_file:= false;
+reset(gf_file);
+cur_loc:=0;
+end;
+@#
+procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|}
+begin
+tfm_count:=max_tfm_size + 1;
+tfm_length:=0;
+eof_tfm_file:= false;
+reset(tfm_file,'NAME='||trim(str(name_of_file)));
+end;
+@#
+procedure open_dvi_file; {prepares to write packed bytes in |dvi_file|}
+begin rewrite(dvi_file);
+end;
+@z
+%
+%line 1570
+%
+%module x
+@x
+begin read(tfm_file,b0); read(tfm_file,b1);
+read(tfm_file,b2); read(tfm_file,b3);
+@y works only if tfm rec size multiple of 4
+begin
+if tfm_count > tfm_length then
+ begin
+ read(tfm_file,tfm_rec);
+ tfm_length:=@= length@>(tfm_rec);
+ tfm_count:=1;
+ end;
+b0:=ord(tfm_rec(.tfm_count.));
+b1:=ord(tfm_rec(.tfm_count+1.));
+b2:=ord(tfm_rec(.tfm_count+2.));
+b3:=ord(tfm_rec(.tfm_count+3.));
+tfm_count:=tfm_count+4;
+eof_tfm_file:=(eof(tfm_file) & (tfm_count > tfm_length));
+@z
+%
+%line 1580
+%
+%module x
+@x
+@p function get_byte:integer; {returns the next byte, unsigned}
+var b:eight_bits;
+begin if eof(gf_file) then get_byte:=0
+else begin read(gf_file,b); incr(cur_loc); get_byte:=b;
+ end;
+end;
+@#
+function get_two_bytes:integer; {returns the next two bytes, unsigned}
+var a,@!b:eight_bits;
+begin read(gf_file,a); read(gf_file,b);
+cur_loc:=cur_loc+2;
+get_two_bytes:=a*256+b;
+end;
+@#
+function get_three_bytes:integer; {returns the next three bytes, unsigned}
+var a,@!b,@!c:eight_bits;
+begin read(gf_file,a); read(gf_file,b); read(gf_file,c);
+cur_loc:=cur_loc+3;
+get_three_bytes:=(a*256+b)*256+c;
+end;
+@#
+function signed_quad:integer; {returns the next four bytes, signed}
+var a,@!b,@!c,@!d:eight_bits;
+begin read(gf_file,a); read(gf_file,b); read(gf_file,c); read(gf_file,d);
+cur_loc:=cur_loc+4;
+if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
+else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+end;
+@y
+@p
+procedure get_gf(var bb: eight_bits); {gets next byte from gf file}
+begin
+if gf_count > gf_length then
+ begin
+ read(gf_file,gf_rec);
+ gf_length:=@= length@>(gf_rec);
+ gf_count:=1;
+ end;
+bb := ord(gf_rec(.gf_count.));
+incr(gf_count);
+incr(cur_loc);
+eof_gf_file:=(eof(gf_file) & (gf_count > gf_length));
+end;
+@#
+function get_byte:integer; {returns the next byte, unsigned}
+var b:eight_bits;
+begin
+get_gf(b); get_byte:=b;
+end;
+@#
+function get_two_bytes:integer; {returns the next two bytes, unsigned}
+var a,@!b:eight_bits;
+begin get_gf(a); get_gf(b);
+get_two_bytes:=a*256+b;
+end;
+@#
+function get_three_bytes:integer; {returns the next three bytes, unsigned}
+var a,@!b,@!c:eight_bits;
+begin get_gf(a); get_gf(b); get_gf(c);
+get_three_bytes:=(a*256+b)*256+c;
+end;
+@#
+function signed_quad:integer; {returns the next four bytes, signed}
+var a,@!b,@!c,@!d:eight_bits;
+begin get_gf(a); get_gf(b); get_gf(c); get_gf(d);
+if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
+else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+end;
+@z
+%
+%line 1627
+%
+%module x
+@x
+@d qi(#)==#+min_quarterword
+ {to put an |eight_bits| item into a quarterword}
+@d qo(#)==#-min_quarterword
+ {to take an |eight_bits| item out of a quarterword}
+@y
+@d qi(#)==# {to put an |eight_bits| item into a quarterword}
+@d qo(#)==# {to take an |eight_bits| item out of a quarterword}
+@z
+%
+%line 2284
+%
+%module x
+@x
+l:=9; init_str9("T")("e")("X")("f")("o")("n")("t")("s")(":")(home_font_area);@/
+@y
+l:=2; init_str2(".")("*")(home_font_area);@/
+@z
+%
+%line 2297
+%
+%module x
+@x
+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
+var ret:boolean;
+begin if c=" " then ret:=false
+else begin ret:=true;
+ if (c=".")then if ext_delimiter=0 then ext_delimiter:=pool_ptr
+ else if area_delimiter=0 then area_delimiter:=pool_ptr
+ else ret:=false;
+ if ret then begin {contribute |c| to the current string}
+ str_room(1); append_char(c); end;
+ end;
+more_name:=ret;
+end;
+@z
+%
+%line 2311
+%
+%module x
+@x
+if area_delimiter=0 then cur_area:=null_string
+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:=null_string; 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:=null_string;
+ cur_ext:=null_string;
+ cur_name:=make_string; end
+else begin cur_name:=str_ptr; incr(str_ptr);
+ str_start[str_ptr]:=ext_delimiter+1;
+ if area_delimiter=0 then
+ begin cur_area:=null_string; 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;
+end;
+@z
+%
+%line 2341
+%
+%module x
+@x
+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
+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]);
+for j:=str_start[a] to str_start[a+1]-1 do append_to_name(str_pool[j]);
+@z
+%
+%line 2357
+%
+%module x
+@x
+@ The |start_gf| procedure prompts the user for the name of the generic
+font file to be input. It opens the file, making sure that some input is
+present; then it opens the output file.
+
+Although this routine is system-independent, it should probably be
+modified to take the file name from the command line (without an initial
+prompt), on systems that permit such things.
+
+@p procedure start_gf;
+label found,done;
+begin loop@+begin print_nl('GF file name: '); input_ln;
+@.GF file name@>
+ buf_ptr:=0; buffer[line_length]:="?";
+ while buffer[buf_ptr]=" " do incr(buf_ptr);
+ if buf_ptr<line_length then
+ begin @<Scan the file name in the buffer@>;
+ if cur_ext=null_string then cur_ext:=gf_ext;
+ pack_file_name(cur_name,cur_area,cur_ext); open_gf_file;
+ if not eof(gf_file) then goto found;
+ print_nl('Oops... I can''t find file '); print(name_of_file);
+@.Oops...@>
+@.I can't find...@>
+ end;
+ end;
+found:job_name:=cur_name; pack_file_name(job_name,null_string,dvi_ext);
+open_dvi_file;
+end;
+
+@ @<Scan the file name in the buffer@>=
+if buffer[line_length-1]="/" then
+ begin interaction:=true; decr(line_length);
+ end;
+begin_name;
+loop@+ begin if buf_ptr=line_length then goto done;
+ if not more_name(buffer[buf_ptr]) then goto done;
+ incr(buf_ptr);
+ end;
+done:end_name
+@y
+@ I don't see the slightest reason why the user should be prompted for
+the name of the file to be processed.
+
+@p procedure start_gf;
+begin
+open_gf_file;
+if eof(gf_file) then
+ bad_gf('Oops... I can''t find gf file ');
+@.Oops...@>
+@.I can't find...@>
+open_dvi_file;
+end;
+@z
+%
+%line 2474
+%
+%module x
+@x
+@ Some systems may find it more efficient to make |dvi_buf| a |packed|
+array, since output of four bytes at once may be facilitated.
+@^system dependencies@>
+@y
+@ We play a trick with variant records so that we can fill up the
+|dvi_buf| array byte by byte, but write it out in one swell foop.
+@^system dependencies@>
+@d dvi_buf==d_buffer.b {buffer for \.{DVI} output}
+@z
+%
+%line 2479
+%
+%module x
+@x
+@!dvi_buf:array[dvi_index] of eight_bits; {buffer for \.{DVI} output}
+@y
+@!d_buffer: packed record
+ case boolean of
+ false:(b:packed array [dvi_index] of eight_bits);
+ true: (l:type_dvi_blck; r:type_dvi_blck);
+ end;
+@z
+%
+%line 2493
+%
+%module x
+@x
+@ The actual output of |dvi_buf[a..b]| to |dvi_file| is performed by calling
+|write_dvi(a,b)|. It is safe to assume that |a| and |b+1| will both be
+multiples of 4 when |write_dvi(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@>
+
+@p procedure write_dvi(@!a,@!b:dvi_index);
+var k:dvi_index;
+begin for k:=a to b do write(dvi_file,dvi_buf[k]);
+end;
+@y
+@ The actual output of |dvi_buf[a..b]| to |dvi_file| is performed by calling
+|write| on the other variant of the |dvi_buf| record.
+@^system dependencies@>
+@z
+%
+%line 2514
+%
+%module x
+@x
+ begin write_dvi(0,half_buf-1); dvi_limit:=half_buf;
+@y
+ begin write(dvi_file,d_buffer.l); dvi_limit:=half_buf;
+@z
+%
+%line 2517
+%
+%module x
+@x
+else begin write_dvi(half_buf,dvi_buf_size-1); dvi_limit:=dvi_buf_size;
+@y
+else begin write(dvi_file,d_buffer.r); dvi_limit:=dvi_buf_size;
+@z
+%
+%line 2525
+%
+%module x
+@x
+if dvi_limit=half_buf then write_dvi(half_buf,dvi_buf_size-1);
+if dvi_ptr>0 then write_dvi(0,dvi_ptr-1)
+@y
+if dvi_limit=half_buf then write(dvi_file,d_buffer.r);
+for k:=dvi_ptr to dvi_buf_size do dvi_buf[k]:=223; {bug is |k| ok?}
+if dvi_ptr>0 then write(dvi_file,d_buffer.l);
+if dvi_ptr>half_buf then write(dvi_file,d_buffer.r);
+@z
+%
+%line 3579
+%
+%module x
+@x
+@!b:array[0..4095] of 0..120; {largest existing character for a given pattern}
+@!r:array[0..4095] of 1..4096; {the ``ruler function''}
+@y
+@!b:array(.0..4095.) of packed 0..120;
+ {largest existing character for a given pattern}
+@!r:array(.0..4095.) of packed 1..4096; {the ``ruler function''}
+@z
+%
+%line 3625
+%
+%module x
+@x
+@!a:array[0..widest_row] of 0..4095; {bit patterns for twelve rows}
+@y
+@!a:array(.0..widest_row.) of packed 0..4095; {bit patterns for twelve rows}
+@z
+%
+%line 4146
+%
+%module x
+@x
+@p begin initialize; {get all variables initialized}
+@<Initialize the strings@>;
+start_gf; {open the input and output files}
+@<Process the preamble@>;
+cur_gf:=get_byte; init_str_ptr:=str_ptr;
+loop@+ begin @<Initialize variables for the next character@>;
+ while (cur_gf>=xxx1)and(cur_gf<=no_op) do @<Process a no-op command@>;
+ if cur_gf=post then @<Finish the \.{DVI} file and |goto final_end|@>;
+ if cur_gf<>boc then if cur_gf<>boc1 then abort('Missing boc!');
+@.Missing boc@>
+ @<Process a character@>;
+ cur_gf:=get_byte; str_ptr:=init_str_ptr; pool_ptr:=str_start[str_ptr];
+ end;
+final_end:end.
+@y
+@p procedure second_init;
+var @!m:integer;
+begin
+@<Initialize the strings@>;@/
+start_gf; {open the input and output files}
+@<Process the preamble@>;
+cur_gf:=get_byte; init_str_ptr:=str_ptr;
+end;
+procedure process;
+var @!k:integer;
+begin
+ @<Process a character@>;
+end;
+begin initialize; {get all variables initialized}
+second_init;
+loop@+ begin @<Initialize variables for the next character@>;
+ while (cur_gf>=xxx1)and(cur_gf<=no_op) do @<Process a no-op command@>;
+ if cur_gf=post then @<Finish the \.{DVI} file and |goto final_end|@>;
+ if cur_gf<>boc then if cur_gf<>boc1 then abort('Missing boc!');
+@.Missing boc@>
+ process;
+ cur_gf:=get_byte; str_ptr:=init_str_ptr; pool_ptr:=str_start[str_ptr];
+ end;
+final_end:end.
+@z
diff --git a/obsolete/systems/knuth/unsupported/mfware/gftodvi.tops20-changes b/obsolete/systems/knuth/unsupported/mfware/gftodvi.tops20-changes
new file mode 100644
index 0000000000..eeb7bddc05
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/mfware/gftodvi.tops20-changes
@@ -0,0 +1,205 @@
+% GFtoDVI change file for TOPS-20 by Tomas Rokicki. Send bug reports
+% to ROKICKI@SU-SCORE.
+
+@x [1] Tell WEAVE to print only the changes:
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\ttw{{\mc TOPS-20}}
+\def\title{GFtoDVI changes for \ttw}
+@z
+
+@x
+@d banner=='This is GFtoDVI, Version 1.7' {printed when the program starts}
+@y
+@d banner=='This is GFtoDVI, TOPS-20 Version 1.7'
+ {printed when the program starts}
+@z
+
+@x [2]
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+@d print_nl(#)==begin write_ln; write(#);
+ end
+@y
+@d print(#)==write(TTY,#)
+@d print_ln(#)==write_ln(TTY,#)
+@d print_nl(#)==begin write_ln(TTY); write(TTY,#);
+ end
+@z
+
+@x [2] remove output specification
+@p program GF_to_DVI(@!output);
+@y
+@p program GF_to_DVI;
+@z
+
+@x
+@<Constants...@>=
+@!max_labels=2000; {maximum number of labels and dots per character}
+@!pool_size=10000; {maximum total length of labels and other strings}
+@!max_strings=1100; {maximum number of labels and other strings}
+@!terminal_line_length=150; {maximum number of characters input in a single
+ line of input from the terminal}
+@!file_name_size=50; {a file name shouldn't be longer than this}
+@!font_mem_size=1000; {space for font metric data}
+@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8}
+@!widest_row=8192; {maximum number of pixels per row}
+@y
+@<Constants...@>=
+@!max_labels=2000; {maximum number of labels and dots per character}
+@!pool_size=10000; {maximum total length of labels and other strings}
+@!max_strings=1100; {maximum number of labels and other strings}
+@!terminal_line_length=150; {maximum number of characters input in a single
+ line of input from the terminal}
+@!file_name_size=50; {a file name shouldn't be longer than this}
+@!font_mem_size=1000; {space for font metric data}
+@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8}
+@!widest_row=8192; {maximum number of pixels per row}
+@!max_rescan=200; {longest command line}
+@z
+
+@x [7]
+@d update_terminal == break(output) {empty the terminal output buffer}
+@y
+@d update_terminal == {the terminal output buffer is always emptied}
+@z
+
+@x [7]
+@<Glob...@>=
+@!buffer:array[0..terminal_line_length] of 0..255;
+@!term_in:text_file; {the terminal, considered as an input file}
+@y
+@d term_in==TTY {the terminal, considered as an input file}
+
+@<Glob...@>=
+@!buffer:array[0..terminal_line_length] of 0..255;
+@z
+
+@x
+begin update_terminal; reset(term_in);
+@y
+begin update_terminal;
+@z
+
+@x [42] fix open procedures
+@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|}
+begin reset(gf_file,name_of_file);
+cur_loc:=0;
+end;
+@#
+procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|}
+begin reset(tfm_file,name_of_file);
+end;
+@#
+procedure open_dvi_file; {prepares to write packed bytes in |dvi_file|}
+begin rewrite(dvi_file,name_of_file);
+end;
+@y
+@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|}
+begin reset(gf_file,name_of_file,'/O/B:8');
+cur_loc:=0;
+end;
+@#
+procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|}
+begin reset(tfm_file,name_of_file,'/O/B:8');
+end;
+@#
+procedure open_dvi_file; {prepares to write packed bytes in |dvi_file|}
+begin rewrite(dvi_file,name_of_file,'/O/B:8');
+end;
+@z
+
+@x [44] fix min_quarterword addition and subtraction
+@d qi(#)==#+min_quarterword
+ {to put an |eight_bits| item into a quarterword}
+@d qo(#)==#-min_quarterword
+ {to take an |eight_bits| item out of a quarterword}
+@y
+@d qi(#)==# {to put an |eight_bits| item into a quarterword}
+@d qo(#)==# {to take an |eight_bits| item out of a quarterword}
+@z
+
+@x
+bad_tfm: print_nl('Bad TFM file for');
+@y
+bad_tfm: print_nl('Tried to open ',name_of_file);
+print_nl('Bad TFM file for');
+@z
+
+@x [60] we allow the command line to be fetched
+@p procedure start_gf;
+label found,done;
+begin loop@+begin print_nl('GF file name: '); input_ln;
+@.GF file name@>
+@y
+@p procedure start_gf;
+label found,done;
+var i,j:integer;
+ startup:boolean;
+begin startup:=true;
+@<Get rescan line@>;
+loop@+begin if not startup then begin
+ print_nl('GF file name: '); input_ln;
+end ;
+startup := false ;
+@.GF file name@>
+@z
+
+@x
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{GFtoDVI} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@y
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{GFtoDVI} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+We call a system procedure to put the command line into the input buffer.
+We then read it in, skipping over the program name to the first blank.
+
+@d RSCAN=@'500 {ReSCAN buffer JSYS}
+
+@<Get rescan line@>=
+jsys(RSCAN,1,i;0;j); {get the command line}
+if (i<>2) or (j<=0) then startup := false
+else begin
+ if eoln(term_in) then read_ln(term_in); {for some TOPS-20's}
+ read(term_in,rescan_buffer:rescan_len); {read in rescan buffer}
+ if rescan_len>max_rescan then abort('command line too long!');
+ read_ln(term_in);
+ if rescan_len=j-2 then startup := false
+ else begin
+ i:=1; while rescan_buffer[i]>' 'do incr(i); {skip invocation}
+ while(i<=rescan_len) and (rescan_buffer[i]=' ')do incr(i); {skip spaces}
+ if i>rescan_len then startup := false
+ else begin
+ buf_ptr := 0 ;
+ while ( i <= rescan_len ) and ( buf_ptr < terminal_line_length ) do begin
+ buffer[buf_ptr] := xord[rescan_buffer[i]] ;
+ incr(buf_ptr) ; incr(i) ;
+ end ;
+ line_length := buf_ptr ;
+ buf_ptr := 0 ;
+ end ;
+ end ;
+end
+
+@ @<Glob...@>=
+@!rescan_buffer:packed array[1..max_rescan] of char;
+@!rescan_len:integer;
+
+@z
diff --git a/obsolete/systems/knuth/unsupported/mfware/gftodvi.vms-changes b/obsolete/systems/knuth/unsupported/mfware/gftodvi.vms-changes
new file mode 100644
index 0000000000..ff24ba5523
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/mfware/gftodvi.vms-changes
@@ -0,0 +1,465 @@
+GFtoDVI change file for Vax/VMS
+Jane Colman, Lawrence Berkeley Laboratory
+19 Nov 84
+
+@x
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iftrue
+\def\title{GFtoDVI changes for Vax/VMS}
+@z
+
+@x
+@d banner=='This is GFtoDVI, Version 1.7' {printed when the program starts}
+@y
+@d banner=='This is GFtoDVI, Vax/VMS Version 1.7'
+@z
+
+@x
+@d othercases == others: {default for cases not listed explicitly}
+@y
+@d othercases == otherwise {default for cases not listed explicitly}
+@z
+
+@x
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+@d print_nl(#)==begin write_ln; write(#);
+ end
+
+@p program GF_to_DVI(@!output);
+@y
+@d crlf==chr(13),chr(10)
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#,crlf)
+@d print_nl(#)==begin write_ln(crlf); write(#);
+ end
+@d VAX_carriage_control==@= carriage_control @>
+@d VAX_none==@= none @>
+@d real==double
+
+@p @=[inherit('sys$library:starlet')]@>@\
+ {allows us to use system symbols and routines}
+program GF_to_DVI(@!input,@!output,@!gf_file,@!tfm_file,@!dvi_file);
+@z
+
+@x
+procedure initialize; {this procedure gets things started properly}
+ var @!i,@!j,@!m,@!n:integer; {loop indices for initializations}
+ begin print_ln(banner);@/
+@y
+@<Vax/VMS procedures@>@/
+procedure initialize; {this procedure gets things started properly}
+ var @!i,@!j,@!m,@!n:integer; {loop indices for initializations}
+ begin
+ open(output,'SYS$OUTPUT',VAX_carriage_control:=VAX_none);
+ rewrite(output);
+ out_FAB:=@=PAS$FAB@>(output);
+ out_RAB:=@=PAS$RAB@>(output);
+ print_ln(banner);@/
+@z
+
+@x
+@<Constants...@>=
+@!max_labels=2000; {maximum number of labels and dots per character}
+@!pool_size=10000; {maximum total length of labels and other strings}
+@!max_strings=1100; {maximum number of labels and other strings}
+@!terminal_line_length=150; {maximum number of characters input in a single
+ line of input from the terminal}
+@!file_name_size=50; {a file name shouldn't be longer than this}
+@!font_mem_size=1000; {space for font metric data}
+@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8}
+@!widest_row=8192; {maximum number of pixels per row}
+@y
+@<Constants...@>=
+@!max_labels=2000; {maximum number of labels and dots per character}
+@!pool_size=10000; {maximum total length of labels and other strings}
+@!max_strings=1100; {maximum number of labels and other strings}
+@!terminal_line_length=150; {maximum number of characters input in a single
+ line of input from the terminal}
+@!file_name_size=50; {a file name shouldn't be longer than this}
+@!font_mem_size=1000; {space for font metric data}
+@!dvi_buf_size=1024; {size of the output buffer;
+ must be twice |VAX_block_length|}
+@!widest_row=8192; {maximum number of pixels per row}
+@z
+
+@x
+@d update_terminal == break(output) {empty the terminal output buffer}
+
+@<Glob...@>=
+@!buffer:array[0..terminal_line_length] of 0..255;
+@!term_in:text_file; {the terminal, considered as an input file}
+@y
+@d update_terminal == write_ln(output) {empty the terminal output buffer}
+@d term_in == input {the terminal, considered as an input file}
+
+@<Glob...@>=
+@!buffer:array[0..terminal_line_length] of 0..255;
+@z
+
+@x
+begin update_terminal; reset(term_in);
+if eoln(term_in) then read_ln(term_in);
+line_length:=0;
+while (line_length<terminal_line_length)and not eoln(term_in) do
+ begin buffer[line_length]:=xord[term_in^]; incr(line_length); get(term_in);
+ end;
+@y
+begin update_terminal;
+line_length:=0;
+while (line_length<terminal_line_length)and not eoln(term_in) do
+ begin buffer[line_length]:=xord[term_in^]; incr(line_length); get(term_in);
+ end;
+buffer[line_length]:=" "; read_ln(term_in);
+@z
+
+@x
+@!byte_file=packed file of eight_bits; {files that contain binary data}
+@y
+{later we'll define files that contain binary data}
+@z
+
+@x
+@!gf_file:byte_file; {the character data we are reading}
+@!dvi_file:byte_file; {the typesetting instructions we are writing}
+@!tfm_file:byte_file; {a font metric file}
+@y
+@!gf_file:packed file of byte_block; {the character data we are reading}
+@!dvi_file:packed file of byte_block;
+ {the typesetting instructions we are writing}
+@!tfm_file:packed file of byte_block; {a font metric file}
+@!gf_count:integer; {number of bytes read from current block of |gf_file|}
+@!dvi_count:integer; {number of bytes read from current block of |dvi_file|}
+@!tfm_count:integer; {number of bytes read from current block of |tfm_file|}
+@z
+
+@x
+begin reset(gf_file,name_of_file);
+@y
+begin open(gf_file,name_of_file,@=old,error:=continue@>);
+reset(gf_file,@=error:=continue@>); gf_count:=0;
+@z
+
+@x
+begin reset(tfm_file,name_of_file);
+@y
+begin close(tfm_file,@=error:=continue@>);
+ open(tfm_file,name_of_file,@=old,error:=continue@>);
+ reset(tfm_file,@=error:=continue@>); tfm_count:=0;
+@z
+
+@x
+begin rewrite(dvi_file,name_of_file);
+@y
+begin open(dvi_file,name_of_file,@=new,error:=continue@>);
+rewrite(dvi_file); dvi_count:=0;
+@z
+
+@x
+@p procedure read_tfm_word;
+begin read(tfm_file,b0); read(tfm_file,b1);
+read(tfm_file,b2); read(tfm_file,b3);
+end;
+@y
+@d read_tfm_file(#) ==
+ begin if tfm_count=VAX_block_length then begin
+ get(tfm_file,@=error:=continue@>); tfm_count:=0;
+ end;
+ #:=tfm_file^[tfm_count]; incr (tfm_count);
+ end
+
+@p procedure read_tfm_word;
+begin read_tfm_file(b0); read_tfm_file(b1);
+read_tfm_file(b2); read_tfm_file(b3);
+end;
+@z
+
+@x
+@p function get_byte:integer; {returns the next byte, unsigned}
+var b:eight_bits;
+begin if eof(gf_file) then get_byte:=0
+else begin read(gf_file,b); incr(cur_loc); get_byte:=b;
+ end;
+end;
+@#
+function get_two_bytes:integer; {returns the next two bytes, unsigned}
+var a,@!b:eight_bits;
+begin read(gf_file,a); read(gf_file,b);
+cur_loc:=cur_loc+2;
+get_two_bytes:=a*256+b;
+end;
+@#
+function get_three_bytes:integer; {returns the next three bytes, unsigned}
+var a,@!b,@!c:eight_bits;
+begin read(gf_file,a); read(gf_file,b); read(gf_file,c);
+cur_loc:=cur_loc+3;
+get_three_bytes:=(a*256+b)*256+c;
+end;
+@#
+function signed_quad:integer; {returns the next four bytes, signed}
+var a,@!b,@!c,@!d:eight_bits;
+begin read(gf_file,a); read(gf_file,b); read(gf_file,c); read(gf_file,d);
+cur_loc:=cur_loc+4;
+if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
+else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+end;
+@y
+@d read_gf_file(#) ==
+ begin if gf_count=VAX_block_length then begin
+ get(gf_file,@=error:=continue@>); gf_count:=0;
+ end;
+ #:=gf_file^[gf_count]; incr(gf_count);
+ end
+
+@p function get_byte:integer; {returns the next byte, unsigned}
+var b:eight_bits;
+begin if eof(gf_file) then get_byte:=0
+else begin read_gf_file(b); incr(cur_loc); get_byte:=b;
+ end;
+end;
+@#
+function get_two_bytes:integer; {returns the next two bytes, unsigned}
+var a,@!b:eight_bits;
+begin read_gf_file(a); read_gf_file(b);
+cur_loc:=cur_loc+2;
+get_two_bytes:=a*256+b;
+end;
+@#
+function get_three_bytes:integer; {returns the next three bytes, unsigned}
+var a,@!b,@!c:eight_bits;
+begin read_gf_file(a); read_gf_file(b); read_gf_file(c);
+cur_loc:=cur_loc+3;
+get_three_bytes:=(a*256+b)*256+c;
+end;
+@#
+function signed_quad:integer; {returns the next four bytes, signed}
+var a,@!b,@!c,@!d:eight_bits;
+begin read_gf_file(a); read_gf_file(b); read_gf_file(c); read_gf_file(d);
+cur_loc:=cur_loc+4;
+if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
+else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+end;
+@z
+
+@x
+@d qi(#)==#+min_quarterword
+ {to put an |eight_bits| item into a quarterword}
+@d qo(#)==#-min_quarterword
+@y
+@d qi(#)==#
+ {to put an |eight_bits| item into a quarterword}
+@d qo(#)==#
+@z
+
+@x
+following structure: If the name contains `\.>' or `\.:', the file area
+@y
+following structure: If the name contains `\.]' or `\.:', the file area
+@z
+
+@x
+@!area_delimiter:pool_pointer; {the most recent `\.>' or `\.:', if any}
+@y
+@!area_delimiter:pool_pointer; {the most recent `\.]' or `\.:', if any}
+@z
+
+@x
+to place. The program here sets it to `\.{TeXfonts:}'.
+@^system dependencies@>
+@.TeXfonts@>
+
+@<Initialize the strings@>=
+l:=9; init_str9("T")("e")("X")("f")("o")("n")("t")("s")(":")(home_font_area);@/
+@y
+to place. The program here sets it to `\.{TeX$fonts:}'.
+@^system dependencies@>
+@.TeX$fonts@>
+
+@<Initialize the strings@>=
+l:=10; init_str10("T")("e")("X")("$")("f")("o")("n")("t")("s")(":")
+ (home_font_area);@/
+@z
+
+@x
+else begin if (c=">")or(c=":") then
+@y
+else begin if (c="]")or(c=":") then
+@z
+
+@x
+Although this routine is system-independent, it should probably be
+modified to take the file name from the command line (without an initial
+prompt), on systems that permit such things.
+
+@p procedure start_gf;
+label found,done;
+begin loop@+begin print_nl('GF file name: '); input_ln;
+@.GF file name@>
+ buf_ptr:=0; buffer[line_length]:="?";
+ while buffer[buf_ptr]=" " do incr(buf_ptr);
+ if buf_ptr<line_length then
+ begin @<Scan the file name in the buffer@>;
+ if cur_ext=null_string then cur_ext:=gf_ext;
+ pack_file_name(cur_name,cur_area,cur_ext); open_gf_file;
+ if not eof(gf_file) then goto found;
+ print_nl('Oops... I can''t find file '); print(name_of_file);
+@.Oops...@>
+@.I can't find...@>
+ end;
+ end;
+@y
+On Vax/VMS this routine has been
+modified to take the file name from the command line (without an initial
+prompt).
+
+@d VAX_volatile==@=volatile@>
+@d VAX_aligned==@=aligned@>
+@d VAX_immed==@=%immed @>
+@d VAX_external==@=external@>
+@d VAX_stdescr==@=%stdescr @>
+@d VAX_lib_get_foreign==@= lib$get_foreign@>
+
+@p procedure start_gf;
+label found,done;
+var
+@!i,j:integer;
+begin
+i:=0; j:=VAX_lib_get_foreign(command_line,,cmd_len,i);
+i:=1; buf_ptr:=0;
+while i<=cmd_len do
+ begin buffer[buf_ptr]:=xord[command_line[i]];
+ incr(buf_ptr); incr(i);
+ end;
+line_length:=buf_ptr;
+loop@+begin
+ buf_ptr:=0; buffer[line_length]:="?";
+ while buffer[buf_ptr]=" " do incr(buf_ptr);
+ if buf_ptr<line_length then
+ begin @<Scan the file name in the buffer@>;
+ if cur_ext=null_string then cur_ext:=gf_ext;
+ pack_file_name(cur_name,cur_area,cur_ext); open_gf_file;
+ if not eof(gf_file) then goto found;
+ print_nl('Oops... I can''t find file '); print_ln(name_of_file);
+@.Oops...@>
+@.I can't find...@>
+ end;
+ print('GF file name: '); input_ln;
+@.GF file name@>
+ end;
+@z
+
+@x
+@ Some systems may find it more efficient to make |dvi_buf| a |packed|
+array, since output of four bytes at once may be facilitated.
+@^system dependencies@>
+
+@<Glob...@>=
+@!dvi_buf:array[dvi_index] of eight_bits; {buffer for \.{DVI} output}
+@y
+@ Some systems may find it more efficient to make |dvi_buf| a |packed|
+array, since output of four bytes at once may be facilitated.
+On Vax/VMS, we get even more complicated than that, for efficiency.
+@^system dependencies@>
+
+@d dvi_buf==d_buffer.b {buffer for \.{DVI} output}
+
+@<Glob...@>=
+@!d_buffer: [VAX_volatile,VAX_aligned(9)] packed record
+ case boolean of
+ false: (b:packed array[dvi_index] of eight_bits);
+ true: (l:byte_block; r:byte_block; j:eight_bits);
+ end;
+@z
+
+@x
+@ The actual output of |dvi_buf[a..b]| to |dvi_file| is performed by calling
+|write_dvi(a,b)|. It is safe to assume that |a| and |b+1| will both be
+multiples of 4 when |write_dvi(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@>
+
+@p procedure write_dvi(@!a,@!b:dvi_index);
+var k:dvi_index;
+begin for k:=a to b do write(dvi_file,dvi_buf[k]);
+end;
+@y
+@ The actual output of |dvi_buf[a..b]| to |dvi_file| is performed by calling
+|write| on the other variant of the |dvi_buf| record.
+@^system dependencies@>
+@z
+
+@x
+ begin write_dvi(0,half_buf-1); dvi_limit:=half_buf;
+@y
+ begin write(dvi_file,d_buffer.l); dvi_limit:=half_buf;
+@z
+
+@x
+else begin write_dvi(half_buf,dvi_buf_size-1); dvi_limit:=dvi_buf_size;
+@y
+else begin write(dvi_file,d_buffer.r); dvi_limit:=dvi_buf_size;
+@z
+
+@x
+if dvi_limit=half_buf then write_dvi(half_buf,dvi_buf_size-1);
+if dvi_ptr>0 then write_dvi(0,dvi_ptr-1)
+@y
+if dvi_limit=half_buf then write(dvi_file,d_buffer.r);
+for k:=dvi_ptr to dvi_buf_size do dvi_buf[k]:=223;
+if dvi_ptr>0 then write(dvi_file,d_buffer.l);
+if dvi_ptr>half_buf then write(dvi_file,d_buffer.r);
+@z
+
+@x
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{GFtoDVI} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@y
+Here are the remaining changes to the program that are necessary to
+make \.{GFtoDVI} work on Vax/VMS.
+@^system dependencies@>
+
+@<Constants...@>=
+VAX_block_length=512;
+
+@ @<Types ...@>=
+byte_block=packed array[0..VAX_block_length-1] of 0..255;
+sixteen_bits=0..65535;
+
+@ @<Glob...@>=
+@!command_line: packed array[1..terminal_line_length] of char;
+@!cmd_len:sixteen_bits;
+
+@ Here is the library procedure that gets the user's command line.
+
+@<Vax/VMS procedures@>=
+[VAX_external]
+function VAX_lib_get_foreign(VAX_stdescr cmdlin:[VAX_volatile]
+packed array[$l1..$u1:integer]of char:=VAX_immed 0;
+VAX_stdescr prompt:[VAX_volatile]packed array[$l2..$u2:integer]
+of char:=VAX_immed 0;
+var len:[VAX_volatile]sixteen_bits:=VAX_immed 0;
+var flag:[VAX_volatile]integer:=VAX_immed 0):integer;extern;
+
+@ Here is the stuff for magic file operations.
+@<Types ...@>=
+unsafe_file = [unsafe] file of char;
+FAB_ptr = ^@=FAB$TYPE@>;
+RAB_ptr = ^@=RAB$TYPE@>;
+
+@ @<Vax/VMS procedures@>=
+function@= PAS$FAB@>(var foobar:unsafe_file):FAB_ptr; extern;
+function@= PAS$RAB@>(var foobar:unsafe_file):RAB_ptr; extern;
+
+@ @<Glob...@>=
+out_FAB: FAB_ptr;
+out_RAB: RAB_ptr;
+@z
diff --git a/obsolete/systems/knuth/unsupported/mfware/gftopk.tops20-changes b/obsolete/systems/knuth/unsupported/mfware/gftopk.tops20-changes
new file mode 100644
index 0000000000..97070fcd30
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/mfware/gftopk.tops20-changes
@@ -0,0 +1,177 @@
+% TOPS-20 change file for GFtoPK by Tomas Rokicki. Send bug reports to
+% ROKICKI@SU-SCORE.
+
+@x [1]
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\ttw{{\mc TOPS-20}}
+\def\title{GFtoPK changes for \ttw}
+@z
+
+@x [4]
+@d banner=='This is GFtoPK, Version 1.4' {printed when the program starts}
+@y
+@d banner=='This is GFtoPK, TOPS-20 Version 1.4' {printed on startup}
+@z
+
+@x [5]
+@d d_print_ln(#)==
+@y
+@d d_print_ln(#)==
+@z
+
+@x [6]
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+@y
+@d print(#)==write(tty,#)
+@d print_ln(#)==write_ln(tty,#)
+@z
+
+@x [7]
+@p program GFtoPK(@!gf_file,@!pk_file,@!output);
+@y
+@p program GFtoPK;
+@z
+
+@x [7]
+@<Constants...@>=
+@!line_length=79; {bracketed lines of output will be at most this long}
+@!terminal_line_length=150; {maximum number of characters input in a single
+ line of input from the terminal}
+@!max_row=16000; {largest index in the main |row| array}
+@y
+@<Constants...@>=
+@!line_length=79; {bracketed lines of output will be at most this long}
+@!terminal_line_length=150; {maximum number of characters input in a single
+ line of input from the terminal}
+@!max_row=16000; {largest index in the main |row| array}
+@!name_length=80; {the maximum length of a name}
+@!max_rescan=200; {the maximum length of a command line}
+@z
+
+@x [50]
+begin reset(gf_file);
+@y
+begin reset(gf_file,gf_name,'/O/B:8');
+@z
+
+@x [51]
+begin rewrite(pk_file);
+@y
+begin
+if startup then @<Make packed file name@> ;
+rewrite(pk_file,pk_name,'/O/B:8');
+@z
+
+@x [51]
+@!pk_loc:integer; {where we are about to write, in |pk_file|}
+@!gf_loc:integer; {where are we in the |gf_file|}
+@y
+@!pk_loc:integer; {where we are about to write, in |pk_file|}
+@!gf_loc:integer; {where are we in the |gf_file|}
+@!pk_name, gf_name: packed array[1..name_length] of char;
+@z
+
+@x [95]
+ initialize ;
+ convert_gf_file ;
+@y
+ initialize ;
+ startup := true ;
+ @<Get command line and check for file name@> ;
+ if not startup then begin
+ print('GF file name: ') ;
+ read_ln(tty, gf_name) ;
+ print('PK file name: ') ;
+ read_ln(tty, pk_name) ;
+ end ;
+ convert_gf_file ;
+@z
+
+@x [99]
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{GFtoPK} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@y
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{GFtoPK} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+We call a system procedure to put the command line into the input buffer.
+We then read it in, skipping over the program name to the first blank.
+
+@d RSCAN=@'500 {ReSCAN buffer JSYS}
+
+@<Get command line and check for file name@>=
+jsys(RSCAN,1,i;0;j); {get the command line}
+if (i<>2) or (j<=0) then startup := false
+else begin
+ if eoln(tty) then read_ln(tty); {for some TOPS-20's}
+ read(tty,rescan_buffer:rescan_len); {read in rescan buffer}
+ if rescan_len>max_rescan then abort('command line too long!');
+ read_ln(tty);
+ if rescan_len=j-2 then startup := false
+ else begin
+ i:=1; while rescan_buffer[i]>' 'do incr(i); {skip invocation}
+ while(i<=rescan_len) and (rescan_buffer[i]=' ')do incr(i); {skip spaces}
+ if i>rescan_len then startup := false
+ else begin
+ for j := 1 to name_length do begin
+ gf_name[j] := ' ' ; pk_name[j] := ' ' ;
+ end ;
+ j := 1 ;
+ last_ext := -1 ;
+ while ( i <= rescan_len ) and ( rescan_buffer[i] <> ' ' ) do begin
+ gf_name[j] := rescan_buffer[i] ;
+ pk_name[j] := rescan_buffer[i] ;
+ if (rescan_buffer[i] = '.') and (last_ext = -1) then last_ext := j ;
+ if rescan_buffer[i] in [':',']','>'] then last_ext := -1 ;
+ incr(j) ; incr(i) ;
+ end ;
+ if last_ext = -1 then begin
+ last_ext := j ;
+ gf_name[j] := '.' ; gf_name[j+1] := 'g' ; gf_name[j+2] := 'f' ;
+ end ;
+ pk_name[last_ext] := '.' ;
+ for i := last_ext+1 to name_length do pk_name[i] := ' ' ;
+ end ;
+ end ;
+end
+
+@ We also wait until we are done with the \.{GF} file to make the packed
+file name, so we can put the size information in it.
+
+@<Make packed file name@>=
+begin
+ if h_mag > 999 then begin
+ incr(last_ext) ;
+ pk_name[last_ext] := chr(ord('0')+h_mag div 1000) ;
+ end ;
+ pk_name[last_ext+1] := chr(ord('0')+h_mag div 100 mod 10) ;
+ pk_name[last_ext+2] := chr(ord('0')+h_mag div 10 mod 10) ;
+ pk_name[last_ext+3] := chr(ord('0')+h_mag mod 10) ;
+ pk_name[last_ext+4] := 'p' ; pk_name[last_ext+5] := 'k' ;
+end
+
+@ @<Glob...@>=
+@!rescan_buffer:packed array[1..max_rescan] of char;
+@!rescan_len:integer;
+@!j : integer ; {general purpose index}
+@!startup : boolean ; {did we have a file name?}
+@!last_ext : integer ; {where was the dot?}
+@z
diff --git a/obsolete/systems/knuth/unsupported/mfware/gftopxl.cms-changes b/obsolete/systems/knuth/unsupported/mfware/gftopxl.cms-changes
new file mode 100644
index 0000000000..f63ecda97f
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/mfware/gftopxl.cms-changes
@@ -0,0 +1,438 @@
+% This is GFTOPXL.CHGCMS in text format, as of jun 5, 1986
+% (change file for IBM CMS PASCAL/VS,
+% created by B.SCHULZE and some other people)
+%
+% Important remark: in large parts of the TeX community, there is a
+% belief that a PXL file must always consist of exactly 128 characters.
+% There are even driver programs that try to find the pxl directory at
+% exactly 128*4+5 words from the end of the pxl file. This belief is
+% wrong. The last but one word of the pxl file is the pointer to the
+% beginning of the directory, so it is easy to calculate the number
+% of characters that are defined. This change file allows GFtoPXL to
+% convert up to 256 characters, and the resulting directory is as
+% small as possible.
+% B. Schulze, Univ. of Bonn
+%
+%line numbers correspond to version 2.1 (of may 5, 86)
+%
+%line 68
+%
+%section x
+@x banner
+@d banner=='This is GFtoPXL, Version 2.1' {printed when the program starts}
+@y
+@d banner=='This is GFtoPXL, CMS Version 2.1 (SFB72)'
+ {printed when the program starts}
+@z
+%
+%line 95
+%
+%section x
+@x
+@d othercases == others: {default for cases not listed explicitly}
+@y
+@d othercases == otherwise {default for cases not listed explicitly}
+@z
+%
+%line 106
+%
+%section x
+@x
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+@y
+@d print(#)==write(output,#)
+@d print_ln(#)==write_ln(output,#)
+@z
+%
+%line 117
+%
+%section x
+@x
+ begin print_ln(banner);@/
+@y
+ begin
+ @= TERMIN @>(output);
+ @= TERMOUT @>(output); {prepare the terminal for output}
+ print_ln(banner);@/
+@z
+%
+%line 135
+%
+%section x
+@x
+@!max_glyph_no=127; {maximum glyph number in font, later change to 255}
+@!top_pixel=700; {boundary of pixel image of glyph}
+@!bot_pixel=-350;
+@!left_pixel=-250;
+@!right_pixel=750;
+@y
+@!max_glyph_no=255; {maximum glyph number in font}
+@!top_pixel=700; {boundary of pixel image of glyph}
+@!bot_pixel=-250;
+@!left_pixel=-250;
+@!right_pixel=750;
+@!len_byte_block=1024; {blocksize of gf file}
+@!len_pxl_block=1024; {blocksize of pxl file}
+@z
+%
+%line 200
+%
+%section x
+@x forget relicts from another program!
+@!term_in:text_file; {the terminal, considered as an input file}
+@!term_out:text_file; {the terminal, considered as an output file}
+@y
+@z
+%
+%line 245
+%
+%section x
+@x
+@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 248
+%
+%section x
+@x
+@!text_file=packed file of text_char;
+@y
+@!text_file=text;
+@z
+%
+%line 695
+%
+%section x
+@x
+@!eight_bits=0..255; {unsigned one-byte quantity}
+@!byte_file=packed file of eight_bits; {files that contain binary data}
+@y
+@!eight_bits= packed 0..255; {unsigned one-byte quantity}
+@!byte_block = packed array (.0..len_byte_block-1.) of eight_bits;
+@!byte_file = packed file of byte_block;
+@!pxl_block = packed array (.0..len_pxl_block-1.) of eight_bits;
+@!px_file = packed file of pxl_block;
+@z
+%
+%line
+%
+%section x
+@x
+@!pxl_file:byte_file; {the stuff we have \.{GFtoPXL}ed}
+@y
+@!eof_gf: boolean;
+@!lrec: integer;
+@!norec: integer;
+@!cur_block: integer;
+@!pxl_file:px_file; {the stuff we have \.{GFtoPXL}ed}
+@z
+%
+%line 709
+%
+%section x
+@x
+begin reset(gf_file);
+@y
+begin reset(gf_file);
+cur_block := 1;
+eof_gf := eof(gf_file);
+@z
+%
+%line 735
+%
+%section x
+@x
+@p function get_byte:integer; {returns the next byte, unsigned}
+var b:eight_bits;
+begin if eof(gf_file) then get_byte:=0
+else begin read(gf_file,b); incr(cur_loc); get_byte:=b;
+ end;
+end;
+@#
+function signed_byte:integer; {returns the next byte, signed}
+var b:eight_bits;
+begin read(gf_file,b); incr(cur_loc);
+if b<128 then signed_byte:=b @+ else signed_byte:=b-256;
+end;
+@#
+function get_two_bytes:integer; {returns the next two bytes, unsigned}
+var a,@!b:eight_bits;
+begin read(gf_file,a); read(gf_file,b);
+cur_loc:=cur_loc+2;
+get_two_bytes:=a*256+b;
+end;
+@#
+function signed_pair:integer; {returns the next two bytes, signed}
+var a,@!b:eight_bits;
+begin read(gf_file,a); read(gf_file,b);
+cur_loc:=cur_loc+2;
+if a<128 then signed_pair:=a*256+b
+else signed_pair:=(a-256)*256+b;
+end;
+@#
+function get_three_bytes:integer; {returns the next three bytes, unsigned}
+var a,@!b,@!c:eight_bits;
+begin read(gf_file,a); read(gf_file,b); read(gf_file,c);
+cur_loc:=cur_loc+3;
+get_three_bytes:=(a*256+b)*256+c;
+end;
+@#
+function signed_trio:integer; {returns the next three bytes, signed}
+var a,@!b,@!c:eight_bits;
+begin read(gf_file,a); read(gf_file,b); read(gf_file,c);
+cur_loc:=cur_loc+3;
+if a<128 then signed_trio:=(a*256+b)*256+c
+else signed_trio:=((a-256)*256+b)*256+c;
+end;
+@#
+function signed_quad:integer; {returns the next four bytes, signed}
+var a,@!b,@!c,@!d:eight_bits;
+begin read(gf_file,a); read(gf_file,b); read(gf_file,c); read(gf_file,d);
+cur_loc:=cur_loc+4;
+if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
+else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+end;
+@y
+@d get_gf(#)==begin
+if eof_gf then prem_end else
+# := gf_file@@(.cur_loc mod len_byte_block.);
+incr(cur_loc);
+if cur_loc mod len_byte_block = 0
+then if cur_block < norec then begin
+get(gf_file); incr (cur_block);
+end
+else eof_gf := true
+end
+@p
+procedure prem_end; begin bad_gf
+('didn''t we read past endfile just now?') end;
+@#
+function get_byte:integer; {returns the next byte, unsigned}
+var b:eight_bits;
+begin
+get_gf(b); get_byte:=b;
+end;
+@#
+function signed_byte:integer; {returns the next byte, signed}
+var b:eight_bits;
+begin get_gf(b);
+if b<128 then signed_byte:=b @+ else signed_byte:=b-256;
+end;
+@#
+function get_two_bytes:integer; {returns the next two bytes, unsigned}
+var a,@!b:eight_bits;
+begin get_gf(a); get_gf(b);
+get_two_bytes:=a*256+b;
+end;
+@#
+function signed_pair:integer; {returns the next two bytes, signed}
+var a,@!b:eight_bits;
+begin get_gf(a); get_gf(b);
+if a<128 then signed_pair:=a*256+b
+else signed_pair:=(a-256)*256+b;
+end;
+@#
+function get_three_bytes:integer; {returns the next three bytes, unsigned}
+var a,@!b,@!c:eight_bits;
+begin get_gf(a); get_gf(b); get_gf(c);
+get_three_bytes:=(a*256+b)*256+c;
+end;
+@#
+function signed_trio:integer; {returns the next three bytes, signed}
+var a,@!b,@!c:eight_bits;
+begin get_gf(a); get_gf(b); get_gf(c);
+if a<128 then signed_trio:=(a*256+b)*256+c
+else signed_trio:=((a-256)*256+b)*256+c;
+end;
+@#
+function signed_quad:integer; {returns the next four bytes, signed}
+var a,@!b,@!c,@!d:eight_bits;
+begin get_gf(a); get_gf(b); get_gf(c); get_gf(d);
+if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
+else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+end;
+@z
+%
+%line 789
+%
+%section x
+@x
+@d pxl_byte(#)==begin write(pxl_file,#); incr(pxl_byte_no); end
+@y
+@d pxl_byte(#)==begin
+pxl_file@@(.pxl_byte_no mod len_pxl_block.):=#;
+incr(pxl_byte_no);
+if pxl_byte_no mod len_pxl_block = 0
+then put(pxl_file)
+end
+@z
+%
+%line 798
+%
+%section x
+@x
+procedure pxl_word(@!w:integer);
+begin
+if w>0 then pxl_byte(w div @"1000000)
+else begin
+ w:=w+@"40000000;
+ w:=w+@"40000000;
+ pxl_byte((w div @"1000000) + 128);
+ end;
+pxl_byte((w div @"10000) mod @"100);
+pxl_byte((w div @"100) mod @"100);
+pxl_byte(w mod @"100);
+end;
+@y
+procedure pxl_word(@!w:integer);
+begin
+if w>=0 then pxl_byte(w div @"1000000) {how comes?}
+else begin
+ w:=w+@"40000000;
+ w:=w+@"40000000;
+ pxl_byte((w div @"1000000) + 128);
+ end;
+pxl_byte((w div @"10000) mod @"100);
+pxl_byte((w div @"100) mod @"100);
+pxl_byte(w mod @"100);
+end;
+@z
+%
+%line 827
+%
+%section x
+@x
+@p function gf_length:integer;
+begin set_pos(gf_file,-1); gf_length:=cur_pos(gf_file);
+end;
+@#
+procedure move_to_byte(n:integer);
+begin set_pos(gf_file,n); cur_loc:=n;
+end;
+@y
+@p function gf_length:integer;
+begin readstr (parms, lrec, norec); gf_length := lrec*norec;
+end;
+@#
+procedure move_to_byte(n:integer);
+var block: integer;
+begin block:=n div lrec + 1;
+eof_gf := false;
+if block <> cur_block then begin cur_block:=block;
+seek(gf_file, block); get (gf_file);
+end;
+cur_loc := n;
+end;
+@z
+%
+%line 867
+%
+%section x
+@x
+@d white=0 {could also be |false|}
+@d black=1 {could also be |true|}
+@y
+@d white==false
+@d black==true
+@z
+%
+%line 873
+%
+%section x
+@x
+@!pixel=white..black; {could also be |boolean|}
+@y
+@!pixel=boolean;
+@z
+%
+%line 987
+%
+%section x
+@x
+if eof(gf_file) then bad_gf('the file ended prematurely');
+@y
+if eof_gf then bad_gf('the file ended prematurely');
+@z
+%
+%line 1203
+%
+%section
+@x
+while (m=223)and not eof(gf_file) do m:=get_byte;
+if not eof(gf_file) then bad_gf('signature in byte ',cur_loc-1:1,
+@y
+while (m=223)and not eof_gf do m:=get_byte;
+if not eof_gf then bad_gf('signature in byte ',cur_loc-1:1,
+@z
+%
+%line 1375
+%
+%section
+@x why the rest?
+for char_code:=0 to max_glyph_no do begin
+@y
+for char_code:=0 to ec do begin
+@z
+%
+%line 1386
+%
+%section
+@x (first line necessary for correct hit!)
+pxl_word(pxl_dir_ptr);
+pxl_word(pxl_id);
+@y
+pxl_word(pxl_dir_ptr);
+pxl_word(pxl_id);
+while pxl_byte_no mod len_pxl_block > 0 do pxl_byte(0);
+{We want to ship out the last |pxl_file| block}
+@z
+%
+%line 1417
+%
+%section
+@x
+ b:=image; incr(m);
+ for i:=2 to 8 do
+ begin
+ b:=b*2+image;
+@y
+ if image then b:=1
+ else b:=0;
+ incr(m);
+ for i:=2 to 8 do
+ begin
+ b:=b*2;
+ if image then b:=b+1;
+@z
+%
+%line 1428
+%
+%section
+@x
+b:=image; incr(m);
+i:=2;
+while m<=max_m do
+ begin
+ b:=b*2+image;
+@y
+if image then b:=1
+ else b:=0;
+incr(m);
+i:=2;
+while m<=max_m do
+ begin
+ b:=b*2;
+ if image then b:=b+1;
+@z
+%
+%line 1506
+%
+%section
+@x
+ if eof(gf_file) then bad_gf('the file ended prematurely');
+@y
+ if eof_gf then bad_gf('the file ended prematurely');
+@z
diff --git a/obsolete/systems/knuth/unsupported/mfware/gftopxl.tops20-changes b/obsolete/systems/knuth/unsupported/mfware/gftopxl.tops20-changes
new file mode 100644
index 0000000000..7ca3c2d096
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/mfware/gftopxl.tops20-changes
@@ -0,0 +1,27 @@
+@x 104
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+@d print_nl==write_ln
+@y
+@d print(#)==write(tty,#)
+@d print_ln(#)==write_ln(tty,#)
+@d print_nl==write_ln(tty)
+@z
+
+@x 108
+@p program GF_to_PXL(@!gf_file,@!pxl_file,@!output);
+@y
+@p program GF_to_PXL(@!gf_file:-,@!pxl_file:+);
+@z
+
+@x 707
+begin reset(gf_file);
+@y
+begin reset(gf_file,'','/B:8');
+@z
+
+@x
+begin rewrite(pxl_file);
+@y
+begin rewrite(pxl_file,'','/B:8');
+@z
diff --git a/obsolete/systems/knuth/unsupported/mfware/gftopxl.vms-changes b/obsolete/systems/knuth/unsupported/mfware/gftopxl.vms-changes
new file mode 100644
index 0000000000..b4df4e47e0
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/mfware/gftopxl.vms-changes
@@ -0,0 +1,409 @@
+GFtoPXL change file for Vax/VMS.
+Jane Colman, Lawrence Berkeley Laboratory
+10 Oct 84
+
+@x
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iftrue
+\def\title{GFtoPXL changes for Vax/VMS}
+@z
+
+@x
+@d banner=='This is GFtoPXL, Version 2.1' {printed when the program starts}
+@y
+@d banner=='This is GFtoPXL, Vax/VMS Version 2.1'
+@z
+
+@x
+@d debug==@{
+@d gubed==@t@>@}
+@d eebug==@{ {change this to `$\\{eebug}\equiv\null$' when really debugging}
+@d gubee==@t@>@} {change this to `$\\{gubee}\equiv\null$' when really debugging}
+@y
+@d debug==@{
+@d gubed==@t@>@}
+@d eebug==@{ {change this to `$\\{eebug}\equiv\null$' when really debugging}
+@d gubee==@t@>@} {change this to `$\\{gubee}\equiv\null$' when really debugging}
+@z
+
+@x
+@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 {Vax/VMS default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@d real == double
+@z
+
+@x
+@p program GF_to_PXL(@!gf_file,@!pxl_file,@!output);
+@y
+@p
+@\@=[inherit('sys$library:starlet')]@>@\
+program GF_to_PXL(@!gf_file,@!pxl_file,@!input,@!output);
+@z
+
+@x
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ begin print_ln(banner);@/
+@y
+@<Procedures for initialization@>@\
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ begin
+ @<Preset initial values@>@\
+ print_ln(banner);@/
+@z
+
+@x
+and |term_out| for terminal output.
+@^system dependencies@>
+
+@<Glob...@>=
+@!buffer:array[0..terminal_line_length] of ASCII_code;
+@!term_in:text_file; {the terminal, considered as an input file}
+@!term_out:text_file; {the terminal, considered as an output file}
+@y
+and |term_out| for terminal output.
+@^system dependencies@>
+
+@d term_in==input {the terminal, considered as an input file}
+@d term_out==output {the terminal, considered as an output file}
+
+@<Glob...@>=
+@!buffer:array[0..terminal_line_length] of ASCII_code;
+@z
+
+@x
+@!byte_file=packed file of eight_bits; {files that contain binary data}
+@y
+{later we'll define files that contain binary date}
+@z
+
+@x
+@!gf_file:byte_file; {the stuff we are \.{GFtoPXL}ing}
+@!pxl_file:byte_file; {the stuff we have \.{GFtoPXL}ed}
+@y
+@!gf_file:packed file of byte_block; {the stuff we are \.{GFtoPXL}ing}
+@!pxl_file:packed file of byte_block; {the stuff we have \.{GFtoPXL}ed}
+@!gf_count:integer; {number of bytes read from current block of |gf_file|}
+@!pxl_count:integer; {number of bytes written to current block of |pxl_file|}
+@!gf_blocks:integer; {number of blocks in |gf_file|}
+@z
+
+@x
+begin reset(gf_file);
+@y
+begin reset(gf_file);
+gf_count:=0;
+@z
+
+@x
+begin rewrite(pxl_file);
+@y
+begin rewrite(pxl_file);
+pxl_count:=0;
+@z
+
+@x
+@p function get_byte:integer; {returns the next byte, unsigned}
+var b:eight_bits;
+begin if eof(gf_file) then get_byte:=0
+else begin read(gf_file,b); incr(cur_loc); get_byte:=b;
+ end;
+end;
+@#
+function signed_byte:integer; {returns the next byte, signed}
+var b:eight_bits;
+begin read(gf_file,b); incr(cur_loc);
+if b<128 then signed_byte:=b @+ else signed_byte:=b-256;
+end;
+@#
+function get_two_bytes:integer; {returns the next two bytes, unsigned}
+var a,@!b:eight_bits;
+begin read(gf_file,a); read(gf_file,b);
+cur_loc:=cur_loc+2;
+get_two_bytes:=a*256+b;
+end;
+@#
+function signed_pair:integer; {returns the next two bytes, signed}
+var a,@!b:eight_bits;
+begin read(gf_file,a); read(gf_file,b);
+cur_loc:=cur_loc+2;
+if a<128 then signed_pair:=a*256+b
+else signed_pair:=(a-256)*256+b;
+end;
+@#
+function get_three_bytes:integer; {returns the next three bytes, unsigned}
+var a,@!b,@!c:eight_bits;
+begin read(gf_file,a); read(gf_file,b); read(gf_file,c);
+cur_loc:=cur_loc+3;
+get_three_bytes:=(a*256+b)*256+c;
+end;
+@#
+function signed_trio:integer; {returns the next three bytes, signed}
+var a,@!b,@!c:eight_bits;
+begin read(gf_file,a); read(gf_file,b); read(gf_file,c);
+cur_loc:=cur_loc+3;
+if a<128 then signed_trio:=(a*256+b)*256+c
+else signed_trio:=((a-256)*256+b)*256+c;
+end;
+@#
+function signed_quad:integer; {returns the next four bytes, signed}
+var a,@!b,@!c,@!d:eight_bits;
+begin read(gf_file,a); read(gf_file,b); read(gf_file,c); read(gf_file,d);
+cur_loc:=cur_loc+4;
+if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
+else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+end;
+@y
+@d read_gf_file(#)==begin
+ if gf_count=VAX_block_length then begin
+ get(gf_file,@=error:=continue@>); gf_count:=0;
+ end;
+ #:=gf_file^[gf_count];
+ incr(gf_count);
+ end
+
+@p function get_byte:integer; {returns the next byte, unsigned}
+var b:eight_bits;
+begin if eof(gf_file) then get_byte:=0
+else begin read_gf_file(b); incr(cur_loc); get_byte:=b;
+ end;
+end;
+@#
+function signed_byte:integer; {returns the next byte, signed}
+var b:eight_bits;
+begin read_gf_file(b); incr(cur_loc);
+if b<128 then signed_byte:=b @+ else signed_byte:=b-256;
+end;
+@#
+function get_two_bytes:integer; {returns the next two bytes, unsigned}
+var a,@!b:eight_bits;
+begin read_gf_file(a); read_gf_file(b);
+cur_loc:=cur_loc+2;
+get_two_bytes:=a*256+b;
+end;
+@#
+function signed_pair:integer; {returns the next two bytes, signed}
+var a,@!b:eight_bits;
+begin read_gf_file(a); read_gf_file(b);
+cur_loc:=cur_loc+2;
+if a<128 then signed_pair:=a*256+b
+else signed_pair:=(a-256)*256+b;
+end;
+@#
+function get_three_bytes:integer; {returns the next three bytes, unsigned}
+var a,@!b,@!c:eight_bits;
+begin read_gf_file(a); read_gf_file(b); read_gf_file(c);
+cur_loc:=cur_loc+3;
+get_three_bytes:=(a*256+b)*256+c;
+end;
+@#
+function signed_trio:integer; {returns the next three bytes, signed}
+var a,@!b,@!c:eight_bits;
+begin read_gf_file(a); read_gf_file(b); read_gf_file(c);
+cur_loc:=cur_loc+3;
+if a<128 then signed_trio:=(a*256+b)*256+c
+else signed_trio:=((a-256)*256+b)*256+c;
+end;
+@#
+function signed_quad:integer; {returns the next four bytes, signed}
+var a,@!b,@!c,@!d:eight_bits;
+begin read_gf_file(a); read_gf_file(b); read_gf_file(c); read_gf_file(d);
+cur_loc:=cur_loc+4;
+if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
+else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+end;
+@z
+
+@x
+@d pxl_byte(#)==begin write(pxl_file,#); incr(pxl_byte_no); end
+@y
+@d pxl_byte(#)==begin pxl_file^[pxl_count]:=#; {output one byte to |pxl_file|}
+ incr(pxl_count);
+ if pxl_count=VAX_block_length then begin
+ put(pxl_file,@=error:=continue@>); pxl_count:=0; end;
+ incr(pxl_byte_no);
+ end
+@z
+
+@x
+begin set_pos(gf_file,-1); gf_length:=cur_pos(gf_file);
+@y
+begin gf_length:=gf_blocks*VAX_block_length-1;
+@z
+
+@x
+begin set_pos(gf_file,n); cur_loc:=n;
+@y
+var @!blk,@!byt:integer; {block and byte number}
+begin cur_loc:=n;
+ blk:=n div VAX_block_length;
+ byt:=n-(blk*VAX_block_length);
+ @=find@>(gf_file,blk+1); {VMS starts counting block numbers at 1, not 0}
+ gf_count:=byt;
+@z
+
+@x
+post_loc:=gf_length-4;
+@y
+post_loc:=gf_length-4;
+repeat if post_loc=0 then bad_gf('all 0s');
+@.all 0s@>
+move_to_byte(post_loc); k:=get_byte; decr(post_loc);
+until k<>0;
+if k<>223 then bad_gf('223 byte is ',k:1);
+@.223 byte is wrong@>
+@z
+
+@x
+final_end:end.
+@y
+while pxl_count>0 do pxl_byte(0);
+close(pxl_file,@=disposition:=save@>,@=error:=continue@>);
+final_end:end.
+@z
+
+@x
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{GFtoPXL} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@y
+Here are the remaining changes to the program
+that are necessary to make \.{GFtoPXL} work on Vax/VMS.
+
+@<Const...@>==
+@!VAX_block_length=512;
+
+@ @<Types...@>==
+@!byte_block=packed array [0..VAX_block_length-1] of 0..255;
+
+@ On Vax/VMS we need the following special definitions, types, variables
+and procedures to be able to get the file name from the command line,
+or to prompt for them.
+
+@d VAX_direct==@=direct@>
+@d VAX_fixed==@=fixed@>
+@d VAX_volatile==@=volatile@>
+@d VAX_immed==@=%immed @>
+@d VAX_external==@=external@>
+@d VAX_stdescr==@=%stdescr @>
+@d VAX_lib_get_foreign==@= lib$get_foreign@>
+@d VAX_length==@=length @>
+@d VAX_fab_type==@= FAB$TYPE @>
+@d VAX_rab_type==@= RAB$TYPE @>
+@d VAX_xab_type==@= XAB$TYPE @>
+@d VAX_fab_xab==@= FAB$L_XAB @>
+@d VAX_xab_nxt==@= XAB$L_NXT @>
+@d VAX_xab_cod==@= XAB$B_COD @>
+@d VAX_xab_fhc==@= XAB$C_FHC @>
+@d VAX_xab_ebk==@= XAB$L_EBK @>
+
+@ @<Types...@>=
+@!sixteen_bits= 0..65535;
+
+@ @<Glob...@>==
+@!command_line:packed array[1..300] of char;
+@!cmd_len:sixteen_bits;
+@!cmd_i:integer;
+@!file_name,@!def_file_name:varying [300] of char;
+@!ask,@!got_file_name: boolean;
+
+@ @<Preset init...@>=
+open(output,'SYS$OUTPUT',@=error:=continue@>); {FIX ME! JUNK FOR RUN-TIME BUG}
+
+cmd_i:=0;
+VAX_lib_get_foreign(command_line,,cmd_len,cmd_i);
+cmd_i:=1; while (cmd_i<=cmd_len) and (command_line[cmd_i]=' ') do incr(cmd_i);
+got_file_name:=cmd_i<=cmd_len;
+if got_file_name then
+ def_file_name:=substr(command_line,cmd_i,cmd_len-cmd_i+1);
+
+if got_file_name then begin
+ file_name:=def_file_name+'.GF';
+ open(gf_file,file_name,@=readonly@>,,VAX_direct,
+ VAX_fixed,@=user_action:=@>gf_open,@=error:=continue@>);
+ ask:=status(gf_file)<>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end
+else ask:=true;
+while ask do begin
+ got_file_name:=false;
+ write('GF file: ');
+ if eof then goto 9999;
+ read_ln(file_name);
+ open(gf_file,file_name,@=readonly@>,,VAX_direct,
+ VAX_fixed,@=user_action:=@>gf_open,@=error:=continue@>);
+ ask:=status(gf_file)<>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end;
+
+if got_file_name then begin
+ cmd_i:=1;
+ for cmd_len:=1 to def_file_name.VAX_length do
+ if (def_file_name[cmd_len]=']')
+ or (def_file_name[cmd_len]=':')
+ then cmd_i:=cmd_len+1;
+ if cmd_i<=def_file_name.VAX_length then
+ def_file_name:=substr(def_file_name,cmd_i,
+ def_file_name.VAX_length-cmd_i+1);
+ file_name:=def_file_name+'.PXL';
+ open(pxl_file,file_name,@=new,disposition:=delete@>,
+ @=error:=continue@>);
+ ask:=status(pxl_file)>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end
+else ask:=true;
+while ask do begin
+ write('PXL file: ');
+ if eof then goto 9999;
+ read_ln(file_name);
+ if file_name.VAX_length=0 then file_name:='SYS$OUTPUT';
+ open(pxl_file,file_name,@=new,disposition:=delete@>,
+ @=error:=continue@>);
+ ask:=status(pxl_file)>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end;
+
+@ Here is the library procedure that gets the user's command line.
+
+@<Procedures for ...@>=
+[VAX_external] function VAX_lib_get_foreign(
+ VAX_stdescr cmdlin:[VAX_volatile] packed array [$l1..$u1:integer] of char
+ := VAX_immed 0;
+ VAX_stdescr prompt:[VAX_volatile] packed array [$l2..$u2:integer] of char
+ := VAX_immed 0;
+ var len : [VAX_volatile] sixteen_bits := VAX_immed 0;
+ var flag : [VAX_volatile] integer := VAX_immed 0)
+ :integer; extern;
+
+@ Here is how we intervene to find out the length of the |gf_file|.
+
+@<Procedures for ...@>=
+function gf_open(var fab:VAX_fab_type; var rab:VAX_rab_type):integer;
+ type XAB_ptr = ^VAX_xab_type;
+ var user_status:integer;
+ xab,fhc:XAB_ptr;
+ begin
+ user_status:=@= $OPEN@>(fab);
+ if odd(user_status) then @= $CONNECT@>(rab);
+ xab:=fab.VAX_fab_xab::XAB_ptr;
+ fhc:=nil;
+ while (xab<>nil) and (fhc=nil) do
+ if xab^.VAX_xab_cod=VAX_xab_fhc then fhc:=xab
+ else xab:=xab^.VAX_xab_nxt::XAB_ptr;
+ if fhc<>nil then gf_blocks:=int(fhc^.VAX_xab_ebk)
+ else gf_blocks:=0;
+
+ gf_open:=user_status;
+ end;
+
+@z
diff --git a/obsolete/systems/knuth/unsupported/mfware/gftopxl.web b/obsolete/systems/knuth/unsupported/mfware/gftopxl.web
new file mode 100644
index 0000000000..3570a115d4
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/mfware/gftopxl.web
@@ -0,0 +1,1551 @@
+% This program is based on an early version of GFtype.
+% Although PXL files are now obsolete (since, for example, they can't
+% handle fonts with more than 128 characters), this program may be
+% needed for awhile to interface with old-fashioned software.
+
+% Version 1.0 was implemented in June 1984 by Arthur Samuel.
+% Version 1.1 corrected a bug in the reference point offset (DEK, Sep 84).
+% Version 2.0 switched to new GF format (JDH, Dec 84).
+% Version 2.1 switched to a newer GF format (JDH, Feb 85).
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\noindent\ignorespaces}
+\def\textindent#1{\hangindent2.5em\noindent\hbox to2.5em{\hss#1 }\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like SAIL
+\font\tenss=cmss10 % for `The METAFONTbook'
+\def\PASCAL{Pascal}
+\def\ph{{\mc PASCAL-H}}
+\font\logo=logo10 % font used for the METAFONT logo
+\def\MF{{\logo META}\-{\logo FONT}}
+\def\<#1>{$\langle#1\rangle$}
+\def\section{\mathhexbox278}
+\let\swap=\leftrightarrow
+\def\round{\mathop{\rm round}\nolimits}
+
+\def\today{\ifcase\month\or
+ January\or February\or March\or April\or May\or June\or
+ July\or August\or September\or October\or November\or December\fi
+ \space\number\day, \number\year}
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index via @@:sort key}{entry@@>
+
+\def\title{GFtoPXL}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont GFtoPXL} processor}
+ \vskip 15pt
+ \centerline{(Version 2.1, \today)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ The preparation of this report
+ was supported in part by the National Science
+ Foundation under grants IST-8201926 and MCS-8300984,
+ and by the System Development Foundation. `\TeX' is a
+ trademark of the American Mathematical Society.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+The \.{GFtoPXL} utility program reads binary generic-font (``\.{GF}'')
+files that are produced by font compilers such as \MF, and converts them
+into PXL Matrix Format (``\.{PXL}'') files. While it is usually possible
+to write driver programs for dot matrix outpot devices that accept
+\.{GF} input files, there are situations where one may want to use an old
+\.{PXLtoDRIVER} program to load recently created \.{GF} information.
+\.{GFto PXL} can be used to generate the required \.{PXL} files. This program,
+in its handling of the \.{GF} input to produce an |image_array|,
+follows the example set by \.{GFtype}.
+
+The |banner| string defined here should be changed whenever \.{GFtoPXL}
+gets modified.
+
+@d banner=='This is GFtoPXL, Version 2.1' {printed when the program starts}
+@d resolution==200.0 {pixelx per inch, standard for pxl files}
+
+@ Some of the code below is intended to be used only when debugging this
+program.
+Such code will not normally be compiled; it is
+delimited by the codewords `$|debug|\ldots|gubed|$', with apologies
+to people who wish to preserve the purity of English. For even
+more drastic and voluminous output, we use |eebug|.
+@^debugging@>
+
+@d debug==@{
+@d gubed==@t@>@}
+@d eebug==@{ {change this to `$\\{eebug}\equiv\null$' when really debugging}
+@d gubee==@t@>@} {change this to `$\\{gubee}\equiv\null$' when really debugging}
+@f debug==begin
+@f gubed==end
+@f eebug==begin
+@f gubee==end
+
+@ This program is written in standard \PASCAL, except where it is
+necessary to use extensions; for example, one extension is to use a
+default |case| as in \.{TANGLE}, \.{WEAVE}, etc. All places where
+nonstandard constructions are used have been listed in the index under
+``system dependencies.''
+@!@^system dependencies@>
+
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+
+@ The binary input comes from |gf_file|, and the output font is written
+on |pxl_file|. Status reporting and error messages appear
+on \PASCAL's standard |output| file. The term |print| is used instead of
+|write| when this program writes on |output|, so that all such output
+could easily be redirected if desired.
+
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+@d print_nl==write_ln
+
+@p program GF_to_PXL(@!gf_file,@!pxl_file,@!output);
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ begin print_ln(banner);@/
+ @<Set initial values@>@/
+ end;
+
+@ If the program has to stop prematurely, it goes to the
+`|final_end|'.
+
+@d final_end=9999 {label for the end of it all}
+
+@<Labels...@>=final_end;
+
+@ The following parameters can be changed at compile time to extend or
+reduce |GF_to_PXL|'s capacity.
+
+@<Constants...@>=
+@!line_length=79; {bracketed lines of output will be at most this long}
+@!terminal_line_length=150; {maximum number of characters input in a single
+ line of input from the terminal}
+@!max_glyph_no=127; {maximum glyph number in font, later change to 255}
+@!top_pixel=700; {boundary of pixel image of glyph}
+@!bot_pixel=-250;
+@!left_pixel=-250;
+@!right_pixel=750;
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d negate(#) == #:=-# {change the sign of a variable}
+@d do_nothing == {empty statement}
+
+@ If the \.{GF} file is badly malformed, the whole process must be aborted;
+\.{GFtoPXL} will give up, after issuing an error message about the symptoms
+that were noticed.
+
+Such errors might be discovered inside of subroutines inside of subroutines,
+so a procedure called |jump_out| has been introduced. This procedure, which
+simply transfers control to the label |final_end| at the end of the program,
+contains the only non-local |goto| statement in \.{GFtoPXL}.
+@^system dependencies@>
+
+@d abort(#)==begin print(' ',#); jump_out;
+ end
+@d bad_gf(#)==abort('Bad GF file: ',#,'!')
+@.Bad GF file@>
+
+@p procedure jump_out;
+begin goto final_end;
+end;
+
+@ We steal the following routine from \MF.
+
+@d unity == @'200000 {$2^{16}$, represents 1.00000}
+
+@p procedure print_scaled(@!s:integer); {prints scaled real, rounded to five
+ digits}
+var @!delta:integer; {amount of allowable inaccuracy}
+begin if s<0 then
+ begin print('-'); negate(s); {print the sign, if negative}
+ end;
+print(s div unity:1); {print the integer part}
+s:=10*(s mod unity)+5;
+if s<>5 then
+ begin delta:=10; print('.');
+ repeat if delta>unity then
+ s:=s+@'100000-(delta div 2); {round the final digit}
+ print(chr(ord('0')+(s div unity))); s:=10*(s mod unity); delta:=delta*10;
+ until s<=delta;
+ end;
+end;
+
+@* Optional modes of output.
+The following is left in the program to simplify the addition of some
+input and output routines should these be needed later.
+
+The |input_ln| routine waits for the user to type a line at his or her
+terminal; then it puts ASCII-code equivalents for the characters on that line
+into the |buffer| array. The |term_in| file is used for terminal input,
+and |term_out| for terminal output.
+@^system dependencies@>
+
+@<Glob...@>=
+@!buffer:array[0..terminal_line_length] of ASCII_code;
+@!term_in:text_file; {the terminal, considered as an input file}
+@!term_out:text_file; {the terminal, considered as an output file}
+
+@ Humdrum.
+@p function lower_casify(@!c:ASCII_code):ASCII_code;
+begin
+if (c>="A") and (c<="Z") then lower_casify:=c+"a"-"A"
+else lower_casify:=c;
+end;
+
+@* The character set.
+Like all programs written with the \.{WEB} system, \.{GFtoPXL} can be
+used with any character set. But it uses ASCII code internally, because
+the programming for portable input-output is easier when a fixed internal
+code is used.
+
+The next few sections of \.{GFtoPXL} have therefore been copied from the
+analogous ones in the \.{WEB} system routines. They have been considerably
+simplified, since \.{GFtoPXL} need not deal with the controversial
+ASCII codes less than @'40. If such codes appear in the \.{GF} file,
+they will be printed as question marks.
+
+@<Types...@>=
+@!ASCII_code=" ".."~"; {a subrange of the integers}
+
+@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
+character sets were common, so it did not make provision for lower case
+letters. Nowadays, of course, we need to deal with both upper and lower case
+alphabets in a convenient way, especially in a program like \.{GFtoPXL}.
+So we shall assume that the \PASCAL\ system being used for \.{GFtoPXL}
+has a character set containing at least the standard visible characters
+of ASCII code (|"!"| through |"~"|).
+
+Some \PASCAL\ compilers use the original name |char| for the data type
+associated with the characters in text files, while other \PASCAL s
+consider |char| to be a 64-element subrange of a larger data type that has
+some other name. In order to accommodate this difference, we shall use
+the name |text_char| to stand for the data type of the characters in the
+output file. We shall also assume that |text_char| consists of
+the elements |chr(first_text_char)| through |chr(last_text_char)|,
+inclusive. The following definitions should be adjusted if necessary.
+@^system dependencies@>
+
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=127 {ordinal number of the largest element of |text_char|}
+
+@<Types...@>=
+@!text_file=packed file of text_char;
+
+@ The \.{GFtoPXL} processor converts between ASCII code and
+the user's external character set by means of arrays |xord| and |xchr|
+that are analogous to \PASCAL's |ord| and |chr| functions.
+
+@<Globals...@>=
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [0..255] of text_char;
+ {specifies conversion of output characters}
+
+@ Under our assumption that the visible characters of standard ASCII are
+all present, the following assignment statements initialize the
+|xchr| array properly, without needing any system-dependent changes.
+
+@<Set init...@>=
+for i:=0 to @'37 do xchr[i]:='?';
+xchr[@'40]:=' ';
+xchr[@'41]:='!';
+xchr[@'42]:='"';
+xchr[@'43]:='#';
+xchr[@'44]:='$';
+xchr[@'45]:='%';
+xchr[@'46]:='&';
+xchr[@'47]:='''';@/
+xchr[@'50]:='(';
+xchr[@'51]:=')';
+xchr[@'52]:='*';
+xchr[@'53]:='+';
+xchr[@'54]:=',';
+xchr[@'55]:='-';
+xchr[@'56]:='.';
+xchr[@'57]:='/';@/
+xchr[@'60]:='0';
+xchr[@'61]:='1';
+xchr[@'62]:='2';
+xchr[@'63]:='3';
+xchr[@'64]:='4';
+xchr[@'65]:='5';
+xchr[@'66]:='6';
+xchr[@'67]:='7';@/
+xchr[@'70]:='8';
+xchr[@'71]:='9';
+xchr[@'72]:=':';
+xchr[@'73]:=';';
+xchr[@'74]:='<';
+xchr[@'75]:='=';
+xchr[@'76]:='>';
+xchr[@'77]:='?';@/
+xchr[@'100]:='@@';
+xchr[@'101]:='A';
+xchr[@'102]:='B';
+xchr[@'103]:='C';
+xchr[@'104]:='D';
+xchr[@'105]:='E';
+xchr[@'106]:='F';
+xchr[@'107]:='G';@/
+xchr[@'110]:='H';
+xchr[@'111]:='I';
+xchr[@'112]:='J';
+xchr[@'113]:='K';
+xchr[@'114]:='L';
+xchr[@'115]:='M';
+xchr[@'116]:='N';
+xchr[@'117]:='O';@/
+xchr[@'120]:='P';
+xchr[@'121]:='Q';
+xchr[@'122]:='R';
+xchr[@'123]:='S';
+xchr[@'124]:='T';
+xchr[@'125]:='U';
+xchr[@'126]:='V';
+xchr[@'127]:='W';@/
+xchr[@'130]:='X';
+xchr[@'131]:='Y';
+xchr[@'132]:='Z';
+xchr[@'133]:='[';
+xchr[@'134]:='\';
+xchr[@'135]:=']';
+xchr[@'136]:='^';
+xchr[@'137]:='_';@/
+xchr[@'140]:='`';
+xchr[@'141]:='a';
+xchr[@'142]:='b';
+xchr[@'143]:='c';
+xchr[@'144]:='d';
+xchr[@'145]:='e';
+xchr[@'146]:='f';
+xchr[@'147]:='g';@/
+xchr[@'150]:='h';
+xchr[@'151]:='i';
+xchr[@'152]:='j';
+xchr[@'153]:='k';
+xchr[@'154]:='l';
+xchr[@'155]:='m';
+xchr[@'156]:='n';
+xchr[@'157]:='o';@/
+xchr[@'160]:='p';
+xchr[@'161]:='q';
+xchr[@'162]:='r';
+xchr[@'163]:='s';
+xchr[@'164]:='t';
+xchr[@'165]:='u';
+xchr[@'166]:='v';
+xchr[@'167]:='w';@/
+xchr[@'170]:='x';
+xchr[@'171]:='y';
+xchr[@'172]:='z';
+xchr[@'173]:='{';
+xchr[@'174]:='|';
+xchr[@'175]:='}';
+xchr[@'176]:='~';
+for i:=@'177 to 255 do xchr[i]:='?';
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|.
+
+@<Set init...@>=
+for i:=first_text_char to last_text_char do xord[chr(i)]:=@'40;
+for i:=" " to "~" do xord[xchr[i]]:=i;
+
+@* Generic font file format.
+The most important output produced by a typical run of \MF\ is the
+``generic font'' (\.{GF}) file that specifies the bit patterns of the
+characters that have been drawn. The term {\sl generic\/} indicates that
+this file format doesn't match the conventions of any name-brand manufacturer;
+but it is easy to convert \.{GF} files to the special format required by
+almost all digital phototypesetting equipment. There's a strong analogy
+between the \.{DVI} files written by \TeX\ and the \.{GF} files written
+by \MF; and, in fact, the file formats have a lot in common.
+
+A \.{GF} file is a stream of 8-bit bytes that may be
+regarded as a series of commands in a machine-like language. The first
+byte of each command is the operation code, and this code is followed by
+zero or more bytes that provide parameters to the command. The parameters
+themselves may consist of several consecutive bytes; for example, the
+`|boc|' (beginning of character) command has six parameters, each of
+which is four bytes long. Parameters are usually regarded as nonnegative
+integers; but four-byte-long parameters can be either positive or
+negative, hence they range in value from $-2^{31}$ to $2^{31}-1$.
+As in \.{TFM} files, numbers that occupy
+more than one byte position appear in BigEndian order,
+and negative numbers appear in two's complement notation.
+
+A \.{GF} file consists of a ``preamble,'' followed by a sequence of one or
+more ``characters,'' followed by a ``postamble.'' The preamble is simply a
+|pre| command, with its parameters that introduce the file; this must come
+first. Each ``character'' consists of a |boc| command, followed by any
+number of other commands that specify ``black'' pixels,
+followed by an |eoc| command. The characters appear in the order that \MF\
+generated them. If we ignore no-op commands (which are allowed between any
+two commands in the file), each |eoc| command is immediately followed by a
+|boc| command, or by a |post| command; in the latter case, there are no
+more characters in the file, and the remaining bytes form the postamble.
+Further details about the postamble will be explained later.
+
+Some parameters in \.{GF} commands are ``pointers.'' These are four-byte
+quantities that give the location number of some other byte in the file;
+the first file byte is number~0, then comes number~1, and so on.
+
+@ The \.{GF} format is intended to be both compact and easily interpreted
+by a machine. Compactness is achieved by making most of the information
+relative instead of absolute. When a \.{GF}-reading program reads the
+commands for a character, it keeps track of two quantities: (a)~the current
+column number,~|m|; and (b)~the current row number,~|n|. These are 32-bit
+signed integers, although most actual font formats produced from \.{GF}
+files will need to curtail this vast range because of practical
+limitations. (\MF\ output will never allow $\vert m\vert$ or $\vert
+n\vert$ to get extremely large, but the \.{GF} format tries to be more general.)
+
+How do \.{GF}'s row and column numbers correspond to the conventions
+of \TeX\ and \MF? Well, the ``reference point'' of a character, in \TeX's
+view, is considered to be at the lower left corner of the pixel in row~0
+and column~0. This point is the intersection of the baseline with the left
+edge of the type; it corresponds to location $(0,0)$ in \MF\ programs.
+Thus the pixel in \.{GF} row~0 and column~0 is \MF's unit square, comprising the
+region of the plane whose coordinates both lie between 0 and~1. The
+pixel in \.{GF} row~|n| and column~|m| consists of the points whose \MF\
+coordinates |(x,y)| satisfy |m<=x<=m+1| and |n<=y<=n+1|. Negative values of
+|m| and~|x| correspond to columns of pixels {\sl left\/} of the reference
+point; negative values of |n| and~|y| correspond to rows of pixels {\sl
+below\/} the baseline.
+
+Besides |m| and |n|, there's also a third aspect of the current
+state, namely the @!|paint_switch|, which is always either \\{black} or
+\\{white}. Each \\{paint} command advances |m| by a specified amount~|d|,
+and blackens the intervening pixels if |paint_switch=black|; then
+the |paint_switch| changes to the opposite state. \.{GF}'s commands are
+designed so that |m| will never decrease within a row, and |n| will never
+increase within a character; hence there is no way to whiten a pixel that
+has been blackened.
+
+@ Here is a list of all the commands that may appear in a \.{GF} file. Each
+command is specified by its symbolic name (e.g., |boc|), its opcode byte
+(e.g., 67), and its parameters (if any). The parameters are followed
+by a bracketed number telling how many bytes they occupy; for example,
+`|d[2]|' means that parameter |d| is two bytes long.
+
+\yskip\hang|paint_0| 0. This is a \\{paint} command with |d=0|; it does
+nothing but change the |paint_switch| from \\{black} to \\{white} or vice~versa.
+
+\yskip\hang\\{paint\_1} through \\{paint\_63} (opcodes 1 to 63).
+These are \\{paint} commands with |d=1| to~63, defined as follows: If
+|paint_switch=black|, blacken |d|~pixels of the current row~|n|,
+in columns |m| through |m+d-1| inclusive. Then, in any case,
+complement the |paint_switch| and advance |m| by~|d|.
+
+\yskip\hang|paint1| 64 |d[1]|. This is a \\{paint} command with a specified
+value of~|d|; \MF\ uses it to paint when |64<=d<256|.
+
+\yskip\hang|@!paint2| 65 |d[2]|. Same as |paint1|, but |d|~can be as high
+as~65535.
+
+\yskip\hang|@!paint3| 66 |d[3]|. Same as |paint1|, but |d|~can be as high
+as $2^{24}-1$. \MF\ never needs this command, and it is hard to imagine
+anybody making practical use of it; surely a more compact encoding will be
+desirable when characters can be this large. But the command is there,
+anyway, just in case.
+
+\yskip\hang|boc| 67 |c[4]| |p[4]| |min_m[4]| |max_m[4]| |min_n[4]|
+|max_n[4]|. Beginning of a character: Here |c| is the character code, and
+|p| points to the previous character beginning (if any) for characters having
+this code number modulo 256. (The pointer |p| is |-1| if there was no
+prior character with an equivalent code.) The values of registers |m| and |n|
+defined by the instructions that follow for this character must
+satisfy |min_m<=m<=max_m| and |min_n<=n<=max_n|. (The values of |max_m| and
+|min_n| need not be the tightest bounds possible.) When a \.{GF}-reading
+program sees a |boc|, it can use |min_m|, |max_m|, |min_n|, and |max_n| to
+initialize the bounds of an array. Then it sets |m:=min_m|, |n:=max_n|, and
+|paint_switch:=white|.
+
+\yskip\hang|boc1| 68 |c[1]| |@!del_m[1]| |max_m[1]| |@!del_n[1]| |max_n[1]|.
+Same as |boc|, but |p| is assumed to be~$-1$; also |del_m=max_m-min_m|
+and |del_n=max_n-min_n| are given instead of |min_m| and |min_n|.
+The one-byte parameters must be between 0 and 255, inclusive.
+\ (This abbreviated |boc| saves 19~bytes per character, in common cases.)
+
+\yskip\hang|eoc| 69. End of character: All pixels blackened so far
+constitute the pattern for this character. In particular, a completely
+blank character might have |eoc| immediately following |boc|.
+
+\yskip\hang|skip0| 70. Decrease |n| by 1 and set |m:=min_m|,
+|paint_switch:=white|. \ (This finishes one row and begins another,
+ready to whiten the leftmost pixel in the new row.)
+
+\yskip\hang|skip1| 71 |d[1]|. Decrease |n| by |d+1|, set |m:=min_m|, and set
+|paint_switch:=white|. This is a way to produce |d| all-white rows.
+
+\yskip\hang|@!skip2| 72 |d[2]|. Same as |skip1|, but |d| can be as large
+as 65535.
+
+\yskip\hang|@!skip3| 73 |d[3]|. Same as |skip1|, but |d| can be as large
+as $2^{24}-1$. \MF\ obviously never needs this command.
+
+\yskip\hang|new_row_0| 74. Decrease |n| by 1 and set |m:=min_m|,
+|paint_switch:=black|. \ (This finishes one row and begins another,
+ready to {\sl blacken\/} the leftmost pixel in the new row.)
+
+\yskip\hang|@!new_row_1| through |@!new_row_164| (opcodes 75 to 238). Same as
+|new_row_0|, but with |m:=min_m+1| through |min_m+164|, respectively.
+
+\yskip\hang|xxx1| 239 |k[1]| |x[k]|. This command is undefined in
+general; it functions as a $(k+2)$-byte |no_op| unless special \.{GF}-reading
+programs are being used. \MF\ generates \\{xxx} commands when encountering
+a \&{special} string; this occurs in the \.{GF} file only between
+characters, after the preamble, and before the postamble. However,
+\\{xxx} commands might appear anywhere in \.{GF} files generated by other
+processors. It is recommended that |x| be a string having the form of a
+keyword followed by possible parameters relevant to that keyword.
+
+\yskip\hang|@!xxx2| 240 |k[2]| |x[k]|. Like |xxx1|, but |0<=k<65536|.
+
+\yskip\hang|xxx3| 241 |k[3]| |x[k]|. Like |xxx1|, but |0<=k<@t$2^{24}$@>|.
+\MF\ uses this when sending a \&{special} string whose length exceeds~255.
+
+\yskip\hang|@!xxx4| 242 |k[4]| |x[k]|. Like |xxx1|, but |k| can be
+ridiculously large; |k| mustn't be negative.
+
+\yskip\hang|yyy| 243 |y[4]|. This command is undefined in general;
+it functions as a 5-byte |no_op| unless special \.{GF}-reading programs
+are being used. \MF\ puts |scaled| numbers into |yyy|'s, as a
+result of \&{numspecial} commands; the intent is to provide numeric
+parameters to \\{xxx} commands that immediately precede.
+
+\yskip\hang|no_op| 244. No operation, do nothing. Any number of |no_op|'s
+may occur between \.{GF} commands, but a |no_op| cannot be inserted between
+a command and its parameters or between two parameters.
+
+\yskip\hang|char_loc| 245 |c[1]| |dx[4]| |dy[4]| |w[4]| |p[4]|.
+This command will appear only in the postamble, which will be explained shortly.
+
+\yskip\hang|@!char_loc0| 246 |c[1]| |@!dm[1]| |w[4]| |p[4]|.
+Same as |char_loc|, except that |dy| is assumed to be zero, and the value
+of~|dx| is taken to be |65536*dm|, where |0<=dm<256|.
+
+\yskip\hang|pre| 247 |i[1]| |k[1]| |x[k]|.
+Beginning of the preamble; this must come at the very beginning of the
+file. Parameter |i| is an identifying number for \.{GF} format, currently
+131. The other information is merely commentary; it is not given
+special interpretation like \\{xxx} commands are. (Note that \\{xxx}
+commands may immediately follow the preamble, before the first |boc|.)
+
+\yskip\hang|post| 248. Beginning of the postamble, see below.
+
+\yskip\hang|post_post| 249. Ending of the postamble, see below.
+
+\yskip\noindent Commands 250--255 are undefined at the present time.
+
+@d gf_id_byte=131 {identifies the kind of \.{GF} files described here}
+
+@ Here are the opcodes that \.{GFtoPXL} actually refers to.
+
+@d paint_0=0 {beginning of the \\{paint} commands}
+@d paint1=64 {move right a given number of columns, then
+ black${}\swap{}$white}
+@d boc=67 {beginning of a character}
+@d boc1=68 {abbreviated |boc|}
+@d eoc=69 {end of a character}
+@d skip0=70 {skip no blank rows}
+@d skip1=71 {skip over blank rows}
+@d new_row_0=74 {move down one row and then right}
+@d max_new_row=238 {move down one row and then right}
+@d xxx1=239 {for \&{special} strings}
+@d yyy=243 {for \&{numspecial} numbers}
+@d nop=244 {no operation}
+@d char_loc=245 {character locators in the postamble}
+@d char_loc0=246 {character locators in the postamble}
+@d pre=247 {preamble}
+@d post=248 {postamble beginning}
+@d post_post=249 {postamble ending}
+@d undefined_commands==250,251,252,253,254,255
+
+@ The last character in a \.{GF} file is followed by `|post|'; this command
+introduces the postamble, which summarizes important facts that \MF\ has
+accumulated. The postamble has the form
+$$\vbox{\halign{\hbox{#\hfil}\cr
+ |post| |p[4]| |@!ds[4]| |@!cs[4]| |@!hppp[4]| |@!vppp[4]|
+ |@!min_m[4]| |@!max_m[4]| |@!min_n[4]| |@!max_n[4]|\cr
+ $\langle\,$character locators$\,\rangle$\cr
+ |post_post| |q[4]| |i[1]| 223's$[{\G}4]$\cr}}$$
+Here |p| is a pointer to the byte following the final |eoc| in the file
+(or to the byte following the preamble, if there are no characters);
+it can be used to locate the beginning of \\{xxx} commands
+that might have preceded the postamble. The |ds| and |cs| parameters
+@^design size@> @^check sum@>
+give the design size and check sum, respectively, which are exactly the
+values put into the header of any \.{TFM} file that shares information with this
+\.{GF} file. Parameters |hppp| and |vppp| are the ratios of
+pixels per point, horizontally and vertically, expressed as |scaled| integers
+(i.e., multiplied by $2^{16}$); they can be used to correlate the font
+with specific device resolutions, magnifications, and ``at sizes.'' Then
+come |min_m|, |max_m|, |min_n|, and |max_n|, which bound the values that
+registers |m| and~|n| assume in all characters in this \.{GF} file.
+(These bounds need not be the best possible; |max_m| and |min_n| may, on the
+other hand, be tighter than the similar bounds in |boc| commands. For
+example, some character may have |min_n=-100| in its |boc|, but it might
+turn out that |n| never gets lower than |-50| in any character; then
+|min_n| can have any value |<=-50|. If there are no characters in the file,
+it's possible to have |min_m>max_m| and/or |min_n>max_n|.)
+
+@ Character locators are introduced by |char_loc| commands,
+which specify a character residue~|c|, character escapements (|dx,dy|),
+a character width~|w|, and a pointer~|p|
+to the beginning of that character. (If two or more characters have the
+same code~|c| modulo 256, only the last will be indicated; the others can be
+located by following backpointers. Characters whose codes differ by a
+multiple of 256 are assumed to share the same font metric information,
+hence the \.{TFM} file contains only residues of character codes modulo~256.
+This convention is intended for oriental languages, when there are many
+character shapes but few distinct widths.)
+@^oriental characters@>@^Chinese characters@>@^Japanese characters@>
+
+The character escapements (|dx,dy|) are the values of \MF's \&{chardx}
+and \&{chardy} parameters; they are in units of |scaled| pixels;
+i.e., |dx| is in horizontal pixel units times $2^{16}$, and |dy| is in
+vertical pixel units times $2^{16}$. This is the intended amount of
+displacement after typesetting the character; for \.{DVI} files, |dy|
+should be zero, but other document file formats allow nonzero vertical
+escapement.
+
+The character width~|w| duplicates the information in the \.{TFM} file; it
+is $2^{24}$ times the ratio of the true width to the font's design size.
+
+The backpointer |p| points to the character's |boc|, or to the first of
+a sequence of consecutive \\{xxx} or |yyy| or |no_op| commands that
+immediately precede the |boc|, if such commands exist; such ``special''
+commands essentially belong to the characters, while the special commands
+after the final character belong to the postamble (i.e., to the font
+as a whole). This convention about |p| applies also to the backpointers
+in |boc| commands, even though it wasn't explained in the description
+of~|boc|. @^backpointers@>
+
+Pointer |p| might be |-1| if the character exists in the \.{TFM} file
+but not in the \.{GF} file. This unusual situation can arise in \MF\ output
+if the user had |proofing<0| when the character was being shipped out,
+but then made |proofing>=0| in order to get a \.{GF} file.
+
+@ The last part of the postamble, following the |post_post| byte that
+signifies the end of the character locators, contains |q|, a pointer to the
+|post| command that started the postamble. An identification byte, |i|,
+comes next; this currently equals~131, as in the preamble.
+
+The |i| byte is followed by four or more bytes that are all equal to
+the decimal number 223 (i.e., @'337 in octal). \MF\ puts out four to seven of
+these trailing bytes, until the total length of the file is a multiple of
+four bytes, since this works out best on machines that pack four bytes per
+word; but any number of 223's is allowed, as long as there are at least four
+of them. In effect, 223 is a sort of signature that is added at the very end.
+@^Fuchs, David Raymond@>
+
+This curious way to finish off a \.{GF} file makes it feasible for
+\.{GF}-reading programs to find the postamble first, on most computers,
+even though \MF\ wants to write the postamble last. Most operating
+systems permit random access to individual words or bytes of a file, so
+the \.{GF} reader can start at the end and skip backwards over the 223's
+until finding the identification byte. Then it can back up four bytes, read
+|q|, and move to byte |q| of the file. This byte should, of course,
+contain the value 248 (|post|); now the postamble can be read, so the
+\.{GF} reader can discover all the information needed for individual characters.
+
+Unfortunately, however, standard \PASCAL\ does not include the ability to
+@^system dependencies@>
+access a random position in a file, or even to determine the length of a file.
+Almost all systems nowadays provide the necessary capabilities, so \.{GF}
+format has been designed to work most efficiently with modern operating systems.
+Indeed, \.{GFtoPXL} insists on being able to read the postamble first, because
+it needs the device width information found there in order to encode characters.
+
+@* Input and Output for binary files.
+We have seen that a \.{GF} file is a sequence of 8-bit bytes. The bytes
+appear physically in what is called a `|packed file of 0..255|'
+in \PASCAL\ lingo.
+
+Packing is system dependent, and many \PASCAL\ systems fail to implement
+such files in a sensible way (at least, from the viewpoint of producing
+good production software). For example, some systems treat all
+byte-oriented files as text, looking for end-of-line marks and such
+things. Therefore some system-dependent code is often needed to deal with
+binary files, even though most of the program in this section of
+\.{GFtoPXL} is written in standard \PASCAL.
+@^system dependencies@>
+
+We shall stick to simple \PASCAL\ in this program, for reasons of clarity,
+even if such simplicity is sometimes unrealistic.
+
+@<Types...@>=
+@!eight_bits=0..255; {unsigned one-byte quantity}
+@!byte_file=packed file of eight_bits; {files that contain binary data}
+
+@ The program deals with two binary file variables: |gf_file| is the
+input file that we are translating into \.{PXL} format, to be written
+on |pxl_file|.
+
+@<Glob...@>=
+@!gf_file:byte_file; {the stuff we are \.{GFtoPXL}ing}
+@!pxl_file:byte_file; {the stuff we have \.{GFtoPXL}ed}
+
+@ To prepare the |gf_file| for input, we |reset| it.
+
+@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|}
+begin reset(gf_file);
+cur_loc:=0;
+end;
+
+@ To prepare the |pxl_file| for output, we |rewrite| it.
+
+@p procedure open_pxl_file; {prepares to write packed bytes in |pxl_file|}
+begin rewrite(pxl_file);
+end;
+
+@ If you looked carefully at the preceding code, you probably asked,
+``What is |cur_loc|?'' Good question. It's a global variable that holds
+the number of the byte about to be read next from |gf_file|. Likewise,
+|pxl_byte| holds the number of the byte about to be written next
+into |pxl_file|.
+
+@<Glob...@>=
+@!cur_loc:integer; {where we are about to look, in |gf_file|}
+@!pxl_byte_no:integer; {where we are about to write, in |pxl_file|}
+
+@ We shall use a set of simple functions to read the next byte or
+bytes from |gf_file|. There are seven possibilities, each of which is
+treated as a separate function in order to minimize the overhead for
+subroutine calls.
+@^system dependencies@>
+
+@p function get_byte:integer; {returns the next byte, unsigned}
+var b:eight_bits;
+begin if eof(gf_file) then get_byte:=0
+else begin read(gf_file,b); incr(cur_loc); get_byte:=b;
+ end;
+end;
+@#
+function signed_byte:integer; {returns the next byte, signed}
+var b:eight_bits;
+begin read(gf_file,b); incr(cur_loc);
+if b<128 then signed_byte:=b @+ else signed_byte:=b-256;
+end;
+@#
+function get_two_bytes:integer; {returns the next two bytes, unsigned}
+var a,@!b:eight_bits;
+begin read(gf_file,a); read(gf_file,b);
+cur_loc:=cur_loc+2;
+get_two_bytes:=a*256+b;
+end;
+@#
+function signed_pair:integer; {returns the next two bytes, signed}
+var a,@!b:eight_bits;
+begin read(gf_file,a); read(gf_file,b);
+cur_loc:=cur_loc+2;
+if a<128 then signed_pair:=a*256+b
+else signed_pair:=(a-256)*256+b;
+end;
+@#
+function get_three_bytes:integer; {returns the next three bytes, unsigned}
+var a,@!b,@!c:eight_bits;
+begin read(gf_file,a); read(gf_file,b); read(gf_file,c);
+cur_loc:=cur_loc+3;
+get_three_bytes:=(a*256+b)*256+c;
+end;
+@#
+function signed_trio:integer; {returns the next three bytes, signed}
+var a,@!b,@!c:eight_bits;
+begin read(gf_file,a); read(gf_file,b); read(gf_file,c);
+cur_loc:=cur_loc+3;
+if a<128 then signed_trio:=(a*256+b)*256+c
+else signed_trio:=((a-256)*256+b)*256+c;
+end;
+@#
+function signed_quad:integer; {returns the next four bytes, signed}
+var a,@!b,@!c,@!d:eight_bits;
+begin read(gf_file,a); read(gf_file,b); read(gf_file,c); read(gf_file,d);
+cur_loc:=cur_loc+4;
+if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
+else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+end;
+
+@ Most info in the |pxl_file| comes in words, but we have to write it
+as bytes and halfwords occasionally.
+
+@d pxl_byte(#)==begin write(pxl_file,#); incr(pxl_byte_no); end
+
+@p procedure pxl_halfword(@!w:integer);
+begin
+if w<0 then w:=w+@"10000;
+pxl_byte(w div @"100);
+pxl_byte(w mod @"100);
+end;
+@#
+procedure pxl_word(@!w:integer);
+begin
+if w>=0 then pxl_byte(w div @"1000000)
+else begin
+ w:=w+@"40000000;
+ w:=w+@"40000000;
+ pxl_byte((w div @"1000000) + 128);
+ end;
+pxl_byte((w div @"10000) mod @"100);
+pxl_byte((w div @"100) mod @"100);
+pxl_byte(w mod @"100);
+end;
+
+@ Finally we come to the routines that are used for random access of the
+|gf_file|. The driver program below needs two such routines: |gf_length| should
+compute the total number of bytes in |gf_file|, possibly also
+causing |eof(gf_file)| to be true; and |move_to_byte(n)|
+should position |gf_file| so that the next |get_byte| will read byte |n|,
+starting with |n=0| for the first byte in the file.
+@^system dependencies@>
+
+Such routines are, of course, highly system dependent. They are implemented
+here in terms of two assumed system routines called |set_pos| and |cur_pos|.
+The call |set_pos(f,n)| moves to item |n| in file |f|, unless |n| is
+negative or larger than the total number of items in |f|; in the latter
+case, |set_pos(f,n)| moves to the end of file |f|.
+The call |cur_pos(f)| gives the total number of items in |f|, if
+|eof(f)| is true; we use |cur_pos| only in such a situation.
+
+@p function gf_length:integer;
+begin set_pos(gf_file,-1); gf_length:=cur_pos(gf_file);
+end;
+@#
+procedure move_to_byte(n:integer);
+begin set_pos(gf_file,n); cur_loc:=n;
+end;
+
+@* Translation to raster form.
+The main work of \.{GFtoPXL} is accomplished by the |do_char| procedure,
+which produces the output for an entire character, assuming that the |boc|
+command for that character has already been processed. This procedure
+works in two parts, the first of which is
+essentially an interpretive routine that reads and acts on the \.{GF}
+commands by writing into an array of pixels, and the second is a
+routine which encapsules this information into the form needed for
+the Raster Information portion of the \.{PXL} file.
+
+
+@ The definition of \.{GF} files refers to two registers,
+$(m,n)$, which hold integer row and column numbers. We also
+need to remember |paint_switch|, who's value is either |black|
+or |white|.
+
+@<Types...@>=
+@!x_coord=left_pixel..right_pixel;
+@!y_coord=bot_pixel..top_pixel;
+{BUG FIXME ??? off by one}
+
+@ @<Glob...@>=
+@!m: x_coord;
+@!n: y_coord; {current state values}
+@!paint_switch: pixel;
+
+@ We'll need a big array of pixels to hold the character image. Each
+pixel should be represented as a single bit in order to save space.
+Different systems may prefer the following definitions, while others
+may do better using the |boolean| type and constants.
+@^system dependencies@>
+
+@d white=0 {could also be |false|}
+@d black=1 {could also be |true|}
+@d complement(#)==if #=black then #:=white@+else #:=black
+ {could also be |paint_switch:=not paint_switch|}
+
+@<Types...@>=
+@!pixel=white..black; {could also be |boolean|}
+
+@ In order to allow different systems to change the |image| array from
+row-major to column-major (or vice versa) easily, or to transpose it top
+and bottom or left and right, we declare and access it as follows.
+@^system dependencies@>
+
+@d image==image_array[n,m]
+
+@<Glob...@>=
+@!image_array: packed array [y_coord,x_coord] of pixel;
+
+@ Maybe there's a faster way to do this on your system. Note that the
+only part of the |image_array| that we clear is the part that the current
+character may use. Thus, the rest of this program may not look outside
+the area delimited by |[y,x]=[min_n..max_n,min_m..max_m]| and expect to
+see anything but junk.
+@^system dependencies@>
+
+@<Clear the image@>=
+begin
+n:=min_n;
+while n<=max_n do begin
+ m:=min_m;
+ while m<=max_m do begin
+ image:=white;
+ incr(m);
+ end;
+ incr(n);
+ end;
+end
+
+@ @<Print the image@>=
+begin
+n:=max_n;
+while (n>=min_n)and(n>=max_n-80) do begin
+ m:=min_m;
+ while (m<=max_m) and (m<=min_m+78) do begin
+ if image=white then print(' ')@+else print('*');
+ incr(m);
+ end;
+ print_ln(' ');
+ decr(n);
+ end;
+end
+
+@ Let's keep track of how many characters are in the font.
+
+@<Glob...@>=
+@!char_code: integer; {current character number}
+@!total_chars:integer; {the total number of characters seen so far}
+
+@ @<Set init...@>=
+total_chars:=0;
+
+@ Before we get into the details of |do_char|, it is convenient to
+consider a simpler routine that computes the first parameter of each
+opcode.
+
+@d three_cases(#)==#,#+1,#+2
+@d four_cases(#)==#,#+1,#+2,#+3
+@d eight_cases(#)==four_cases(#),four_cases(#+4)
+@d nine_cases(#)==eight_cases(#),#+8
+@d sixteen_cases(#)==eight_cases(#),eight_cases(#+8)
+@d eighteen_cases(#)==nine_cases(#),nine_cases(#+9)
+@d thirty_two_cases(#)==sixteen_cases(#),sixteen_cases(#+16)
+@d sixty_four_cases(#)==thirty_two_cases(#),thirty_two_cases(#+32)
+@d eighty_two_cases(#)==sixty_four_cases(#),eighteen_cases(#+64)
+@d one_hundred_sixty_five_cases(#)==
+ #,eighty_two_cases(#+1),eighty_two_cases(#+83)
+
+@p function first_par(o:eight_bits):integer;
+begin case o of
+sixty_four_cases(paint_0): first_par:=o-paint_0;
+paint1,skip1,char_loc,char_loc0,xxx1: first_par:=get_byte;
+paint1+1,skip1+1,xxx1+1: first_par:=get_two_bytes;
+paint1+2,skip1+2,xxx1+2: first_par:=get_three_bytes;
+xxx1+3,yyy: first_par:=signed_quad;
+skip0,nop,boc,boc1,eoc,pre,post,post_post,undefined_commands: first_par:=0;
+one_hundred_sixty_five_cases(new_row_0): first_par:=o-new_row_0;
+end;
+end;
+
+@ Strictly speaking, the |do_char| procedure is really a function with
+side effects, not a `\&{procedure}'; it returns the value |false| if
+\.{GFtoPXL} should be aborted because of some unusual happening. The
+subroutine is organized as a typical interpreter, with a multiway branch
+on the command code.
+
+@p function do_char:boolean;
+label 1,2,3,4,9997,9998,9999;
+var o:eight_bits; {operation code of the current command}
+@!p,@!q:integer; {parameters of the current command}
+i,j: integer; {used to index in |select byte type|}
+b: eight_bits; {holding byte for pxl bits}
+begin {we've already scanned the |boc|}
+do_char:=true;
+while true do @<Translate the next command in the \.{GF} file;
+ |goto 9999| if it was |eoc|;
+ |goto 9998| if premature termination is needed@>;
+9998: print_ln('!'); do_char:=false; goto 9997;
+9999:
+@<Remove white rows and columns@>;
+@<Save directory info.@>
+@<Encode the glyph@>;
+9997: end;
+
+@ This is the main command loop.
+
+@d error(#)==begin print(a:1,': ! ',#); print_nl; end
+
+@<Translate the next command...@>=
+begin a:=cur_loc;
+o:=get_byte; p:=first_par(o);
+if eof(gf_file) then bad_gf('the file ended prematurely');
+@.the file ended prematurely@>
+@<Translate command |o|@>;
+end
+
+@ The multiway switch in |first_par|, above, was organized by the length
+of each command; the one in |do_char| is organized by the semantics.
+
+@<Translate command...@>=
+if o<=paint1+2 then @<Translate a |paint| command@>
+else if (new_row_0<=o) and (o<=max_new_row) then
+ @<Translate a |new_row| command@>
+else case o of
+ four_cases(skip0): @<Translate a |skip| command@>;
+ @t\4@>@<Cases for commands |nop|, |pre|, |post|, |post_post|, |boc|,
+ and |eoc|@>@;
+ four_cases(xxx1): @<Translate an |xxx| command@>;
+ yyy: @<Translate a |yyy| command@>;
+ othercases error('undefined command ',o:1,'!')
+@.undefined command@>
+ endcases
+
+@ @<Cases for commands |nop|...@>=
+nop: do_nothing;
+pre: begin error('preamble command within a character!'); goto 9998;
+ end;
+@.preamble command within a character@>
+post,post_post: begin error('postamble command within a character!'); goto 9998;
+@.postamble command within a character@>
+ end;
+boc,boc1: begin error('boc occurred before eoc'); goto 9998;
+@.boc occurred before eoc@>
+ end;
+eoc: goto 9999;
+
+@ @<Translate an |xxx| command@>=
+begin bad_char:=false;
+while p>0 do begin
+ q:=get_byte;
+ if (q<" ")or(q>"~") then bad_char:=true;
+ decr(p);
+ end;
+if bad_char then error('non-ASCII character in xxx command!');
+@.non-ASCII character...@>
+end
+
+@ @<Translate a |yyy| command@>=
+do_nothing
+
+@ @<Translate a |paint| command@>=
+begin
+if m+p>right_pixel then
+ begin
+ if m<=right_pixel then {give error message only once}
+ error('character extends too far to the right for me');
+@.character extends...@>
+ m:=m+p;
+ end
+else while p>0 do begin
+ image:=paint_switch;
+ incr(m);
+ decr(p);
+ end;
+complement(paint_switch);
+end
+
+@ @<Translate a |new_row| command@>=
+begin
+decr(n);
+m:=min_m+p;
+paint_switch:=black;
+end
+
+@ @<Translate a |skip| command@>=
+begin
+n:=n-(p+1);
+m:=min_m;
+paint_switch:=white;
+end
+
+@ Note that \.{GF} format does not guarantee that |max_m| and |max_n| are
+as small as they might be (they're sure to be big enough, though). Likewise,
+|min_m| and |min_n| might be smaller than they might be. Here we set the
+bounds as tightly as possible.
+
+@d no_black==(min_n>max_n)
+
+@<Remove white rows and columns@>=
+@!debug
+print_nl;
+print_ln('before: minm=',min_m:1,' maxm=',max_m:1,
+ ' minn=',min_n:1,' maxn=',max_n:1);
+gubed@/
+n:=min_n;
+while n<=max_n do begin
+ m:=min_m;
+ while m<=max_m do begin
+ if image=black then goto 1;
+ incr(m);
+ end;
+ incr(n);
+ min_n:=n; {blank row at bottom now gone}
+ end;
+1:
+if no_black then begin
+ min_m:=max_m+1;
+ goto 4; {why bother?}
+ end;
+n:=max_n;
+while n>min_n do begin
+ m:=min_m;
+ while m<=max_m do begin
+ if image=black then goto 2;
+ incr(m);
+ end;
+ decr(n);
+ max_n:=n; {blank row at top now gone}
+ end;
+2:
+m:=min_m;
+while m<max_m do begin
+ n:=min_n;
+ while n<=max_n do begin
+ if image=black then goto 3;
+ incr(n);
+ end;
+ incr(m);
+ min_m:=m; {blank column at left now gone}
+ end;
+3:
+m:=max_m;
+while m>min_m do begin
+ n:=min_n;
+ while n<=max_n do begin
+ if image=black then goto 4;
+ incr(n);
+ end;
+ decr(m);
+ max_m:=m; {blank column at right now gone}
+ end;
+4:
+cols:=max_m-min_m+1;
+rows:=max_n-min_n+1;
+num_bytes:=4*((cols+31) div 32);
+@!debug
+print_ln('after : minm=',min_m:1,' maxm=',max_m:1,
+ ' minn=',min_n:1,' maxn=',max_n:1);
+print_ln('cols=',cols:1,' rows=',rows:1);
+gubed
+
+@ While we were at it, we also snuck in a computation of how many
+rows and columns are in the bounding box and the number of bytes
+needed to report each row of pixels.
+
+@<Glob...@>=
+@!cols,@!rows: integer; {columns and rows of pixels}
+@!num_bytes: integer; {needed bytes per row}
+
+@* Reading the postamble.
+Now imagine that we are reading the \.{GF} file and positioned just
+after the |post| command. That, in fact, is the situation,
+when the following part of \.{GFtoPXL} is called upon to read, translate,
+and check the rest of the postamble.
+
+@p procedure read_postamble;
+var k:integer; {loop index}
+@!p,@!q,@!m,@!c:integer; {general purpose registers}
+begin post_loc:=cur_loc-1;
+print_ln('Postamble starts at byte ',post_loc:1,'.');
+@.Postamble starts at byte n@>
+p:=signed_quad;
+design_size:=signed_quad; check_sum:=signed_quad;@/
+print('design size = ',design_size:1,' (');
+print_scaled(design_size div 16); print_ln(')');
+print_ln('check sum = ',check_sum:1);@/
+hppp:=signed_quad; vppp:=signed_quad;@/
+print('hppp = ',hppp:1,' ('); print_scaled(hppp); print_ln(')');
+print('vppp = ',vppp:1,' ('); print_scaled(vppp); print_ln(')');
+magnification:=hppp/(65536.0*resolution/72.27);
+pxl_mag:=round(1000*magnification);
+print_ln('mag = ',pxl_mag:1);
+min_m:=signed_quad; max_m:=signed_quad;
+min_n:=signed_quad; max_n:=signed_quad;@/
+print_ln('min m = ',min_m:1,', max m = ',max_m:1);@/
+print_ln('min n = ',min_n:1,', max n = ',max_n:1);@/
+@<Process the character locations in the postamble@>;
+@<Make sure that the end of the file is well-formed@>;
+end;
+
+@ Here is the main information we glean from the postamble.
+
+@<Glob...@>=
+@!design_size: integer;
+@!min_m, @!max_m, @!min_n, @!max_n: integer;
+@!hppp, @!vppp: integer;
+@!check_sum: integer;
+@!post_loc: integer;
+@!magnification: real;
+@!tfm_width: array [0..max_glyph_no] of integer;
+@!device_width: array [0..max_glyph_no] of integer;
+
+@ When we get to the present code, the |post_post| command has
+just been read.
+
+@<Make sure that the end of the file is well-formed@>=
+if k<>post_post then
+ error('should be postpost!');
+@.should be postpost@>
+q:=signed_quad;
+if q<>post_loc then
+ error('postamble pointer should be ',post_loc:1,' not ',q:1);
+@.postamble pointer should be...@>
+m:=get_byte;
+if m<>gf_id_byte then error('identification byte should be ',gf_id_byte:1);
+@.identification byte should be n@>
+k:=cur_loc; m:=223;
+while (m=223)and not eof(gf_file) do m:=get_byte;
+if not eof(gf_file) then bad_gf('signature in byte ',cur_loc-1:1,
+@.signature...should be...@>
+ ' should be 223')
+else if cur_loc<k+4 then
+ error('not enough signature bytes at end of file');
+@.not enough signature bytes...@>
+
+@ @<Process the character locations...@>=
+repeat k:=get_byte;
+if (k=char_loc) or (k=char_loc0) then begin
+ c:=first_par(k);
+ if c>max_glyph_no then abort('Character number too large');
+ if k=char_loc0 then device_width[c]:=get_byte
+ else begin device_width[c]:=round(signed_quad/unity);
+ m := signed_quad;
+ end;
+ tfm_width[c]:=signed_quad;
+ p:=signed_quad;
+ k:=nop;
+ end;
+until k<>nop;
+
+@ This routines is brought into play in order to read the postamble first.
+
+@p procedure find_postamble;
+var q,@!k: integer;
+begin
+post_loc:=gf_length-4;
+repeat if post_loc=0 then bad_gf('all 223s');
+@.all 223s@>
+move_to_byte(post_loc); k:=get_byte; decr(post_loc);
+until k<>223;
+if k<>gf_id_byte then bad_gf('ID byte is ',k:1);
+@.ID byte is wrong@>
+move_to_byte(post_loc-3); q:=signed_quad;
+if (q<0)or(q>post_loc-3) then
+ bad_gf('post pointer ',q:1,' at byte ',post_loc-3:1);
+@.post pointer is wrong@>
+move_to_byte(q); k:=get_byte;
+if k<>post then bad_gf('byte ',q:1,' is not post');
+@.byte n is not post@>
+end;
+
+@* PXL Matrix Format.
+A \.{PXL} file is an expanded raster description of a single font at a
+particular resolution and contains essentially the same information as
+that contained in a \.{GF} file. \.{PXL} files are used by many existing
+device-driver programs for dot matrix devices. By convention, \.{PXL} files
+are for 200 pixels per inch. \.{GFtoPXL} will report the magnification
+over the design point size that will occur if the \.{PXL} file is
+used on a 200 pixel per inch output device.
+
+All words in of \.{PXL} files are in 32-bit format, with the four lower
+bits zero on 36-bit machines. The raster information is contained in a
+sequence of binary words which record white pixels as zeros and black
+pixels as ones.
+
+The first word of the \.{PXL} file and the last word contain the \.{PXL
+ID} which is currently equal to 1001(decimal).
+
+This first word is followed by a sequence of raster information words
+where each line of pixels in the glyphs is represented by one or more
+words of binary information. The number of words used to represent each
+row of pixels for any particular glyph is fixed and it is set by the value
+of |max_m-min_m+1| for that particular glyph. Each white pixel is represented
+by a zero and each black pixel is represented by a one in the corresponding bit
+positions (the first 32 only of each word on 36-bit machines).
+ The unused bit positions
+toward the end of each set of words for each row of pixels are filled with
+zeros. It sould be noted that this representation is more wasteful of
+space than it needs to be, but it may possibly simplify the
+subsequent use of the information by a device-driver program.
+
+The Font Directory follows, occupying a fixed position with respect to the
+end of the file (in words 517 through 6 from this end), and assigns 4
+words for each of the potential 128 different glyphs that could be
+contained in this particular font in the order of their assending ascii
+values (not in the order that the glyphs appear in the raster section,
+which may be entirely arbitrary). This means that the first four words are
+for the ascii zero glyph. All four words reserved for any missing glyphs
+are set to zero.
+
+The first word of each glyph's directory information contains the Pixel
+Width in the left half-word (the leftmost 16 bits) and the Pixel Height in
+the right half-word (the next 16 bits). These dimensions are those of the
+smallest bounding-box, measured in pixels, and they have nothing
+necessarily to do with the width and height figures that appear in the
+\.{TFM} file. The \.{TFM} width, measured in \.{FIXes}, where 1 \.{FIX}
+is $1/(2^{20}$ times the design size, is listed in the fourth word of the
+glyph's directory information.
+
+The second word of the glyph's directory information contains the offset
+of the glyph's reference point from its upper-left-hand corner of the
+bounding box, measured in pixels, with the X-Offset in the left half-word
+and the Y-Offset in the right half-word. These numbers may be negative,
+and two's complement representation is used. Remember that the positive x
+direction means `rightward' and positive y is `downward' on the page.
+
+The third word of a glyph's directory information contains the number of the
+word in this \.{PXL} file where the Raster Description for this particular
+glyph begins, measured from the first word which is numbered zero.
+
+As mentioned earlier, the fourth word of directory information for each
+glyph contains the \.{TFM} width.
+
+The final five words in the \.{PXL} file contain information relation to
+the entire file.
+
+ The first of these five words is a checksum which should
+match the checksum contained in the \.{TFM} file that \TeX\ used in
+reference to this font, although, if this checksum is zero, no validity
+checking will be done.
+
+The second of these five words is an integer that is 1000 times the
+magnification factor at which this font was produced.
+
+The third word contains the design sige of the font measured in \.{FIXes}
+($2^{-20}$ unmagnified points).
+
+The fourth word contains a pointer to the first word of the font directory.
+
+The fifth and last word of the entire file contains a duplicate of the
+\.{PXL} ID as contained in the first word of the file.
+
+@d pxl_id=1001 {current version of \.{PXL} format}
+
+@ @<Glob...@>=
+@!glyph_ptr: array [0..max_glyph_no] of integer;
+@!glyph_cols: array [0..max_glyph_no] of integer;
+@!glyph_rows: array [0..max_glyph_no] of integer;
+@!cols_offset: array [0..max_glyph_no] of integer;
+@!rows_offset: array [0..max_glyph_no] of integer;
+@!bc,@!ec:integer;
+@!pxl_dir_ptr:integer;
+@!pxl_mag: integer;
+
+@ @<Set init...@>=
+char_code:=0;
+while char_code<=max_glyph_no do
+begin
+glyph_cols[char_code]:=0;
+glyph_rows[char_code]:=0;
+cols_offset[char_code]:=0;
+rows_offset[char_code]:=0;
+glyph_ptr[char_code]:=0; {marks nonexistent character}
+incr(char_code);
+end;
+bc:=max_glyph_no+1; ec:=-1;
+
+@ The |glyph_ptr| is saved in Encode the glyph.
+
+@<Save directory info.@>=
+glyph_cols[char_code]:=cols;
+glyph_rows[char_code]:=rows;
+cols_offset[char_code]:=-min_m;
+rows_offset[char_code]:=max_n;
+
+@ @<Start up the |pxl_file|@>=
+pxl_byte_no:=0;
+pxl_word(pxl_id);
+@!debug
+print_ln('Start of PXL info');
+gubed
+
+@ When we get to this section we have all of the esential information
+needed to write the |4*max_glyph_no| words of the font directory and the
+last five words of the |pxl_file|.
+
+@<Finish off the |pxl_file|@>=
+if (pxl_byte_no mod 4)<>0 then abort('This can''t happen: alignment');
+pxl_dir_ptr:=pxl_byte_no div 4;
+for char_code:=0 to max_glyph_no do begin
+pxl_halfword(glyph_cols[char_code]);
+pxl_halfword(glyph_rows[char_code]);
+pxl_halfword(cols_offset[char_code]);
+pxl_halfword(rows_offset[char_code]);
+pxl_word(glyph_ptr[char_code]); {ptr to glyph raster info}
+pxl_word(tfm_width[char_code]);
+end;
+pxl_word(check_sum);
+pxl_word(pxl_mag);
+pxl_word(design_size);
+pxl_word(pxl_dir_ptr);
+pxl_word(pxl_id);
+@!debug
+print_ln('End of PXL info');
+gubed
+
+@ The following procedure writes out the |pxl| raster, and updates
+|pxl_byte_no|.
+
+@<Encode the glyph@>=
+if glyph_ptr[char_code]<>0 then error('Duplicate glyph');
+glyph_ptr[char_code]:=pxl_byte_no div 4;
+@!eebug
+print_nl; @<Print the image@>;
+gubee@/
+n:=max_n;
+while (n>=min_n) do
+begin
+m:=min_m;
+for j:=1 to num_bytes do
+begin
+if m<(max_m-7) then @<Get full byte@> else
+if (m>max_m) then pxl_byte(0)
+else @<Get mixed byte@>;
+end;
+if (pxl_byte_no mod 4)<>0 then error('Mod 4 error in |encode_glyph|');
+decr(n)
+end;
+
+@ @<Get full byte@>=
+ begin
+ b:=image; incr(m);
+ for i:=2 to 8 do
+ begin
+ b:=b*2+image;
+ incr(m);
+ end;
+ pxl_byte(b);
+ end
+
+@ @<Get mixed byte@>=
+begin
+b:=image; incr(m);
+i:=2;
+while m<=max_m do
+ begin
+ b:=b*2+image;
+ incr(m);
+ incr(i);
+ end;
+for i:=i to 8 do b:=b*2;
+pxl_byte(b);
+end
+
+
+@* The main program.
+Now we are ready to put it all together. This is where \.{GFtoPXL} starts,
+and where it ends.
+
+@p begin initialize; {get all variables initialized}
+open_gf_file;
+find_postamble; read_postamble;
+open_gf_file;
+@<Process the preamble@>;
+open_pxl_file;
+@<Start up the |pxl_file|@>
+@<Translate all the characters@>;
+print_nl;
+@<Finish off the |pxl_file|@>
+print('Font had ',total_chars:1,' character');
+if total_chars<>1 then print('s');
+print(' altogether');
+final_end:end.
+
+@ The main program needs a few global variables in order to do its work.
+
+@<Glob...@>=
+@!a:integer; {byte number of the current command}
+@!o,@!p,@!q:integer; {general purpose registers}
+@!bad_char:boolean; {has a non-ASCII character code appeared in this \\{xxx}?}
+
+@ \.{GFtoPXL} looks at the preamble in order to do error checking, and to
+display the introductory comment.
+
+@<Process the preamble@>=
+o:=get_byte; {fetch the first byte}
+if o<>pre then bad_gf('First byte isn''t start of preamble!');
+@.First byte isn't...@>
+o:=get_byte; {fetch the identification byte}
+if o<>gf_id_byte then
+ error('identification byte should be ',gf_id_byte:1,
+ ' not ',o:1,'!');
+@.identification byte should be n@>
+o:=get_byte; {fetch the length of the introductory comment}
+print('''');
+while o>0 do
+ begin decr(o); print(xchr[get_byte]);
+ end;
+print_ln('''');
+
+@ @<Translate all...@>=
+repeat
+ @<Pass |nop|, |xxx| and |yyy| commands@>;
+ if o<>post then begin
+ if (o<>boc)and(o<>boc1)
+ then bad_gf('byte ',cur_loc-1:1,' is not boc (',o:1,')');
+@.byte n is not boc@>
+ @<Pass a |boc| command@>;
+ if not do_char then bad_gf('char ended unexpectedly');
+@.char ended unexpectedly@>
+ print(']');
+ incr(total_chars);
+ if (total_chars mod 10)=0 then print_nl;
+ end
+until o=post;
+
+@ @<Pass |nop|, |xxx| and |yyy| commands@>=
+repeat
+ a:=cur_loc;
+ o:=get_byte; p:=first_par(o);
+ if eof(gf_file) then bad_gf('the file ended prematurely');
+@.the file ended prematurely@>
+ if o=yyy then begin @<Translate a |yyy|...@>; o:=nop; end
+ else if (o>=xxx1) and (o<=xxx1+3) then begin
+ @<Translate an |xxx|...@>; o:=nop;
+ end;
+until o<>nop;
+
+@ @<Pass a |boc|...@>=
+a:=cur_loc;
+if o=boc1 then
+ begin char_code:=get_byte;
+ q:=get_byte; max_m:=get_byte; min_m:=max_m-q;
+ q:=get_byte; max_n:=get_byte; min_n:=max_n-q;
+ end
+else begin char_code:=get_two_bytes; char_code:=get_two_bytes;
+ p:=signed_quad; {ignore backpointer}
+ min_m:=signed_quad; max_m:=signed_quad;
+ min_n:=signed_quad; max_n:=signed_quad;
+ end;
+print('[',char_code:1);
+if char_code>max_glyph_no then abort('Character number too large');
+if char_code>ec then ec:=char_code;
+if char_code<bc then bc:=char_code;
+if min_m<left_pixel then abort('Pixels beyond left limit');
+if max_m>right_pixel then abort('Pixels beyond right limit');
+if min_n<bot_pixel then abort('Pixels beyond bottom limit');
+if max_n>top_pixel then abort('Pixels beyond top limit');
+@.Pixels beyond...limit@>
+@<Clear the image@>;
+n:=max_n;
+m:=min_m;
+paint_switch:=white;
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{GFtoPXL} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@* Index.
+Pointers to error messages appear here together with the section numbers
+where each ident\-i\-fier is used.
diff --git a/obsolete/systems/knuth/unsupported/mfware/gftype.cms-changes b/obsolete/systems/knuth/unsupported/mfware/gftype.cms-changes
new file mode 100644
index 0000000000..1f29ae5745
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/mfware/gftype.cms-changes
@@ -0,0 +1,223 @@
+% This is GFTYPE.CHGCMS in text format, as of jul 28, 1985
+% (change file for IBM CMS PASCAL/VS)
+% (written by B. Schulze based on a file from Klaus Thull)
+% (banner line changed to match 2.2; then Tangles and compiles)
+% (but may not work beyond that. --Alan Spragens 18 June 1986)
+%
+%line numbers correspond to version 2.1 (of apr 13, 85)
+%
+%line 65
+%
+@x
+@d banner=='This is GFtype, Version 2.2' {printed when the program starts}
+@y
+@d banner=='This is GFtype, CMS Version 2.2 (SFB72)'
+ {printed when the program starts}
+@z
+%
+%module
+%
+%line 74
+@x
+@d othercases == others: {default for cases not listed explicitly}
+@y
+@d othercases == otherwise {default for cases not listed explicitly}
+@f othercases == else
+@d term_in == tty_in
+@d term_out == tty_out
+@z
+%
+%module
+%
+%line 84
+@x
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+@d print_nl==write_ln
+@y
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+@d print_nl==write_ln(' ')
+@z
+%
+%module
+%
+%line 117
+@x
+@!line_length=79; {\\{xxx} strings will not produce lines longer than this}
+@y
+@!line_length=79; {\\{xxx} strings will not produce lines longer than this}
+@!len_byte_block=1024; {blocksize of gf file}
+@z
+%
+%module
+%
+%line 181
+@x
+@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
+%
+%module
+%
+%line 184
+@x
+@!text_file=packed file of text_char;
+@y
+@!text_file=text;
+@z
+%
+%module
+%
+%line 634
+@x
+@!eight_bits=0..255; {unsigned one-byte quantity}
+@!byte_file=packed file of eight_bits; {files that contain binary data}
+@y
+@!eight_bits= packed 0..255; {unsigned one-byte quantity}
+@!byte_block = packed array [0..len_byte_block-1] of eight_bits;
+@!byte_file = packed file of byte_block;
+@z
+%
+%module
+%
+%line 663
+@x
+@p function get_byte:integer; {returns the next byte, unsigned}
+var b:eight_bits;
+begin if eof(gf_file) then get_byte:=0
+else begin read(gf_file,b); incr(cur_loc); get_byte:=b;
+ end;
+end;
+@#
+function get_two_bytes:integer; {returns the next two bytes, unsigned}
+var a,@!b:eight_bits;
+begin read(gf_file,a); read(gf_file,b);
+cur_loc:=cur_loc+2;
+get_two_bytes:=a*256+b;
+end;
+@#
+function get_three_bytes:integer; {returns the next three bytes, unsigned}
+var a,@!b,@!c:eight_bits;
+begin read(gf_file,a); read(gf_file,b); read(gf_file,c);
+cur_loc:=cur_loc+3;
+get_three_bytes:=(a*256+b)*256+c;
+end;
+@#
+function signed_quad:integer; {returns the next four bytes, signed}
+var a,@!b,@!c,@!d:eight_bits;
+begin read(gf_file,a); read(gf_file,b); read(gf_file,c); read(gf_file,d);
+cur_loc:=cur_loc+4;
+if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
+else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+end;
+@y
+@d eof_gf==((cur_loc mod len_byte_block = 0)
+and (eof(gf_file)))
+@d get_gf(#)==begin
+ if eof_gf then prem_end else
+ # := gf_file@@(.cur_loc mod len_byte_block.);
+ incr(cur_loc);
+ if cur_loc mod len_byte_block = 0
+ then get(gf_file)
+ end
+
+@p
+procedure prem_end; begin bad_gf
+('didn''t we read past endfile just now?') end;
+@#
+function get_byte:integer; {returns the next byte, unsigned}
+var b:eight_bits;
+begin
+get_gf(b); get_byte:=b;
+end;
+@#
+function get_two_bytes:integer; {returns the next two bytes, unsigned}
+var a,@!b:eight_bits;
+begin get_gf(a); get_gf(b);
+get_two_bytes:=a*256+b;
+end;
+@#
+function get_three_bytes:integer; {returns the next three bytes, unsigned}
+var a,@!b,@!c:eight_bits;
+begin get_gf(a); get_gf(b); get_gf(c);
+get_three_bytes:=(a*256+b)*256+c;
+end;
+@#
+function signed_quad:integer; {returns the next four bytes, signed}
+var a,@!b,@!c,@!d:eight_bits;
+begin get_gf(a); get_gf(b); get_gf(c); get_gf(d);
+if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
+else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+end;
+@z
+%
+%module
+%
+%line 734
+@x
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@y
+@d update_terminal == write_ln(term_out)
+@z
+%
+%module
+%
+%line 745
+@x
+@p procedure input_ln; {inputs a line from the terminal}
+var k:0..terminal_line_length;
+begin update_terminal; reset(term_in);
+if eoln(term_in) then read_ln(term_in);
+k:=0;
+while (k<terminal_line_length)and not eoln(term_in) do
+ begin buffer[k]:=xord[term_in^]; incr(k); get(term_in);
+ end;
+buffer[k]:=" ";
+end;
+@y
+@p procedure input_ln; {inputs a line from the terminal}
+var k:0..terminal_line_length; c: text_char;
+begin update_terminal;
+if eoln(term_in) then get(term_in);
+k:=0;
+while (k<terminal_line_length)and not eoln(term_in) do
+ begin
+ buffer(.k.):=xord(.term_in@@.);
+ get (term_in);
+ incr(k);
+ end;
+buffer[k]:=" ";
+end;
+@z
+%
+%module
+%
+%line 770
+@x
+begin rewrite(term_out); {prepare the terminal for output}
+@y
+begin @= termout@>(term_out); {prepare the terminal for output}
+@= termin@>(term_in); {prepare the terminal for input}
+@z
+%
+%module
+%
+%line 1027
+@x
+ if eof(gf_file) then bad_gf('the file ended prematurely')
+@y
+ if eof_gf then bad_gf('the file ended prematurely');
+@z
+%
+%module
+%
+%line 1216
+@x
+while (m=223)and not eof(gf_file) do m:=get_byte;
+if not eof(gf_file) then bad_gf('signature in byte ',cur_loc-1:1,
+@y
+while (m=223)and not eof_gf do m:=get_byte;
+if not eof_gf then bad_gf('signature in byte ',cur_loc-1:1,
+@z
diff --git a/obsolete/systems/knuth/unsupported/mfware/gftype.tops20-changes b/obsolete/systems/knuth/unsupported/mfware/gftype.tops20-changes
new file mode 100644
index 0000000000..b6e573e825
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/mfware/gftype.tops20-changes
@@ -0,0 +1,99 @@
+% This TOPS-20 change file for GFTYPE was written by Tomas Rokicki.
+% Send bug reports to ROKICKI@SU-SCORE.
+
+@x [2]
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\ttw{{\mc TOPS-20}}
+\def\title{GFtype changes for \ttw}
+@z
+
+@x [3]
+@d banner=='This is GFtype, Version 2.2' {printed when the program starts}
+@y
+@d banner=='This is GFtype, Version 2.2' {printed when the program starts}
+@z
+
+@x [6]
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+@d print_nl==write_ln
+@y
+@d print(#)==write(tty,#)
+@d print_ln(#)==write_ln(tty,#)
+@d print_nl==write_ln(tty)
+@z
+
+@x [6]
+@p program GF_type(@!gf_file,@!output);
+@y
+@p program GF_type;
+@z
+
+@x
+@<Constants...@>=
+@!terminal_line_length=150; {maximum number of characters input in a single
+ line of input from the terminal}
+@!line_length=79; {\\{xxx} strings will not produce lines longer than this}
+@!max_row=79; {vertical extent of pixel image array}
+@!max_col=79; {horizontal extent of pixel image array}
+@y
+@<Constants...@>=
+@!terminal_line_length=150; {maximum number of characters input in a single
+ line of input from the terminal}
+@!line_length=79; {\\{xxx} strings will not produce lines longer than this}
+@!max_row=79; {vertical extent of pixel image array}
+@!max_col=79; {horizontal extent of pixel image array}
+@!name_length=80; {maximum length of a name}
+@z
+
+@x [52]
+begin reset(gf_file);
+@y
+begin reset(gf_file,gf_name,'/O/B:8');
+if eof(gf_file) then abort('GF file does not exist!');
+@z
+
+@x [53]
+@!cur_loc:integer; {where we are about to look, in |gf_file|}
+@y
+@!cur_loc:integer; {where we are about to look, in |gf_file|}
+@!gf_name:packed array[1..name_length] of char;
+@z
+
+@x [57]
+into the |buffer| array. The |term_in| file is used for terminal input,
+and |term_out| for terminal output.
+@^system dependencies@>
+
+@<Glob...@>=
+@!buffer:array[0..terminal_line_length] of ASCII_code;
+@!term_in:text_file; {the terminal, considered as an input file}
+@!term_out:text_file; {the terminal, considered as an output file}
+@y
+into the |buffer| array. The |tty| file is used for terminal input and
+terminal output.
+
+@d term_in==tty {the terminal, considered as an input file}
+@d term_out==tty {the terminal, considered as an output file}
+
+@<Glob...@>=
+@!buffer:array[0..terminal_line_length] of ASCII_code;
+@z
+
+@x [59]
+begin update_terminal; reset(term_in);
+@y
+begin update_terminal;
+@z
+
+@x [61]
+begin rewrite(term_out); {prepare the terminal for output}
+write_ln(term_out,banner);@/
+@y
+begin
+ print('GF file name: ');
+ read_ln(tty,gf_name);
+@z \ No newline at end of file
diff --git a/obsolete/systems/knuth/unsupported/mfware/gftype.vms-changes b/obsolete/systems/knuth/unsupported/mfware/gftype.vms-changes
new file mode 100644
index 0000000000..5d94b14052
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/mfware/gftype.vms-changes
@@ -0,0 +1,301 @@
+GFtype change file for Vax/VMS.
+Based on DVItype change file for Vax/VMS, copyright 1983 by David Fuchs.
+08Aug84 Jane Colman
+
+@x
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iftrue
+\def\title{GF$\,$\lowercase{type} changes for Vax/VMS}
+@z
+
+@x
+@d banner=='This is GFtype, Version 2.2' {printed when the program starts}
+@y
+@d banner=='This is GFtype, Vax/VMS Version 2.2'
+@z
+
+@x
+@d othercases == others: {default for cases not listed explicitly}
+@y
+@d othercases == otherwise {Vax/VMS default for cases not listed explicitly}
+@z
+
+@x
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+@d print_nl==write_ln
+@y
+@d print(#)==write(type_file,#)
+@d print_ln(#)==write_ln(type_file,#)
+@d print_nl==write_ln(type_file)
+@z
+
+@x
+@p program GF_type(@!gf_file,@!output);
+@y
+@p program GF_type(@!gf_file,@!type_file,@!input,@!output);
+@z
+
+@x
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ begin print_ln(banner);@/
+@y
+@<Procedures for initialization@>@/
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ begin
+ @<Preset initial values@>@/
+ print_ln(banner);@/
+@z
+
+@x
+@!byte_file=packed file of eight_bits; {files that contain binary data}
+@y
+{later we'll define files that contain binary data}
+@z
+
+@x
+@!gf_file:byte_file; {the stuff we are \.{GF}typing}
+@y
+@!gf_file:packed file of byte_block; {the stuff we are \.{GF}typing}
+@!gf_count:integer; {number of bytes read from current block of |gf_file|}
+@z
+
+@x
+begin reset(gf_file);
+@y
+begin reset(gf_file);
+gf_count:=0;
+@z
+
+@x
+@p function get_byte:integer; {returns the next byte, unsigned}
+var b:eight_bits;
+begin if eof(gf_file) then get_byte:=0
+else begin read(gf_file,b); incr(cur_loc); get_byte:=b;
+ end;
+end;
+@#
+function get_two_bytes:integer; {returns the next two bytes, unsigned}
+var a,@!b:eight_bits;
+begin read(gf_file,a); read(gf_file,b);
+cur_loc:=cur_loc+2;
+get_two_bytes:=a*256+b;
+end;
+@#
+function get_three_bytes:integer; {returns the next three bytes, unsigned}
+var a,@!b,@!c:eight_bits;
+begin read(gf_file,a); read(gf_file,b); read(gf_file,c);
+cur_loc:=cur_loc+3;
+get_three_bytes:=(a*256+b)*256+c;
+end;
+@#
+function signed_quad:integer; {returns the next four bytes, signed}
+var a,@!b,@!c,@!d:eight_bits;
+begin read(gf_file,a); read(gf_file,b); read(gf_file,c); read(gf_file,d);
+cur_loc:=cur_loc+4;
+if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
+else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+end;
+@y
+@d read_gf_file(#)==begin
+ if gf_count=VAX_block_length then begin
+ get(gf_file,@=error:=continue@>); gf_count:=0;
+ end;
+ #:=gf_file^[gf_count];
+ incr(gf_count);
+ end
+
+@p function get_byte:integer; {returns the next byte, unsigned}
+var b:eight_bits;
+begin if eof(gf_file) then get_byte:=0
+else begin read_gf_file(b); incr(cur_loc); get_byte:=b;
+ end;
+end;
+@#
+function get_two_bytes:integer; {returns the next two bytes, unsigned}
+var a,@!b:eight_bits;
+begin read_gf_file(a); read_gf_file(b);
+cur_loc:=cur_loc+2;
+get_two_bytes:=a*256+b;
+end;
+@#
+function get_three_bytes:integer; {returns the next three bytes, unsigned}
+var a,@!b,@!c:eight_bits;
+begin read_gf_file(a); read_gf_file(b); read_gf_file(c);
+cur_loc:=cur_loc+3;
+get_three_bytes:=(a*256+b)*256+c;
+end;
+@#
+function signed_quad:integer; {returns the next four bytes, signed}
+var a,@!b,@!c,@!d:eight_bits;
+begin read_gf_file(a); read_gf_file(b); read_gf_file(c); read_gf_file(d);
+cur_loc:=cur_loc+4;
+if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
+else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+end;
+@z
+
+@x
+and |term_out| for terminal output.
+@^system dependencies@>
+
+@<Glob...@>=
+@!buffer:array[0..terminal_line_length] of ASCII_code;
+@!term_in:text_file; {the terminal, considered as an input file}
+@!term_out:text_file; {the terminal, considered as an output file}
+@y
+and |term_out| for terminal output.
+@^system dependencies@>
+
+@d term_in==input {the terminal, considered as an input file}
+@d term_out==output {the terminal, considered as an output file}
+
+@<Glob...@>=
+@!buffer:array[0..terminal_line_length] of ASCII_code;
+@z
+
+@x
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@y
+On Vax/VMS, this is actually not necessary in this context, since
+|update_terminal| is always called just before a |read|.
+
+@d update_terminal == {the terminal output buffer is emptied by |read|}
+@z
+
+@x
+begin update_terminal; reset(term_in);
+if eoln(term_in) then read_ln(term_in);
+k:=0;
+while (k<terminal_line_length)and not eoln(term_in) do
+ begin buffer[k]:=xord[term_in^]; incr(k); get(term_in);
+ end;
+buffer[k]:=" ";
+@y
+begin update_terminal;
+k:=0;
+while (k<terminal_line_length)and not eoln(term_in) do
+ begin buffer[k]:=xord[term_in^]; incr(k); get(term_in);
+ end;
+buffer[k]:=" ";
+read_ln(term_in);
+@z
+
+@x
+final_end:end.
+@y
+close(type_file,@=disposition:=save@>,@=error:=continue@>);
+final_end:end.
+@z
+
+@x
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{GFtype} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@y
+Here are the remaining changes to the program
+that are necessary to make \.{GFtype} work on Vax/VMS.
+
+@<Const...@>==
+@!VAX_block_length=512;
+
+@ @<Types...@>==
+@!byte_block=packed array [0..VAX_block_length-1] of 0..255;
+
+@ On Vax/VMS we need the following special definitions, types, variables
+and procedures to be able to get the file name from the command line,
+or to prompt for them.
+
+@d VAX_volatile==@=volatile@>
+@d VAX_immed==@=%immed @>
+@d VAX_external==@=external@>
+@d VAX_stdescr==@=%stdescr @>
+@d VAX_lib_get_foreign==@= lib$get_foreign@>
+@d VAX_length==@=length @>
+
+@ @<Types...@>=
+@!sixteen_bits= 0..65535;
+
+@ @<Glob...@>==
+@!type_file: text;
+@!command_line:packed array[1..300] of char;
+@!cmd_len:sixteen_bits;
+@!cmd_i:integer;
+@!file_name,@!def_file_name:varying [300] of char;
+@!ask,@!got_file_name: boolean;
+
+@ @<Preset init...@>=
+open(output,'SYS$OUTPUT',@=error:=continue@>); {FIX ME! JUNK FOR RUN-TIME BUG}
+
+cmd_i:=0;
+VAX_lib_get_foreign(command_line,,cmd_len,cmd_i);
+cmd_i:=1; while (cmd_i<=cmd_len) and (command_line[cmd_i]=' ') do incr(cmd_i);
+got_file_name:=cmd_i<=cmd_len;
+if got_file_name then
+ def_file_name:=substr(command_line,cmd_i,cmd_len-cmd_i+1);
+
+if got_file_name then begin
+ file_name:=def_file_name+'.GF';
+ open(gf_file,file_name,@=readonly@>, @=error:=continue@>);
+ ask:=status(gf_file)<>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end
+else ask:=true;
+while ask do begin
+ got_file_name:=false;
+ write('GF file: ');
+ if eof then goto 9999;
+ read_ln(file_name);
+ open(gf_file,file_name,@=readonly@>, @=error:=continue@>);
+ ask:=status(gf_file)<>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end;
+
+if got_file_name then begin
+ cmd_i:=1;
+ for cmd_len:=1 to def_file_name.VAX_length do
+ if (def_file_name[cmd_len]=']')
+ or (def_file_name[cmd_len]=':')
+ then cmd_i:=cmd_len+1;
+ if cmd_i<=def_file_name.VAX_length then
+ def_file_name:=substr(def_file_name,cmd_i,
+ def_file_name.VAX_length-cmd_i+1);
+ file_name:=def_file_name+'.TYP';
+ open(type_file,file_name,@=new,32767,disposition:=delete@>,
+ @=error:=continue@>);
+ ask:=status(type_file)>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end
+else ask:=true;
+while ask do begin
+ write('TYPE file: ');
+ if eof then goto 9999;
+ read_ln(file_name);
+ if file_name.VAX_length=0 then file_name:='SYS$OUTPUT';
+ open(type_file,file_name,@=new,32767,disposition:=delete@>,
+ @=error:=continue@>);
+ ask:=status(type_file)>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end;
+rewrite(type_file);
+
+@ Here is the library procedure that gets the user's command line.
+
+@<Procedures for ...@>=
+[VAX_external] function VAX_lib_get_foreign(
+ VAX_stdescr cmdlin:[VAX_volatile] packed array [$l1..$u1:integer] of char
+ := VAX_immed 0;
+ VAX_stdescr prompt:[VAX_volatile] packed array [$l2..$u2:integer] of char
+ := VAX_immed 0;
+ var len : [VAX_volatile] sixteen_bits := VAX_immed 0;
+ var flag : [VAX_volatile] integer := VAX_immed 0)
+ :integer; extern;
+@z
diff --git a/obsolete/systems/knuth/unsupported/mfware/pktogf.tops20-changes b/obsolete/systems/knuth/unsupported/mfware/pktogf.tops20-changes
new file mode 100644
index 0000000000..a2cf8acd49
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/mfware/pktogf.tops20-changes
@@ -0,0 +1,153 @@
+% TOPS-20 change file for PKtoGF by Tomas Rokicki. Send bug reports to
+% rokicki@sushi.stanford.edu.
+
+@x [1]
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\ttw{{\mc TOPS-20}}
+\def\title{PKtoGF changes for \ttw}
+@z
+
+@x [4]
+@d banner=='This is PKtoGF, Version 1.0'
+@y
+@d banner=='This is PKtoGF, TOPS-20 Version 1.0'
+@z
+
+@x [6]
+@d print_ln(#)==write_ln(output,#)
+@d print(#)==write(output,#)
+@y
+@d print_ln(#)==write_ln(tty,#)
+@d print(#)==write(tty,#)
+@z
+
+@x [6]
+@p program PKtoGF(input, output);
+@y
+@p program PKtoGF;
+@z
+
+@x [8]
+@<Constants...@>=
+@y
+@<Constants...@>=
+@!max_rescan=200; {maximum length of a command line}
+@z
+
+@x [56]
+@p procedure open_gf_file; {prepares to write packed bytes in a |gf_file|}
+begin rewrite(gf_file,gf_name);
+gf_loc := 0 ;
+end;
+@#
+procedure open_pk_file; {prepares the input for reading}
+begin reset(pk_file,pk_name);
+pk_loc := 0 ;
+end;
+@y
+@p procedure open_gf_file; {prepares to write packed bytes in a |gf_file|}
+begin rewrite(gf_file,gf_name,'/O/B:8');
+gf_loc := 0 ;
+end;
+@#
+procedure open_pk_file; {prepares the input for reading}
+begin reset(pk_file,pk_name,'/O/B:8');
+pk_loc := 0 ;
+end;
+@z
+
+@x [92]
+@d get_line(#) == if eoln(input) then read_ln(input) ;
+ i := 1 ;
+ while not (eoln(input) or eof(input)) do begin
+ #[i] := input^ ;
+ incr(i) ;
+ get(input) ;
+ end ;
+ #[i] := ' '
+@y
+@d get_line(#) == if eoln(tty) then read_ln(tty) ;
+ i := 1 ;
+ while not (eoln(tty) or eof(tty)) do begin
+ #[i] := tty^ ;
+ incr(i) ;
+ get(tty) ;
+ end ;
+ #[i] := ' '
+@z
+
+@x [96]
+initialize ;
+dialog ;
+@y
+initialize ;
+startup := true ;
+@<Get command line and check for file names@> ;
+if not startup then dialog ;
+@z
+
+@x [99]
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{PKtoGF} work at a particular installation.
+Any additional routines should be inserted here.
+@^system dependencies@>
+@y
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{PKtoGF} work at a particular installation.
+Any additional routines should be inserted here.
+@^system dependencies@>
+
+We call a system procedure to put the command line into the input buffer.
+We then read it in, skipping over the program name to the first blank.
+
+@d RSCAN=@'500 {ReSCAN buffer JSYS}
+
+@<Get command line and check for file names@>=
+jsys(RSCAN,1,i;0;j); {get the command line}
+if (i<>2) or (j<=0) then startup := false
+else begin
+ if eoln(tty) then read_ln(tty); {for some TOPS-20's}
+ read(tty,rescan_buffer:rescan_len); {read in rescan buffer}
+ if rescan_len>max_rescan then abort('command line too long!');
+ read_ln(tty);
+ if rescan_len=j-2 then startup := false
+ else begin
+ i:=1; while rescan_buffer[i]>' 'do incr(i); {skip invocation}
+ while(i<=rescan_len) and (rescan_buffer[i]=' ')do incr(i); {skip spaces}
+ if i>rescan_len then startup := false
+ else begin
+ for j := 1 to name_length do begin
+ pk_name[j] := ' ' ; gf_name[j] := ' ' ;
+ end ;
+ j := 1 ;
+ last_ext := -1 ;
+ while ( i <= rescan_len ) and ( rescan_buffer[i] <> ' ' ) and
+ ( rescan_buffer[i] <> '/' ) do begin
+ pk_name[j] := rescan_buffer[i] ;
+ gf_name[j] := rescan_buffer[i] ;
+ if (rescan_buffer[i] = '.') and (last_ext = -1) then last_ext := j ;
+ if rescan_buffer[i] in [':',']','>'] then last_ext := -1 ;
+ incr(j) ; incr(i) ;
+ end ;
+ if last_ext = -1 then begin
+ last_ext := j ;
+ pk_name[j] := '.' ; pk_name[j+1] := 'p' ; pk_name[j+2] := 'k' ;
+ end ;
+ gf_name[last_ext] := '.' ; gf_name[last_ext+1] := 'g' ;
+ gf_name[last_ext+2] := 'f' ;
+ for i := last_ext+3 to name_length do gf_name[i] := ' ' ;
+ end ;
+ end ;
+end
+
+@ @<Glob...@>=
+@!rescan_buffer:packed array[1..max_rescan] of char;
+@!rescan_len:integer;
+@!startup : boolean ; {did we have a file name?}
+@!last_ext : integer ; {where was the dot?}
+@z
diff --git a/obsolete/systems/knuth/unsupported/mfware/pktogf.web b/obsolete/systems/knuth/unsupported/mfware/pktogf.web
new file mode 100644
index 0000000000..8fc8a0256f
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/mfware/pktogf.web
@@ -0,0 +1,1727 @@
+% PKtoGF.web
+%
+% PKtoGF creates a generic font file from a packed pixel file.
+%
+% Preliminary 0.0 version: January, 1988
+% Fixed bug to include specials in character (1.0): January 1988
+% Cleaned up description (bitweight errors) no version change: July 1990
+% Fixed bug with empty character setting min_n to 1 (1.1): 19 October 1990
+\def\versiondate{19 October 1990}
+%
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like PASCAL
+\font\logo=logo10 % font used for the METAFONT logo
+\def\MF{{\logo META}\-{\logo FONT}}
+\def\PASCAL{{\mc Pascal}}
+\def\tamu{Texas A\char38 M}
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index
+\def\title{PKtoGF}
+\def\contentspagenumber{0}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont PKtoGF} processor}
+ \vskip 15pt
+ \centerline{(Version 1.1, \versiondate)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ The preparation of this report
+ was supported in part by the National Science
+ Foundation under grants IST-8201926 and MCS-8300984,
+ and by the System Development Foundation. `\TeX' is a
+ trademark of the American Mathematical Society.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+This program takes a packed, or \.{PK} file, and converts it into the
+standard \.{GF} format. The resulting \.{GF} file is standard in
+every way, and is essentially identical to the \.{GF} file from which
+the \.{PK} file was produced in the first place. Note that, however,
+\.{GF} to \.{PK} to \.{GF} is not an exact identity transformation, as
+the new \.{GF} file will have a different preamble string and the actual
+minimum bounding box will be used, instead of a possibly larger bounding
+box in the original \.{GF} file.
+
+@ The |banner| string defined here should be changed whenever \.{PKtoGF}
+gets modified. You should update the preamble comment as well.
+
+@d banner=='This is PKtoGF, Version 1.1'
+ {printed when the program starts}
+@d preamble_comment=='PKtoGF 1.1 output'
+@d comm_length==17
+
+@ This program is written in standard \PASCAL, except where it is necessary
+to use extensions; for example, \.{PKtoGF} must read files whose names
+are dynamically specified, and that would be impossible in pure \PASCAL.
+
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+
+@ Both the input and output come from binary files. On line interaction
+is handled through \PASCAL's standard |input| and |output| files.
+
+@d print_ln(#)==write_ln(output,#)
+@d print(#)==write(output,#)
+
+@p program PKtoGF(input, output);
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ begin print_ln(banner);@/
+ @<Set initial values@>@/
+ end;
+
+@ If the program has to stop prematurely, it goes to the
+`|final_end|'.
+
+@d final_end=9999 {label for the end of it all}
+
+@<Labels...@>=final_end;
+
+@ These constants determine the maximum length of a file name and the length
+of the terminal line, as well as the maximum number of run counts allowed
+per line of the \.{GF} file. (We need this to implement repeat counts.)
+@^system dependancies@>
+
+@<Constants...@>=
+@!name_length=80; {maximum length of a file name}
+@!terminal_line_length=132; {maximum length of an input line}
+@!max_counts=400; {maximum number of run counts in a raster line}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d do_nothing == {empty statement}
+
+@ It is possible that a malformed packed file (heaven forbid!) or some other
+error might be detected by this program. Such errors might occur in a deeply
+nested procedure, so the procedure called |jump_out| has been added to transfer
+to the very end of the program with an error message.
+
+@d abort(#)==begin print_ln(' ',#); jump_out; end
+
+@p procedure jump_out;
+begin goto final_end;
+end;
+
+@* The character set.
+Like all programs written with the \.{WEB} system, \.{PKtoGF} can be
+used with any character set. But it uses ASCII code internally, because
+the programming for portable input-output is easier when a fixed internal
+code is used.
+
+The next few sections of \.{PKtoGF} have therefore been copied from the
+analogous ones in the \.{WEB} system routines. They have been considerably
+simplified, since \.{PKtoGF} need not deal with the controversial
+ASCII codes less than @'40.
+
+@<Types...@>=
+@!ASCII_code=" ".."~"; {a subrange of the integers}
+
+@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
+character sets were common, so it did not make provision for lower case
+letters. Nowadays, of course, we need to deal with both upper and lower case
+alphabets in a convenient way, especially in a program like \.{GFtoPK}.
+So we shall assume that the \PASCAL\ system being used for \.{GFtoPK}
+has a character set containing at least the standard visible characters
+of ASCII code (|"!"| through |"~"|).
+
+Some \PASCAL\ compilers use the original name |char| for the data type
+associated with the characters in text files, while other \PASCAL s
+consider |char| to be a 64-element subrange of a larger data type that has
+some other name. In order to accommodate this difference, we shall use
+the name |text_char| to stand for the data type of the characters in the
+output file. We shall also assume that |text_char| consists of
+the elements |chr(first_text_char)| through |chr(last_text_char)|,
+inclusive. The following definitions should be adjusted if necessary.
+@^system dependencies@>
+
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=127 {ordinal number of the largest element of |text_char|}
+
+@<Types...@>=
+@!text_file=packed file of text_char;
+
+@ The \.{GFtoPK} processor converts between ASCII code and
+the user's external character set by means of arrays |xord| and |xchr|
+that are analogous to \PASCAL's |ord| and |chr| functions.
+
+@<Globals...@>=
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [0..255] of text_char;
+ {specifies conversion of output characters}
+
+@ Under our assumption that the visible characters of standard ASCII are
+all present, the following assignment statements initialize the
+|xchr| array properly, without needing any system-dependent changes.
+
+@<Set init...@>=
+for i:=0 to @'37 do xchr[i]:='?';
+xchr[@'40]:=' ';
+xchr[@'41]:='!';
+xchr[@'42]:='"';
+xchr[@'43]:='#';
+xchr[@'44]:='$';
+xchr[@'45]:='%';
+xchr[@'46]:='&';
+xchr[@'47]:='''';@/
+xchr[@'50]:='(';
+xchr[@'51]:=')';
+xchr[@'52]:='*';
+xchr[@'53]:='+';
+xchr[@'54]:=',';
+xchr[@'55]:='-';
+xchr[@'56]:='.';
+xchr[@'57]:='/';@/
+xchr[@'60]:='0';
+xchr[@'61]:='1';
+xchr[@'62]:='2';
+xchr[@'63]:='3';
+xchr[@'64]:='4';
+xchr[@'65]:='5';
+xchr[@'66]:='6';
+xchr[@'67]:='7';@/
+xchr[@'70]:='8';
+xchr[@'71]:='9';
+xchr[@'72]:=':';
+xchr[@'73]:=';';
+xchr[@'74]:='<';
+xchr[@'75]:='=';
+xchr[@'76]:='>';
+xchr[@'77]:='?';@/
+xchr[@'100]:='@@';
+xchr[@'101]:='A';
+xchr[@'102]:='B';
+xchr[@'103]:='C';
+xchr[@'104]:='D';
+xchr[@'105]:='E';
+xchr[@'106]:='F';
+xchr[@'107]:='G';@/
+xchr[@'110]:='H';
+xchr[@'111]:='I';
+xchr[@'112]:='J';
+xchr[@'113]:='K';
+xchr[@'114]:='L';
+xchr[@'115]:='M';
+xchr[@'116]:='N';
+xchr[@'117]:='O';@/
+xchr[@'120]:='P';
+xchr[@'121]:='Q';
+xchr[@'122]:='R';
+xchr[@'123]:='S';
+xchr[@'124]:='T';
+xchr[@'125]:='U';
+xchr[@'126]:='V';
+xchr[@'127]:='W';@/
+xchr[@'130]:='X';
+xchr[@'131]:='Y';
+xchr[@'132]:='Z';
+xchr[@'133]:='[';
+xchr[@'134]:='\';
+xchr[@'135]:=']';
+xchr[@'136]:='^';
+xchr[@'137]:='_';@/
+xchr[@'140]:='`';
+xchr[@'141]:='a';
+xchr[@'142]:='b';
+xchr[@'143]:='c';
+xchr[@'144]:='d';
+xchr[@'145]:='e';
+xchr[@'146]:='f';
+xchr[@'147]:='g';@/
+xchr[@'150]:='h';
+xchr[@'151]:='i';
+xchr[@'152]:='j';
+xchr[@'153]:='k';
+xchr[@'154]:='l';
+xchr[@'155]:='m';
+xchr[@'156]:='n';
+xchr[@'157]:='o';@/
+xchr[@'160]:='p';
+xchr[@'161]:='q';
+xchr[@'162]:='r';
+xchr[@'163]:='s';
+xchr[@'164]:='t';
+xchr[@'165]:='u';
+xchr[@'166]:='v';
+xchr[@'167]:='w';@/
+xchr[@'170]:='x';
+xchr[@'171]:='y';
+xchr[@'172]:='z';
+xchr[@'173]:='{';
+xchr[@'174]:='|';
+xchr[@'175]:='}';
+xchr[@'176]:='~';
+for i:=@'177 to 255 do xchr[i]:='?';
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|.
+
+@<Set init...@>=
+for i:=first_text_char to last_text_char do xord[chr(i)]:=@'40;
+for i:=" " to "~" do xord[xchr[i]]:=i;
+
+@* Generic font file format.
+The most important output produced by a typical run of \MF\ is the
+``generic font'' (\.{GF}) file that specifies the bit patterns of the
+characters that have been drawn. The term {\sl generic\/} indicates that
+this file format doesn't match the conventions of any name-brand manufacturer;
+but it is easy to convert \.{GF} files to the special format required by
+almost all digital phototypesetting equipment. There's a strong analogy
+between the \.{DVI} files written by \TeX\ and the \.{GF} files written
+by \MF; and, in fact, the file formats have a lot in common.
+
+A \.{GF} file is a stream of 8-bit bytes that may be
+regarded as a series of commands in a machine-like language. The first
+byte of each command is the operation code, and this code is followed by
+zero or more bytes that provide parameters to the command. The parameters
+themselves may consist of several consecutive bytes; for example, the
+`|boc|' (beginning of character) command has six parameters, each of
+which is four bytes long. Parameters are usually regarded as nonnegative
+integers; but four-byte-long parameters can be either positive or
+negative, hence they range in value from $-2^{31}$ to $2^{31}-1$.
+As in \.{TFM} files, numbers that occupy
+more than one byte position appear in BigEndian order,
+and negative numbers appear in two's complement notation.
+
+A \.{GF} file consists of a ``preamble,'' followed by a sequence of one or
+more ``characters,'' followed by a ``postamble.'' The preamble is simply a
+|pre| command, with its parameters that introduce the file; this must come
+first. Each ``character'' consists of a |boc| command, followed by any
+number of other commands that specify ``black'' pixels,
+followed by an |eoc| command. The characters appear in the order that \MF\
+generated them. If we ignore no-op commands (which are allowed between any
+two commands in the file), each |eoc| command is immediately followed by a
+|boc| command, or by a |post| command; in the latter case, there are no
+more characters in the file, and the remaining bytes form the postamble.
+Further details about the postamble will be explained later.
+
+Some parameters in \.{GF} commands are ``pointers.'' These are four-byte
+quantities that give the location number of some other byte in the file;
+the first file byte is number~0, then comes number~1, and so on.
+
+@ The \.{GF} format is intended to be both compact and easily interpreted
+by a machine. Compactness is achieved by making most of the information
+relative instead of absolute. When a \.{GF}-reading program reads the
+commands for a character, it keeps track of two quantities: (a)~the current
+column number,~|m|; and (b)~the current row number,~|n|. These are 32-bit
+signed integers, although most actual font formats produced from \.{GF}
+files will need to curtail this vast range because of practical
+limitations. (\MF\ output will never allow $\vert m\vert$ or $\vert
+n\vert$ to get extremely large, but the \.{GF} format tries to be more
+general.)
+
+How do \.{GF}'s row and column numbers correspond to the conventions
+of \TeX\ and \MF? Well, the ``reference point'' of a character, in \TeX's
+view, is considered to be at the lower left corner of the pixel in row~0
+and column~0. This point is the intersection of the baseline with the left
+edge of the type; it corresponds to location $(0,0)$ in \MF\ programs.
+Thus the pixel in \.{GF} row~0 and column~0 is \MF's unit square, comprising
+the region of the plane whose coordinates both lie between 0 and~1. The
+pixel in \.{GF} row~|n| and column~|m| consists of the points whose \MF\
+coordinates |(x,y)| satisfy |m<=x<=m+1| and |n<=y<=n+1|. Negative values of
+|m| and~|x| correspond to columns of pixels {\sl left\/} of the reference
+point; negative values of |n| and~|y| correspond to rows of pixels {\sl
+below\/} the baseline.
+
+Besides |m| and |n|, there's also a third aspect of the current
+state, namely the @!|paint_switch|, which is always either \\{black} or
+\\{white}. Each \\{paint} command advances |m| by a specified amount~|d|,
+and blackens the intervening pixels if |paint_switch=black|; then
+the |paint_switch| changes to the opposite state. \.{GF}'s commands are
+designed so that |m| will never decrease within a row, and |n| will never
+increase within a character; hence there is no way to whiten a pixel that
+has been blackened.
+
+@ Here is a list of all the commands that may appear in a \.{GF} file. Each
+command is specified by its symbolic name (e.g., |boc|), its opcode byte
+(e.g., 67), and its parameters (if any). The parameters are followed
+by a bracketed number telling how many bytes they occupy; for example,
+`|d[2]|' means that parameter |d| is two bytes long.
+
+\yskip\hang|paint_0| 0. This is a \\{paint} command with |d=0|; it does
+nothing but change the |paint_switch| from \\{black} to \\{white} or
+vice~versa.
+
+\yskip\hang\\{paint\_1} through \\{paint\_63} (opcodes 1 to 63).
+These are \\{paint} commands with |d=1| to~63, defined as follows: If
+|paint_switch=black|, blacken |d|~pixels of the current row~|n|,
+in columns |m| through |m+d-1| inclusive. Then, in any case,
+complement the |paint_switch| and advance |m| by~|d|.
+
+\yskip\hang|paint1| 64 |d[1]|. This is a \\{paint} command with a specified
+value of~|d|; \MF\ uses it to paint when |64<=d<256|.
+
+\yskip\hang|@!paint2| 65 |d[2]|. Same as |paint1|, but |d|~can be as high
+as~65535.
+
+\yskip\hang|@!paint3| 66 |d[3]|. Same as |paint1|, but |d|~can be as high
+as $2^{24}-1$. \MF\ never needs this command, and it is hard to imagine
+anybody making practical use of it; surely a more compact encoding will be
+desirable when characters can be this large. But the command is there,
+anyway, just in case.
+
+\yskip\hang|boc| 67 |c[4]| |p[4]| |min_m[4]| |max_m[4]| |min_n[4]|
+|max_n[4]|. Beginning of a character: Here |c| is the character code, and
+|p| points to the previous character beginning (if any) for characters having
+this code number modulo 256. (The pointer |p| is |-1| if there was no
+prior character with an equivalent code.) The values of registers |m| and |n|
+defined by the instructions that follow for this character must
+satisfy |min_m<=m<=max_m| and |min_n<=n<=max_n|. (The values of |max_m| and
+|min_n| need not be the tightest bounds possible.) When a \.{GF}-reading
+program sees a |boc|, it can use |min_m|, |max_m|, |min_n|, and |max_n| to
+initialize the bounds of an array. Then it sets |m:=min_m|, |n:=max_n|, and
+|paint_switch:=white|.
+
+\yskip\hang|boc1| 68 |c[1]| |@!del_m[1]| |max_m[1]| |@!del_n[1]| |max_n[1]|.
+Same as |boc|, but |p| is assumed to be~$-1$; also |del_m=max_m-min_m|
+and |del_n=max_n-min_n| are given instead of |min_m| and |min_n|.
+The one-byte parameters must be between 0 and 255, inclusive.
+\ (This abbreviated |boc| saves 19~bytes per character, in common cases.)
+
+\yskip\hang|eoc| 69. End of character: All pixels blackened so far
+constitute the pattern for this character. In particular, a completely
+blank character might have |eoc| immediately following |boc|.
+
+\yskip\hang|skip0| 70. Decrease |n| by 1 and set |m:=min_m|,
+|paint_switch:=white|. \ (This finishes one row and begins another,
+ready to whiten the leftmost pixel in the new row.)
+
+\yskip\hang|skip1| 71 |d[1]|. Decrease |n| by |d+1|, set |m:=min_m|, and set
+|paint_switch:=white|. This is a way to produce |d| all-white rows.
+
+\yskip\hang|@!skip2| 72 |d[2]|. Same as |skip1|, but |d| can be as large
+as 65535.
+
+\yskip\hang|@!skip3| 73 |d[3]|. Same as |skip1|, but |d| can be as large
+as $2^{24}-1$. \MF\ obviously never needs this command.
+
+\yskip\hang|new_row_0| 74. Decrease |n| by 1 and set |m:=min_m|,
+|paint_switch:=black|. \ (This finishes one row and begins another,
+ready to {\sl blacken\/} the leftmost pixel in the new row.)
+
+\yskip\hang|@!new_row_1| through |@!new_row_164| (opcodes 75 to 238). Same as
+|new_row_0|, but with |m:=min_m+1| through |min_m+164|, respectively.
+
+\yskip\hang|xxx1| 239 |k[1]| |x[k]|. This command is undefined in
+general; it functions as a $(k+2)$-byte |no_op| unless special \.{GF}-reading
+programs are being used. \MF\ generates \\{xxx} commands when encountering
+a \&{special} string; this occurs in the \.{GF} file only between
+characters, after the preamble, and before the postamble. However,
+\\{xxx} commands might appear anywhere in \.{GF} files generated by other
+processors. It is recommended that |x| be a string having the form of a
+keyword followed by possible parameters relevant to that keyword.
+
+\yskip\hang|@!xxx2| 240 |k[2]| |x[k]|. Like |xxx1|, but |0<=k<65536|.
+
+\yskip\hang|xxx3| 241 |k[3]| |x[k]|. Like |xxx1|, but |0<=k<@t$2^{24}$@>|.
+\MF\ uses this when sending a \&{special} string whose length exceeds~255.
+
+\yskip\hang|@!xxx4| 242 |k[4]| |x[k]|. Like |xxx1|, but |k| can be
+ridiculously large; |k| mustn't be negative.
+
+\yskip\hang|yyy| 243 |y[4]|. This command is undefined in general;
+it functions as a 5-byte |no_op| unless special \.{GF}-reading programs
+are being used. \MF\ puts |scaled| numbers into |yyy|'s, as a
+result of \&{numspecial} commands; the intent is to provide numeric
+parameters to \\{xxx} commands that immediately precede.
+
+\yskip\hang|no_op| 244. No operation, do nothing. Any number of |no_op|'s
+may occur between \.{GF} commands, but a |no_op| cannot be inserted between
+a command and its parameters or between two parameters.
+
+\yskip\hang|char_loc| 245 |c[1]| |dx[4]| |dy[4]| |w[4]| |p[4]|.
+This command will appear only in the postamble, which will be explained
+shortly.
+
+\yskip\hang|@!char_loc0| 246 |c[1]| |@!dm[1]| |w[4]| |p[4]|.
+Same as |char_loc|, except that |dy| is assumed to be zero, and the value
+of~|dx| is taken to be |65536*dm|, where |0<=dm<256|.
+
+\yskip\hang|pre| 247 |i[1]| |k[1]| |x[k]|.
+Beginning of the preamble; this must come at the very beginning of the
+file. Parameter |i| is an identifying number for \.{GF} format, currently
+131. The other information is merely commentary; it is not given
+special interpretation like \\{xxx} commands are. (Note that \\{xxx}
+commands may immediately follow the preamble, before the first |boc|.)
+
+\yskip\hang|post| 248. Beginning of the postamble, see below.
+
+\yskip\hang|post_post| 249. Ending of the postamble, see below.
+
+\yskip\noindent Commands 250--255 are undefined at the present time.
+
+@d gf_id_byte=131 {identifies the kind of \.{GF} files described here}
+
+@ Here are the opcodes that \.{GFtoPK} actually refers to.
+
+@d paint_0=0 {beginning of the \\{paint} commands}
+@d paint1=64 {move right a given number of columns, then
+ black${}\leftrightarrow{}$white}
+@d boc=67 {beginning of a character}
+@d boc1=68 {abbreviated |boc|}
+@d eoc=69 {end of a character}
+@d skip0=70 {skip no blank rows}
+@d skip1=71 {skip over blank rows}
+@d new_row_0=74 {move down one row and then right}
+@d max_new_row=238 {move down one row and then right}
+@d no_op=247 {noop}
+@d xxx1=239 {for \&{special} strings}
+@d yyy=243 {for \&{numspecial} numbers}
+@d nop=244 {no operation}
+@d char_loc=245 {character locators in the postamble}
+@d char_loc0=246 {character locators in the postamble}
+@d pre=247 {preamble}
+@d post=248 {postamble beginning}
+@d post_post=249 {postamble ending}
+@d undefined_commands==250,251,252,253,254,255
+
+@ The last character in a \.{GF} file is followed by `|post|'; this command
+introduces the postamble, which summarizes important facts that \MF\ has
+accumulated. The postamble has the form
+$$\vbox{\halign{\hbox{#\hfil}\cr
+ |post| |p[4]| |@!ds[4]| |@!cs[4]| |@!hppp[4]| |@!vppp[4]|
+ |@!min_m[4]| |@!max_m[4]| |@!min_n[4]| |@!max_n[4]|\cr
+ $\langle\,$character locators$\,\rangle$\cr
+ |post_post| |q[4]| |i[1]| 223's$[{\G}4]$\cr}}$$
+Here |p| is a pointer to the byte following the final |eoc| in the file
+(or to the byte following the preamble, if there are no characters);
+it can be used to locate the beginning of \\{xxx} commands
+that might have preceded the postamble. The |ds| and |cs| parameters
+@^design size@> @^check sum@>
+give the design size and check sum, respectively, which are exactly the
+values put into the header of any \.{TFM} file that shares information with
+this \.{GF} file. Parameters |hppp| and |vppp| are the ratios of
+pixels per point, horizontally and vertically, expressed as |scaled| integers
+(i.e., multiplied by $2^{16}$); they can be used to correlate the font
+with specific device resolutions, magnifications, and ``at sizes.'' Then
+come |min_m|, |max_m|, |min_n|, and |max_n|, which bound the values that
+registers |m| and~|n| assume in all characters in this \.{GF} file.
+(These bounds need not be the best possible; |max_m| and |min_n| may, on the
+other hand, be tighter than the similar bounds in |boc| commands. For
+example, some character may have |min_n=-100| in its |boc|, but it might
+turn out that |n| never gets lower than |-50| in any character; then
+|min_n| can have any value |<=-50|. If there are no characters in the file,
+it's possible to have |min_m>max_m| and/or |min_n>max_n|.)
+
+@ Character locators are introduced by |char_loc| commands,
+which specify a character residue~|c|, character escapements (|dx,dy|),
+a character width~|w|, and a pointer~|p|
+to the beginning of that character. (If two or more characters have the
+same code~|c| modulo 256, only the last will be indicated; the others can be
+located by following backpointers. Characters whose codes differ by a
+multiple of 256 are assumed to share the same font metric information,
+hence the \.{TFM} file contains only residues of character codes modulo~256.
+This convention is intended for oriental languages, when there are many
+character shapes but few distinct widths.)
+@^oriental characters@>@^Chinese characters@>@^Japanese characters@>
+
+The character escapements (|dx,dy|) are the values of \MF's \&{chardx}
+and \&{chardy} parameters; they are in units of |scaled| pixels;
+i.e., |dx| is in horizontal pixel units times $2^{16}$, and |dy| is in
+vertical pixel units times $2^{16}$. This is the intended amount of
+displacement after typesetting the character; for \.{DVI} files, |dy|
+should be zero, but other document file formats allow nonzero vertical
+escapement.
+
+The character width~|w| duplicates the information in the \.{TFM} file; it
+is $2^{24}$ times the ratio of the true width to the font's design size.
+
+The backpointer |p| points to the character's |boc|, or to the first of
+a sequence of consecutive \\{xxx} or |yyy| or |no_op| commands that
+immediately precede the |boc|, if such commands exist; such ``special''
+commands essentially belong to the characters, while the special commands
+after the final character belong to the postamble (i.e., to the font
+as a whole). This convention about |p| applies also to the backpointers
+in |boc| commands, even though it wasn't explained in the description
+of~|boc|. @^backpointers@>
+
+Pointer |p| might be |-1| if the character exists in the \.{TFM} file
+but not in the \.{GF} file. This unusual situation can arise in \MF\ output
+if the user had |proofing<0| when the character was being shipped out,
+but then made |proofing>=0| in order to get a \.{GF} file.
+
+@ The last part of the postamble, following the |post_post| byte that
+signifies the end of the character locators, contains |q|, a pointer to the
+|post| command that started the postamble. An identification byte, |i|,
+comes next; this currently equals~131, as in the preamble.
+
+The |i| byte is followed by four or more bytes that are all equal to
+the decimal number 223 (i.e., @'337 in octal). \MF\ puts out four to seven of
+these trailing bytes, until the total length of the file is a multiple of
+four bytes, since this works out best on machines that pack four bytes per
+word; but any number of 223's is allowed, as long as there are at least four
+of them. In effect, 223 is a sort of signature that is added at the very end.
+@^Fuchs, David Raymond@>
+
+This curious way to finish off a \.{GF} file makes it feasible for
+\.{GF}-reading programs to find the postamble first, on most computers,
+even though \MF\ wants to write the postamble last. Most operating
+systems permit random access to individual words or bytes of a file, so
+the \.{GF} reader can start at the end and skip backwards over the 223's
+until finding the identification byte. Then it can back up four bytes, read
+|q|, and move to byte |q| of the file. This byte should, of course,
+contain the value 248 (|post|); now the postamble can be read, so the
+\.{GF} reader can discover all the information needed for individual
+characters.
+
+Unfortunately, however, standard \PASCAL\ does not include the ability to
+@^system dependencies@>
+access a random position in a file, or even to determine the length of a file.
+Almost all systems nowadays provide the necessary capabilities, so \.{GF}
+format has been designed to work most efficiently with modern operating
+systems. \.{GFtoPK} first reads the postamble, and then scans the file from
+front to back.
+
+@* Packed file format.
+The packed file format is a compact representation of the data contained in a
+\.{GF} file. The information content is the same, but packed (\.{PK}) files
+are almost always less than half the size of their \.{GF} counterparts. They
+are also easier to convert into a raster representation because they do not
+have a profusion of \\{paint}, \\{skip}, and \\{new\_row} commands to be
+separately interpreted. In addition, the \.{PK} format expressedly forbids
+\&{special} commands within a character. The minimum bounding box for each
+character is explicit in the format, and does not need to be scanned for as in
+the \.{GF} format. Finally, the width and escapement values are combined with
+the raster information into character ``packets'', making it simpler in many
+cases to process a character.
+
+A \.{PK} file is organized as a stream of 8-bit bytes. At times, these bytes
+might be split into 4-bit nybbles or single bits, or combined into multiple
+byte parameters. When bytes are split into smaller pieces, the `first' piece
+is always the most significant of the byte. For instance, the first bit of
+a byte is the bit with value 128; the first nybble can be found by dividing
+a byte by 16. Similarly, when bytes are combined into multiple byte
+parameters, the first byte is the most significant of the parameter. If the
+parameter is signed, it is represented by two's-complement notation.
+
+The set of possible eight-bit values are separated into two sets, those that
+introduce a character definition, and those that do not. The values that
+introduce a character definition comprise the range from 0 to 239; byte values
+above 239 are interpreted commands. Bytes which introduce character
+definitions are called flag bytes, and various fields within the byte indicate
+various things about how the character definition is encoded. Command bytes
+have zero or more parameters, and can never appear within a character
+definition or between parameters of another command, where they would be
+interpeted as data.
+
+A \.{PK} file consists of a preamble, followed by a sequence of one or more
+character definitions, followed by a postamble. The preamble command must
+be the first byte in the file, followed immediately by its parameters.
+Any number of character definitions may follow, and any command but the
+preamble command and the postamble command may occur between character
+definitions. The very last command in the file must be the postamble.
+
+@ The packed file format is intended to be easy to read and interpret by
+device drivers. The small size of the file reduces the input/output overhead
+each time a font is defined. For those drivers that load and save each font
+file into memory, the small size also helps reduce the memory requirements.
+The length of each character packet is specified, allowing the character raster
+data to be loaded into memory by simply counting bytes, rather than
+interpreting each command; then, each character can be interpreted on a demand
+basis. This also makes it possible for a driver to skip a particular
+character quickly if it knows that the character is unused.
+
+@ First, the command bytes shall be presented; then the format of the
+character definitions will be defined. Eight of the possible sixteen
+commands (values 240 through 255) are currently defined; the others are
+reserved for future extensions. The commands are listed below. Each command
+is specified by its symbolic name (e.g., \\{pk\_no\_op}), its opcode byte,
+and any parameters. The parameters are followed by a bracketed number
+telling how many bytes they occupy, with the number preceded by a plus sign if
+it is a signed quantity. (Four byte quantities are always signed, however.)
+
+\yskip\hang|pk_xxx1| 240 |k[1]| |x[k]|. This command is undefined in general;
+it functions as a $(k+2)$-byte \\{no\_op} unless special \.{PK}-reading
+programs are being used. \MF\ generates \\{xxx} commands when encountering
+a \&{special} string. It is recommended that |x| be a string having the form
+of a keyword followed by possible parameters relevant to that keyword.
+
+\yskip\hang\\{pk\_xxx2} 241 |k[2]| |x[k]|. Like |pk_xxx1|, but |0<=k<65536|.
+
+\yskip\hang\\{pk\_xxx3} 242 |k[3]| |x[k]|. Like |pk_xxx1|, but
+|0<=k<@t$2^{24}$@>|. \MF\ uses this when sending a \&{special} string whose
+length exceeds~255.
+
+\yskip\hang\\{pk\_xxx4} 243 |k[4]| |x[k]|. Like |pk_xxx1|, but |k| can be
+ridiculously large; |k| musn't be negative.
+
+\yskip\hang|pk_yyy| 244 |y[4]|. This command is undefined in general; it
+functions as a five-byte \\{no\_op} unless special \.{PK} reading programs
+are being used. \MF\ puts |scaled| numbers into |yyy|'s, as a result of
+\&{numspecial} commands; the intent is to provide numeric parameters to
+\\{xxx} commands that immediately precede.
+
+\yskip\hang|pk_post| 245. Beginning of the postamble. This command is
+followed by enough |pk_no_op| commands to make the file a multiple
+of four bytes long. Zero through three bytes are usual, but any number
+is allowed.
+This should make the file easy to read on machines which pack four bytes to
+a word.
+
+\yskip\hang|pk_no_op| 246. No operation, do nothing. Any number of
+|pk_no_op|'s may appear between \.{PK} commands, but a |pk_no_op| cannot be
+inserted between a command and its parameters, between two parameters, or
+inside a character definition.
+
+\yskip\hang|pk_pre| 247 |i[1]| |k[1]| |x[k]| |ds[4]| |cs[4]| |hppp[4]|
+|vppp[4]|. Preamble command. Here, |i| is the identification byte of the
+file, currently equal to 89. The string |x| is merely a comment, usually
+indicating the source of the \.{PK} file. The parameters |ds| and |cs| are
+the design size of the file in $1/2^{20}$ points, and the checksum of the
+file, respectively. The checksum should match the \.{TFM} file and the
+\.{GF} files for this font. Parameters |hppp| and |vppp| are the ratios
+of pixels per point, horizontally and vertically, multiplied by $2^{16}$; they
+can be used to correlate the font with specific device resolutions,
+magnifications, and ``at sizes''. Usually, the name of the \.{PK} file is
+formed by concatenating the font name (e.g., cmr10) with the resolution at
+which the font is prepared in pixels per inch multiplied by the magnification
+factor, and the letters \.{PK}. For instance, cmr10 at 300 dots per inch
+should be named CMR10.300PK; at one thousand dots per inch and magstephalf,
+it should be named CMR10.1095PK.
+
+@ We put a few of the above opcodes into definitions for symbolic use by
+this program.
+
+@d pk_id = 89 {the version of \.{PK} file described}
+@d pk_xxx1 = 240 {\&{special} commands}
+@d pk_yyy = 244 {\&{numspecial} commands}
+@d pk_post = 245 {postamble}
+@d pk_no_op = 246 {no operation}
+@d pk_pre = 247 {preamble}
+
+@ The \.{PK} format has two conflicting goals; to pack character raster and
+size information as compactly as possible, while retaining ease of translation
+into raster and other forms. A suitable compromise was found in the use of
+run-encoding of the raster information. Instead of packing the individual
+bits of the character, we instead count the number of consecutive `black' or
+`white' pixels in a horizontal raster row, and then encode this number. Run
+counts are found for each row, from the top of the character to the bottom.
+This is essentially the way the \.{GF} format works.
+Instead of presenting each row individually, however, let us concatenate all
+of the horizontal raster rows into one long string of pixels, and encode this
+row. With knowledge of the width of the bit-map, the original character glyph
+can be easily reconstructed. In addition, we do not need special commands to
+mark the end of one row and the beginning of the next.
+
+Next, let us put the burden of finding the minimum bounding box on the part
+of the font generator, since the characters will usually be used much more
+often than they are generated. The minimum bounding box is the smallest
+rectangle which encloses all `black' pixels of a character. Let us also
+eliminate the need for a special end of character marker, by supplying
+exactly as many bits as are required to fill the minimum bounding box, from
+which the end of the character is implicit.
+
+Let us next consider the distribution of the run counts. Analysis of several
+dozen pixel files at 300 dots per inch yields a distribution peaking at four,
+falling off slowly until ten, then a bit more steeply until twenty, and then
+asymptotically approaching the horizontal. Thus, the great majority of our
+run counts will fit in a four-bit nybble. The eight-bit byte is attractive for
+our run-counts, as it is the standard on many systems; however, the wasted four
+bits in the majority of cases seems a high price to pay. Another possibility
+is to use a Huffman-type encoding scheme with a variable number of bits for
+each run-count; this was rejected because of the overhead in fetching and
+examining individual bits in the file. Thus, the character raster definitions
+in the \.{PK} file format are based on the four-bit nybble.
+
+@ The analysis of the pixel files yielded another interesting statistic: fully
+37\char`\%\
+of the raster rows were duplicates of the previous row. Thus, the \.{PK}
+format allows the specification of repeat counts, which indicate how many times
+a horizontal raster row is to be repeated. These repeated rows are taken out
+of the character glyph before individual rows are concatenated into the long
+string of pixels.
+
+For elegance, we disallow a run count of zero. The case of a null raster
+description should be gleaned from the character width and height being equal
+to zero, and no raster data should be read. No other zero counts are ever
+necessary. Also, in the absence of repeat counts, the repeat value is set to
+be zero (only the original row is sent.) If a repeat count is seen, it takes
+effect on the current row. The current row is defined as the row on which the
+first pixel of the next run count will lie. The repeat count is set back to
+zero when the last pixel in the current row is seen, and the row is sent out.
+
+This poses a problem for entirely black and entirely white rows, however. Let
+us say that the current row ends with four white pixels, and then we have five
+entirely empty rows, followed by a black pixel at the beginning of the next
+row, and the character width is ten pixels. We would like to use a repeat
+count, but there is no legal place to put it. If we put it before the white
+run count, it will apply to the current row. If we put it after, it applies
+to the row with the black pixel at the beginning. Thus, entirely white or
+entirely black repeated rows are always packed as large run counts (in this
+case, a white run count of 54) rather than repeat counts.
+
+@ Now let us turn our attention to the actual packing of the run counts and
+repeat counts into nybbles. There are only sixteen possible nybble values.
+We need to indicate run counts and repeat counts. Since the run counts are
+much more common, we will devote the majority of the nybble values to them.
+We therefore indicate a repeat count by a nybble of 14 followed by a packed
+number, where a packed number will be explained later. Since the repeat
+count value of one is so common, we indicate a repeat one command by a single
+nybble of 15. A 14 followed by the packed number 1 is still legal for a
+repeat one count, however. The run counts are coded directly as packed
+numbers.
+
+For packed numbers, therefore, we have the nybble values 0 through 13. We
+need to represent the positive integers up to, say, $2^{31}-1$. We would
+like the more common smaller numbers to take only one or two nybbles, and
+the infrequent large numbers to take three or more. We could therefore
+allocate one nybble value to indicate a large run count taking three or more
+nybbles. We do this with the value 0.
+
+@ We are left with the values 1 through 13. We can allocate some of these, say
+|dyn_f|, to be one-nybble run counts.
+These will work for the run counts |1..dyn_f|. For subsequent run
+counts, we will use a nybble greater than |dyn_f|, followed by a second nybble,
+whose value can run from 0 through 15. Thus, the two-byte nybble values will
+run from |dyn_f+1..(13-dyn_f)*16+dyn_f|. We have our definition of large run
+count values now, being all counts greater than |(13-dyn_f)*16+dyn_f|.
+
+We can analyze our several dozen pixel files and determine an optimal value of
+|dyn_f|, and use this value for all of the characters. Unfortunately, values
+of |dyn_f| that pack small characters well tend to pack the large characters
+poorly, and values that pack large characters well are not efficient for the
+smaller characters. Thus, we choose the optimal |dyn_f| on a character basis,
+picking the value which will pack each individual character in the smallest
+number of nybbles. Legal values of |dyn_f| run from 0 (with no one-byte run
+counts) to 13 (with no two-byte run counts).
+
+@ Our only remaining task in the coding of packed numbers is the large run
+counts. We use a scheme suggested by D.~E.~Knuth
+@^Knuth, D.~E.@>
+which will simply and elegantly represent arbitrarily large values. The
+general scheme to represent an integer |i| is to write its hexadecimal
+representation, with leading zeros removed. Then we count the number of
+digits, and prepend one less than that many zeros before the hexadecimal
+representation. Thus, the values from one to fifteen occupy one nybble;
+the values sixteen through 255 occupy three, the values 256 through 4095
+require five, etc.
+
+For our purposes, however, we have already represented the numbers one
+through |(13-dyn_f)*16+dyn_f|. In addition, the one-nybble values have
+already been taken by our other commands, which means that only the values
+from sixteen up are available to us for long run counts. Thus, we simply
+normalize our long run counts, by subtracting |(13-dyn_f)*16+dyn_f+1| and
+adding 16, and then representing the result according to the scheme above.
+
+@ The final algorithm for decoding the run counts based on the above scheme
+might look like this, assuming a procedure called \\{pk\_nyb} is available
+to get the next nybble from the file, and assuming that the global
+|repeat_count| indicates whether a row needs to be repeated. Note that this
+routine is recursive, but since a repeat count can never directly follow
+another repeat count, it can only be recursive to one level.
+
+@<Packed number procedure@>=
+function pk_packed_num : integer ;
+var i, j, k : integer ;
+begin
+ i := get_nyb ;
+ if i = 0 then begin
+ repeat j := get_nyb ; incr(i) ; until j <> 0 ;
+ while i > 0 do begin j := j * 16 + get_nyb ; decr(i) ; end ;
+ pk_packed_num := j - 15 + (13-dyn_f)*16 + dyn_f ;
+ end else if i <= dyn_f then
+ pk_packed_num := i
+ else if i < 14 then
+ pk_packed_num := (i-dyn_f-1)*16+get_nyb+dyn_f+1
+ else begin
+ if i = 14 then
+ repeat_count := pk_packed_num
+ else
+ repeat_count := 1 ;
+ pk_packed_num := pk_packed_num ;
+ end ;
+end ;
+
+@ For low resolution fonts, or characters with `gray' areas, run encoding can
+often make the character many times larger. Therefore, for those characters
+that cannot be encoded efficiently with run counts, the \.{PK} format allows
+bit-mapping of the characters. This is indicated by a |dyn_f| value of
+14. The bits are packed tightly, by concatenating all of the horizontal raster
+rows into one long string, and then packing this string eight bits to a byte.
+The number of bytes required can be calculated by |(width*height+7) div 8|.
+This format should only be used when packing the character by run counts takes
+more bytes than this, although, of course, it is legal for any character.
+Any extra bits in the last byte should be set to zero.
+
+@ At this point, we are ready to introduce the format for a character
+descripter. It consists of three parts: a flag byte, a character preamble,
+and the raster data. The most significant four bits of the flag byte
+yield the |dyn_f| value for that character. (Notice that only values of
+0 through 14 are legal for |dyn_f|, with 14 indicating a bit mapped character;
+thus, the flag bytes do not conflict with the command bytes, whose upper nybble
+is always 15.) The next bit (with weight 8) indicates whether the first run
+count is a black count or a white count, with a one indicating a black count.
+For bit-mapped characters, this bit should be set to a zero. The next bit
+(with weight 4) indicates whether certain later parameters (referred to as size
+parameters) are given in one-byte or two-byte quantities, with a one indicating
+that they are in two-byte quantities. The last two bits are concatenated on to
+the beginning of the length parameter in the character preamble, which will be
+explained below.
+
+However, if the last three bits of the flag byte are all set (normally
+indicating that the size parameters are two-byte values and that a 3 should be
+prepended to the length parameter), then a long format of the character
+preamble should be used instead of one of the short forms.
+
+Therefore, there are three formats for the character preamble, and which one
+is used depends on the least significant three bits of the flag byte. If the
+least significant three bits are in the range zero through three, the short
+format is used. If they are in the range four through six, the extended short
+format is used. Otherwise, if the least significant bits are all set, then
+the long form of the character preamble is used. The preamble formats are
+explained below.
+
+\yskip\hang Short form: |flag[1]| |pl[1]| |cc[1]| |tfm[3]| |dm[1]| |w[1]|
+|h[1]| |hoff[+1]| |voff[+1]|.
+If this format of the character preamble is used, the above
+parameters must all fit in the indicated number of bytes, signed or unsigned
+as indicated. Almost all of the standard \TeX\ font characters fit; the few
+exceptions are fonts such as \.{aminch}.
+
+\yskip\hang Extended short form: |flag[1]| |pl[2]| |cc[1]| |tfm[3]| |dm[2]|
+|w[2]| |h[2]| |hoff[+2]| |voff[+2]|. Larger characters use this extended
+format.
+
+\yskip\hang Long form: |flag[1]| |pl[4]| |cc[4]| |tfm[4]| |dx[4]| |dy[4]|
+|w[4]| |h[4]| |hoff[4]| |voff[4]|. This is the general format which
+allows all of the
+parameters of the \.{GF} file format, including vertical escapement.
+\vskip\baselineskip
+The |flag| parameter is the flag byte. The parameter |pl| (packet length)
+contains the offset
+of the byte following this character descripter, with respect to the beginning
+of the |tfm| width parameter. This is given so a \.{PK} reading program can,
+once it has read the flag byte, packet length, and character code (|cc|), skip
+over the character by simply reading this many more bytes. For the two short
+forms of the character preamble, the last two bits of the flag byte should be
+considered the two most-significant bits of the packet length. For the short
+format, the true packet length might be calculated as |(flag mod 4)*256+pl|;
+for the extended format, it might be calculated as |(flag mod 4)*65536+pl|.
+
+The |w| parameter is the width and the |h| parameter is the height in pixels
+of the minimum bounding box. The |dx| and |dy| parameters are the horizontal
+and vertical escapements, respectively. In the short formats, |dy| is assumed
+to be zero and |dm| is |dy| but in pixels;
+in the long format, |dx| and |dy| are both
+in pixels multiplied by $2^{16}$. The |hoff| is the horizontal offset from the
+upper left pixel to the reference pixel; the |voff| is the vertical offset.
+They are both given in pixels, with right and down being positive. The
+reference pixel is the pixel which occupies the unit square in \MF; the
+\MF\ reference point is the lower left hand corner of this pixel. (See the
+example below.)
+
+@ \TeX\ requires that all characters which have the same character codes
+modulo 256 also have the same |tfm| widths, and escapement values. The \.{PK}
+format does not itself make this a requirement, but in order for the font to
+work correctly with the \TeX\ software, this constraint should be observed.
+
+
+Following the character preamble is the raster information for the
+character, packed by run counts or by bits, as indicated by the flag byte.
+If the character is packed by run counts and the required number of nybbles
+is odd, then the last byte of the raster description should have a zero
+for its least significant nybble.
+
+@ As an illustration of the \.{PK} format, the character \char4\ from the font
+amr10 at 300 dots per inch will be encoded. (Note: amr fonts are obsolete,
+and the reference to this character is retained from an older version of
+the Computer Modern fonts solely for illustration.) This character was chosen
+because it illustrates some
+of the borderline cases. The raster for the character looks like this (the
+row numbers are chosen for convenience, and are not \MF's row numbers.)
+
+\vskip\baselineskip
+\centerline{\vbox{\baselineskip=10pt
+\halign{\hfil#\quad&&\hfil#\hfil\cr
+0& & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+1& & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+2& & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+3& & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+4& & &M&M& & & & & & & & & & & & & & & & &M&M\cr
+5& & &M&M& & & & & & & & & & & & & & & & &M&M\cr
+6& & &M&M& & & & & & & & & & & & & & & & &M&M\cr
+7\cr
+8\cr
+9& & & & &M&M& & & & & & & & & & & & &M&M& & \cr
+10& & & & &M&M& & & & & & & & & & & & &M&M& & \cr
+11& & & & &M&M& & & & & & & & & & & & &M&M& & \cr
+12& & & & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M& & \cr
+13& & & & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M& & \cr
+14& & & & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M& & \cr
+15& & & & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M& & \cr
+16& & & & &M&M& & & & & & & & & & & & &M&M& & \cr
+17& & & & &M&M& & & & & & & & & & & & &M&M& & \cr
+18& & & & &M&M& & & & & & & & & & & & &M&M& & \cr
+19\cr
+20\cr
+21\cr
+22& & &M&M& & & & & & & & & & & & & & & & &M&M\cr
+23& & &M&M& & & & & & & & & & & & & & & & &M&M\cr
+24& & &M&M& & & & & & & & & & & & & & & & &M&M\cr
+25& & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+26& & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+27& & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+28&*& &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+&\hphantom{M}&\hphantom{M}\cr
+}}}
+The width of the minimum bounding box for this character is 20; its height
+is 29. The `*' represents the reference pixel; notice how it lies outside the
+minimum bounding box. The |hoff| value is $-2$, and the |voff| is~28.
+
+The first task is to calculate the run counts and repeat counts. The repeat
+counts are placed at the first transition (black to white or white to black)
+in a row, and are enclosed in brackets. White counts are enclosed in
+parentheses. It is relatively easy to generate the counts list:
+\vskip\baselineskip
+\centerline{82 [2] (16) 2 (42) [2] 2 (12) 2 (4) [3]}
+\centerline{16 (4) [2] 2 (12) 2 (62) [2] 2 (16) 82}
+\vskip\baselineskip
+Note that any duplicated rows that are not all white or all black are removed
+before the repeat counts are calculated. The rows thus removed are rows 5, 6,
+10, 11, 13, 14, 15, 17, 18, 23, and 24.
+
+@ The next step in the encoding of this character is to calculate the optimal
+value of |dyn_f|. The details of how this calculation is done are not
+important here; suffice it to say that there is a simple algorithm which in one
+pass over the count list can determine the best value of |dyn_f|. For this
+character, the optimal value turns out to be 8 (atypically low). Thus, all
+count values less than or equal to 8 are packed in one nybble; those from
+nine to $(13-8)*16+8$ or 88 are packed in two nybbles. The run encoded values
+now become (in hex, separated according to the above list):
+\vskip\baselineskip
+\centerline{\tt D9 E2 97 2 B1 E2 2 93 2 4 E3}
+\centerline{\tt 97 4 E2 2 93 2 C5 E2 2 97 D9}
+\vskip\baselineskip\noindent
+which comes to 36 nybbles, or 18 bytes. This is shorter than the 73 bytes
+required for the bit map, so we use the run count packing.
+
+@ The short form of the character preamble is used because all of the
+parameters fit in their respective lengths. The packet length is therefore
+18 bytes for the raster, plus
+eight bytes for the character preamble parameters following the character
+code, or 26. The |tfm| width for this character is 640796, or {\tt 9C71C} in
+hexadecimal. The horizontal escapement is 25 pixels. The flag byte is
+88 hex, indicating the short preamble, the black first count, and the
+|dyn_f| value of 8. The final total character packet, in hexadecimal, is:
+\vskip\baselineskip
+$$\vbox{\halign{\hfil #\quad&&{\tt #\ }\cr
+Flag byte&88\cr
+Packet length&1A\cr
+Character code&04\cr
+|tfm| width&09&C7&1C\cr
+Horizontal escapement (pixels)&19\cr
+Width of bit map&14\cr
+Height of bit map&1D\cr
+Horizontal offset (signed)&FE\cr
+Vertical offset&1C\cr
+Raster data&D9&E2&97\cr
+&2B&1E&22\cr
+&93&24&E3\cr
+&97&4E&22\cr
+&93&2C&5E\cr
+&22&97&D9\cr}}$$
+
+@ This format was written by Tomas Rokicki in August, 1985.
+
+@* Input and output.
+There are two types of files that this program must deal with---standard
+text files and files of bytes (packed files and generic font files.)
+For our purposes, we shall consider an eight-bit byte to consist of the
+values |0..255|. If your system does not pack these values to a byte, it is
+no major difficulty; you must only insure that the input function
+|pk_byte| can read packed bytes, and that the output fuunction |gf_byte|
+packs the bytes to be shipped.
+
+@<Types...@>=
+@!eight_bits=0..255; {packed file byte}
+@!byte_file=packed file of eight_bits ; {for packed file words}
+@^system dependancies@>
+
+@ @<Glob...@>=
+@!gf_file,@!pk_file:byte_file; {the I/O streams}
+@^system dependencies@>
+
+@ To prepare these files for input, we |reset| them. An extension of
+\PASCAL\ is needed in the case of |gf_file|, since we want to associate
+it with external files whose names are specified dynamically (i.e., not
+known at compile time). The following code assumes that `|reset(f,s)|'
+does this, when |f| is a file variable and |s| is a string variable that
+specifies the file name. If |eof(f)| is true immediately after
+|reset(f,s)| has acted, we assume that no file named |s| is accessible.
+@^system dependencies@>
+
+@p procedure open_gf_file; {prepares to write packed bytes in a |gf_file|}
+begin rewrite(gf_file,gf_name);
+gf_loc := 0 ;
+end;
+@#
+procedure open_pk_file; {prepares the input for reading}
+begin reset(pk_file,pk_name);
+pk_loc := 0 ;
+end;
+
+@ We need a place to store the names of the input and output files, as well
+as a byte counter for the output file.
+
+@<Glob...@>=
+@!gf_name,@!pk_name:packed array[1..name_length] of char; {names of input
+ and output files}
+@!gf_loc, @!pk_loc:integer; {how many bytes have we sent?}
+
+@ We need a procedure that will write a byte to the \.{GF} file. If the
+particular system
+@^system dependencies@>
+requires buffering, here is the place to do it.
+
+@p procedure gf_byte (i : integer) ;
+begin gf_file^ := i ;
+put(gf_file) ;
+incr(gf_loc) ;
+end;
+
+@ We also need a function that will get a single byte from the \.{PK} file.
+Again, buffering may be done in this procedure.
+
+@p function pk_byte : eight_bits ;
+var nybble, temp : eight_bits ;
+begin
+ temp := pk_file^ ;
+ get(pk_file) ;
+ pk_loc := pk_loc + 1 ;
+ pk_byte := temp ;
+end ;
+
+@ Now we are ready to open the files and write the identification of the
+pixel file.
+
+@<Open files@>=
+open_pk_file ;
+open_gf_file
+
+@ As we are reading the packed file, we often need to fetch 16 and 32 bit
+quantities. Here we have two procedures to do this.
+
+@p function signed_byte : integer ;
+var a : integer ;
+begin
+ a := pk_byte ;
+ if a > 127 then
+ a := a - 256 ;
+ signed_byte := a ;
+end ;
+@#
+function get_16 : integer ;
+var a : integer ;
+begin
+ a := pk_byte ;
+ get_16 := a * 256 + pk_byte ;
+end ;
+@#
+function signed_16 : integer ;
+var a : integer ;
+begin
+ a := signed_byte ;
+ signed_16 := a * 256 + pk_byte ;
+end ;
+@#
+function get_32 : integer ;
+var a : integer ;
+begin
+ a := get_16 ;
+ if a > 32767 then a := a - 65536 ;
+ get_32 := a * 65536 + get_16 ;
+end ;
+
+@ As we are writing the \.{GF} file, we often need to write signed and
+unsigned, one, two, three, and four-byte values. These routines give
+us that capability.
+
+@p procedure gf_sbyte(i : integer) ;
+begin
+ if i < 0 then
+ i := i + 256 ;
+ gf_byte(i) ;
+end ;
+@#
+procedure gf_16(i : integer) ;
+begin
+ gf_byte(i div 256) ;
+ gf_byte(i mod 256) ;
+end ;
+@#
+procedure gf_24(i : integer) ;
+begin
+ gf_byte(i div 65536) ;
+ gf_16(i mod 65536) ;
+end ;
+@#
+procedure gf_quad(i : integer) ;
+begin
+ if i >= 0 then begin
+ gf_byte(i div 16777216) ;
+ end else begin
+ i := (i + 1073741824) + 1073741824 ;
+ gf_byte(128 + (i div 16777216)) ;
+ end ;
+ gf_24(i mod 16777216) ;
+end ;
+
+@* Character unpacking.
+Now we deal with unpacking characters into the \.{GF} representation.
+
+@<Unpack and write character@>=
+dyn_f := flag_byte div 16 ;
+flag_byte := flag_byte mod 16 ;
+turn_on := flag_byte >= 8 ;
+if turn_on then flag_byte := flag_byte - 8 ;
+if flag_byte = 7 then
+ @<Read long character preamble@>
+else if flag_byte > 3 then
+ @<Read extended short character preamble@>
+else
+ @<Read short character preamble@> ;
+@<Calculate and check |min_m|, |max_m|, |min_n|, and |max_n|@> ;
+@<Save character locator@> ;
+@<Write character preamble@> ;
+@<Read and translate raster description@> ;
+gf_byte(eoc) ;
+last_eoc := gf_loc ;
+if end_of_packet <> pk_loc then abort('Bad pk file! Bad packet length.')
+
+@ We need a whole lot of globals used but not defined up there.
+
+@<Glob...@>=
+@!i, @!j : integer ; {index pointers}
+@!end_of_packet : integer ; {where we expect the end of the packet to be}
+@!dyn_f : integer ; {dynamic packing variable}
+@!car : integer ; {the character we are reading}
+@!tfm_width : integer ; {the TFM width of the current character}
+@!x_off, @!y_off : integer ; {the offsets for the character}
+
+@ Now we read and check the preamble of the \.{PK} file. In the preamble, we
+find the |hppp|, |design_size|, |checksum|. We write the relevant parameters
+to the \.{GF} file, including the preamble comment.
+
+@<Read preamble@>=
+if pk_byte <> pk_pre then abort('Bad pk file! pre command missing.') ;
+gf_byte(pre) ;
+if pk_byte <> pk_id then abort('Wrong version of packed file!.') ;
+gf_byte(gf_id_byte) ;
+j := pk_byte ;
+for i := 1 to j do hppp := pk_byte ;
+gf_byte(comm_length) ;
+for i := 1 to comm_length do
+ gf_byte(xord[comment[i]]) ;
+design_size := get_32 ;
+checksum := get_32 ;
+hppp := get_32 ; vppp := get_32 ;
+if hppp <> vppp then print_ln('Warning: aspect ratio not 1:1!') ;
+magnification := round(hppp * 72.27 * 5 / 65536) ;
+last_eoc := gf_loc
+
+@ Of course, we need to define the above variables.
+
+@<Glob...@>=
+@!comment : packed array[1..comm_length] of char ;
+@!magnification : integer ; {resolution at which pixel file is prepared}
+@!design_size : integer ; {design size in \.{FIXes}}
+@!checksum : integer ; {checksum of pixel file}
+@!hppp, @!vppp : integer ; {horizontal and vertical points per inch}
+
+@ @<Set init...@>=
+comment := preamble_comment ;
+
+@ Now, the character preamble reading modules. First, we have the general
+case: the long character preamble format.
+
+@<Read long character preamble@>=
+begin
+ packet_length := get_32 ; car := get_32 ;
+ end_of_packet := packet_length + pk_loc ;
+ tfm_width := get_32 ;
+ hor_esc := get_32 ;
+ ver_esc := get_32 ;
+ c_width := get_32 ;
+ c_height := get_32 ;
+ word_width := (c_width + 31) div 32 ;
+ x_off := get_32 ;
+ y_off := get_32 ;
+end
+
+@ This module reads the character preamble with double byte parameters.
+
+@<Read extended short character preamble@>=
+begin
+ packet_length := (flag_byte - 4) * 65536 + get_16 ;
+ car := pk_byte ;
+ end_of_packet := packet_length + pk_loc ;
+ i := pk_byte ;
+ tfm_width := i * 65536 + get_16 ;
+ hor_esc := get_16 * 65536 ;
+ ver_esc := 0 ;
+ c_width := get_16 ;
+ c_height := get_16 ;
+ word_width := (c_width + 31) div 32 ;
+ x_off := signed_16 ;
+ y_off := signed_16 ;
+end
+
+@ Here we read the most common character preamble, that with single byte
+parameters.
+
+@<Read short character preamble@>=
+begin
+ packet_length := flag_byte * 256 + pk_byte ;
+ car := pk_byte ;
+ end_of_packet := packet_length + pk_loc ;
+ i := pk_byte ;
+ tfm_width := i * 65536 + get_16 ;
+ hor_esc := pk_byte * 65536 ;
+ ver_esc := 0 ;
+ c_width := pk_byte ;
+ c_height := pk_byte ;
+ word_width := (c_width + 31) div 32 ;
+ x_off := signed_byte ;
+ y_off := signed_byte ;
+end
+
+@ Some more globals:
+
+@<Glob...@>=
+@!c_height, @!c_width : integer ; {sizes of the character glyphs}
+@!word_width : integer ; {width of character in raster words}
+@!hor_esc, @!ver_esc : integer ; {the character escapement}
+@!packet_length : integer ; {the length of the packet in bytes}
+@!last_eoc : integer ; {the last end of character}
+
+@ The \.{GF} format requires the minimum and maximum |m| and |n|
+values in the postamble, so we generate them here. One thing
+that should be noted, here. The value |max_n-min_n| will be the
+height of the character glyph, but for the width, you need to
+use |max_m-min_m-1|, because of the peculiarities of the \.{GF}
+format.
+
+@<Calculate and check |min_m|, |max_m|, |min_n|, and |max_n|@>=
+if (c_height = 0) or (c_width = 0) then begin
+ c_height := 0 ; c_width := 0 ; x_off := 0 ; y_off := 0 ;
+end ;
+min_m := - x_off ;
+if min_m < mmin_m then
+ mmin_m := min_m ;
+max_m := c_width + min_m ;
+if max_m > mmax_m then
+ mmax_m := max_m ;
+min_n := y_off - c_height + 1 ;
+max_n := y_off ;
+if min_n > max_n then
+ min_n := max_n ;
+if min_n < mmin_n then
+ mmin_n := min_n ;
+if max_n > mmax_n then
+ mmax_n := max_n
+
+@ We have to declare the variables which hold the bounding box. We
+also need the arrays that hold the back pointers to the characters,
+the horizontal and vertical escapements, and the \.{TFM} widths.
+
+@<Glob...@>=
+@!min_m, @!max_m, @!min_n, @!max_n : integer ;
+@!mmin_m, @!mmax_m, @!mmin_n, @!mmax_n : integer ;
+@!char_pointer, @!s_tfm_width : array [0..255] of integer ;
+@!s_hor_esc, @!s_ver_esc : array [0..255] of integer ;
+@!this_char_ptr : integer ;
+
+@ We initialize these bounding box values to be ridiculous, and say
+that there were no characters seen yet.
+
+@<Set init...@>=
+mmin_m := 999999 ;
+mmin_n := 999999 ;
+mmax_m := -999999 ;
+mmax_n := -999999 ;
+for i := 0 to 255 do
+ char_pointer[i] := -1 ;
+
+@ This module takes care of the simple job of writing the character
+preamble, after picking one to fit.
+
+@<Write character preamble@>=
+begin
+ if (char_pointer[car mod 256] = -1) and
+ (car >= 0) and (car < 256) and
+ (max_m >= 0) and (max_m < 256) and
+ (max_n >= 0) and (max_n < 256) and
+ (max_m >= min_m) and (max_n >= min_n) and
+ (max_m < min_m + 256) and (max_n < min_n + 256) then begin
+ char_pointer[car mod 256] := this_char_ptr ;
+ gf_byte(boc1) ;
+ gf_byte(car) ;
+ gf_byte(max_m - min_m) ;
+ gf_byte(max_m) ;
+ gf_byte(max_n - min_n) ;
+ gf_byte(max_n) ;
+ end else begin
+ gf_byte(boc) ;
+ gf_quad(car) ;
+ gf_quad(char_pointer[car mod 256]) ;
+ char_pointer[car mod 256] := this_char_ptr ;
+ gf_quad(min_m) ;
+ gf_quad(max_m) ;
+ gf_quad(min_n) ;
+ gf_quad(max_n) ;
+ end ;
+end
+
+@ In this routine we either save or check the current character
+parameters.
+
+@<Save character locator@>=
+begin
+ i := car mod 256 ;
+ if (char_pointer[i] = -1) then begin
+ s_ver_esc[i] := ver_esc ;
+ s_hor_esc[i] := hor_esc ;
+ s_tfm_width[i] := tfm_width ;
+ end else begin
+ if (s_ver_esc[i] <> ver_esc) or
+ (s_hor_esc[i] <> hor_esc) or
+ (s_tfm_width[i] <> tfm_width) then
+ print_ln('Two characters mod ', i:1,' have mismatched parameters') ;
+ end ;
+end
+
+@ And another module to write out those character locators we have so
+carefully saved up the information for.
+
+@<Write character locators@>=
+for i := 0 to 255 do
+ if char_pointer[i] <> -1 then begin
+ if (s_ver_esc[i] = 0) and (s_hor_esc[i] >= 0) and
+ (s_hor_esc[i] < 16777216) and (s_hor_esc[i] mod 65536 = 0) then begin
+ gf_byte(char_loc0) ;
+ gf_byte(i) ;
+ gf_byte(s_hor_esc[i] div 65536) ;
+ end else begin
+ gf_byte(char_loc) ;
+ gf_byte(i) ;
+ gf_quad(s_hor_esc[i]) ;
+ gf_quad(s_ver_esc[i]) ;
+ end ;
+ gf_quad(s_tfm_width[i]) ;
+ gf_quad(char_pointer[i]) ;
+ end
+
+@ Now we have the most important part of the program, where we actually
+interpret the commands in the raster description. First of all, we need
+a procedure to get a single nybble from the file, as well as one to get
+a single bit. We also use the |pk_packed_num| procedure defined in the
+\.{PK} file description.
+
+@p function get_nyb : integer ;
+var temp : eight_bits ;
+begin
+ if bit_weight = 0 then begin
+ input_byte := pk_byte ;
+ bit_weight := 16 ;
+ end ;
+ temp := input_byte div bit_weight ;
+ input_byte := input_byte - temp * bit_weight ;
+ bit_weight := bit_weight div 16 ;
+ get_nyb := temp ;
+end ;
+@#
+function get_bit : boolean ;
+var temp : boolean ;
+begin
+ bit_weight := bit_weight div 2 ;
+ if bit_weight = 0 then begin
+ input_byte := pk_byte ;
+ bit_weight := 128 ;
+ end ;
+ temp := input_byte >= bit_weight ;
+ if temp then
+ input_byte := input_byte - bit_weight ;
+ get_bit := temp ;
+end ;
+@<Packed number procedure@>
+
+@ Now, the globals to help communication between these procedures, and a buffer
+for the raster row counts.
+
+@<Glob...@>=
+@!input_byte : eight_bits ; {the byte we are currently decimating}
+@!bit_weight : eight_bits ; {weight of the current bit}
+@!nybble : eight_bits ; {the current nybble}
+@!row_counts : array [0..max_counts] of integer ;
+ {where the row is constructed}
+@!rcp : integer ; { the row counts pointer }
+
+@ Actually, if the character is a bit mapped character, then we
+make it look like run counts by determining the appropriate
+values ourselves. Thus, we have a routine which gets the next
+count value, below.
+
+@<Get next count value into |count|@>=
+begin
+ turn_on := not turn_on ;
+ if dyn_f = 14 then begin
+ count := 1 ;
+ done := false ;
+ while not done do begin
+ if count_down <= 0 then
+ done := true
+ else if (turn_on = get_bit) then
+ count := count + 1
+ else
+ done := true ;
+ count_down := count_down - 1 ;
+ end ;
+ end else
+ count := pk_packed_num ;
+end
+
+@ And the main procedure.
+
+@<Read and translate raster description@>=
+if (c_width > 0) and (c_height > 0) then begin
+ bit_weight := 0 ;
+ count_down := c_height * c_width - 1 ;
+ if dyn_f = 14 then
+ turn_on := get_bit ;
+ repeat_count := 0 ;
+ x_to_go := c_width ;
+ y_to_go := c_height ;
+ cur_n := c_height ;
+ count := 0 ;
+ first_on := turn_on ;
+ turn_on := not turn_on ;
+ rcp := 0 ;
+ while y_to_go > 0 do begin
+ if count = 0 then
+ @<Get next count...@> ;
+ if rcp = 0 then
+ first_on := turn_on ;
+ while count >= x_to_go do begin
+ row_counts[rcp] := x_to_go ;
+ count := count - x_to_go ;
+ for i := 0 to repeat_count do begin
+ @<Output row@> ;
+ y_to_go := y_to_go - 1 ;
+ end ;
+ repeat_count := 0 ;
+ x_to_go := c_width ;
+ rcp := 0 ;
+ if (count > 0) then
+ first_on := turn_on ;
+ end ;
+ if count > 0 then begin
+ row_counts[rcp] := count ;
+ if rcp = 0 then
+ first_on := turn_on ;
+ rcp := rcp + 1 ;
+ if rcp > max_counts then begin
+ print_ln('A character had too many run counts') ;
+ jump_out ;
+ end ;
+ x_to_go := x_to_go - count ;
+ count := 0 ;
+ end ;
+ end ;
+end
+
+@ This routine actually outputs a row to the \.{GF} file.
+
+@<Output row@>=
+if (rcp > 0) or first_on then begin
+ j := 0 ;
+ max := rcp ;
+ if not turn_on then
+ max := max - 1 ;
+ if cur_n - y_to_go = 1 then begin
+ if first_on then
+ gf_byte(new_row_0)
+ else if row_counts[0] < 165 then begin
+ gf_byte(new_row_0 + row_counts[0]) ;
+ j := j + 1 ;
+ end else
+ gf_byte(skip0) ;
+ end else if cur_n > y_to_go then begin
+ if cur_n - y_to_go < 257 then begin
+ gf_byte(skip1) ;
+ gf_byte(cur_n - y_to_go - 1) ;
+ end else begin
+ gf_byte(skip1+1) ;
+ gf_16(cur_n - y_to_go - 1) ;
+ end ;
+ if first_on then
+ gf_byte(paint_0) ;
+ end else if first_on then
+ gf_byte(paint_0) ;
+ cur_n := y_to_go ;
+ while j <= max do begin
+ if row_counts[j] < 64 then
+ gf_byte(paint_0 + row_counts[j])
+ else if row_counts[j] < 256 then begin
+ gf_byte(paint1) ;
+ gf_byte(row_counts[j]) ;
+ end else begin
+ gf_byte(paint1+1) ;
+ gf_16(row_counts[j]) ;
+ end ;
+ j := j + 1 ;
+ end ;
+end
+
+@ Here we need the array which counts down the number of bits, and
+the current state flag.
+
+@<Glob...@>=
+@!count_down : integer ; { have we run out of bits yet? }
+@!done : boolean ; { are we done yet? }
+@!max : integer ; { the maximum number of counts to output }
+@!repeat_count : integer ; {how many times to repeat the next row?}
+@!x_to_go, @!y_to_go : integer ; {how many columns/rows left?}
+@!turn_on, @!first_on : boolean ; {are we black here?}
+@!count : integer ; {how many bits of current color left?}
+@!cur_n : integer ; {what row are we at?}
+
+@ To finish the \.{GF} file, we write out a postamble, including the
+character locators that we stored away.
+
+@<Write \.{GF} postamble@>=
+j := gf_loc ;
+gf_byte(post) ;
+gf_quad(last_eoc) ;
+gf_quad(design_size) ;
+gf_quad(checksum) ;
+gf_quad(hppp) ;
+gf_quad(vppp) ;
+gf_quad(mmin_m) ;
+gf_quad(mmax_m) ;
+gf_quad(mmin_n) ;
+gf_quad(mmax_n) ;
+@<Write character locators@> ;
+gf_byte(post_post) ;
+gf_quad(j) ;
+gf_byte(gf_id_byte) ;
+for i := 0 to 3 do
+ gf_byte(223) ;
+while gf_loc mod 4 <> 0 do
+ gf_byte(223)
+
+@ We need the |flag_byte| variable.
+
+@<Glob...@>=
+@!flag_byte : integer ; {command or character flag byte}
+
+@ Another necessary procedure skips over any specials between characters
+and before and after the postamble. (It echoes the specials exactly.)
+
+@p procedure skip_specials ;
+var i, j, k : integer ;
+begin
+ this_char_ptr := gf_loc ;
+ repeat
+ flag_byte := pk_byte ;
+ if flag_byte >= 240 then
+ case flag_byte of
+ 240, 241, 242, 243 :
+begin
+ i := 0 ;
+ gf_byte(flag_byte-1) ;
+ for j := 240 to flag_byte do begin
+ k := pk_byte ;
+ gf_byte(k) ;
+ i := 256 * i + k ;
+ end ;
+ for j := 1 to i do gf_byte(pk_byte) ;
+end ;
+ 244 :
+begin
+ gf_byte(243) ;
+ gf_quad(get_32) ;
+end ;
+ 245 : begin end ;
+ 246 : begin end ;
+ 247, 248, 249, 250, 251, 252, 253, 254, 255 :
+ abort('Unexpected ', flag_byte:1,'!') ;
+ endcases ;
+ until (flag_byte < 240) or (flag_byte = pk_post) ;
+end ;
+
+@* Terminal communication.
+We must get the file names and determine whether input is to be in
+hexadecimal or binary. To do this, we use the standard input path
+name. We need a procedure to flush the input buffer. For most systems,
+this will be an empty statement. For other systems, a |print_ln| will
+provide a quick fix. We also need a routine to get a line of input from
+the terminal. On some systems, a simple |read_ln| will do. Finally,
+a macro to print a string to the first blank is required.
+
+@d flush_buffer == begin end
+@d get_line(#) == if eoln(input) then read_ln(input) ;
+ i := 1 ;
+ while not (eoln(input) or eof(input)) do begin
+ #[i] := input^ ;
+ incr(i) ;
+ get(input) ;
+ end ;
+ #[i] := ' '
+
+@ @p procedure dialog ;
+var i : integer ; {index variable}
+buffer : packed array [1..name_length] of char; {input buffer}
+begin
+ for i := 1 to name_length do begin
+ gf_name[i] := ' ' ;
+ pk_name[i] := ' ' ;
+ end;
+ print('Input file name: ') ;
+ flush_buffer ;
+ get_line(pk_name) ;
+ print('Output file name: ') ;
+ flush_buffer ;
+ get_line(gf_name) ;
+end ;
+
+@* The main program.
+Now that we have all the pieces written, let us put them together.
+
+@p begin
+initialize ;
+dialog ;
+@<Open files@> ;
+@<Read preamble@> ;
+skip_specials ;
+while flag_byte <> pk_post do begin
+ @<Unpack and write character@> ;
+ skip_specials ;
+end ;
+while not eof(pk_file) do i := pk_byte ;
+@<Write \.{GF} postamble@> ;
+print_ln(pk_loc:1,' bytes unpacked to ',gf_loc:1,' bytes.');
+final_end :
+end .
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{PKtoGF} work at a particular installation.
+Any additional routines should be inserted here.
+@^system dependencies@>
+
+@* Index.
+Pointers to error messages appear here together with the section numbers
+where each ident\-i\-fier is used.
diff --git a/obsolete/systems/knuth/unsupported/mfware/pktopx.tops20-changes b/obsolete/systems/knuth/unsupported/mfware/pktopx.tops20-changes
new file mode 100644
index 0000000000..85d03a3ad6
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/mfware/pktopx.tops20-changes
@@ -0,0 +1,199 @@
+% TOPS-20 change file for PKtoPX by Tomas Rokicki. Send bug reports to
+% ROKICKI@SU-SCORE. The majority of these changes eliminate the sign-bit
+% manipulations necessary on 32-bit machines, but unnecessary on the 36-bit
+% TOPS-20.
+
+@x [1]
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\ttw{{\mc TOPS-20}}
+\def\title{PKtoPX changes for \ttw}
+@z
+
+@x [4]
+@d banner=='This is PKtoPX, Version 2.3'
+@y
+@d banner=='This is PKtoPX, Version 2.3'
+@z
+
+@x [6]
+@d print_ln(#)==write_ln(output,#)
+@d print(#)==write(output,#)
+@y
+@d print_ln(#)==write_ln(tty,#)
+@d print(#)==write(tty,#)
+@z
+
+@x [6]
+@p program PKtoPX(input, output);
+@y
+@p program PKtoPX;
+@z
+
+@x [8]
+@<Constants...@>=
+@!name_length=80; {maximum length of a file name}
+@!terminal_line_length=132; {maximum length of an input line}
+@!max_div_32=100; {maximum character width divided by 32}
+@y
+@<Constants...@>=
+@!name_length=80; {maximum length of a file name}
+@!terminal_line_length=132; {maximum length of an input line}
+@!max_div_32=100; {maximum character width divided by 32}
+@!max_rescan=200; {maximum length of a command line}
+@z
+
+@x [55]
+@!pxl_file:word_file; {where the input comes from}
+@y
+@!pxl_file:byte_file; {where the input comes from}
+@z
+
+@x [56]
+@p procedure open_pxl_file; {prepares to write packed bytes in a |pxl_file|}
+begin rewrite(pxl_file,pxl_name);
+pxl_loc := 0 ;
+end;
+@#
+procedure open_pk_file; {prepares the input for reading}
+begin reset(pk_file,pk_name);
+pk_loc := 0 ;
+end;
+@y
+@p procedure open_pxl_file; {prepares to write packed bytes in a |pxl_file|}
+begin rewrite(pxl_file,pxl_name,'/O/B:8');
+pxl_loc := 0 ;
+end;
+@#
+procedure open_pk_file; {prepares the input for reading}
+begin reset(pk_file,pk_name,'/O/B:8');
+pk_loc := 0 ;
+end;
+@z
+
+@x [60]
+@p procedure pixel_integer (i : integer) ;
+begin pxl_file^ := i ;
+put(pxl_file) ;
+incr(pxl_loc) ;
+end;
+@y
+@p procedure pixel_integer (i : integer) ;
+begin if i < 0 then i := i + 65536 * 65536 ;
+pxl_file^ := i div 16777216 ; put(pxl_file) ;
+pxl_file^ := i div 65536 mod 256 ; put(pxl_file) ;
+pxl_file^ := i div 256 mod 256 ; put(pxl_file) ;
+pxl_file^ := i mod 256 ; put(pxl_file) ;
+incr(pxl_loc) ;
+end;
+@z
+
+@x [79]
+@!power : array [0..31] of integer ; {contains the powers of two}
+@y
+@!power : array [0..32] of integer ; {contains the bit counts}
+@z
+
+@x [79]
+power[0] := 1 ;
+for i := 1 to 30 do power[i] := power[i-1] * 2 ;
+power[31] := - one_fourth - one_fourth ;
+@y
+power[0] := 1 ;
+for i := 1 to 32 do power[i] := power[i-1] * 2 ;
+@z
+
+@x [92]
+@d get_line(#) == if eoln(input) then read_ln(input) ;
+ i := 1 ;
+ while not (eoln(input) or eof(input)) do begin
+ #[i] := input^ ;
+ incr(i) ;
+ get(input) ;
+ end ;
+ #[i] := ' '
+@y
+@d get_line(#) == if eoln(tty) then read_ln(tty) ;
+ i := 1 ;
+ while not (eoln(tty) or eof(tty)) do begin
+ #[i] := tty^ ;
+ incr(i) ;
+ get(tty) ;
+ end ;
+ #[i] := ' '
+@z
+
+@x [96]
+initialize ;
+dialog ;
+@y
+initialize ;
+startup := true ;
+@<Get command line and check for file names@> ;
+if not startup then dialog ;
+@z
+
+@x [99]
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{PKtoPX} work at a particular installation.
+Any additional routines should be inserted here.
+@^system dependencies@>
+@y
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{PKtoPX} work at a particular installation.
+Any additional routines should be inserted here.
+@^system dependencies@>
+
+We call a system procedure to put the command line into the input buffer.
+We then read it in, skipping over the program name to the first blank.
+
+@d RSCAN=@'500 {ReSCAN buffer JSYS}
+
+@<Get command line and check for file names@>=
+jsys(RSCAN,1,i;0;j); {get the command line}
+if (i<>2) or (j<=0) then startup := false
+else begin
+ if eoln(tty) then read_ln(tty); {for some TOPS-20's}
+ read(tty,rescan_buffer:rescan_len); {read in rescan buffer}
+ if rescan_len>max_rescan then abort('command line too long!');
+ read_ln(tty);
+ if rescan_len=j-2 then startup := false
+ else begin
+ i:=1; while rescan_buffer[i]>' 'do incr(i); {skip invocation}
+ while(i<=rescan_len) and (rescan_buffer[i]=' ')do incr(i); {skip spaces}
+ if i>rescan_len then startup := false
+ else begin
+ for j := 1 to name_length do begin
+ pk_name[j] := ' ' ; pxl_name[j] := ' ' ;
+ end ;
+ j := 1 ;
+ last_ext := -1 ;
+ while ( i <= rescan_len ) and ( rescan_buffer[i] <> ' ' ) and
+ ( rescan_buffer[i] <> '/' ) do begin
+ pk_name[j] := rescan_buffer[i] ;
+ pxl_name[j] := rescan_buffer[i] ;
+ if (rescan_buffer[i] = '.') and (last_ext = -1) then last_ext := j ;
+ if rescan_buffer[i] in [':',']','>'] then last_ext := -1 ;
+ incr(j) ; incr(i) ;
+ end ;
+ if last_ext = -1 then begin
+ last_ext := j ;
+ pk_name[j] := '.' ; pk_name[j+1] := 'p' ; pk_name[j+2] := 'k' ;
+ end ;
+ pxl_name[last_ext] := '.' ; pxl_name[last_ext+1] := 'p' ;
+ pxl_name[last_ext+2] := 'x' ; pxl_name[last_ext+3] := 'l' ;
+ for i := last_ext+4 to name_length do pxl_name[i] := ' ' ;
+ end ;
+ end ;
+end
+
+@ @<Glob...@>=
+@!rescan_buffer:packed array[1..max_rescan] of char;
+@!rescan_len:integer;
+@!startup : boolean ; {did we have a file name?}
+@!last_ext : integer ; {where was the dot?}
+@z
diff --git a/obsolete/systems/knuth/unsupported/mfware/pktopx.web b/obsolete/systems/knuth/unsupported/mfware/pktopx.web
new file mode 100644
index 0000000000..8d005ac100
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/mfware/pktopx.web
@@ -0,0 +1,1150 @@
+% PKtoPX.web
+%
+% PKtoPX creates a regular pixel file from a packed pixel file.
+%
+% Preliminary 0.0 version: May, 1985
+% First release, 0.9 version: 8 May 1985
+% Updated to reflect new pk format, 2.0 version: 25 July 1985
+% Updated again for new pk format, 2.1 version: 15 August 1985
+% Raster_pointer array bug fixed, 2.2 version: 19 October 1985
+% Fixed documentation, 2.3 version: 17 November 1987
+\def\versiondate{30 November 1987}
+%
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like PASCAL
+\font\logo=logo10 % font used for the METAFONT logo
+\def\MF{{\logo META}\-{\logo FONT}}
+\def\PASCAL{{\mc Pascal}}
+\def\tamu{Texas A\char38 M}
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index
+\def\title{PKtoPX}
+\def\contentspagenumber{0}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont PKtoPX} processor}
+ \vskip 15pt
+ \centerline{(Version 2.3, \versiondate)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ The preparation of this report
+ was supported in part by the National Science
+ Foundation under grants IST-8201926 and MCS-8300984,
+ and by the System Development Foundation. `\TeX' is a
+ trademark of the American Mathematical Society.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+The standard format for the distribution of font raster information for \TeX\
+has been \.{PXL} files. These files are loosely packed, based on a 32-bit
+word, and use no forms of compression. \TeX\ requires dozens of fonts in many
+different sizes, with typical installations having hundreds of pixel files
+using many megabytes of disk storage.
+Distribution of the unwieldy pixel files is also a difficult problem for
+microcomputer systems, on which \TeX\ is only just becoming available.
+Many boxes of diskettes would be required just to store a basic set of fonts
+in three sizes for a three-hundred dot per inch device.
+A better format is called for.
+
+This program takes a packed, or \.{PK} file, and converts it into the
+standard \.{PXL} format. This program is intended as a model of a \.{PK}
+reading program, and it has been written in such a fashion that it can be
+easily inserted into a driver. The work that is necessary is to essentially
+change it from a program to a procedure. Each module of globals should be
+changed to a module of locals, etc.
+
+@ The |banner| string defined here should be changed whenever \.{PKtoPX}
+gets modified.
+
+@d banner=='This is PKtoPX, Version 2.3'
+ {printed when the program starts}
+
+@ This program is written in standard \PASCAL, except where it is necessary
+to use extensions; for example, \.{PKtoPX} must read files whose names
+are dynamically specified, and that would be impossible in pure \PASCAL.
+
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+
+@ Both the input and output come from binary files. On line interaction
+is handled through \PASCAL's standard |input| and |output| files.
+
+@d print_ln(#)==write_ln(output,#)
+@d print(#)==write(output,#)
+
+@p program PKtoPX(input, output);
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ begin print_ln(banner);@/
+ @<Set initial values@>@/
+ end;
+
+@ If the program has to stop prematurely, it goes to the
+`|final_end|'. In addition, if, when unpacking an individual character,
+we encounter a character number greater than 127, we go to |bad_char|.
+Successful completion of a character goes to |good_char|.
+
+@d final_end=9999 {label for the end of it all}
+@d bad_char=9997 {in case of a bad character}
+@d good_char=9998 {successful character read}
+
+@<Labels...@>=final_end, bad_char, good_char;
+
+@ These constants determine the maximum length of a file name and the length
+of the terminal line, as well as the widest character that can be translated.
+@^system dependancies@>
+
+@<Constants...@>=
+@!name_length=80; {maximum length of a file name}
+@!terminal_line_length=132; {maximum length of an input line}
+@!max_div_32=100; {maximum character width divided by 32}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d do_nothing == {empty statement}
+
+@ It is possible that a malformed packed file (heaven forbid!) or some other
+error might be detected by this program. Such errors might occur in a deeply
+nested procedure, so the procedure called |jump_out| has been added to transfer
+to the very end of the program with an error message.
+
+@d abort(#)==begin print_ln(' ',#); jump_out; end
+
+@p procedure jump_out;
+begin goto final_end;
+end;
+
+@* Pixel file format.
+A \.{PXL} file is an expanded raster description of a single font at a
+particular resolution. \.{PXL} files are used by many existing
+device-driver programs for dot matrix devices.
+All words in a \.{PXL} files are in 32-bit format, with the four lower
+bits zero on 36-bit machines. The raster information is contained in a
+sequence of binary words which record white pixels as zeros and black
+pixels as ones.
+
+The first word of the \.{PXL} file and the last word contain the \.{PXL
+ID} which is currently equal to 1001 (decimal).
+This first word is followed by a sequence of raster information words
+where each line of pixels in the glyphs is represented by one or more
+words of binary information. The number of words used to represent each
+row of pixels for any particular glyph is fixed and it is set by the value
+of |max_m-min_m+1| for that particular glyph. Each white pixel is represented
+by a zero and each black pixel is represented by a one in the corresponding bit
+positions (the first 32 only of each word on 36-bit machines).
+The unused bit positions
+toward the end of each set of words for each row of pixels are filled with
+zeros.
+
+The font directory follows, occupying a fixed position with respect to the
+end of the file (in words 517 through 6 from this end), and assigns 4
+words for each of the potential 128 different glyphs that could be
+contained in this particular font in the order of their ascending ascii
+values (not in the order that the glyphs appear in the raster section,
+which may be entirely arbitrary). This means that the first four words are
+for the ascii zero glyph. All four words reserved for any missing glyphs
+are set to zero.
+
+The first word of each glyph's directory information contains the pixel
+width in the left half-word (the leftmost 16 bits) and the pixel height in
+the right half-word (the next 16 bits). These dimensions are those of the
+smallest bounding-box, measured in pixels, and they have nothing
+necessarily to do with the width and height figures that appear in the
+\.{TFM} file. The \.{TFM} width, measured in \.{FIXes}, where 1 \.{FIX}
+is $1/2^{20}$ times the design size, is listed in the fourth word of the
+glyph's directory information.
+
+The second word of the glyph's directory information contains the offset
+of the glyph's reference point from its upper-left-hand corner of the
+bounding box, measured in pixels, with the x-offset in the left half-word
+and the y-offset in the right half-word. These numbers may be negative,
+and two's complement representation is used. Remember that the positive x
+direction means `rightward' and positive y is `downward' on the page.
+
+The third word of a glyph's directory information contains the number of the
+word in this \.{PXL} file where the raster description for this particular
+glyph begins, measured from the first word which is numbered zero.
+As mentioned earlier, the fourth word of directory information for each
+glyph contains the \.{TFM} width.
+
+The final five words in the \.{PXL} file contain information relation to
+the entire file.
+The first of these five words is a checksum which should
+match the checksum contained in the \.{TFM} file that \TeX\ used in
+reference to this font, although, if this checksum is zero, no validity
+checking will be done.
+The second of these five words is an integer that is 1000 times the
+magnification factor at which this font was produced.
+The third word contains the design size of the font measured in \.{FIXes}
+($2^{-20}$ unmagnified points).
+The fourth word contains a pointer to the first word of the font directory.
+The fifth and last word of the entire file contains a duplicate of the
+\.{PXL} ID as contained in the first word of the file.
+
+@d pxl_id=1001 {current version of \.{PXL} format}
+
+@* Packed file format.
+The packed file format is a compact representation of the data contained in a
+\.{GF} file. The information content is the same, but packed (\.{PK}) files
+are almost always less than half the size of their \.{GF} counterparts. They
+are also easier to convert into a raster representation because they do not
+have a profusion of \\{paint}, \\{skip}, and \\{new\_row} commands to be
+separately interpreted. In addition, the \.{PK} format expressedly forbids
+\&{special} commands within a character. The minimum bounding box for each
+character is explicit in the format, and does not need to be scanned for as in
+the \.{GF} format. Finally, the width and escapement values are combined with
+the raster information into character ``packets'', making it simpler in many
+cases to process a character.
+
+A \.{PK} file is organized as a stream of 8-bit bytes. At times, these bytes
+might be split into 4-bit nybbles or single bits, or combined into multiple
+byte parameters. When bytes are split into smaller pieces, the `first' piece
+is always the most significant of the byte. For instance, the first bit of
+a byte is the bit with value 128; the first nybble can be found by dividing
+a byte by 16. Similarly, when bytes are combined into multiple byte
+parameters, the first byte is the most significant of the parameter. If the
+parameter is signed, it is represented by two's-complement notation.
+
+The set of possible eight-bit values are separated into two sets, those that
+introduce a character definition, and those that do not. The values that
+introduce a character definition comprise the range from 0 to 239; byte values
+above 239 are interpreted commands. Bytes which introduce character
+definitions are called flag bytes, and various fields within the byte indicate
+various things about how the character definition is encoded. Command bytes
+have zero or more parameters, and can never appear within a character
+definition or between parameters of another command, where they would be
+interpeted as data.
+
+A \.{PK} file consists of a preamble, followed by a sequence of one or more
+character definitions, followed by a postamble. The preamble command must
+be the first byte in the file, followed immediately by its parameters.
+Any number of character definitions may follow, and any command but the
+preamble command and the postamble command may occur between character
+definitions. The very last command in the file must be the postamble.
+
+@ The packed file format is intended to be easy to read and interpret by
+device drivers. The small size of the file reduces the input/output overhead
+each time a font is defined. For those drivers that load and save each font
+file into memory, the small size also helps reduce the memory requirements.
+The length of each character packet is specified, allowing the character raster
+data to be loaded into memory by simply counting bytes, rather than
+interpreting each command; then, each character can be interpreted on a demand
+basis. This also makes it possible for a driver to skip a particular
+character quickly if it knows that the character is unused.
+
+@ First, the command bytes shall be presented; then the format of the
+Character definitions will be defined. Eight of the possible sixteen
+commands (values 240 through 255) are currently defined; the others are
+reserved for future extensions. The commands are listed below. Each command
+is specified by its symbolic name (e.g., \\{pk\_no\_op}), its opcode byte,
+and any parameters. The parameters are followed by a bracketed number
+telling how many bytes they occupy, with the number preceded by a plus sign if
+it is a signed quantity. (Four byte quantities are always signed, however.)
+
+\yskip\hang|pk_xxx1| 240 |k[1]| |x[k]|. This command is undefined in general;
+it functions as a $(k+2)$-byte \\{no\_op} unless special \.{PK}-reading
+programs are being used. \MF\ generates \\{xxx} commands when encountering
+a \&{special} string. It is recommended that |x| be a string having the form
+of a keyword followed by possible parameters relevant to that keyword.
+
+\yskip\hang\\{pk\_xxx2} 241 |k[2]| |x[k]|. Like |pk_xxx1|, but |0<=k<65536|.
+
+\yskip\hang\\{pk\_xxx3} 242 |k[3]| |x[k]|. Like |pk_xxx1|, but
+|0<=k<@t$2^{24}$@>|. \MF\ uses this when sending a \&{special} string whose
+length exceeds~255.
+
+\yskip\hang\\{pk\_xxx4} 243 |k[4]| |x[k]|. Like |pk_xxx1|, but |k| can be
+ridiculously large; |k| musn't be negative.
+
+\yskip\hang|pk_yyy| 244 |y[4]|. This command is undefined in general; it
+functions as a five-byte \\{no\_op} unless special \.{PK} reading programs
+are being used. \MF\ puts |scaled| numbers into |yyy|'s, as a result of
+\&{numspecial} commands; the intent is to provide numeric parameters to
+\\{xxx} commands that immediately precede.
+
+\yskip\hang|pk_post| 245. Beginning of the postamble. This command is
+followed by enough |pk_no_op| commands to make the file a multiple
+of four bytes long. Zero through three bytes are usual, but any number
+is allowed.
+This should make the file easy to read on machines which pack four bytes to
+a word.
+
+\yskip\hang|pk_no_op| 246. No operation, do nothing. Any number of
+|pk_no_op|'s may appear between \.{PK} commands, but a |pk_no_op| cannot be
+inserted between a command and its parameters, between two parameters, or
+inside a character definition.
+
+\yskip\hang|pk_pre| 247 |i[1]| |k[1]| |x[k]| |ds[4]| |cs[4]| |hppp[4]|
+|vppp[4]|. Preamble command. Here, |i| is the identification byte of the
+file, currently equal to 89. The string |x| is merely a comment, usually
+indicating the source of the \.{PK} file. The parameters |ds| and |cs| are
+the design size of the file in $1/2^{20}$ points, and the checksum of the
+file, respectively. The checksum should match the \.{TFM} file and the
+\.{GF} files for this font. Parameters |hppp| and |vppp| are the ratios
+of pixels per point, horizontally and vertically, multiplied by $2^{16}$; they
+can be used to correlate the font with specific device resolutions,
+magnifications, and ``at sizes''. Usually, the name of the \.{PK} file is
+formed by concatenating the font name (e.g., amr10) with the resolution at
+which the font is prepared in pixels per inch multiplied by the magnification
+factor, and the letters \.{PK}. For instance, amr10 at 300 dots per inch
+should be named AMR10.300PK; at one thousand dots per inch and magstephalf,
+it should be named AMR10.1095PK.
+
+@ We put a few of the above opcodes into definitions for symbolic use by
+this program.
+
+@d pk_id = 89 {the version of \.{PK} file described}
+@d pk_xxx1 = 240 {\&{special} commands}
+@d pk_yyy = 244 {\&{numspecial} commands}
+@d pk_post = 245 {postamble}
+@d pk_no_op = 246 {no operation}
+@d pk_pre = 247 {preamble}
+
+@ The \.{PK} format has two conflicting goals; to pack character raster and
+size information as compactly as possible, while retaining ease of translation
+into raster and other forms. A suitable compromise was found in the use of
+run-encoding of the raster information. Instead of packing the individual
+bits of the character, we instead count the number of consecutive `black' or
+`white' pixels in a horizontal raster row, and then encode this number. Run
+counts are found for each row, from the top of the character to the bottom.
+This is essentially the way the \.{GF} format works.
+Instead of presenting each row individually, however, let us concatenate all
+of the horizontal raster rows into one long string of pixels, and encode this
+row. With knowledge of the width of the bit-map, the original character glyph
+can be easily reconstructed. In addition, we do not need special commands to
+mark the end of one row and the beginning of the next.
+
+Next, let us put the burden of finding the minimum bounding box on the part
+of the font generator, since the characters will usually be used much more
+often than they are generated. The minimum bounding box is the smallest
+rectangle which encloses all `black' pixels of a character. Let us also
+eliminate the need for a special end of character marker, by supplying
+exactly as many bits as are required to fill the minimum bounding box, from
+which the end of the character is implicit.
+
+Let us next consider the distribution of the run counts. Analysis of several
+dozen pixel files at 300 dots per inch yields a distribution peaking at four,
+falling off slowly until ten, then a bit more steeply until twenty, and then
+asymptotically approaching the horizontal. Thus, the great majority of our
+run counts will fit in a four-bit nybble. The eight-bit byte is attractive for
+our run-counts, as it is the standard on many systems; however, the wasted four
+bits in the majority of cases seems a high price to pay. Another possibility
+is to use a Huffman-type encoding scheme with a variable number of bits for
+each run-count; this was rejected because of the overhead in fetching and
+examining individual bits in the file. Thus, the character raster definitions
+in the \.{PK} file format are based on the four-bit nybble.
+
+@ The analysis of the pixel files yielded another interesting statistic: fully
+37\char`\%\
+of the raster rows were duplicates of the previous row. Thus, the \.{PK}
+format allows the specification of repeat counts, which indicate how many times
+a horizontal raster row is to be repeated. These repeated rows are taken out
+of the character glyph before individual rows are concatenated into the long
+string of pixels.
+
+For elegance, we disallow a run count of zero. The case of a null raster
+description should be gleaned from the character width and height being equal
+to zero, and no raster data should be read. No other zero counts are ever
+necessary. Also, in the absence of repeat counts, the repeat value is set to
+be zero (only the original row is sent.) If a repeat count is seen, it takes
+effect on the current row. The current row is defined as the row on which the
+first pixel of the next run count will lie. The repeat count is set back to
+zero when the last pixel in the current row is seen, and the row is sent out.
+
+This poses a problem for entirely black and entirely white rows, however. Let
+us say that the current row ends with four white pixels, and then we have five
+entirely empty rows, followed by a black pixel at the beginning of the next
+row, and the character width is ten pixels. We would like to use a repeat
+count, but there is no legal place to put it. If we put it before the white
+run count, it will apply to the current row. If we put it after, it applies
+to the row with the black pixel at the beginning. Thus, entirely white or
+entirely black repeated rows are always packed as large run counts (in this
+case, a white run count of 54) rather than repeat counts.
+
+@ Now let us turn our attention to the actual packing of the run counts and
+repeat counts into nybbles. There are only sixteen possible nybble values.
+We need to indicate run counts and repeat counts. Since the run counts are
+much more common, we will devote the majority of the nybble values to them.
+We therefore indicate a repeat count by a nybble of 14 followed by a packed
+number, where a packed number will be explained later. Since the repeat
+count value of one is so common, we indicate a repeat one command by a single
+nybble of 15. A 14 followed by the packed number 1 is still legal for a
+repeat one count, however. The run counts are coded directly as packed
+numbers.
+
+For packed numbers, therefore, we have the nybble values 0 through 13. We
+need to represent the positive integers up to, say, $2^{31}-1$. We would
+like the more common smaller numbers to take only one or two nybbles, and
+the infrequent large numbers to take three or more. We could therefore
+allocate one nybble value to indicate a large run count taking three or more
+nybbles. We do this with the value 0.
+
+@ We are left with the values 1 through 13. We can allocate some of these, say
+|dyn_f|, to be one-nybble run counts.
+These will work for the run counts |1..dyn_f|. For subsequent run
+counts, we will use a nybble greater than |dyn_f|, followed by a second nybble,
+whose value can run from 0 through 15. Thus, the two-byte nybble values will
+run from |dyn_f+1..(13-dyn_f)*16+dyn_f|. We have our definition of large run
+count values now, being all counts greater than |(13-dyn_f)*16+dyn_f|.
+
+We can analyze our several dozen pixel files and determine an optimal value of
+|dyn_f|, and use this value for all of the characters. Unfortunately, values
+of |dyn_f| that pack small characters well tend to pack the large characters
+poorly, and values that pack large characters well are not efficient for the
+smaller characters. Thus, we choose the optimal |dyn_f| on a character basis,
+picking the value which will pack each individual character in the smallest
+number of nybbles. Legal values of |dyn_f| run from 0 (with no one-byte run
+counts) to 13 (with no two-byte run counts).
+
+@ Our only remaining task in the coding of packed numbers is the large run
+counts. We use a scheme suggested by D.~E.~Knuth
+@^Knuth, D.~E.@>
+which will simply and elegantly represent arbitrarily large values. The
+general scheme to represent an integer |i| is to write its hexadecimal
+representation, with leading zeros removed. Then we count the number of
+digits, and prepend one less than that many zeros before the hexadecimal
+representation. Thus, the values from one to fifteen occupy one nybble;
+the values sixteen through 255 occupy three, the values 256 through 4095
+require five, etc.
+
+For our purposes, however, we have already represented the numbers one
+through |(13-dyn_f)*16+dyn_f|. In addition, the one-nybble values have
+already been taken by our other commands, which means that only the values
+from sixteen up are available to us for long run counts. Thus, we simply
+normalize our long run counts, by subtracting |(13-dyn_f)*16+dyn_f+1| and
+adding 16, and then representing the result according to the scheme above.
+
+@ The final algorithm for decoding the run counts based on the above scheme
+might look like this, assuming a procedure called \\{pk\_nyb} is available
+to get the next nybble from the file, and assuming that the global
+|repeat_count| indicates whether a row needs to be repeated. Note that this
+routine is recursive, but since a repeat count can never directly follow
+another repeat count, it can only be recursive to one level.
+
+@<Packed number procedure@>=
+function pk_packed_num : integer ;
+var i, j, k : integer ;
+begin
+ i := get_nyb ;
+ if i = 0 then begin
+ repeat j := get_nyb ; incr(i) ; until j <> 0 ;
+ while i > 0 do begin j := j * 16 + get_nyb ; decr(i) ; end ;
+ pk_packed_num := j - 15 + (13-dyn_f)*16 + dyn_f ;
+ end else if i <= dyn_f then
+ pk_packed_num := i
+ else if i < 14 then
+ pk_packed_num := (i-dyn_f-1)*16+get_nyb+dyn_f+1
+ else begin
+ if i = 14 then
+ repeat_count := pk_packed_num
+ else
+ repeat_count := 1 ;
+ pk_packed_num := pk_packed_num ;
+ end ;
+end ;
+
+@ For low resolution fonts, or characters with `gray' areas, run encoding can
+often make the character many times larger. Therefore, for those characters
+that cannot be encoded efficiently with run counts, the \.{PK} format allows
+bit-mapping of the characters. This is indicated by a |dyn_f| value of
+14. The bits are packed tightly, by concatenating all of the horizontal raster
+rows into one long string, and then packing this string eight bits to a byte.
+The number of bytes required can be calculated by |(width*height+7) div 8|.
+This format should only be used when packing the character by run counts takes
+more bytes than this, although, of course, it is legal for any character.
+Any extra bits in the last byte should be set to zero.
+
+@ At this point, we are ready to introduce the format for a character
+descripter. It consists of three parts: a flag byte, a character preamble,
+and the raster data. The most significant four nybbles of the flag byte
+yield the |dyn_f| value for that character. (Notice that only values of
+0 through 14 are legal for |dyn_f|, with 14 indicating a bit mapped character;
+thus, the flag bytes do not conflict with the command bytes, whose upper nybble
+is always 15.) The next bit (with weight 16) indicates whether the first run
+count is a black count or a white count, with a one indicating a black count.
+For bit-mapped characters, this bit should be set to a zero. The next bit
+(with weight 8) indicates whether certain later parameters (referred to as size
+parameters) are given in one-byte or two-byte quantities, with a one indicating
+that they are in two-byte quantities. The last two bits are concatenated on to
+the beginning of the length parameter in the character preamble, which will be
+explained below.
+
+However, if the last three bits of the flag byte are all set (normally
+indicating that the size parameters are two-byte values and that a 3 should be
+prepended to the length parameter), then a long format of the character
+preamble should be used instead of one of the short forms.
+
+Therefore, there are three formats for the character preamble, and which one
+is used depends on the least significant three bits of the flag byte. If the
+least significant three bits are in the range zero through three, the short
+format is used. If they are in the range four through six, the extended short
+format is used. Otherwise, if the least significant bits are all set, then
+the long form of the character preamble is used. The preamble formats are
+explained below.
+
+\yskip\hang Short form: |flag[1]| |pl[1]| |cc[1]| |tfm[3]| |dm[1]| |w[1]|
+|h[1]| |hoff[+1]| |voff[+1]|.
+If this format of the character preamble is used, the above
+parameters must all fit in the indicated number of bytes, signed or unsigned
+as indicated. Almost all of the standard \TeX\ font characters fit; the few
+exceptions are fonts such as \.{aminch}.
+
+\yskip\hang Extended short form: |flag[1]| |pl[2]| |cc[1]| |tfm[3]| |dm[2]|
+|w[2]| |h[2]| |hoff[+2]| |voff[+2]|. Larger characters use this extended
+format.
+
+\yskip\hang Long form: |flag[1]| |pl[4]| |cc[4]| |tfm[4]| |dx[4]| |dy[4]|
+|w[4]| |h[4]| |hoff[4]| |voff[4]|. This is the general format which
+allows all of the
+parameters of the \.{GF} file format, including vertical escapement.
+\vskip\baselineskip
+The |flag| parameter is the flag byte. The parameter |pl| (packet length)
+contains the offset
+of the byte following this character descripter, with respect to the beginning
+of the |tfm| width parameter. This is given so a \.{PK} reading program can,
+once it has read the flag byte, packet length, and character code (|cc|), skip
+over the character by simply reading this many more bytes. For the two short
+forms of the character preamble, the last two bits of the flag byte should be
+considered the two most-significant bits of the packet length. For the short
+format, the true packet length might be calculated as |(flag mod 4)*256+pl|;
+for the extended format, it might be calculated as |(flag mod 4)*65536+pl|.
+
+The |w| parameter is the width and the |h| parameter is the height in pixels
+of the minimum bounding box. The |dx| and |dy| parameters are the horizontal
+and vertical escapements, respectively. In the short formats, |dy| is assumed
+to be zero and |dm| is |dy| but in pixels;
+in the long format, |dx| and |dy| are both
+in pixels multiplied by $2^{16}$. The |hoff| is the horizontal offset from the
+upper left pixel to the reference pixel; the |voff| is the vertical offset.
+They are both given in pixels, with right and down being positive. The
+reference pixel is the pixel which occupies the unit square in \MF; the
+\MF\ reference point is the lower left hand corner of this pixel. (See the
+example below.)
+
+@ \TeX\ requires that all characters which have the same character codes
+modulo 256 also have the same |tfm| widths, and escapement values. The \.{PK}
+format does not itself make this a requirement, but in order for the font to
+work correctly with the \TeX\ software, this constraint should be observed.
+The current version of \TeX\ (1.5) cannot output character codes greater
+than 255 anyway.
+
+Following the character preamble is the raster information for the
+character, packed by run counts or by bits, as indicated by the flag byte.
+If the character is packed by run counts and the required number of nybbles
+is odd, then the last byte of the raster description should have a zero
+for its least significant nybble.
+
+@ As an illustration of the \.{PK} format, the character \char4\ from the font
+amr10 at 300 dots per inch will be encoded. This character was chosen
+because it illustrates some
+of the borderline cases. The raster for the character looks like this (the
+row numbers are chosen for convenience, and are not \MF's row numbers.)
+
+\vskip\baselineskip
+\centerline{\vbox{\baselineskip=10pt
+\halign{\hfil#\quad&&\hfil#\hfil\cr
+0& & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+1& & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+2& & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+3& & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+4& & &M&M& & & & & & & & & & & & & & & & &M&M\cr
+5& & &M&M& & & & & & & & & & & & & & & & &M&M\cr
+6& & &M&M& & & & & & & & & & & & & & & & &M&M\cr
+7\cr
+8\cr
+9& & & & &M&M& & & & & & & & & & & & &M&M& & \cr
+10& & & & &M&M& & & & & & & & & & & & &M&M& & \cr
+11& & & & &M&M& & & & & & & & & & & & &M&M& & \cr
+12& & & & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M& & \cr
+13& & & & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M& & \cr
+14& & & & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M& & \cr
+15& & & & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M& & \cr
+16& & & & &M&M& & & & & & & & & & & & &M&M& & \cr
+17& & & & &M&M& & & & & & & & & & & & &M&M& & \cr
+18& & & & &M&M& & & & & & & & & & & & &M&M& & \cr
+19\cr
+20\cr
+21\cr
+22& & &M&M& & & & & & & & & & & & & & & & &M&M\cr
+23& & &M&M& & & & & & & & & & & & & & & & &M&M\cr
+24& & &M&M& & & & & & & & & & & & & & & & &M&M\cr
+25& & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+26& & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+27& & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+28&*& &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+&\hphantom{M}&\hphantom{M}\cr
+}}}
+The width of the minimum bounding box for this character is 20; its height
+is 29. The `*' represents the reference pixel; notice how it lies outside the
+minimum bounding box. The |hoff| value is $-2$, and the |voff| is~28.
+
+The first task is to calculate the run counts and repeat counts. The repeat
+counts are placed at the first transition (black to white or white to black)
+in a row, and are enclosed in brackets. White counts are enclosed in
+parentheses. It is relatively easy to generate the counts list:
+\vskip\baselineskip
+\centerline{82 [2] (16) 2 (42) [2] 2 (12) 2 (4) [3]}
+\centerline{16 (4) [2] 2 (12) 2 (62) [2] 2 (16) 82}
+\vskip\baselineskip
+Note that any duplicated rows that are not all white or all black are removed
+before the repeat counts are calculated. The rows thus removed are rows 5, 6,
+10, 11, 13, 14, 15, 17, 18, 23, and 24.
+
+@ The next step in the encoding of this character is to calculate the optimal
+value of |dyn_f|. The details of how this calculation is done are not
+important here; suffice it to say that there is a simple algorithm which in one
+pass over the count list can determine the best value of |dyn_f|. For this
+character, the optimal value turns out to be 8 (atypically low). Thus, all
+count values less than or equal to 8 are packed in one nybble; those from
+nine to $(13-8)*16+8$ or 88 are packed in two nybbles. The run encoded values
+now become (in hex, separated according to the above list):
+\vskip\baselineskip
+\centerline{\tt D9 E2 97 2 B1 E2 2 93 2 4 E3}
+\centerline{\tt 97 4 E2 2 93 2 C5 E2 2 97 D9}
+\vskip\baselineskip\noindent
+which comes to 36 nybbles, or 18 bytes. This is shorter than the 73 bytes
+required for the bit map, so we use the run count packing.
+
+@ The short form of the character preamble is used because all of the
+parameters fit in their respective lengths. The packet length is therefore
+18 bytes for the raster, plus
+eight bytes for the character preamble parameters following the character
+code, or 26. The |tfm| width for this character is 640796, or {\tt 9C71C} in
+hexadecimal. The horizontal escapement is 25 pixels. The flag byte is
+88 hex, indicating the short preamble, the black first count, and the
+|dyn_f| value of 8. The final total character packet, in hexadecimal, is:
+\vskip\baselineskip
+$$\vbox{\halign{\hfil #\quad&&{\tt #\ }\cr
+Flag byte&88\cr
+Packet length&1A\cr
+Character code&04\cr
+|tfm| width&09&C7&1C\cr
+Horizontal escapement (pixels)&19\cr
+Width of bit map&14\cr
+Height of bit map&1D\cr
+Horizontal offset (signed)&FE\cr
+Vertical offset&1C\cr
+Raster data&D9&E2&97\cr
+&2B&1E&22\cr
+&93&24&E3\cr
+&97&4E&22\cr
+&93&2C&5E\cr
+&22&97&D9\cr}}$$
+
+@ This format was written by Tomas Rokicki in August, 1985.
+
+@* Input and output.
+There are three types of files that this program must deal with---standard
+text files, files of integers (pixel files), and files of bytes (packed files.)
+For our purposes, we shall consider an eight-bit byte to consist of the
+values |0..255|. If your system does not pack these values to a byte, it is
+no major difficulty; you must only insure that the input function
+|pk_byte| can read packed bytes.
+
+@<Types...@>=
+@!eight_bits=0..255; {packed file byte}
+@!word_file=packed file of integer; {for pixel file words}
+@!byte_file=packed file of eight_bits ; {for packed file words}
+@^system dependancies@>
+
+@ @<Glob...@>=
+@!pxl_file:word_file; {where the input comes from}
+@!pk_file:byte_file; {where the final output goes}
+@^system dependencies@>
+
+@ To prepare these files for input, we |reset| them. An extension of
+\PASCAL\ is needed in the case of |pxl_file|, since we want to associate
+it with external files whose names are specified dynamically (i.e., not
+known at compile time). The following code assumes that `|reset(f,s)|'
+does this, when |f| is a file variable and |s| is a string variable that
+specifies the file name. If |eof(f)| is true immediately after
+|reset(f,s)| has acted, we assume that no file named |s| is accessible.
+@^system dependencies@>
+
+@p procedure open_pxl_file; {prepares to write packed bytes in a |pxl_file|}
+begin rewrite(pxl_file,pxl_name);
+pxl_loc := 0 ;
+end;
+@#
+procedure open_pk_file; {prepares the input for reading}
+begin reset(pk_file,pk_name);
+pk_loc := 0 ;
+end;
+
+@ We need a place to store the names of the input and output files, as well
+as a byte counter for the output file.
+
+@<Glob...@>=
+@!pxl_name,@!pk_name:packed array[1..name_length] of char; {names of input
+ and output files}
+@!pxl_loc, @!pk_loc:integer; {how many bytes have we sent?}
+
+@ We need a procedure that will write a word to the \.{PXL} file. If the
+particular system
+@^system dependencies@>
+requires buffering, here is the place to do it.
+
+@p procedure pixel_integer (i : integer) ;
+begin pxl_file^ := i ;
+put(pxl_file) ;
+incr(pxl_loc) ;
+end;
+
+@ We also need a function that will get a single byte from the \.{PK} file.
+Again, buffering may be done in this procedure.
+
+@p function pk_byte : eight_bits ;
+var nybble, temp : eight_bits ;
+begin
+ temp := pk_file^ ;
+ get(pk_file) ;
+ pk_loc := pk_loc + 1 ;
+ pk_byte := temp ;
+end ;
+
+@ Now we are ready to open the files and write the identification of the
+pixel file.
+
+@<Open files@>=
+open_pk_file ;
+open_pxl_file ;
+pixel_integer(pxl_id)
+
+@ As we are reading the packed file, we often need to fetch 16 and 32 bit
+quantities. Here we have two procedures to do this.
+
+@p function get_16 : integer ;
+var a : integer ;
+begin a := pk_byte ; get_16 := a * 256 + pk_byte ; end ;
+@#
+function get_32 : integer ;
+var a : integer ;
+begin a := get_16 ; if a > 32767 then a := a - 65536 ;
+get_32 := a * 65536 + get_16 ; end ;
+
+@ Now we read and check the preamble of the \.{PK} file. In the preamble, we
+find the |hppp|, |design_size|, |checksum|.
+
+@<Read preamble@>=
+if pk_byte <> pk_pre then abort('Bad pk file! pre command missing.') ;
+if pk_byte <> pk_id then abort('Wrong version of packed file!.') ;
+j := pk_byte ;
+for i := 1 to j do hppp := pk_byte ;
+design_size := get_32 ;
+checksum := get_32 ;
+hppp := get_32 ; vppp := get_32 ;
+if hppp <> vppp then print_ln('Warning: aspect ratio not 1:1!') ;
+magnification := round(hppp * 72.27 * 5 / 65536)
+
+@ Of course, we need to define the above variables.
+
+@<Glob...@>=
+@!magnification : integer ; {resolution at which pixel file is prepared}
+@!design_size : integer ; {design size in \.{FIXes}}
+@!checksum : integer ; {checksum of pixel file}
+@!hppp, @!vppp : integer ; {horizontal and vertical points per inch}
+
+@* Character unpacking.
+This is the procedure where we read the character packet and decode it into
+standard pixel raster format. We create one row at a time, checking for
+repeat commands, and then repeat the row as many times as is necessary.
+The information
+gleaned from the beginning of the character packet is to be placed in
+the arrays |sizes|, |offsets|, |raster_pointer|, and |tfm_width|.
+We also check that the length of the character packet is correct.
+
+@<Unpack and write character@>=
+dyn_f := flag_byte div 16 ;
+flag_byte := flag_byte mod 16 ;
+turn_on := flag_byte >= 8 ;
+if turn_on then flag_byte := flag_byte - 8 ;
+if flag_byte = 7 then
+ @<Read long character preamble@>
+else if flag_byte > 3 then
+ @<Read extended short character preamble@>
+else
+ @<Read short character preamble@> ;
+if raster_pointer[car] <> 0 then abort('Second time this character used!') ;
+raster_pointer[car] := pxl_loc ;
+@<Read and translate raster description@> ;
+if end_of_packet <> pk_loc then abort('Bad pk file! Bad packet length.')
+
+@ We need a whole lot of globals used but not defined up there.
+
+@<Glob...@>=
+@!i, @!j : integer ; {index pointers}
+@!end_of_packet : integer ; {where we expect the end of the packet to be}
+@!raster_pointer : array [0..127] of integer ; {raster pointers}
+@!sizes : array [0..127] of integer ; {character sizes}
+@!offsets : array [0..127] of integer ; {character offsets}
+@!tfm_width : array [0..127] of integer ; {character \.{tfm} widths}
+@!dyn_f : integer ; {dynamic packing variable}
+@!car : integer ; {the character we are reading}
+
+@ We also need to initialize the |raster_pointer| array to zeros.
+
+@<Set init...@>=
+for i := 0 to 127 do raster_pointer[i] := 0 ;
+
+@ Now, the preamble reading modules. First, we have the general case: the
+long character preamble format. If the character number is too large, we go
+to the label |bad_char|.
+
+@<Read long character preamble@>=
+begin
+ packet_length := get_32 ; car := get_32 ;
+ end_of_packet := packet_length + pk_loc ;
+ if (car > 127) or (car < 0) then goto bad_char ;
+ tfm_width[car] := get_32 ;
+ hor_esc := get_32 ;
+ i := get_32 ;
+ c_width := get_32 ;
+ c_height := get_32 ;
+ if (c_width < 0) or (c_height < 0) or (c_width > 65535) or
+ (c_height > 65535) then goto bad_char ;
+ word_width := (c_width + 31) div 32 ;
+ sizes[car] := c_width * 65536 + c_height ;
+ i := get_32 ; j := get_32 ;
+ if j < 0 then j := j + 65536 ;
+ offsets[car] := i * 65536 + j ;
+end
+
+@ This module reads the character preamble with double byte parameters.
+
+@<Read extended short character preamble@>=
+begin
+ packet_length := (flag_byte - 4) * 65536 + get_16 ;
+ car := pk_byte ;
+ end_of_packet := packet_length + pk_loc ;
+ if car > 127 then goto bad_char ;
+ i := pk_byte ;
+ tfm_width[car] := i * 65536 + get_16 ;
+ hor_esc := get_16 ;
+ c_width := get_16 ;
+ c_height := get_16 ;
+ word_width := (c_width + 31) div 32 ;
+ sizes[car] := c_width * 65536 + c_height ;
+ i := get_16 ; j := get_16 ;
+ if i > 32767 then i := i - 65536 ;
+ offsets[car] := i * 65536 + j ;
+end
+
+@ Here we read the most common character preamble, that with single byte
+parameters.
+
+@<Read short character preamble@>=
+begin
+ packet_length := flag_byte * 256 + pk_byte ;
+ car := pk_byte ;
+ end_of_packet := packet_length + pk_loc ;
+ if car > 127 then goto bad_char ;
+ i := pk_byte ;
+ tfm_width[car] := i * 65536 + get_16 ;
+ hor_esc := pk_byte ;
+ c_width := pk_byte ;
+ c_height := pk_byte ;
+ word_width := (c_width + 31) div 32 ;
+ sizes[car] := c_width * 65536 + c_height ;
+ i := pk_byte ; j := pk_byte ;
+ if i > 127 then i := i - 256 ;
+ if j > 127 then j := j + 255 * 256 ;
+ offsets[car] := i * 65536 + j ;
+end
+
+@ Some more globals:
+
+@<Glob...@>=
+@!c_height, @!c_width : integer ; {sizes of the character glyphs}
+@!c_offsets : integer ; {where to put the character offsets}
+@!word_width : integer ; {width of character in raster words}
+@!hor_esc : integer ; {the character escapement}
+@!packet_length : integer ; {the length of the packet in bytes}
+
+@ Now we have the most important part of the program, where we actually
+interpret the commands in the raster description. First of all, we need
+a procedure to get a single nybble from the file, as well as one to get
+a single bit. We also use the |pk_packed_num| procedure defined in the
+\.{PK} file description.
+
+@p function get_nyb : integer ;
+var temp : eight_bits ;
+begin
+ if bit_weight = 0 then begin
+ input_byte := pk_byte ;
+ bit_weight := 16 ;
+ end ;
+ temp := input_byte div bit_weight ;
+ input_byte := input_byte - temp * bit_weight ;
+ bit_weight := bit_weight div 16 ;
+ get_nyb := temp ;
+end ;
+@#
+function get_bit : boolean ;
+var temp : boolean ;
+begin
+ bit_weight := bit_weight div 2 ;
+ if bit_weight = 0 then begin
+ input_byte := pk_byte ;
+ bit_weight := 128 ;
+ end ;
+ temp := input_byte >= bit_weight ;
+ if temp then
+ input_byte := input_byte - bit_weight ;
+ get_bit := temp ;
+end ;
+@<Packed number procedure@>
+
+@ Now, the globals to help communication between these procedures, and a buffer
+for the raster row.
+
+@<Glob...@>=
+@!input_byte : eight_bits ; {the byte we are currently decimating}
+@!bit_weight : eight_bits ; {weight of the current bit}
+@!nybble : eight_bits ; {the current nybble}
+@!row : array [0..max_div_32] of integer ; {where the row is constructed}
+
+@ And the main procedure.
+
+@<Read and translate raster description@>=
+bit_weight := 0 ;
+if dyn_f = 14 then
+ @<Get raster by bits@>
+else @<Create normally packed raster@>
+
+@ If |dyn_f=14|, then we need to get the raster representation
+one bit at a time.
+
+@<Get raster by bits@>=
+begin
+bit_weight := 0 ;
+for i := 1 to c_height do begin
+ word := 0 ;
+ word_weight := 31 ;
+ for j := 1 to c_width do begin
+ if get_bit then word := word + power[word_weight] ;
+ word_weight := word_weight - 1 ;
+ if word_weight = -1 then begin
+ pixel_integer(word) ;
+ word := 0 ;
+ word_weight := 31 ;
+ end ;
+ end ;
+ if word_weight < 31 then
+ pixel_integer(word) ;
+end;
+end
+
+@ We need the power array, which contains the powers of two, as well as the
+|word| and |word_weight| variables for the above procedure.
+
+@<Glob...@>=
+@!word : integer ; {contains partially created raster word}
+@!word_weight : integer ; {weight of the current position}
+@!power : array [0..31] of integer ; {contains the powers of two}
+@!gpower : array [0..32] of integer ; {contains various rows of black}
+
+@ @<Set init...@>=
+power[0] := 1 ;
+for i := 1 to 30 do power[i] := power[i-1] * 2 ;
+power[31] := - one_fourth - one_fourth ;
+gpower[0] := 0 ;
+for i := 1 to 32 do gpower[i] := gpower[i-1] + power[i-1] ;
+
+@ @<Const...@>=
+one_fourth = 1073741824 ;
+
+@ Otherwise, we translate the bit counts into the raster rows. |count|
+contains the number of bits of the current color, and |turn_on| indicates
+whether or not they should be black. |rows_left| contains the number of
+rows to be sent.
+
+@<Create normally packed raster@>=
+begin
+rows_left := c_height ;
+h_bit := c_width ;
+repeat_count := 0 ;
+word_weight := 32 ;
+word := 0 ;
+r_p := 1 ;
+while rows_left > 0 do begin
+ count := pk_packed_num ;
+ while count > 0 do begin
+ if (count < word_weight) and (count < h_bit) then begin
+ if turn_on then word := word + gpower[word_weight] -
+ gpower[word_weight - count] ;
+ h_bit := h_bit - count ;
+ word_weight := word_weight - count ;
+ count := 0 ;
+ end else if (count >= h_bit) and (h_bit <= word_weight) then begin
+ if turn_on then word := word + gpower[word_weight] -
+ gpower[word_weight - h_bit] ;
+ row[r_p] := word ;
+ @<Send row@> ;
+ rows_left := rows_left - repeat_count - 1 ;
+ repeat_count := 0 ;
+ r_p := 1 ;
+ word := 0 ;
+ word_weight := 32 ;
+ count := count - h_bit ;
+ h_bit := c_width ;
+ end else begin
+ if turn_on then word := word + gpower[word_weight] ;
+ row[r_p] := word ;
+ r_p := r_p + 1 ;
+ word := 0 ;
+ count := count - word_weight ;
+ h_bit := h_bit - word_weight ;
+ word_weight := 32 ;
+ end ;
+ end ;
+ turn_on := not turn_on ;
+end ;
+if (rows_left <> 0) or (h_bit <> c_width) then
+ abort('Bad pk file---more bits than required!');
+end
+
+@ We need to declare the repeat flag, bit counter, and color flag here.
+
+@<Glob...@>=
+@!repeat_count : integer ; {how many times to repeat the next row?}
+@!rows_left : integer ; {how many rows left?}
+@!turn_on : boolean ; {are we black here?}
+@!h_bit : integer ; {what is our horizontal position?}
+@!count : integer ; {how many bits of current color left?}
+@!r_p : integer ; {where in the row are we?}
+
+@ @<Send row@>=
+for i := 0 to repeat_count do
+ for j := 1 to word_width do
+ pixel_integer(row[j])
+
+@ To finish up the pixel file, we simply write out the data for each of the
+characters, including the tfm widths, their raster locations, sizes, and
+offsets. Then, we finish up the pixel file with the |magnification|,
+|design_size|, |checksum|, and another |pxl_id|.
+
+@<Write pixel directory@>=
+dir_ptr := pxl_loc ;
+for car := 0 to 127 do begin
+ pixel_integer(sizes[car]) ;
+ pixel_integer(offsets[car]) ;
+ pixel_integer(raster_pointer[car]) ;
+ pixel_integer(tfm_width[car]) ;
+end ;
+pixel_integer(checksum) ;
+pixel_integer(magnification) ;
+pixel_integer(design_size) ;
+pixel_integer(dir_ptr) ;
+pixel_integer(pxl_id)
+
+@ We need a global |dir_ptr| which holds the location of the pixel
+directory, as well as the |flag_byte| variable.
+
+@<Glob...@>=
+@!dir_ptr : integer ; {where does the pixel directory begin?}
+@!flag_byte : integer ; {command or character flag byte}
+
+@ Another necessary procedure skips over any specials between characters
+and before and after the postamble.
+
+@p procedure skip_specials ;
+var i, j, k : integer ;
+begin
+ repeat
+ flag_byte := pk_byte ;
+ if flag_byte >= 240 then
+ case flag_byte of
+ 240, 241, 242, 243 :
+begin
+ i := 0 ;
+ for j := 240 to flag_byte do i := 256 * i + pk_byte ;
+ for j := 1 to i do k := pk_byte ;
+end ;
+ 244 : i := get_32 ;
+ 245 : begin end ;
+ 246 : begin end ;
+ 247, 248, 249, 250, 251, 252, 253, 254, 255 :
+ abort('Unexpected ', flag_byte:1,'!') ;
+ endcases ;
+ until (flag_byte < 240) or (flag_byte = pk_post) ;
+end ;
+
+@* Terminal communication.
+We must get the file names and determine whether input is to be in
+hexadecimal or binary. To do this, we use the standard input path
+name. We need a procedure to flush the input buffer. For most systems,
+this will be an empty statement. For other systems, a |print_ln| will
+provide a quick fix. We also need a routine to get a line of input from
+the terminal. On some systems, a simple |read_ln| will do. Finally,
+a macro to print a string to the first blank is required.
+
+@d flush_buffer == begin end
+@d get_line(#) == if eoln(input) then read_ln(input) ;
+ i := 1 ;
+ while not (eoln(input) or eof(input)) do begin
+ #[i] := input^ ;
+ incr(i) ;
+ get(input) ;
+ end ;
+ #[i] := ' '
+
+@ @p procedure dialog ;
+var i : integer ; {index variable}
+buffer : packed array [1..name_length] of char; {input buffer}
+begin
+ for i := 1 to name_length do begin
+ pxl_name[i] := ' ' ;
+ pk_name[i] := ' ' ;
+ end;
+ print('Input file name: ') ;
+ flush_buffer ;
+ get_line(pk_name) ;
+ print('Output file name: ') ;
+ flush_buffer ;
+ get_line(pxl_name) ;
+end ;
+
+@* The main program.
+Now that we have all the pieces written, let us put them together.
+
+@p begin
+initialize ;
+dialog ;
+@<Open files@> ;
+@<Read preamble@> ;
+skip_specials ;
+while flag_byte <> pk_post do begin
+ @<Unpack and write character@> ;
+ goto good_char ;
+ bad_char: while pk_loc <> end_of_packet do i := pk_byte ;
+ print_ln('Character ',car:1,' out of range!') ;
+ good_char: skip_specials ;
+end ;
+while not eof(pk_file) do i := pk_byte ;
+@<Write pixel directory@> ;
+print_ln(pk_loc:1,' bytes read from packed file.');
+print_ln((pxl_loc*4):1,' bytes written to pixel file.');
+final_end :
+end .
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{PKtoPX} work at a particular installation.
+Any additional routines should be inserted here.
+@^system dependencies@>
+
+@* Index.
+Pointers to error messages appear here together with the section numbers
+where each ident\-i\-fier is used.
diff --git a/obsolete/systems/knuth/unsupported/mfware/pktype.tops20-changes b/obsolete/systems/knuth/unsupported/mfware/pktype.tops20-changes
new file mode 100644
index 0000000000..de0fd9917d
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/mfware/pktype.tops20-changes
@@ -0,0 +1,66 @@
+% TOPS-20 change file for PKtype by Tomas Rokicki. Send bug reports to
+% ROKICKI@SU-SCORE. The majority of these changes eliminate the sign-bit
+% manipulations necessary on 32-bit machines, but unnecessary on the 36-bit
+% TOPS-20.
+
+@x [1]
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\ttw{{\mc TOPS-20}}
+\def\title{PKtype changes for \ttw}
+@z
+
+@x [4]
+@d banner=='This is PKtype, Version 2.2'
+@y
+@d banner=='This is PKtype, Version 2.2'
+@d output==tty
+@z
+
+@x [6]
+@p program PKtype(input, output);
+@y
+@p program PKtype;
+@z
+
+@x [56]
+@p procedure open_typ_file; {prepares to write text data to the |typ_file|}
+begin rewrite(typ_file,typ_name);
+end;
+@#
+procedure open_pk_file; {prepares the input for reading}
+begin reset(pk_file,pk_name);
+pk_loc := 0 ;
+end;
+@y
+@p procedure open_typ_file; {prepares to write text data to the |typ_file|}
+begin rewrite(typ_file,typ_name,'/O');
+end;
+@#
+procedure open_pk_file; {prepares the input for reading}
+begin reset(pk_file,pk_name,'/O/B:8');
+pk_loc := 0 ;
+end;
+@z
+
+@x [92]
+@d get_line(#) == if eoln(input) then read_ln(input) ;
+ i := 1 ;
+ while not (eoln(input) or eof(input)) do begin
+ #[i] := input^ ;
+ incr(i) ;
+ get(input) ;
+ end ;
+ #[i] := ' '
+@y
+@d get_line(#) == if eoln(tty) then read_ln(tty) ;
+ i := 1 ;
+ while not (eoln(tty) or eof(tty)) do begin
+ #[i] := tty^ ;
+ incr(i) ;
+ get(tty) ;
+ end ;
+ #[i] := ' '
+@z
diff --git a/obsolete/systems/knuth/unsupported/mfware/pktype.web b/obsolete/systems/knuth/unsupported/mfware/pktype.web
new file mode 100644
index 0000000000..f9ab34149a
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/mfware/pktype.web
@@ -0,0 +1,1156 @@
+% PKtype.web
+%
+% PKtype verifies the correctness of a PK file.
+%
+% Preliminary 0.0 version: May, 1985
+% First release, 0.9 version: 8 May 1985
+% Updated to reflect new pk format, 2.0 version: 25 July 1985
+% Updated again for new pk format, 2.1 version: 15 August 1985
+% Docmentation updated, 2.2 version: 17 November 1987
+%
+% slight editing to correspond with MFware report -- don, 21 Oct 89
+\def\versiondate{30 November 1987}
+%
+\def\hang{\hangindent 3em\noindent\ignorespaces}
+\font\ninerm=cmr9
+\font\logo=logo10 % font used for the METAFONT logo
+\def\MF{{\logo META}\-{\logo FONT}}
+\def\PASCAL{Pascal}
+\def\tamu{Texas A\char38 M}
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index
+\def\title{PKtype}
+\def\contentspagenumber{0}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont PKtype} processor}
+ \vskip 15pt
+ \centerline{(Version 2.2, \versiondate)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ The preparation of this report
+ was supported in part by the National Science
+ Foundation under grants IST-8201926 and MCS-8300984,
+ and by the System Development Foundation. `\TeX' is a
+ trademark of the American Mathematical Society.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+This program reads a \.{PK} file, verifies that it is in the correct
+format, and writes it in textual format.
+
+@ The |banner| string defined here should be changed whenever \.{PKtype}
+gets modified.
+
+@d banner=='This is PKtype, Version 2.2' {printed when the program starts}
+
+@ This program is written in standard \PASCAL, except where it is necessary
+to use extensions; for example, \.{PKtype} must read files whose names
+are dynamically specified, and that would be impossible in pure \PASCAL.
+
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+
+@ Both the input and output come from binary files. On line interaction
+is handled through \PASCAL's standard |input| and |output| files. Two macros
+are used to write to the type file, so this output can be easily redirected.
+
+@d print_ln(#)==write_ln(output,#)
+@d print(#)==write(output,#)
+@d t_print_ln(#)==write_ln(typ_file,#)
+@d t_print(#)==write(typ_file,#)
+
+@p program PKtype(input, output);
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ begin print_ln(banner);@/
+ @<Set initial values@>@/
+ end;
+
+@ If the program has to stop prematurely, it goes to the
+`|final_end|'.
+
+@d final_end=9999 {label for the end of it all}
+
+@<Labels...@>=final_end;
+
+@ These constants determine the maximum length of a file name and the length
+of the terminal line, as well as the widest character that can be translated.
+@^system dependencies@>
+
+@<Constants...@>=
+@!name_length=80; {maximum length of a file name}
+@!terminal_line_length=132; {maximum length of an input line}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d do_nothing == {empty statement}
+
+@ It is possible that a malformed packed file (heaven forbid!) or some other
+error might be detected by this program. Such errors might occur in a deeply
+nested procedure, so the procedure called |jump_out| has been added to transfer
+to the very end of the program with an error message.
+
+@d abort(#)==begin print_ln(' ',#); t_print_ln(' ',#); jump_out; end
+
+@p procedure jump_out;
+begin goto final_end;
+end;
+
+@* The character set.
+Like all programs written with the \.{WEB} system, \.{PKtype} can be
+used with any character set. But it uses ASCII code internally, because
+the programming for portable input-output is easier when a fixed internal
+code is used.
+
+The next few sections of \.{PKtype} have therefore been copied from the
+analogous ones in the \.{WEB} system routines. They have been considerably
+simplified, since \.{PKtype} need not deal with the controversial
+ASCII codes less than @'40 or greater than @'176.
+
+@<Types...@>=
+@!ASCII_code=" ".."~"; {a subrange of the integers}
+
+@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
+character sets were common, so it did not make provision for lower case
+letters. Nowadays, of course, we need to deal with both upper and lower case
+alphabets in a convenient way, especially in a program like \.{PKtype}.
+So we shall assume that the \PASCAL\ system being used for \.{PKtype}
+has a character set containing at least the standard visible characters
+of ASCII code (|"!"| through |"~"|).
+
+Some \PASCAL\ compilers use the original name |char| for the data type
+associated with the characters in text files, while other \PASCAL s
+consider |char| to be a 64-element subrange of a larger data type that has
+some other name. In order to accommodate this difference, we shall use
+the name |text_char| to stand for the data type of the characters in the
+output file. We shall also assume that |text_char| consists of
+the elements |chr(first_text_char)| through |chr(last_text_char)|,
+inclusive. The following definitions should be adjusted if necessary.
+@^system dependencies@>
+
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=127 {ordinal number of the largest element of |text_char|}
+
+@<Types...@>=
+@!text_file=packed file of text_char;
+
+@ The \.{PKtype} processor converts between ASCII code and
+the user's external character set by means of arrays |xord| and |xchr|
+that are analogous to \PASCAL's |ord| and |chr| functions.
+
+@<Globals...@>=
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [0..255] of text_char;
+ {specifies conversion of output characters}
+
+@ Under our assumption that the visible characters of standard ASCII are
+all present, the following assignment statements initialize the
+|xchr| array properly, without needing any system-dependent changes.
+
+@<Set init...@>=
+for i:=0 to @'37 do xchr[i]:='?';
+xchr[@'40]:=' ';
+xchr[@'41]:='!';
+xchr[@'42]:='"';
+xchr[@'43]:='#';
+xchr[@'44]:='$';
+xchr[@'45]:='%';
+xchr[@'46]:='&';
+xchr[@'47]:='''';@/
+xchr[@'50]:='(';
+xchr[@'51]:=')';
+xchr[@'52]:='*';
+xchr[@'53]:='+';
+xchr[@'54]:=',';
+xchr[@'55]:='-';
+xchr[@'56]:='.';
+xchr[@'57]:='/';@/
+xchr[@'60]:='0';
+xchr[@'61]:='1';
+xchr[@'62]:='2';
+xchr[@'63]:='3';
+xchr[@'64]:='4';
+xchr[@'65]:='5';
+xchr[@'66]:='6';
+xchr[@'67]:='7';@/
+xchr[@'70]:='8';
+xchr[@'71]:='9';
+xchr[@'72]:=':';
+xchr[@'73]:=';';
+xchr[@'74]:='<';
+xchr[@'75]:='=';
+xchr[@'76]:='>';
+xchr[@'77]:='?';@/
+xchr[@'100]:='@@';
+xchr[@'101]:='A';
+xchr[@'102]:='B';
+xchr[@'103]:='C';
+xchr[@'104]:='D';
+xchr[@'105]:='E';
+xchr[@'106]:='F';
+xchr[@'107]:='G';@/
+xchr[@'110]:='H';
+xchr[@'111]:='I';
+xchr[@'112]:='J';
+xchr[@'113]:='K';
+xchr[@'114]:='L';
+xchr[@'115]:='M';
+xchr[@'116]:='N';
+xchr[@'117]:='O';@/
+xchr[@'120]:='P';
+xchr[@'121]:='Q';
+xchr[@'122]:='R';
+xchr[@'123]:='S';
+xchr[@'124]:='T';
+xchr[@'125]:='U';
+xchr[@'126]:='V';
+xchr[@'127]:='W';@/
+xchr[@'130]:='X';
+xchr[@'131]:='Y';
+xchr[@'132]:='Z';
+xchr[@'133]:='[';
+xchr[@'134]:='\';
+xchr[@'135]:=']';
+xchr[@'136]:='^';
+xchr[@'137]:='_';@/
+xchr[@'140]:='`';
+xchr[@'141]:='a';
+xchr[@'142]:='b';
+xchr[@'143]:='c';
+xchr[@'144]:='d';
+xchr[@'145]:='e';
+xchr[@'146]:='f';
+xchr[@'147]:='g';@/
+xchr[@'150]:='h';
+xchr[@'151]:='i';
+xchr[@'152]:='j';
+xchr[@'153]:='k';
+xchr[@'154]:='l';
+xchr[@'155]:='m';
+xchr[@'156]:='n';
+xchr[@'157]:='o';@/
+xchr[@'160]:='p';
+xchr[@'161]:='q';
+xchr[@'162]:='r';
+xchr[@'163]:='s';
+xchr[@'164]:='t';
+xchr[@'165]:='u';
+xchr[@'166]:='v';
+xchr[@'167]:='w';@/
+xchr[@'170]:='x';
+xchr[@'171]:='y';
+xchr[@'172]:='z';
+xchr[@'173]:='{';
+xchr[@'174]:='|';
+xchr[@'175]:='}';
+xchr[@'176]:='~';
+for i:=@'177 to 255 do xchr[i]:='?';
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|.
+
+@<Set init...@>=
+for i:=first_text_char to last_text_char do xord[chr(i)]:=@'40;
+for i:=" " to "~" do xord[xchr[i]]:=i;
+
+@* Packed file format.
+The packed file format is a compact representation of the data contained in a
+\.{GF} file. The information content is the same, but packed (\.{PK}) files
+are almost always less than half the size of their \.{GF} counterparts. They
+are also easier to convert into a raster representation because they do not
+have a profusion of \\{paint}, \\{skip}, and \\{new\_row} commands to be
+separately interpreted. In addition, the \.{PK} format expressedly forbids
+\&{special} commands within a character. The minimum bounding box for each
+character is explicit in the format, and does not need to be scanned for as in
+the \.{GF} format. Finally, the width and escapement values are combined with
+the raster information into character ``packets'', making it simpler in many
+cases to process a character.
+
+A \.{PK} file is organized as a stream of 8-bit bytes. At times, these bytes
+might be split into 4-bit nybbles or single bits, or combined into multiple
+byte parameters. When bytes are split into smaller pieces, the `first' piece
+is always the most significant of the byte. For instance, the first bit of
+a byte is the bit with value 128; the first nybble can be found by dividing
+a byte by 16. Similarly, when bytes are combined into multiple byte
+parameters, the first byte is the most significant of the parameter. If the
+parameter is signed, it is represented by two's-complement notation.
+
+The set of possible eight-bit values is separated into two sets, those that
+introduce a character definition, and those that do not. The values that
+introduce a character definition range from 0 to 239; byte values
+above 239 are interpreted as commands. Bytes that introduce character
+definitions are called flag bytes, and various fields within the byte indicate
+various things about how the character definition is encoded. Command bytes
+have zero or more parameters, and can never appear within a character
+definition or between parameters of another command, where they would be
+interpeted as data.
+
+A \.{PK} file consists of a preamble, followed by a sequence of one or more
+character definitions, followed by a postamble. The preamble command must
+be the first byte in the file, followed immediately by its parameters.
+Any number of character definitions may follow, and any command but the
+preamble command and the postamble command may occur between character
+definitions. The very last command in the file must be the postamble.
+
+@ The packed file format is intended to be easy to read and interpret by
+device drivers. The small size of the file reduces the input/output overhead
+each time a font is loaded. For those drivers that load and save each font
+file into memory, the small size also helps reduce the memory requirements.
+The length of each character packet is specified, allowing the character raster
+data to be loaded into memory by simply counting bytes, rather than
+interpreting each command; then, each character can be interpreted on a demand
+basis. This also makes it possible for a driver to skip a particular
+character quickly if it knows that the character is unused.
+
+@ First, the command bytes will be presented; then the format of the
+character definitions will be defined. Eight of the possible sixteen
+commands (values 240 through 255) are currently defined; the others are
+reserved for future extensions. The commands are listed below. Each command
+is specified by its symbolic name (e.g., \\{pk\_no\_op}), its opcode byte,
+and any parameters. The parameters are followed by a bracketed number
+telling how many bytes they occupy, with the number preceded by a plus sign if
+it is a signed quantity. (Four byte quantities are always signed, however.)
+
+\yskip\hang|pk_xxx1| 240 |k[1]| |x[k]|. This command is undefined in general;
+it functions as a $(k+2)$-byte \\{no\_op} unless special \.{PK}-reading
+programs are being used. \MF\ generates \\{xxx} commands when encountering
+a \&{special} string. It is recommended that |x| be a string having the form
+of a keyword followed by possible parameters relevant to that keyword.
+
+\yskip\hang\\{pk\_xxx2} 241 |k[2]| |x[k]|. Like |pk_xxx1|, but |0<=k<65536|.
+
+\yskip\hang\\{pk\_xxx3} 242 |k[3]| |x[k]|. Like |pk_xxx1|, but
+|0<=k<@t$2^{24}$@>|. \MF\ uses this when sending a \&{special} string whose
+length exceeds~255.
+
+\yskip\hang\\{pk\_xxx4} 243 |k[4]| |x[k]|. Like |pk_xxx1|, but |k| can be
+ridiculously large; |k| musn't be negative.
+
+\yskip\hang|pk_yyy| 244 |y[4]|. This command is undefined in general; it
+functions as a five-byte \\{no\_op} unless special \.{PK} reading programs
+are being used. \MF\ puts |scaled| numbers into |yyy|'s, as a result of
+\&{numspecial} commands; the intent is to provide numeric parameters to
+\\{xxx} commands that immediately precede.
+
+\yskip\hang|pk_post| 245. Beginning of the postamble. This command is
+followed by enough |pk_no_op| commands to make the file a multiple
+of four bytes long. Zero through three bytes are usual, but any number
+is allowed.
+This should make the file easy to read on machines that pack four bytes to
+a word.
+
+\yskip\hang|pk_no_op| 246. No operation, do nothing. Any number of
+|pk_no_op|'s may appear between \.{PK} commands, but a |pk_no_op| cannot be
+inserted between a command and its parameters, between two parameters, or
+inside a character definition.
+
+\yskip\hang|pk_pre| 247 |i[1]| |k[1]| |x[k]| |ds[4]| |cs[4]| |hppp[4]|
+|vppp[4]|. Preamble command. Here, |i| is the identification byte of the
+file, currently equal to 89. The string |x| is merely a comment, usually
+indicating the source of the \.{PK} file. The parameters |ds| and |cs| are
+the design size of the file in $1/2^{20}$ points, and the checksum of the
+file, respectively. The checksum should match the \.{TFM} file and the
+\.{GF} files for this font. Parameters |hppp| and |vppp| are the ratios
+of pixels per point, horizontally and vertically, multiplied by $2^{16}$; they
+can be used to correlate the font with specific device resolutions,
+magnifications, and ``at sizes''. Usually, the name of the \.{PK} file is
+formed by concatenating the font name (e.g., cmr10) with the resolution at
+which the font is prepared in pixels per inch multiplied by the magnification
+factor, and the letters \.{PK}. For instance, cmr10 at 300 dots per inch
+should be named \.{CMR10.300PK}; at one thousand dots per inch and magstephalf,
+it should be named \.{CMR10.1095PK}.
+
+@ We put a few of the above opcodes into definitions for symbolic use by
+this program.
+
+@d pk_id = 89 {the version of \.{PK} file described}
+@d pk_xxx1 = 240 {\&{special} commands}
+@d pk_yyy = 244 {\&{numspecial} commands}
+@d pk_post = 245 {postamble}
+@d pk_no_op = 246 {no operation}
+@d pk_pre = 247 {preamble}
+
+@ The \.{PK} format has two conflicting goals: to pack character raster and
+size information as compactly as possible, while retaining ease of translation
+into raster and other forms. A suitable compromise was found in the use of
+run-encoding of the raster information. Instead of packing the individual
+bits of the character, we instead count the number of consecutive `black' or
+`white' pixels in a horizontal raster row, and then encode this number. Run
+counts are found for each row from left to right, traversing rows from the
+top to bottom. This is essentially the way the \.{GF} format works.
+Instead of presenting each row individually, however, we concatenate all
+of the horizontal raster rows into one long string of pixels, and encode this
+row. With knowledge of the width of the bit-map, the original character glyph
+can be easily reconstructed. In addition, we do not need special commands to
+mark the end of one row and the beginning of the next.
+
+Next, we place the burden of finding the minimum bounding box on the part
+of the font generator, since the characters will usually be used much more
+often than they are generated. The minimum bounding box is the smallest
+rectangle that encloses all `black' pixels of a character. We also
+eliminate the need for a special end of character marker, by supplying
+exactly as many bits as are required to fill the minimum bounding box, from
+which the end of the character is implicit.
+
+Let us next consider the distribution of the run counts. Analysis of several
+dozen pixel files at 300 dots per inch yields a distribution peaking at four,
+falling off slowly until ten, then a bit more steeply until twenty, and then
+asymptotically approaching the horizontal. Thus, the great majority of our
+run counts will fit in a four-bit nybble. The eight-bit byte is attractive for
+our run-counts, as it is the standard on many systems; however, the wasted four
+bits in the majority of cases seem a high price to pay. Another possibility
+is to use a Huffman-type encoding scheme with a variable number of bits for
+each run-count; this was rejected because of the overhead in fetching and
+examining individual bits in the file. Thus, the character raster definitions
+in the \.{PK} file format are based on the four-bit nybble.
+
+@ An analysis of typical pixel files yielded another interesting statistic:
+Fully 37\char`\%\
+of the raster rows were duplicates of the previous row. Thus, the \.{PK}
+format allows the specification of repeat counts, which indicate how many times
+a horizontal raster row is to be repeated. These repeated rows are taken out
+of the character glyph before individual rows are concatenated into the long
+string of pixels.
+
+For elegance, we disallow a run count of zero. The case of a null raster
+description should be gleaned from the character width and height being equal
+to zero, and no raster data should be read. No other zero counts are ever
+necessary. Also, in the absence of repeat counts, the repeat value is set to
+be zero (only the original row is sent.) If a repeat count is seen, it takes
+effect on the current row. The current row is defined as the row on which the
+first pixel of the next run count will lie. The repeat count is set back to
+zero when the last pixel in the current row is seen, and the row is sent out.
+
+This poses a problem for entirely black and entirely white rows, however. Let
+us say that the current row ends with four white pixels, and then we have five
+entirely empty rows, followed by a black pixel at the beginning of the next
+row, and the character width is ten pixels. We would like to use a repeat
+count, but there is no legal place to put it. If we put it before the white
+run count, it will apply to the current row. If we put it after, it applies
+to the row with the black pixel at the beginning. Thus, entirely white or
+entirely black repeated rows are always packed as large run counts (in this
+case, a white run count of 54) rather than repeat counts.
+
+@ Now we turn our attention to the actual packing of the run counts and
+repeat counts into nybbles. There are only sixteen possible nybble values.
+We need to indicate run counts and repeat counts. Since the run counts are
+much more common, we will devote the majority of the nybble values to them.
+We therefore indicate a repeat count by a nybble of 14 followed by a packed
+number, where a packed number will be explained later. Since the repeat
+count value of one is so common, we indicate a repeat one command by a single
+nybble of 15. A 14 followed by the packed number 1 is still legal for a
+repeat one count. The run counts are coded directly as packed
+numbers.
+
+For packed numbers, therefore, we have the nybble values 0 through 13. We
+need to represent the positive integers up to, say, $2^{31}-1$. We would
+like the more common smaller numbers to take only one or two nybbles, and
+the infrequent large numbers to take three or more. We could therefore
+allocate one nybble value to indicate a large run count taking three or more
+nybbles. We do this with the value 0.
+
+@ We are left with the values 1 through 13. We can allocate some of these, say
+|dyn_f|, to be one-nybble run counts.
+These will work for the run counts |1..dyn_f|. For subsequent run
+counts, we will use a nybble greater than |dyn_f|, followed by a second nybble,
+whose value can run from 0 through 15. Thus, the two-nybble values will
+run from |dyn_f+1..(13-dyn_f)*16+dyn_f|. We have our definition of large run
+count values now, being all counts greater than |(13-dyn_f)*16+dyn_f|.
+
+We can analyze our several dozen pixel files and determine an optimal value of
+|dyn_f|, and use this value for all of the characters. Unfortunately, values
+of |dyn_f| that pack small characters well tend to pack the large characters
+poorly, and values that pack large characters well are not efficient for the
+smaller characters. Thus, we choose the optimal |dyn_f| on a character basis,
+picking the value that will pack each individual character in the smallest
+number of nybbles. Legal values of |dyn_f| run from 0 (with no one-nybble run
+counts) to 13 (with no two-nybble run counts).
+
+@ Our only remaining task in the coding of packed numbers is the large run
+counts. We use a scheme suggested by D.~E.~Knuth
+@^Knuth, Donald Ervin@>
+that simply and elegantly represents arbitrarily large values. The
+general scheme to represent an integer |i| is to write its hexadecimal
+representation, with leading zeros removed. Then we count the number of
+digits, and prepend one less than that many zeros before the hexadecimal
+representation. Thus, the values from one to fifteen occupy one nybble;
+the values sixteen through 255 occupy three, the values 256 through 4095
+require five, etc.
+
+For our purposes, however, we have already represented the numbers one
+through |(13-dyn_f)*16+dyn_f|. In addition, the one-nybble values have
+already been taken by our other commands, which means that only the values
+from sixteen up are available to us for long run counts. Thus, we simply
+normalize our long run counts, by subtracting |(13-dyn_f)*16+dyn_f+1| and
+adding 16, and then we represent the result according to the scheme above.
+
+@ The final algorithm for decoding the run counts based on the above scheme
+might look like this, assuming that a procedure called \\{pk\_nyb} is available
+to get the next nybble from the file, and assuming that the global
+|repeat_count| indicates whether a row needs to be repeated. Note that this
+routine is recursive, but since a repeat count can never directly follow
+another repeat count, it can only be recursive to one level.
+
+@<Packed number procedure@>=
+function pk_packed_num : integer ;
+var i, j, k : integer ;
+begin
+ i := get_nyb ;
+ if i = 0 then begin
+ repeat j := get_nyb ; incr(i) ; until j <> 0 ;
+ while i > 0 do begin j := j * 16 + get_nyb ; decr(i) ; end ;
+ pk_packed_num := j - 15 + (13-dyn_f)*16 + dyn_f ;
+ end else if i <= dyn_f then
+ pk_packed_num := i
+ else if i < 14 then
+ pk_packed_num := (i-dyn_f-1)*16+get_nyb+dyn_f+1
+ else begin
+ if repeat_count <> 0 then abort('Second repeat count for this row!') ;
+@.Second repeat count...@>
+ if i = 14 then
+ repeat_count := pk_packed_num
+ else
+ repeat_count := 1 ;
+ send_out(true, repeat_count) ;
+ pk_packed_num := pk_packed_num ;
+ end ;
+end ;
+
+@ For low resolution fonts, or characters with `gray' areas, run encoding can
+often make the character many times larger. Therefore, for those characters
+that cannot be encoded efficiently with run counts, the \.{PK} format allows
+bit-mapping of the characters. This is indicated by a |dyn_f| value of
+14. The bits are packed tightly, by concatenating all of the horizontal raster
+rows into one long string, and then packing this string eight bits to a byte.
+The number of bytes required can be calculated by |(width*height+7) div 8|.
+This format should only be used when packing the character by run counts takes
+more bytes than this, although, of course, it is legal for any character.
+Any extra bits in the last byte should be set to zero.
+
+@ At this point, we are ready to introduce the format for a character
+descriptor. It consists of three parts: a flag byte, a character preamble,
+and the raster data. The most significant four bits of the flag byte
+yield the |dyn_f| value for that character. (Notice that only values of
+0 through 14 are legal for |dyn_f|, with 14 indicating a bit mapped character;
+thus, the flag bytes do not conflict with the command bytes, whose upper nybble
+is always 15.) The next bit (with weight 16) indicates whether the first run
+count is a black count or a white count, with a one indicating a black count.
+For bit-mapped characters, this bit should be set to a zero. The next bit
+(with weight 8) indicates whether certain later parameters (referred to as size
+parameters) are given in one-byte or two-byte quantities, with a one indicating
+that they are in two-byte quantities. The last two bits are concatenated on to
+the beginning of the length parameter in the character preamble, which will be
+explained below.
+
+However, if the last three bits of the flag byte are all set (normally
+indicating that the size parameters are two-byte values and that a 3 should be
+prepended to the length parameter), then a long format of the character
+preamble should be used instead of one of the short forms.
+
+Therefore, there are three formats for the character preamble; the one that
+is used depends on the least significant three bits of the flag byte. If the
+least significant three bits are in the range zero through three, the short
+format is used. If they are in the range four through six, the extended short
+format is used. Otherwise, if the least significant bits are all set, then
+the long form of the character preamble is used. The preamble formats are
+explained below.
+
+\yskip\hang Short form: |flag[1]| |pl[1]| |cc[1]| |tfm[3]| |dm[1]| |w[1]|
+|h[1]| |hoff[+1]| |voff[+1]|.
+If this format of the character preamble is used, the above
+parameters must all fit in the indicated number of bytes, signed or unsigned
+as indicated. Almost all of the standard \TeX\ font characters fit; the few
+exceptions are fonts such as \.{aminch}.
+
+\yskip\hang Extended short form: |flag[1]| |pl[2]| |cc[1]| |tfm[3]| |dm[2]|
+|w[2]| |h[2]| |hoff[+2]| |voff[+2]|. Larger characters use this extended
+format.
+
+\yskip\hang Long form: |flag[1]| |pl[4]| |cc[4]| |tfm[4]| |dx[4]| |dy[4]|
+|w[4]| |h[4]| |hoff[4]| |voff[4]|. This is the general format that
+allows all of the
+parameters of the \.{GF} file format, including vertical escapement.
+\vskip\baselineskip
+The |flag| parameter is the flag byte. The parameter |pl| (packet length)
+contains the offset
+of the byte following this character descriptor, with respect to the beginning
+of the |tfm| width parameter. This is given so a \.{PK} reading program can,
+once it has read the flag byte, packet length, and character code (|cc|), skip
+over the character by simply reading this many more bytes. For the two short
+forms of the character preamble, the last two bits of the flag byte should be
+considered the two most-significant bits of the packet length. For the short
+format, the true packet length might be calculated as |(flag mod 4)*256+pl|;
+for the short extended format, it might be calculated as
+|(flag mod 4)*65536+pl|.
+
+The |w| parameter is the width and the |h| parameter is the height in pixels
+of the minimum bounding box. The |dx| and |dy| parameters are the horizontal
+and vertical escapements, respectively. In the short formats, |dy| is assumed
+to be zero and |dm| is |dx| but in pixels;
+in the long format, |dx| and |dy| are both
+in pixels multiplied by $2^{16}$. The |hoff| is the horizontal offset from the
+upper left pixel to the reference pixel; the |voff| is the vertical offset.
+They are both given in pixels, with right and down being positive. The
+reference pixel is the pixel that occupies the unit square in \MF; the
+\MF\ reference point is the lower left hand corner of this pixel. (See the
+example below.)
+
+@ \TeX\ requires all characters that have the same character codes
+modulo 256 to have also the same |tfm| widths and escapement values. The \.{PK}
+format does not itself make this a requirement, but in order for the font to
+work correctly with the \TeX\ software, this constraint should be observed.
+(The standard version of \TeX\ cannot output character codes greater
+than 255, but extended versions do exist.)
+
+Following the character preamble is the raster information for the
+character, packed by run counts or by bits, as indicated by the flag byte.
+If the character is packed by run counts and the required number of nybbles
+is odd, then the last byte of the raster description should have a zero
+for its least significant nybble.
+
+@ As an illustration of the \.{PK} format, the character \char4\ from the font
+amr10 at 300 dots per inch will be encoded. This character was chosen
+because it illustrates some
+of the borderline cases. The raster for the character looks like this (the
+row numbers are chosen for convenience, and are not \MF's row numbers.)
+
+\vskip\baselineskip
+{\def\smbox{\vrule height 7pt width 7pt depth 0pt \hskip 3pt}%
+\catcode`\*=\active \let*=\smbox
+\centerline{\vbox{\baselineskip=10pt
+\halign{\hfil#\quad&&\hfil#\hfil\cr
+0& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr
+1& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr
+2& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr
+3& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr
+4& & &*&*& & & & & & & & & & & & & & & & &*&*\cr
+5& & &*&*& & & & & & & & & & & & & & & & &*&*\cr
+6& & &*&*& & & & & & & & & & & & & & & & &*&*\cr
+7\cr
+8\cr
+9& & & & &*&*& & & & & & & & & & & & &*&*& & \cr
+10& & & & &*&*& & & & & & & & & & & & &*&*& & \cr
+11& & & & &*&*& & & & & & & & & & & & &*&*& & \cr
+12& & & & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& & \cr
+13& & & & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& & \cr
+14& & & & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& & \cr
+15& & & & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& & \cr
+16& & & & &*&*& & & & & & & & & & & & &*&*& & \cr
+17& & & & &*&*& & & & & & & & & & & & &*&*& & \cr
+18& & & & &*&*& & & & & & & & & & & & &*&*& & \cr
+19\cr
+20\cr
+21\cr
+22& & &*&*& & & & & & & & & & & & & & & & &*&*\cr
+23& & &*&*& & & & & & & & & & & & & & & & &*&*\cr
+24& & &*&*& & & & & & & & & & & & & & & & &*&*\cr
+25& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr
+26& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr
+27& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr
+28&+& &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr
+&\hphantom{*}&\hphantom{*}\cr
+}}}}
+The width of the minimum bounding box for this character is 20; its height
+is 29. The `+' represents the reference pixel; notice how it lies outside the
+minimum bounding box. The |hoff| value is $-2$, and the |voff| is~28.
+
+The first task is to calculate the run counts and repeat counts. The repeat
+counts are placed at the first transition (black to white or white to black)
+in a row, and are enclosed in brackets. White counts are enclosed in
+parentheses. It is relatively easy to generate the counts list:
+\vskip\baselineskip
+\centerline{82 [2] (16) 2 (42) [2] 2 (12) 2 (4) [3]}
+\centerline{16 (4) [2] 2 (12) 2 (62) [2] 2 (16) 82}
+\vskip\baselineskip
+Note that any duplicated rows that are not all white or all black are removed
+before the repeat counts are calculated. The rows thus removed are rows 5, 6,
+10, 11, 13, 14, 15, 17, 18, 23, and 24.
+
+@ The next step in the encoding of this character is to calculate the optimal
+value of |dyn_f|. The details of how this calculation is done are not
+important here; suffice it to say that there is a simple algorithm that can
+determine the best value of |dyn_f| in one pass over the count list. For this
+character, the optimal value turns out to be 8 (atypically low). Thus, all
+count values less than or equal to 8 are packed in one nybble; those from
+nine to $(13-8)*16+8$ or 88 are packed in two nybbles. The run encoded values
+now become (in hex, separated according to the above list):
+\vskip\baselineskip
+\centerline{\tt D9 E2 97 2 B1 E2 2 93 2 4 E3}
+\centerline{\tt 97 4 E2 2 93 2 C5 E2 2 97 D9}
+\vskip\baselineskip\noindent
+which comes to 36 nybbles, or 18 bytes. This is shorter than the 73 bytes
+required for the bit map, so we use the run count packing.
+
+@ The short form of the character preamble is used because all of the
+parameters fit in their respective lengths. The packet length is therefore
+18 bytes for the raster, plus
+eight bytes for the character preamble parameters following the character
+code, or 26. The |tfm| width for this character is 640796, or {\tt 9C71C} in
+hexadecimal. The horizontal escapement is 25 pixels. The flag byte is
+88 hex, indicating the short preamble, the black first count, and the
+|dyn_f| value of 8. The final total character packet, in hexadecimal, is:
+\vskip\baselineskip
+$$\vbox{\halign{\hfil #\quad&&{\tt #\ }\cr
+Flag byte&88\cr
+Packet length&1A\cr
+Character code&04\cr
+|tfm| width&09&C7&1C\cr
+Horizontal escapement (pixels)&19\cr
+Width of bit map&14\cr
+Height of bit map&1D\cr
+Horizontal offset (signed)&FE\cr
+Vertical offset&1C\cr
+Raster data&D9&E2&97\cr
+&2B&1E&22\cr
+&93&24&E3\cr
+&97&4E&22\cr
+&93&2C&5E\cr
+&22&97&D9\cr}}$$
+
+@* Input and output.
+There are two types of files that this program must deal with---standard
+text files and files of bytes (packed files.)
+For our purposes, we shall consider an eight-bit byte to consist of the
+values |0..255|. If your system does not pack these values to a byte, it is
+no major difficulty; you must only insure that the input function
+|pk_byte| can read packed bytes.
+
+@<Types...@>=
+@!eight_bits=0..255; {packed file byte}
+@!byte_file=packed file of eight_bits ; {for packed file words}
+@^system dependencies@>
+
+@ @<Glob...@>=
+@!pk_file:byte_file; {where the input comes from}
+@!typ_file:text_file; {where the final output goes}
+@^system dependencies@>
+
+@ To prepare these files for input and output, we |reset| and |rewrite| them.
+An extension of \PASCAL\ is needed, since we want to associate files
+with external names that are specified dynamically (i.e., not
+known at compile time). The following code assumes that `|reset(f,s)|'
+does this, when |f| is a file variable and |s| is a string variable that
+specifies the file name. If |eof(f)| is true immediately after
+|reset(f,s)| has acted, we assume that no file named |s| is accessible.
+@^system dependencies@>
+
+@p procedure open_pk_file; {prepares the input for reading}
+begin reset(pk_file,pk_name);
+pk_loc := 0 ;
+end;
+@#
+procedure open_typ_file; {prepares to write text data to the |typ_file|}
+begin rewrite(typ_file,typ_name);
+end;
+
+@ We need a place to store the names of the input and output file, as well
+as a byte counter for the output file.
+
+@<Glob...@>=
+@!pk_name,@!typ_name:packed array[1..name_length] of char; {name of input
+ and output files}
+@!pk_loc:integer; {how many bytes have we read?}
+
+@ We also need a function that will get a single byte from the \.{pk} file.
+
+@p function pk_byte : eight_bits ;
+var temp : eight_bits ;
+begin
+ temp := pk_file^ ;
+ get(pk_file) ;
+ pk_loc := pk_loc + 1 ;
+ pk_byte := temp ;
+end ;
+
+@ Now we are ready to open the files and write the identification of the
+pixel file.
+
+@<Open files@>=
+open_pk_file ;
+open_typ_file ;
+t_print_ln(banner) ;
+t_print('Input file: ') ;
+i := 1 ;
+while pk_name[i] <> ' ' do begin
+ t_print(pk_name[i]) ; incr(i) ;
+end ;
+t_print_ln(' ')
+
+@ As we are reading the packed file, we often need to fetch 16 and 32 bit
+quantities. Here we have two procedures to do this.
+
+@p function get_16 : integer ;
+var a : integer ;
+begin a := pk_byte ; get_16 := a * 256 + pk_byte ; end ;
+@#
+function get_32 : integer ;
+var a : integer ;
+begin a := get_16 ; if a > 32767 then a := a - 65536 ;
+get_32 := a * 65536 + get_16 ; end ;
+
+@ We still need the |term_pos| variable.
+
+@<Glob...@>=
+@!term_pos : integer ; {current terminal position}
+
+@ Now we read and check the preamble of the \.{PK} file. In the preamble, we
+find the |hppp|, |design_size|, |checksum|.
+
+@<Read preamble@>=
+if pk_byte <> pk_pre then abort('Bad PK file: pre command missing!') ;
+@.pre command missing@>
+if pk_byte <> pk_id then abort('Wrong version of PK file!') ;
+@.Wrong version of PK file@>
+j := pk_byte ;
+t_print('''') ;
+for i := 1 to j do t_print(xchr[pk_byte]) ;
+t_print_ln('''') ;
+design_size := get_32 ;
+t_print_ln('Design size = ',design_size:1) ;
+checksum := get_32 ;
+t_print_ln('Checksum = ',checksum:1) ;
+hppp := get_32 ; vppp := get_32 ;
+t_print('Resolution: horizontal = ',hppp:1,' vertical = ',vppp:1) ;
+magnification := round(hppp * 72.27 / 65536) ;
+t_print_ln(' (',magnification:1,' dpi)') ;
+if hppp <> vppp then print_ln('Warning: aspect ratio not 1:1!')
+
+@ Of course, we need to define the above variables.
+
+@<Glob...@>=
+@!magnification : integer ; {resolution at which pixel file is prepared}
+@!design_size : integer ; {design size in FIXes}
+@!checksum : integer ; {checksum of pixel file}
+@!hppp, @!vppp : integer ; {horizontal and vertical points per inch}
+
+@* Character unpacking.
+Here we simply unpack the character, writing the information we glean to the
+|typ_file|.
+
+@<Unpack and write character@>=
+t_print((pk_loc-1):1,': Flag byte = ',flag_byte:1) ;
+dyn_f := flag_byte div 16 ;
+flag_byte := flag_byte mod 16 ;
+turn_on := flag_byte >= 8 ;
+if turn_on then flag_byte := flag_byte - 8 ;
+if flag_byte = 7 then
+ @<Read long character preamble@>
+else if flag_byte > 3 then
+ @<Read extended short character preamble@>
+else
+ @<Read short character preamble@> ;
+t_print_ln(' Character = ',car:1,' Packet length = ',
+ packet_length:1) ;
+t_print_ln(' Dynamic packing variable = ',dyn_f:1) ;
+t_print(' TFM width = ',tfm_width:1,' dx = ',dx:1) ;
+if dy <> 0 then t_print_ln(' dy = ',dy:1) else t_print_ln(' ') ;
+t_print_ln(' Height = ',height:1,' Width = ',width:1,' X-offset = ',
+ x_off:1, ' Y-offset = ',y_off:1) ;
+@<Read and translate raster description@> ;
+if end_of_packet <> pk_loc then abort('Bad PK file: Bad packet length!')
+@.Bad packet length@>
+
+@ We need a whole lot of globals used but not defined up there.
+
+@<Glob...@>=
+@!i, @!j : integer ; {index pointers}
+@!flag_byte : integer ; {the byte that introduces the character definition}
+@!end_of_packet : integer ; {where we expect the end of the packet to be}
+@!width, @!height : integer ; {width and height of character}
+@!x_off, @!y_off : integer ; {x and y offsets of character}
+@!tfm_width : integer ; {character tfm width}
+@!tfms : array [0..255] of integer ; {character tfm widths}
+@!dx, @!dy : integer ; {escapement values}
+@!dxs, @!dys : array [0..255] of integer ; {escapement values}
+@!status : array[0..255] of boolean ; {has the character been seen?}
+@!dyn_f : integer ; {dynamic packing variable}
+@!car : integer ; {the character we are reading}
+@!packet_length : integer ; {the length of the character packet}
+
+@ Now, the preamble reading modules. First, we have the general case: the
+long character preamble format.
+
+@<Read long character preamble@>=
+begin
+ packet_length := get_32 ; car := get_32 ;
+ end_of_packet := packet_length + pk_loc ;
+ packet_length := packet_length + 9 ;
+ tfm_width := get_32 ;
+ dx := get_32 ; dy := get_32 ;
+ width := get_32 ;
+ height := get_32 ;
+ x_off := get_32 ; y_off := get_32 ;
+end
+
+@ This module reads the character preamble with double byte parameters.
+
+@<Read extended short character preamble@>=
+begin
+ packet_length := (flag_byte - 4) * 65536 + get_16 ;
+ car := pk_byte ;
+ end_of_packet := packet_length + pk_loc ;
+ packet_length := packet_length + 4 ;
+ i := pk_byte ;
+ tfm_width := i * 65536 + get_16 ;
+ dx := get_16 * 65536 ;
+ dy := 0 ;
+ width := get_16 ;
+ height := get_16 ;
+ x_off := get_16 ; y_off := get_16 ;
+ if x_off > 32767 then x_off := x_off - 65536 ;
+ if y_off > 32767 then y_off := y_off - 65536 ;
+end
+
+@ Here we read the most common character preamble, that with single byte
+parameters.
+
+@<Read short character preamble@>=
+begin
+ packet_length := flag_byte * 256 + pk_byte ;
+ car := pk_byte ;
+ end_of_packet := packet_length + pk_loc ;
+ packet_length := packet_length + 3 ;
+ i := pk_byte ;
+ tfm_width := i * 65536 + get_16 ;
+ dx := pk_byte * 65536 ;
+ dy := 0 ;
+ width := pk_byte ;
+ height := pk_byte ;
+ x_off := pk_byte ; y_off := pk_byte ;
+ if x_off > 127 then x_off := x_off - 256 ;
+ if y_off > 127 then y_off := y_off - 256 ;
+end
+
+@ Now we have the most important part of the program, where we actually
+interpret the commands in the raster description. First of all, we need
+a procedure to get a single nybble from the file, as well as one to get
+a single bit.
+
+@p function get_nyb : integer ;
+var temp : eight_bits ;
+begin
+ if bit_weight = 0 then begin
+ input_byte := pk_byte ;
+ bit_weight := 16 ;
+ end ;
+ temp := input_byte div bit_weight ;
+ input_byte := input_byte - temp * bit_weight ;
+ bit_weight := bit_weight div 16 ;
+ get_nyb := temp ;
+end ;
+@#
+function get_bit : boolean ;
+var temp : boolean ;
+begin
+ bit_weight := bit_weight div 2 ;
+ if bit_weight = 0 then begin
+ input_byte := pk_byte ;
+ bit_weight := 128 ;
+ end ;
+ temp := input_byte >= bit_weight ;
+ if temp then
+ input_byte := input_byte - bit_weight ;
+ get_bit := temp ;
+end ;
+
+@ We also need a function to write output to the screen. We put as many
+counts on a line as possible, to reduce the volume of output. Each count
+will appear as a number, with white counts enclosed by parentheses and repeat
+counts by brackets.
+
+@p procedure send_out(@!repeat_count: boolean ; @!value : integer ) ;
+var i, len : integer ;
+begin
+ i := 10 ; len := 1 ;
+ while value >= i do begin incr(len) ; i := i * 10 ; end ;
+ if repeat_count or not turn_on then len := len + 2 ;
+ if term_pos + len > 78 then begin
+ term_pos := len + 2 ; t_print_ln(' ') ; t_print(' ') ;
+ end else term_pos := term_pos + len ;
+ if repeat_count then t_print('[', value:1, ']')
+ else if turn_on then t_print(value:1)
+ else t_print('(', value:1, ')') ;
+end ;
+@<Packed number procedure@>
+
+@ Now, the globals to help communication between these procedures.
+
+@<Glob...@>=
+@!input_byte : eight_bits ; {the byte we are currently decimating}
+@!bit_weight : eight_bits ; {weight of the current bit}
+@!nybble : eight_bits ; {the current nybble}
+
+@ And the main procedure.
+
+@<Read and translate raster description@>=
+bit_weight := 0 ;
+if dyn_f = 14 then
+ @<Get raster by bits@>
+else @<Create normally packed raster@>
+
+@ If |dyn_f=14|, then we need to get the raster representation
+one bit at a time.
+
+@<Get raster by bits@>=
+begin
+for i := 1 to height do begin
+ t_print(' ') ;
+ for j := 1 to width do
+ if get_bit then t_print('*')
+ else t_print('.') ;
+ t_print_ln(' ') ;
+end;
+end
+
+@ Otherwise, we translate the bit counts into the raster rows. |count|
+contains the number of bits of the current color, and |turn_on| indicates
+whether or not they should be black. |rows_left| contains the number of
+rows to be sent.
+
+@<Create normally packed raster@>=
+begin
+term_pos := 2 ;
+t_print(' ') ;
+rows_left := height ;
+h_bit := width ;
+repeat_count := 0 ;
+while rows_left > 0 do begin
+ count := pk_packed_num ;
+ send_out(false, count) ;
+ if count >= h_bit then begin
+ rows_left := rows_left - repeat_count - 1 ;
+ repeat_count := 0 ;
+ count := count - h_bit ;
+ h_bit := width ;
+ rows_left := rows_left - count div width ;
+ count := count mod width ;
+ end ;
+ h_bit := h_bit - count ;
+ turn_on := not turn_on ;
+end ;
+t_print_ln(' ') ;
+if (rows_left <> 0) or (h_bit <> width) then
+ abort('Bad PK file: More bits than required!');
+@.More bits than required@>
+end
+
+@ We need to declare the repeat flag, bit counter, and color flag here.
+
+@<Glob...@>=
+@!repeat_count : integer ; {how many times to repeat the next row?}
+@!rows_left : integer ; {how many rows left?}
+@!turn_on : boolean ; {are we black here?}
+@!h_bit : integer ; {what is our horizontal position?}
+@!count : integer ; {how many bits of current color left?}
+
+@ If any specials are found, we write them out here.
+
+@p procedure skip_specials ;
+var i, j, k : integer ;
+begin
+ repeat
+ flag_byte := pk_byte ;
+ if flag_byte >= 240 then
+ case flag_byte of
+ 240, 241, 242, 243 :
+begin
+ t_print((pk_loc-1):1,': Special: ''') ;
+ i := 0 ;
+ for j := 240 to flag_byte do i := 256 * i + pk_byte ;
+ for j := 1 to i do t_print(xchr[pk_byte]) ;
+ t_print_ln('''') ;
+end ;
+ 244 : t_print_ln((pk_loc-1):1,': Num special: ',get_32:1) ;
+ 245 : t_print_ln((pk_loc-1):1,': Postamble') ;
+ 246 : t_print_ln((pk_loc-1):1,': No op') ;
+ 247, 248, 249, 250, 251, 252, 253, 254, 255 :
+ abort('Unexpected ', flag_byte:1,'!') ;
+@.Unexpected bbb@>
+ endcases ;
+ until (flag_byte < 240) or (flag_byte = pk_post) ;
+end ;
+
+@* Terminal communication.
+We must get the file names and determine whether input is to be in
+hexadecimal or binary. To do this, we use the standard input path
+name. We need a procedure to flush the input buffer. For most systems,
+this will be an empty statement. For other systems, a |print_ln| will
+provide a quick fix. We also need a routine to get a line of input from
+the terminal. On some systems, a simple |read_ln| will do. Finally,
+a macro to print a string to the first blank is required.
+
+@d flush_buffer == begin end
+@d get_line(#) == if eoln(input) then read_ln(input) ;
+ i := 1 ;
+ while not (eoln(input) or eof(input)) do begin
+ #[i] := input^ ;
+ incr(i) ;
+ get(input) ;
+ end ;
+ #[i] := ' '
+
+@ @p procedure dialog ;
+var i : integer ; {index variable}
+buffer : packed array [1..name_length] of char; {input buffer}
+begin
+ for i := 1 to name_length do begin
+ typ_name[i] := ' ' ;
+ pk_name[i] := ' ' ;
+ end;
+ print('Input file name: ') ;
+ flush_buffer ;
+ get_line(pk_name) ;
+ print('Output file name: ') ;
+ flush_buffer ;
+ get_line(typ_name) ;
+end ;
+
+@* The main program.
+Now that we have all the pieces written, let us put them together.
+
+@p begin
+initialize ;
+dialog ;
+@<Open files@> ;
+@<Read preamble@> ;
+skip_specials ;
+while flag_byte <> pk_post do begin
+ @<Unpack and write character@> ;
+ skip_specials ;
+end ;
+j := 0 ;
+while not eof(pk_file) do begin
+ i := pk_byte ;
+ if i <> pk_no_op then abort('Bad byte at end of file: ',i:1) ;
+@.Bad byte at end of file@>
+ t_print_ln((pk_loc-1):1,': No op') ;
+ incr(j) ;
+end ;
+t_print_ln(pk_loc:1,' bytes read from packed file.');
+final_end :
+end .
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{PKtype} work at a particular installation.
+Any additional routines should be inserted here.
+@^system dependencies@>
+
+@* Index.
+Pointers to error messages appear here together with the section numbers
+where each ident\-i\-fier is used.
diff --git a/obsolete/systems/knuth/unsupported/mfware/pxtopk.tops20-changes b/obsolete/systems/knuth/unsupported/mfware/pxtopk.tops20-changes
new file mode 100644
index 0000000000..366b609230
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/mfware/pxtopk.tops20-changes
@@ -0,0 +1,345 @@
+% TOPS-20 change file for PXtoPK by Tomas Rokicki. Send bug reports to
+% ROKICKI@SU-SCORE. The majority of these changes are to eliminate the
+% sign bit manipulations necessary on 32-bit machines but unnecessary on
+% the 36-bit DEC-20.
+
+@x [1]
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\ttw{{\mc TOPS-20}}
+\def\title{PXtoPK changes for \ttw}
+@z
+
+@x [3]
+@d banner=='This is PXtoPK, Version 2.3'
+@y
+@d banner=='This is PXtoPK, TOPS-20 Version 2.3'
+@z
+
+@x [5]
+@d print_ln(#)==write_ln(output,#)
+@d print(#)==write(output,#)
+@y
+@d print_ln(#)==write_ln(tty,#)
+@d print(#)==write(tty,#)
+@z
+
+@x [5]
+@p program PXtoPK(input, output);
+@y
+@p program PXtoPK;
+@z
+
+@x [7]
+@<Constants...@>=
+@!max_mem_size=200000; {the major array used for almost everything.}
+@!name_length=80; {maximum length of a file name}
+@!terminal_line_length=132; {maximum length of an input line}
+@y
+@<Constants...@>=
+@!max_mem_size=100000; {the major array used for almost everything.}
+@!name_length=80; {maximum length of a file name}
+@!terminal_line_length=132; {maximum length of an input line}
+@!max_rescan=200; {maximum length of a command line}
+@z
+
+@x [46]
+@!pxl_file:word_file; {where the input comes from}
+@y
+@!pxl_file:byte_file; {where the input comes from}
+@z
+
+@x [47]
+@p procedure open_pxl_file; {prepares to read packed bytes in a |pxl_file|}
+begin reset(pxl_file,pxl_name);
+eof_pixel:=eof(pxl_file);
+end;
+@#
+procedure open_pk_file; {prepares the output for writing}
+begin rewrite(pk_file,pk_name);
+end;
+@y
+@p procedure open_pxl_file; {prepares to read packed bytes in a |pxl_file|}
+begin reset(pxl_file,pxl_name,'/O/B:8');
+eof_pixel:=eof(pxl_file);
+end;
+@#
+procedure make_pk_name;
+var res, i, j : integer ;
+begin
+ @<Make pk name@> ;
+end;
+@#
+procedure open_pk_file; {prepares the output for writing}
+begin if startup then make_pk_name;
+rewrite(pk_file,pk_name,'/O/B:8');
+end;
+@z
+
+@x [50]
+@p function pixel_integer : integer ;
+var i:integer;
+begin i := pxl_file^ ;
+get(pxl_file) ;
+eof_pixel:=eof(pxl_file);
+pixel_integer:=i;
+end;
+@y
+@p function pixel_integer : integer ;
+var i:integer;
+begin i:=pxl_file^ ; get(pxl_file);
+i:=i*256+pxl_file^ ; get(pxl_file);
+i:=i*256+pxl_file^ ; get(pxl_file);
+i:=i*256+pxl_file^ ; get(pxl_file);
+eof_pixel:=eof(pxl_file);
+pixel_integer:=i;
+end;
+@z
+
+@x [57]
+@p function hi(a:integer) : integer ;
+begin
+ hi := a div 65536 ;
+end ;
+@#
+function lo(a:integer) : integer ;
+begin
+ lo := a mod 65536 ;
+end ;
+@#
+function his(a:integer) : integer ;
+begin
+ if a < 0 then
+ his := ( a + one_fourth + one_fourth ) div 65536 - 32768
+ else
+ his := a div 65536 ;
+end ;
+@#
+function hip(a:integer) : integer ;
+begin
+ if a < 0 then
+ hip := ( a + one_fourth + one_fourth ) div 65536 + 32768
+ else
+ hip := a div 65536 ;
+end ;
+@#
+function lop(a:integer) : integer ;
+begin
+ lop := a - 65536 * his(a) ;
+end ;
+@#
+function los(a:integer) : integer ;
+var b : integer ;
+begin
+ b := lop(a) ;
+ if b > 32767 then
+ los := b - 65536
+ else
+ los := b ;
+end ;
+@y
+@p function hi(a:integer) : integer ;
+begin
+ hi := a div 65536 ;
+end ;
+@#
+function lo(a:integer) : integer ;
+begin
+ lo := a mod 65536 ;
+end ;
+@#
+function his(a:integer) : integer ;
+begin
+ a := a div 65536 ;
+ if a > 32767 then his := a - 65536
+ else his := a ;
+end ;
+@#
+function hip(a:integer) : integer ;
+begin
+ hip := a div 65536 ;
+end ;
+@#
+function lop(a:integer) : integer ;
+begin
+ lop := a mod 65536 ;
+end ;
+@#
+function los(a:integer) : integer ;
+var b : integer ;
+begin
+ b := a mod 65536 ;
+ if b > 32767 then
+ los := b - 65536
+ else
+ los := b ;
+end ;
+@z
+
+@x [69]
+for i := ones_row to repeat_pointer - 2 do mem[i] := -1 ;
+@y
+for i := ones_row to repeat_pointer - 2 do mem[i] := power[32] - 1 ;
+@z
+
+@x [69]
+if i = 0 then
+ mem[repeat_pointer - 1] := -1
+else if i = 1 then
+ mem[repeat_pointer - 1] := - one_fourth - one_fourth
+else
+ mem[repeat_pointer - 1] := - power[32 - i] ;
+@y
+if i = 0 then
+ mem[repeat_pointer - 1] := power[32] - 1
+else
+ mem[repeat_pointer - 1] := power[32] - power[32 - i] ;
+@z
+
+@x [72]
+@!power : array [0..31] of integer ;
+@y
+@!power : array [0..32] of integer ;
+@z
+
+@x [72]
+power[0] := 1 ;
+for i := 1 to 30 do
+ power[i] := power[i-1] * 2 ;
+power[31] := - power[30] - power[30] ;
+@y
+power[0] := 1 ;
+for i := 1 to 32 do power[i] := power[i-1] + power[i-1] ;
+@z
+
+@x [77]
+else if bit_mod_32 = 31 then begin
+ if word < 0 then begin
+ bit := black ;
+ word := word + one_fourth + one_fourth ;
+ end else
+ bit := white ;
+end else begin
+ if word >= power[bit_mod_32] then begin
+ word := word - power[bit_mod_32] ;
+ bit := black ;
+ end else
+ bit := white ;
+@y
+else begin if word >= power[bit_mod_32] then begin
+ word := word - power[bit_mod_32] ;
+ bit := black ;
+end else bit := white ;
+@z
+
+@x [94]
+@d get_line(#) == if eoln(input) then read_ln(input) ;
+ i := 1 ;
+ while not (eoln(input) or eof(input)) do begin
+ #[i] := input^ ;
+ incr(i) ;
+ get(input) ;
+ end ;
+ #[i] := ' '
+@y
+@d get_line(#) == if eoln(tty) then read_ln(tty) ;
+ i := 1 ;
+ while not (eoln(tty) or eof(tty)) do begin
+ #[i] := tty^ ;
+ incr(i) ;
+ get(tty) ;
+ end ;
+ #[i] := ' '
+@z
+
+@x [96]
+initialize ;
+dialog ;
+@y
+initialize ;
+startup := true ;
+@<Get command line and check for file names@> ;
+if not startup then dialog ;
+@z
+
+@x [98]
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{PXtoPK} work at a particular installation.
+Any additional routines should be inserted here.
+@^system dependencies@>
+@y
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{PXtoPK} work at a particular installation.
+Any additional routines should be inserted here.
+@^system dependencies@>
+
+We call a system procedure to put the command line into the input buffer.
+We then read it in, skipping over the program name to the first blank.
+
+@d RSCAN=@'500 {ReSCAN buffer JSYS}
+
+@<Get command line and check for file names@>=
+jsys(RSCAN,1,i;0;j); {get the command line}
+if (i<>2) or (j<=0) then startup := false
+else begin
+ if eoln(tty) then read_ln(tty); {for some TOPS-20's}
+ read(tty,rescan_buffer:rescan_len); {read in rescan buffer}
+ if rescan_len>max_rescan then abort('command line too long!');
+ read_ln(tty);
+ if rescan_len=j-2 then startup := false
+ else begin
+ i:=1; while rescan_buffer[i]>' 'do incr(i); {skip invocation}
+ while(i<=rescan_len) and (rescan_buffer[i]=' ')do incr(i); {skip spaces}
+ if i>rescan_len then startup := false
+ else begin
+ for j := 1 to name_length do begin
+ pk_name[j] := ' ' ; pxl_name[j] := ' ' ;
+ end ;
+ j := 1 ;
+ last_ext := -1 ;
+ while ( i <= rescan_len ) and ( rescan_buffer[i] <> ' ' ) and
+ ( rescan_buffer[i] <> '/' ) do begin
+ pk_name[j] := rescan_buffer[i] ;
+ pxl_name[j] := rescan_buffer[i] ;
+ if (rescan_buffer[i] = '.') and (last_ext = -1) then last_ext := j ;
+ if rescan_buffer[i] in [':',']','>'] then last_ext := -1 ;
+ incr(j) ; incr(i) ;
+ end ;
+ if last_ext = -1 then begin
+ last_ext := j ;
+ pxl_name[j] := '.' ; pxl_name[j+1] := 'p' ; pxl_name[j+2] := 'x' ;
+ pxl_name[j+3] := 'l' ;
+ end ;
+ pk_name[last_ext] := '.' ;
+ end ;
+ end ;
+end
+
+@ Next, a procedure to put the magnification in the packed file name.
+
+@<Make pk name@>=
+res := (magnification + 3) div 5 ;
+i := 1 ;
+while res >= i * 10 do i := i * 10 ;
+if last_ext + 7 > name_length then abort('PK file name too long!');
+j := last_ext + 1 ;
+while i > 0 do begin
+ pk_name[j] := xchr["0"+res div i] ;
+ res := res mod i ; i := i div 10 ;
+ incr(j) ;
+end ;
+pk_name[j] := 'p' ;
+pk_name[j+1] := 'k' ;
+for i := j+2 to name_length do pk_name[i] := ' '
+
+@ @<Glob...@>=
+@!rescan_buffer:packed array[1..max_rescan] of char;
+@!rescan_len:integer;
+@!i, @!j : integer ; {general purpose indices}
+@!startup : boolean ; {did we have a file name?}
+@!last_ext : integer ; {where was the dot?}
+@z
diff --git a/obsolete/systems/knuth/unsupported/mfware/pxtopk.web b/obsolete/systems/knuth/unsupported/mfware/pxtopk.web
new file mode 100644
index 0000000000..0da0c4fc44
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/mfware/pxtopk.web
@@ -0,0 +1,1648 @@
+% PXtoPK.web
+%
+% PXtoPK creates a packed pixel file from a regular pixel file.
+%
+% Preliminary 0.0 version: May, 1985
+% First release 0.9 version: 8 May 1985
+% Updated to new PK standards (2.0) : 25 July 1985
+% Updated again to new PK format (2.1) : 15 August 1985
+% One_fourth bug fixed (2.2) : 23 January 1985
+% Use of i after for i := loop fixed (2.3) 14 November 1987
+\def\versiondate{30 November 1987}
+%
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like PASCAL
+\font\logo=logo10 % font used for the METAFONT logo
+\def\MF{{\logo META}\-{\logo FONT}}
+\def\PASCAL{{\mc Pascal}}
+\def\tamu{Texas A\char38 M}
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index
+\def\title{PXtoPK}
+\def\contentspagenumber{0}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont PXtoPK} processor}
+ \vskip 15pt
+ \centerline{(Version 2.3, \versiondate)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ The preparation of this report
+ was supported in part by the National Science
+ Foundation under grants IST-8201926 and MCS-8300984,
+ and by the System Development Foundation. `\TeX' is a
+ trademark of the American Mathematical Society.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+The standard format for the distribution of font raster information for \TeX\
+has been \.{PXL} files. These files are loosely packed, based on a 32-bit
+word, and use no forms of compression. \TeX\ requires dozens of fonts in many
+different sizes, with typical installations having hundreds of pixel files
+using many megabytes of disk storage.
+Distribution of the unwieldy pixel files is also a difficult problem for
+microcomputer systems, on which \TeX\ is only just becoming available.
+Many boxes of diskettes would be required just to store a basic set of fonts
+in three sizes for a three-hundred dot per inch device.
+A better format is called for.
+
+This program compresses a pixel file into a packed, or \.{PK}, file.
+This new format is primarily intended for distribution. Drivers can be adapted
+to read these files, and since pixel files can be converted back and forth
+with this program and its companion \.{pktopx}, no information will be lost by
+leaving the files in one format or another.
+
+@ The |banner| string defined here should be changed whenever \.{PXtoPK}
+gets modified.
+
+@d banner=='This is PXtoPK, Version 2.3'
+ {printed when the program starts}
+
+@ This program is written in standard \PASCAL, except where it is necessary
+to use extensions; for example, \.{PXtoPK} must read files whose names
+are dynamically specified, and that would be impossible in pure \PASCAL.
+
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+
+@ Both the input and output come from binary files. On line interaction
+is handled through \PASCAL's standard |input| and |output| files.
+
+@d print_ln(#)==write_ln(output,#)
+@d print(#)==write(output,#)
+
+@p program PXtoPK(input, output);
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ begin print_ln(banner);@/
+ @<Set initial values@>@/
+ end;
+
+@ If the program has to stop prematurely, it goes to the
+`|final_end|'.
+
+@d final_end=9999 {label for the end of it all}
+
+@<Labels...@>=final_end;
+
+@ The variable |max_mem_size| should be set to the size of the largest font
+that will be downloaded, with a few thousand extra for safety. 100,000 should
+be sufficient.
+@^system dependancies@>
+
+@<Constants...@>=
+@!max_mem_size=200000; {the major array used for almost everything.}
+@!name_length=80; {maximum length of a file name}
+@!terminal_line_length=132; {maximum length of an input line}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d do_nothing == {empty statement}
+
+@ It is possible that a malformed pixel file (heaven forbid!) or some other
+error might be detected by this program. Such errors might occur in a deeply
+nested procedure, so the procedure called |jump_out| has been added to transfer
+to the very end of the program with an error message.
+
+@d abort(#)==begin print_ln(' ',#); jump_out; end
+
+@p procedure jump_out;
+begin goto final_end;
+end;
+
+@* The character set.
+Like all programs written with the \.{WEB} system, \.{PXtoPK} can be
+used with any character set. But it uses ASCII code internally, because
+the programming for portable input-output is easier when a fixed internal
+code is used.
+
+The next few sections of \.{PXtoPK} have therefore been copied from the
+analogous ones in the \.{WEB} system routines. They have been considerably
+simplified, since \.{PXtoPK} need not deal with the controversial
+ASCII codes less than @'40.
+
+@<Types...@>=
+@!ASCII_code=" ".."~"; {a subrange of the integers}
+
+@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
+character sets were common, so it did not make provision for lower case
+letters. Nowadays, of course, we need to deal with both upper and lower case
+alphabets in a convenient way, especially in a program like \.{PXtoPK}.
+So we shall assume that the \PASCAL\ system being used for \.{PXtoPK}
+has a character set containing at least the standard visible characters
+of ASCII code (|"!"| through |"~"|).
+
+Some \PASCAL\ compilers use the original name |char| for the data type
+associated with the characters in text files, while other \PASCAL s
+consider |char| to be a 64-element subrange of a larger data type that has
+some other name. In order to accommodate this difference, we shall use
+the name |text_char| to stand for the data type of the characters in the
+output file. We shall also assume that |text_char| consists of
+the elements |chr(first_text_char)| through |chr(last_text_char)|,
+inclusive. The following definitions should be adjusted if necessary.
+@^system dependencies@>
+
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=127 {ordinal number of the largest element of |text_char|}
+
+@<Types...@>=
+@!text_file=packed file of text_char;
+
+@ The \.{PXtoPK} processor converts between ASCII code and
+the user's external character set by means of arrays |xord| and |xchr|
+that are analogous to \PASCAL's |ord| and |chr| functions.
+
+@<Globals...@>=
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [0..255] of text_char;
+ {specifies conversion of output characters}
+
+@ Under our assumption that the visible characters of standard ASCII are
+all present, the following assignment statements initialize the
+|xchr| array properly, without needing any system-dependent changes.
+
+@<Set init...@>=
+for i:=0 to @'37 do xchr[i]:='?';
+xchr[@'40]:=' ';
+xchr[@'41]:='!';
+xchr[@'42]:='"';
+xchr[@'43]:='#';
+xchr[@'44]:='$';
+xchr[@'45]:='%';
+xchr[@'46]:='&';
+xchr[@'47]:='''';@/
+xchr[@'50]:='(';
+xchr[@'51]:=')';
+xchr[@'52]:='*';
+xchr[@'53]:='+';
+xchr[@'54]:=',';
+xchr[@'55]:='-';
+xchr[@'56]:='.';
+xchr[@'57]:='/';@/
+xchr[@'60]:='0';
+xchr[@'61]:='1';
+xchr[@'62]:='2';
+xchr[@'63]:='3';
+xchr[@'64]:='4';
+xchr[@'65]:='5';
+xchr[@'66]:='6';
+xchr[@'67]:='7';@/
+xchr[@'70]:='8';
+xchr[@'71]:='9';
+xchr[@'72]:=':';
+xchr[@'73]:=';';
+xchr[@'74]:='<';
+xchr[@'75]:='=';
+xchr[@'76]:='>';
+xchr[@'77]:='?';@/
+xchr[@'100]:='@@';
+xchr[@'101]:='A';
+xchr[@'102]:='B';
+xchr[@'103]:='C';
+xchr[@'104]:='D';
+xchr[@'105]:='E';
+xchr[@'106]:='F';
+xchr[@'107]:='G';@/
+xchr[@'110]:='H';
+xchr[@'111]:='I';
+xchr[@'112]:='J';
+xchr[@'113]:='K';
+xchr[@'114]:='L';
+xchr[@'115]:='M';
+xchr[@'116]:='N';
+xchr[@'117]:='O';@/
+xchr[@'120]:='P';
+xchr[@'121]:='Q';
+xchr[@'122]:='R';
+xchr[@'123]:='S';
+xchr[@'124]:='T';
+xchr[@'125]:='U';
+xchr[@'126]:='V';
+xchr[@'127]:='W';@/
+xchr[@'130]:='X';
+xchr[@'131]:='Y';
+xchr[@'132]:='Z';
+xchr[@'133]:='[';
+xchr[@'134]:='\';
+xchr[@'135]:=']';
+xchr[@'136]:='^';
+xchr[@'137]:='_';@/
+xchr[@'140]:='`';
+xchr[@'141]:='a';
+xchr[@'142]:='b';
+xchr[@'143]:='c';
+xchr[@'144]:='d';
+xchr[@'145]:='e';
+xchr[@'146]:='f';
+xchr[@'147]:='g';@/
+xchr[@'150]:='h';
+xchr[@'151]:='i';
+xchr[@'152]:='j';
+xchr[@'153]:='k';
+xchr[@'154]:='l';
+xchr[@'155]:='m';
+xchr[@'156]:='n';
+xchr[@'157]:='o';@/
+xchr[@'160]:='p';
+xchr[@'161]:='q';
+xchr[@'162]:='r';
+xchr[@'163]:='s';
+xchr[@'164]:='t';
+xchr[@'165]:='u';
+xchr[@'166]:='v';
+xchr[@'167]:='w';@/
+xchr[@'170]:='x';
+xchr[@'171]:='y';
+xchr[@'172]:='z';
+xchr[@'173]:='{';
+xchr[@'174]:='|';
+xchr[@'175]:='}';
+xchr[@'176]:='~';
+for i:=@'177 to 255 do xchr[i]:='?';
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|.
+
+@<Set init...@>=
+for i:=first_text_char to last_text_char do xord[chr(i)]:=@'40;
+for i:=" " to "~" do xord[xchr[i]]:=i;
+
+@* Pixel file format.
+A \.{PXL} file is an expanded raster description of a single font at a
+particular resolution. \.{PXL} files are used by many existing
+device-driver programs for dot matrix devices.
+All words in of \.{PXL} files are in 32-bit format, with the four lower
+bits zero on 36-bit machines. The raster information is contained in a
+sequence of binary words which record white pixels as zeros and black
+pixels as ones.
+
+The first word of the \.{PXL} file and the last word contain the \.{PXL
+ID} which is currently equal to 1001 (decimal).
+This first word is followed by a sequence of raster information words
+where each line of pixels in the glyphs is represented by one or more
+words of binary information. The number of words used to represent each
+row of pixels for any particular glyph is fixed and it is set by the value
+of |max_m-min_m+1| for that particular glyph. Each white pixel is represented
+by a zero and each black pixel is represented by a one in the corresponding bit
+positions (the first 32 only of each word on 36-bit machines).
+The unused bit positions
+toward the end of each set of words for each row of pixels are filled with
+zeros.
+
+The font directory follows, occupying a fixed position with respect to the
+end of the file (in words 517 through 6 from this end), and assigns 4
+words for each of the potential 128 different glyphs that could be
+contained in this particular font in the order of their assending ascii
+values (not in the order that the glyphs appear in the raster section,
+which may be entirely arbitrary). This means that the first four words are
+for the ascii zero glyph. All four words reserved for any missing glyphs
+are set to zero.
+
+The first word of each glyph's directory information contains the pixel
+width in the left half-word (the leftmost 16 bits) and the pixel height in
+the right half-word (the next 16 bits). These dimensions are those of the
+smallest bounding-box, measured in pixels, and they have nothing
+necessarily to do with the width and height figures that appear in the
+\.{TFM} file. The \.{TFM} width, measured in \.{FIXes}, where 1 \.{FIX}
+is $1/2^{20}$ times the design size, is listed in the fourth word of the
+glyph's directory information.
+
+The second word of the glyph's directory information contains the offset
+of the glyph's reference point from its upper-left-hand corner of the
+bounding box, measured in pixels, with the x-offset in the left half-word
+and the y-offset in the right half-word. These numbers may be negative,
+and two's complement representation is used. Remember that the positive x
+direction means `rightward' and positive y is `downward' on the page.
+
+The third word of a glyph's directory information contains the number of the
+word in this \.{PXL} file where the raster description for this particular
+glyph begins, measured from the first word which is numbered zero.
+As mentioned earlier, the fourth word of directory information for each
+glyph contains the \.{TFM} width.
+
+The final five words in the \.{PXL} file contain information relation to
+the entire file.
+The first of these five words is a checksum which should
+match the checksum contained in the \.{TFM} file that \TeX\ used in
+reference to this font, although, if this checksum is zero, no validity
+checking will be done.
+The second of these five words is an integer that is 1000 times the
+magnification factor at which this font was produced.
+The third word contains the design sige of the font measured in \.{FIXes}
+($2^{-20}$ unmagnified points).
+The fourth word contains a pointer to the first word of the font directory.
+The fifth and last word of the entire file contains a duplicate of the
+\.{PXL} ID as contained in the first word of the file.
+
+@d pxl_id=1001 {current version of \.{PXL} format}
+
+@* Packed file format.
+The packed file format is a compact representation of the data contained in a
+\.{GF} file. The information content is the same, but packed (\.{PK}) files
+are almost always less than half the size of their \.{GF} counterparts. They
+are also easier to convert into a raster representation because they do not
+have a profusion of \\{paint}, \\{skip}, and \\{new\_row} commands to be
+separately interpreted. In addition, the \.{PK} format expressedly forbids
+\&{special} commands within a character. The minimum bounding box for each
+character is explicit in the format, and does not need to be scanned for as in
+the \.{GF} format. Finally, the width and escapement values are combined with
+the raster information into character ``packets'', making it simpler in many
+cases to process a character.
+
+A \.{PK} file is organized as a stream of 8-bit bytes. At times, these bytes
+might be split into 4-bit nybbles or single bits, or combined into multiple
+byte parameters. When bytes are split into smaller pieces, the `first' piece
+is always the most significant of the byte. For instance, the first bit of
+a byte is the bit with value 128; the first nybble can be found by dividing
+a byte by 16. Similarly, when bytes are combined into multiple byte
+parameters, the first byte is the most significant of the parameter. If the
+parameter is signed, it is represented by two's-complement notation.
+
+The set of possible eight-bit values are separated into two sets, those that
+introduce a character definition, and those that do not. The values that
+introduce a character definition comprise the range from 0 to 239; byte values
+above 239 are interpreted commands. Bytes which introduce character
+definitions are called flag bytes, and various fields within the byte indicate
+various things about how the character definition is encoded. Command bytes
+have zero or more parameters, and can never appear within a character
+definition or between parameters of another command, where they would be
+interpeted as data.
+
+A \.{PK} file consists of a preamble, followed by a sequence of one or more
+character definitions, followed by a postamble. The preamble command must
+be the first byte in the file, followed immediately by its parameters.
+Any number of character definitions may follow, and any command but the
+preamble command and the postamble command may occur between character
+definitions. The very last command in the file must be the postamble.
+
+@ The packed file format is intended to be easy to read and interpret by
+device drivers. The small size of the file reduces the input/output overhead
+each time a font is defined. For those drivers that load and save each font
+file into memory, the small size also helps reduce the memory requirements.
+The length of each character packet is specified, allowing the character raster
+data to be loaded into memory by simply counting bytes, rather than
+interpreting each command; then, each character can be interpreted on a demand
+basis. This also makes it possible for a driver to skip a particular
+character quickly if it knows that the character is unused.
+
+@ First, the command bytes shall be presented; then the format of the
+Character definitions will be defined. Eight of the possible sixteen
+commands (values 240 through 255) are currently defined; the others are
+reserved for future extensions. The commands are listed below. Each command
+is specified by its symbolic name (e.g., \\{pk\_no\_op}), its opcode byte,
+and any parameters. The parameters are followed by a bracketed number
+telling how many bytes they occupy, with the number preceded by a plus sign if
+it is a signed quantity. (Four byte quantities are always signed, however.)
+
+\yskip\hang|pk_xxx1| 240 |k[1]| |x[k]|. This command is undefined in general;
+it functions as a $(k+2)$-byte \\{no\_op} unless special \.{PK}-reading
+programs are being used. \MF\ generates \\{xxx} commands when encountering
+a \&{special} string. It is recommended that |x| be a string having the form
+of a keyword followed by possible parameters relevant to that keyword.
+
+\yskip\hang\\{pk\_xxx2} 241 |k[2]| |x[k]|. Like |pk_xxx1|, but |0<=k<65536|.
+
+\yskip\hang\\{pk\_xxx3} 242 |k[3]| |x[k]|. Like |pk_xxx1|, but
+|0<=k<@t$2^{24}$@>|. \MF\ uses this when sending a \&{special} string whose
+length exceeds~255.
+
+\yskip\hang\\{pk\_xxx4} 243 |k[4]| |x[k]|. Like |pk_xxx1|, but |k| can be
+ridiculously large; |k| musn't be negative.
+
+\yskip\hang|pk_yyy| 244 |y[4]|. This command is undefined in general; it
+functions as a five-byte \\{no\_op} unless special \.{PK} reading programs
+are being used. \MF\ puts |scaled| numbers into |yyy|'s, as a result of
+\&{numspecial} commands; the intent is to provide numeric parameters to
+\\{xxx} commands that immediately precede.
+
+\yskip\hang|pk_post| 245. Beginning of the postamble. This command is
+followed by enough |pk_no_op| commands to make the file a multiple
+of four bytes long. Zero through three are usual, but any number is
+allowed.
+This should make the file easy to read on machines which pack four bytes to
+a word.
+
+\yskip\hang|pk_no_op| 246. No operation, do nothing. Any number of
+|pk_no_op|'s may appear between \.{PK} commands, but a |pk_no_op| cannot be
+inserted between a command and its parameters, between two parameters, or
+inside a character definition.
+
+\yskip\hang|pk_pre| 247 |i[1]| |k[1]| |x[k]| |ds[4]| |cs[4]| |hppp[4]|
+|vppp[4]|. Preamble command. Here, |i| is the identification byte of the
+file, currently equal to 89. The string |x| is merely a comment, usually
+indicating the source of the \.{PK} file. The parameters |ds| and |cs| are
+the design size of the file in $1/2^{20}$ points, and the checksum of the
+file, respectively. The checksum should match the \.{TFM} file and the
+\.{GF} files for this font. Parameters |hppp| and |vppp| are the ratios
+of pixels per point, horizontally and vertically, multiplied by $2^{16}$; they
+can be used to correlate the font with specific device resolutions,
+magnifications, and ``at sizes''. Usually, the name of the \.{PK} file is
+formed by concatenating the font name (e.g., amr10) with the resolution at
+which the font is prepared in pixels per inch multiplied by the magnification
+factor, and the letters \.{PK}. For instance, amr10 at 300 dots per inch
+should be named AMR10.300PK; at one thousand dots per inch and magstephalf,
+it should be named AMR10.1095PK.
+
+@ We put a few of the above opcodes into definitions for symbolic use by
+this program.
+
+@d pk_id = 89 {the version of \.{PK} file described}
+@d pk_xxx1 = 240 {\&{special} commands}
+@d pk_yyy = 244 {\&{numspecial} commands}
+@d pk_post = 245 {postamble}
+@d pk_no_op = 246 {no operation}
+@d pk_pre = 247 {preamble}
+
+@ The \.{PK} format has two conflicting goals; to pack character raster and
+size information as compactly as possible, while retaining ease of translation
+into raster and other forms. A suitable compromise was found in the use of
+run-encoding of the raster information. Instead of packing the individual
+bits of the character, we instead count the number of consecutive `black' or
+`white' pixels in a horizontal raster row, and then encode this number. Run
+counts are found for each row, from the top of the character to the bottom.
+This is essentially the way the \.{GF} format works.
+Instead of presenting each row individually, however, let us concatenate all
+of the horizontal raster rows into one long string of pixels, and encode this
+row. With knowledge of the width of the bit-map, the original character glyph
+can be easily reconstructed. In addition, we do not need special commands to
+mark the end of one row and the beginning of the next.
+
+Next, let us put the burden of finding the minimum bounding box on the part
+of the font generator, since the characters will usually be used much more
+often than they are generated. The minimum bounding box is the smallest
+rectangle which encloses all `black' pixels of a character. Let us also
+eliminate the need for a special end of character marker, by supplying
+exactly as many bits as are required to fill the minimum bounding box, from
+which the end of the character is implicit.
+
+Let us next consider the distribution of the run counts. Analysis of several
+dozen pixel files at 300 dots per inch yields a distribution peaking at four,
+falling off slowly until ten, then a bit more steeply until twenty, and then
+asymptotically approaching the horizontal. Thus, the great majority of our
+run counts will fit in a four-bit nybble. The eight-bit byte is attractive for
+our run-counts, as it is the standard on many systems; however, the wasted four
+bits in the majority of cases seems a high price to pay. Another possibility
+is to use a Huffman-type encoding scheme with a variable number of bits for
+each run-count; this was rejected because of the overhead in fetching and
+examining individual bits in the file. Thus, the character raster definitions
+in the \.{PK} file format are based on the four-bit nybble.
+
+@ The analysis of the pixel files yielded another interesting statistic: fully
+37\char`\%\
+of the raster rows were duplicates of the previous row. Thus, the \.{PK}
+format allows the specification of repeat counts, which indicate how many times
+a horizontal raster row is to be repeated. These repeated rows are taken out
+of the character glyph before individual rows are concatenated into the long
+string of pixels.
+
+For elegance, we disallow a run count of zero. The case of a null raster
+description should be gleaned from the character width and height being equal
+to zero, and no raster data should be read. No other zero counts are ever
+necessary. Also, in the absence of repeat counts, the repeat value is set to
+be zero (only the original row is sent.) If a repeat count is seen, it takes
+effect on the current row. The current row is defined as the row on which the
+first pixel of the next run count will lie. The repeat count is set back to
+zero when the last pixel in the current row is seen, and the row is sent out.
+
+This poses a problem for entirely black and entirely white rows, however. Let
+us say that the current row ends with four white pixels, and then we have five
+entirely empty rows, followed by a black pixel at the beginning of the next
+row, and the character width is ten pixels. We would like to use a repeat
+count, but there is no legal place to put it. If we put it before the white
+run count, it will apply to the current row. If we put it after, it applies
+to the row with the black pixel at the beginning. Thus, entirely white or
+entirely black repeated rows are always packed as large run counts (in this
+case, a white run count of 54) rather than repeat counts.
+
+@ Now let us turn our attention to the actual packing of the run counts and
+repeat counts into nybbles. There are only sixteen possible nybble values.
+We need to indicate run counts and repeat counts. Since the run counts are
+much more common, we will devote the majority of the nybble values to them.
+We therefore indicate a repeat count by a nybble of 14 followed by a packed
+number, where a packed number will be explained later. Since the repeat
+count value of one is so common, we indicate a repeat one command by a single
+nybble of 15. A 14 followed by the packed number 1 is still legal for a
+repeat one count, however. The run counts are coded directly as packed
+numbers.
+
+For packed numbers, therefore, we have the nybble values 0 through 13. We
+need to represent the positive integers up to, say, $2^{31}-1$. We would
+like the more common smaller numbers to take only one or two nybbles, and
+the infrequent large numbers to take three or more. We could therefore
+allocate one nybble value to indicate a large run count taking three or more
+nybbles. We do this with the value 0.
+
+@ We are left with the values 1 through 13. We can allocate some of these, say
+|dyn_f|, to be one-nybble run counts.
+These will work for the run counts |1..dyn_f|. For subsequent run
+counts, we will use a nybble greater than |dyn_f|, followed by a second nybble,
+whose value can run from 0 through 15. Thus, the two-byte nybble values will
+run from |dyn_f+1..(13-dyn_f)*16+dyn_f|. We have our definition of large run
+count values now, being all counts greater than |(13-dyn_f)*16+dyn_f|.
+
+We can analyze our several dozen pixel files and determine an optimal value of
+|dyn_f|, and use this value for all of the characters. Unfortunately, values
+of |dyn_f| that pack small characters well tend to pack the large characters
+poorly, and values that pack large characters well are not efficient for the
+smaller characters. Thus, we choose the optimal |dyn_f| on a character basis,
+picking the value which will pack each individual character in the smallest
+number of nybbles. Legal values of |dyn_f| run from 0 (with no one-byte run
+counts) to 13 (with no two-byte run counts).
+
+@ Our only remaining task in the coding of packed numbers is the large run
+counts. We use a scheme suggested by D.~E.~Knuth
+@^Knuth, D.~E.@>
+which will simply and elegantly represent arbitrarily large values. The
+general scheme to represent an integer |i| is to write its hexadecimal
+representation, with leading zeros removed. Then we count the number of
+digits, and prepend one less than that many zeros before the hexadecimal
+representation. Thus, the values from one to fifteen occupy one nybble;
+the values sixteen through 255 occupy three, the values 256 through 4095
+require five, etc.
+
+For our purposes, however, we have already represented the numbers one
+through |(13-dyn_f)*16+dyn_f|. In addition, the one-nybble values have
+already been taken by our other commands, which means that only the values
+from sixteen up are available to us for long run counts. Thus, we simply
+normalize our long run counts, by subtracting |(13-dyn_f)*16+dyn_f+1| and
+adding 16, and then representing the result according to the scheme above.
+
+@ The final algorithm for decoding the run counts based on the above scheme
+might look like this, assuming a procedure called \\{pk\_nyb} is available
+to get the next nybble from the file, and assuming that the global
+|repeat_count| indicates whether a row needs to be repeated. Note that this
+routine is recursive, but since a repeat count can never directly follow
+another repeat count, it can only be recursive to one level.
+
+@p@{ function pk_packed_num : integer ;
+var i, j, k : integer ;
+begin
+ i := get_nyb ;
+ if i = 0 then begin
+ repeat j := get_nyb ; incr(i) ; until j <> 0 ;
+ while i > 0 do begin j := j * 16 + get_nyb ; decr(i) ; end ;
+ pk_packed_num := j - 15 + (13-dyn_f)*16 + dyn_f ;
+ end else if i <= dyn_f then
+ pk_packed_num := i
+ else if i < 14 then
+ pk_packed_num := (i-dyn_f-1)*16+get_nyb+dyn_f+1
+ else begin
+ if i = 14 then
+ repeat_count := pk_packed_num
+ else
+ repeat_count := 1 ;
+ pk_packed_num := pk_packed_num ;
+ end ;
+end ; @}
+
+@ For low resolution fonts, or characters with `gray' areas, run encoding can
+often make the character many times larger. Therefore, for those characters
+that cannot be encoded efficiently with run counts, the \.{PK} format allows
+bit-mapping of the characters. This is indicated by a |dyn_f| value of
+14. The bits are packed tightly, by concatenating all of the horizontal raster
+rows into one long string, and then packing this string eight bits to a byte.
+The number of bytes required can be calculated by |(width*height+7) div 8|.
+This format should only be used when packing the character by run counts takes
+more bytes than this, although, of course, it is legal for any character.
+Any extra bits in the last byte should be set to zero.
+
+@ At this point, we are ready to introduce the format for a character
+descripter. It consists of three parts: a flag byte, a character preamble,
+and the raster data. The most significant four nybbles of the flag byte
+yield the |dyn_f| value for that character. (Notice that only values of
+0 through 14 are legal for |dyn_f|, with 14 indicating a bit mapped character;
+thus, the flag bytes do not conflict with the command bytes, whose upper nybble
+is always 15.) The next bit (with weight 16) indicates whether the first run
+count is a black count or a white count, with a one indicating a black count.
+For bit-mapped characters, this bit should be set to a zero. The next bit
+(with weight 8) indicates whether certain later parameters (referred to as size
+parameters) are given in one-byte or two-byte quantities, with a one indicating
+that they are in two-byte quantities. The last two bits are concatenated on to
+the beginning of the length parameter in the character preamble, which will be
+explained below.
+
+However, if the last three bits of the flag byte are all set (normally
+indicating that the size parameters are two-byte values and that a 3 should be
+prepended to the length parameter), then a long format of the character
+preamble should be used instead of one of the short forms.
+
+Therefore, there are three formats for the character preamble, and which one
+is used depends on the least significant three bits of the flag byte. If the
+least significant three bits are in the range zero through three, the short
+format is used. If they are in the range four through six, the extended short
+format is used. Otherwise, if the least significant bits are all set, then
+the long form of the character preamble is used. The preamble formats are
+explained below.
+
+\yskip\hang Short form: |flag[1]| |pl[1]| |cc[1]| |tfm[3]| |dm[1]| |w[1]|
+|h[1]| |hoff[+1]| |voff[+1]|.
+If this format of the character preamble is used, the above
+parameters must all fit in the indicated number of bytes, signed or unsigned
+as indicated. Almost all of the standard \TeX\ font characters fit; the few
+exceptions are fonts such as \.{aminch}.
+
+\yskip\hang Extended short form: |flag[1]| |pl[2]| |cc[1]| |tfm[3]| |dm[2]|
+|w[2]| |h[2]| |hoff[+2]| |voff[+2]|. Larger characters use this extended
+format.
+
+\yskip\hang Long form: |flag[1]| |pl[4]| |cc[4]| |tfm[4]| |dx[4]| |dy[4]|
+|w[4]| |h[4]| |hoff[4]| |voff[4]|. This is the general format which
+allows all of the
+parameters of the \.{GF} file format, including vertical escapement.
+\vskip\baselineskip
+The |flag| parameter is the flag byte. The parameter |pl| (packet length)
+contains the offset
+of the byte following this character descripter, with respect to the beginning
+of the |tfm| width parameter. This is given so a \.{PK} reading program can,
+once it has read the flag byte, packet length, and character code (|cc|), skip
+over the character by simply reading this many more bytes. For the two short
+forms of the character preamble, the last two bits of the flag byte should be
+considered the two most-significant bits of the packet length. For the short
+format, the true packet length might be calculated as |(flag mod 4)*256+pl|;
+for the extended format, it might be calculated as |(flag mod 4)*65536+pl|.
+
+The |w| parameter is the width and the |h| parameter is the height in pixels
+of the minimum bounding box. The |dx| and |dy| parameters are the horizontal
+and vertical escapements, respectively. In the short formats, |dy| is assumed
+to be zero and |dm| is |dy| but in pixels;
+in the long format, |dx| and |dy| are both
+in pixels multiplied by $2^{16}$. The |hoff| is the horizontal offset from the
+upper left pixel to the reference pixel; the |voff| is the vertical offset.
+They are both given in pixels, with right and down being positive. The
+reference pixel is the pixel which occupies the unit square in \MF; the
+\MF\ reference point is the lower left hand corner of this pixel. (See the
+example below.)
+
+@ \TeX\ requires that all characters which have the same character codes
+modulo 256 also have the same |tfm| widths, and escapement values. The \.{PK}
+format does not itself make this a requirement, but in order for the font to
+work correctly with the \TeX\ software, this constraint should be observed.
+The current version of \TeX\ (1.5) cannot output character codes greater
+than 255 anyway.
+
+Following the character preamble is the raster information for the
+character, packed by run counts or by bits, as indicated by the flag byte.
+If the character is packed by run counts and the required number of nybbles
+is odd, then the last byte of the raster description should have a zero
+for its least significant nybble.
+
+@ As an illustration of the \.{PK} format, the character \char4\ from the font
+amr10 at 300 dots per inch will be encoded. This character was chosen
+because it illustrates some
+of the borderline cases. The raster for the character looks like this (the
+row numbers are chosen for convenience, and are not \MF's row numbers.)
+
+\vskip\baselineskip
+\centerline{\vbox{\baselineskip=10pt
+\halign{\hfil#\quad&&\hfil#\hfil\cr
+0& & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+1& & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+2& & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+3& & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+4& & &M&M& & & & & & & & & & & & & & & & &M&M\cr
+5& & &M&M& & & & & & & & & & & & & & & & &M&M\cr
+6& & &M&M& & & & & & & & & & & & & & & & &M&M\cr
+7\cr
+8\cr
+9& & & & &M&M& & & & & & & & & & & & &M&M& & \cr
+10& & & & &M&M& & & & & & & & & & & & &M&M& & \cr
+11& & & & &M&M& & & & & & & & & & & & &M&M& & \cr
+12& & & & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M& & \cr
+13& & & & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M& & \cr
+14& & & & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M& & \cr
+15& & & & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M& & \cr
+16& & & & &M&M& & & & & & & & & & & & &M&M& & \cr
+17& & & & &M&M& & & & & & & & & & & & &M&M& & \cr
+18& & & & &M&M& & & & & & & & & & & & &M&M& & \cr
+19\cr
+20\cr
+21\cr
+22& & &M&M& & & & & & & & & & & & & & & & &M&M\cr
+23& & &M&M& & & & & & & & & & & & & & & & &M&M\cr
+24& & &M&M& & & & & & & & & & & & & & & & &M&M\cr
+25& & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+26& & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+27& & &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+28&*& &M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M&M\cr
+&\hphantom{M}&\hphantom{M}\cr
+}}}
+The width of the minimum bounding box for this character is 20; its height
+is 29. The `*' represents the reference pixel; notice how it lies outside the
+minimum bounding box. The |hoff| value is $-2$, and the |voff| is~28.
+
+The first task is to calculate the run counts and repeat counts. The repeat
+counts are placed at the first transition (black to white or white to black)
+in a row, and are enclosed in brackets. White counts are enclosed in
+parentheses. It is relatively easy to generate the counts list:
+\vskip\baselineskip
+\centerline{82 [2] (16) 2 (42) [2] 2 (12) 2 (4) [3]}
+\centerline{16 (4) [2] 2 (12) 2 (62) [2] 2 (16) 82}
+\vskip\baselineskip
+Note that any duplicated rows that are not all white or all black are removed
+before the repeat counts are calculated. The rows thus removed are rows 5, 6,
+10, 11, 13, 14, 15, 17, 18, 23, and 24.
+
+@ The next step in the encoding of this character is to calculate the optimal
+value of |dyn_f|. The details of how this calculation is done are not
+important here; suffice it to say that there is a simple algorithm which in one
+pass over the count list can determine the best value of |dyn_f|. For this
+character, the optimal value turns out to be 8 (atypically low). Thus, all
+count values less than or equal to 8 are packed in one nybble; those from
+nine to $(13-8)*16+8$ or 88 are packed in two nybbles. The run encoded values
+now become (in hex, separated according to the above list):
+\vskip\baselineskip
+\centerline{\tt D9 E2 97 2 B1 E2 2 93 2 4 E3}
+\centerline{\tt 97 4 E2 2 93 2 C5 E2 2 97 D9}
+\vskip\baselineskip\noindent
+which comes to 36 nybbles, or 18 bytes. This is shorter than the 73 bytes
+required for the bit map, so we use the run count packing.
+
+@ The short form of the character preamble is used because all of the
+parameters fit in their respective lengths. The packet length is therefore
+18 bytes for the raster, plus
+eight bytes for the character preamble parameters following the character
+code, or 26. The |tfm| width for this character is 640796, or {\tt 9C71C} in
+hexadecimal. The horizontal escapement is 25 pixels. The flag byte is
+88 hex, indicating the short preamble, the black first count, and the
+|dyn_f| value of 8. The final total character packet, in hexadecimal, is:
+\vskip\baselineskip
+$$\vbox{\halign{\hfil #\quad&&{\tt #\ }\cr
+Flag byte&88\cr
+Packet length&1A\cr
+Character code&04\cr
+|tfm| width&09&C7&1C\cr
+Horizontal escapement (pixels)&19\cr
+Width of bit map&14\cr
+Height of bit map&1D\cr
+Horizontal offset (signed)&FE\cr
+Vertical offset&1C\cr
+Raster data&D9&E2&97\cr
+&2B&1E&22\cr
+&93&24&E3\cr
+&97&4E&22\cr
+&93&2C&5E\cr
+&22&97&D9\cr}}$$
+
+@ This format was written by Tomas Rokicki in August, 1985.
+
+@* Input and output.
+There are three types of files that this program must deal with---standard
+text files, files of integers (pixel files), and files of bytes (packed files.)
+For our purposes, we shall consider an eight-bit byte to consist of the
+values |0..255|. If your system does not pack these values to a byte, it is
+no major difficulty; you must only insure that the output routine
+|pk_byte| converts the value to the appropriate type before sending it to the
+file.
+
+@<Types...@>=
+@!eight_bits=0..255; {packed file byte}
+@!word_file=packed file of integer; {for pixel file words}
+@!byte_file=packed file of eight_bits ; {for packed file words}
+@^system dependancies@>
+
+@ @<Glob...@>=
+@!pxl_file:word_file; {where the input comes from}
+@!pk_file:byte_file; {where the final output goes}
+@^system dependencies@>
+
+@ To prepare these files for input, we |reset| them. An extension of
+\PASCAL\ is needed in the case of |pxl_file|, since we want to associate
+it with external files whose names are specified dynamically (i.e., not
+known at compile time). The following code assumes that `|reset(f,s)|'
+does this, when |f| is a file variable and |s| is a string variable that
+specifies the file name. If |eof(f)| is true immediately after
+|reset(f,s)| has acted, we assume that no file named |s| is accessible.
+@^system dependencies@>
+
+@p procedure open_pxl_file; {prepares to read packed bytes in a |pxl_file|}
+begin reset(pxl_file,pxl_name);
+eof_pixel:=eof(pxl_file);
+end;
+@#
+procedure open_pk_file; {prepares the output for writing}
+begin rewrite(pk_file,pk_name);
+end;
+
+@ We need a place to store the names of the input and output file, as well
+as a character counter for the output file and a line position variable.
+
+@<Glob...@>=
+@!pxl_name,@!pk_name:packed array[1..name_length] of char; {name of input
+ and output files}
+@!pk_loc:integer; {how many bytes have we sent?}
+
+@ @<Set init...@>=
+pk_loc := 0 ;
+
+@ We need a function that will read in a word from the \.{PXL} file. If
+the particular system
+@^system dependencies@>
+requires buffering, here is the place to do it. It also sets a global flag
+|eof_pixel| when it reaches the end of the file. If this flag is set on
+entrance to |load_pxl_file|, it is assumed that the file is bad.
+
+@p function pixel_integer : integer ;
+var i:integer;
+begin i := pxl_file^ ;
+get(pxl_file) ;
+eof_pixel:=eof(pxl_file);
+pixel_integer:=i;
+end;
+
+@ @<Glob...@>=
+@!eof_pixel:boolean; {true when end of pixel file is reached.}
+
+@ We also need a few routines to write data to the \.{PK} file. We write
+data in 4-, 8-, 16-, 24-, and 32-bit chunks, so we define the appropriate
+routines. We must be careful not to let the sign bit mess us up, as some
+\PASCAL's implement division of a negative integer differently. We define a
+constant to help us with the sign manipulations.
+
+@<Const...@>=
+@!one_fourth=1073741824 ; {two to the thirtieth}
+
+@ @p procedure pk_byte(b : integer) ;
+begin
+if b < 0 then b := b + 256 ;
+pk_file^ := b ;
+put(pk_file) ;
+incr(pk_loc) ;
+end ;
+@#
+procedure pk_halfword(a:integer) ;
+begin
+ if a < 0 then a := a + 65536 ;
+ pk_byte(a div 256) ;
+ pk_byte(a mod 256) ;
+end ;
+@#
+procedure pk_three_bytes(a:integer);
+begin
+ pk_byte(a div 65536 mod 256) ;
+ pk_byte(a div 256 mod 256) ;
+ pk_byte(a mod 256) ;
+end ;
+@#
+procedure pk_word(a:integer) ;
+var b : integer ;
+begin
+ if a < 0 then begin
+ a := a + one_fourth + one_fourth ;
+ b := 128 + a div 16777216 ;
+ end else b := a div 16777216 ;
+ pk_byte(b) ;
+ pk_byte(a div 65536 mod 256) ;
+ pk_byte(a div 256 mod 256) ;
+ pk_byte(a mod 256) ;
+end ;
+@#
+procedure pk_nyb(a:integer) ;
+begin
+ if bit_weight = 16 then begin
+ output_byte := a * 16 ;
+ bit_weight := 1 ;
+ end else begin
+ pk_byte(output_byte + a) ;
+ bit_weight := 16 ;
+ end ;
+end ;
+
+@ We need the globals |bit_weight| and |output_byte| for buffering.
+
+@<Glob...@>=
+@!bit_weight : integer ; {output bit weight}
+@!output_byte : integer ; {output byte for pk file}
+
+@ Here is a procedure that reads the \.{PXL} file into memory, and sets the
+|dir_ptr| to the proper place. It only checks that the first and last
+bytes of the file contain |pxl_id|.
+
+@p procedure load_pxl_file ; {read in the pixel data}
+label 9997, {used for a bad format}
+ 9999; {used for normal completion}
+var k:integer; {index for word moves}
+begin
+ open_pxl_file ;
+ k := 0 ;
+ if eof_pixel then goto 9997;
+ while not eof_pixel do begin
+ mem[k] := pixel_integer ;
+ k := k + 1 ;
+ if k > max_mem_size then
+ abort('PXtoPK memory size exceeded on load of pixel file!') ;
+ end ;
+ print_ln((4*k):1, ' bytes read from pixel file.') ;
+ if k + 10000 > max_mem_size then
+ abort('I don''t think that there will be enough memory.') ;
+ next_mem_free := k ;
+ k := k - 1 ;
+ if (mem[k] <> pxl_id) or (mem[0]<>pxl_id) then goto 9997 ;
+ goto 9999 ;
+9997: abort('PXL file is bad');
+@.PXL file is bad@>
+9999: dir_ptr := mem[k-1] ;
+end;
+
+@ We need to declare the |mem| array and a few other variables.
+
+@<Glob...@>=
+@!mem : array [0..max_mem_size] of integer ; {memory array}
+@!next_mem_free : integer ; {next memory location available}
+@!dir_ptr : integer ; {points to the directory of the pixel file}
+
+@* Writing the packed file.
+Next we have some bit manipulation routines we need.
+
+@p function hi(a:integer) : integer ;
+begin
+ hi := a div 65536 ;
+end ;
+@#
+function lo(a:integer) : integer ;
+begin
+ lo := a mod 65536 ;
+end ;
+@#
+function his(a:integer) : integer ;
+begin
+ if a < 0 then
+ his := ( a + one_fourth + one_fourth ) div 65536 - 32768
+ else
+ his := a div 65536 ;
+end ;
+@#
+function hip(a:integer) : integer ;
+begin
+ if a < 0 then
+ hip := ( a + one_fourth + one_fourth ) div 65536 + 32768
+ else
+ hip := a div 65536 ;
+end ;
+@#
+function lop(a:integer) : integer ;
+begin
+ lop := a - 65536 * his(a) ;
+end ;
+@#
+function los(a:integer) : integer ;
+var b : integer ;
+begin
+ b := lop(a) ;
+ if b > 32767 then
+ los := b - 65536
+ else
+ los := b ;
+end ;
+
+@ We now need a few definitions to make access of the pixel file simpler.
+
+@d x_size == hi(mem[dir_ptr]) {sizes}
+@d y_size == lo(mem[dir_ptr])
+@d x_offset == his(mem[dir_ptr+1]) {offsets}
+@d y_offset == los(mem[dir_ptr+1])
+@d raster_pointer == mem[dir_ptr+2] {raster pointer}
+@d tfm_width == mem[dir_ptr+3] {tfm width}
+@d checksum == mem[dir_ptr+512] {checksum at end of directory}
+@d magnification == mem[dir_ptr+513]
+@d design_size == mem[dir_ptr+514]
+
+@ Now we write the preamble. First, we must determine if we can use eight
+bit sizes and offsets, or if we need sixteen bits. Then, we simply copy
+some data from the pixel file to the packed file. Since pixel files are
+assumed to be square, we simply write the horizontal magnification factor
+out as the vertical magnification factor.
+
+@d preamble_comment == 'PXTOPK 2.3 output'
+@d comm_length = 17
+
+@p procedure write_preamble ;
+var
+ i : integer ; {general purpose index}
+begin
+ open_pk_file ;
+ pk_byte(pk_pre) ;
+ pk_byte(pk_id) ;
+ pk_byte(comm_length) ;
+ for i := 1 to comm_length do pk_byte(xord[comment[i]]) ;
+ pk_word(design_size) ; pk_word(checksum) ;
+ pk_word(hppp) ; pk_word(hppp) ;
+end ;
+
+@ We define a few globals to maintain some of this data.
+
+@<Glob...@>=
+@!car : integer ; {a global character pointer}
+@!hppp : integer ; {horizontal pixels per point}
+@!comment : packed array [1..comm_length] of char ;
+
+@ We initialize the comment array:
+
+@<Set init...@>=
+comment := preamble_comment ;
+
+@ The write postamble procedure is very simple, having just to write the
+|pk_post| command, followed by enough |pk_no_op|'s to make the file a
+multiple of four bytes long.
+
+@p procedure write_postamble ;
+begin
+ pk_byte(pk_post) ;
+ while (pk_loc mod 4 <> 0) do pk_byte(pk_no_op) ;
+ print_ln(pk_loc:1, ' bytes written to packed file.') ;
+end ;
+
+@* Packing and shipping character data.
+Now we have the meat of the program---where we actually pack and send a
+character to the |pk_file|. First, we determine if we can use repeat
+commands by looking for repeated raster rows that are not all zeros or
+all ones. Next, we create a list of bit counts in the |mem| array,
+starting with white bits (if any) and continuing until the end of the
+character. We determine the length of the character in the packed form,
+and compare it with the length in a bit-packed form, and send out the smaller
+of the two.
+
+@ First, we need a routine to compare two raster rows and tell us if they
+are the same.
+
+@p function equal(row1, row2: integer) : boolean ;
+var i : integer ; {index}
+temp : boolean ;
+begin
+ i := width ;
+ temp := true ;
+ while (i > 0) and temp do begin
+ if mem[row1] <> mem[row2] then
+ temp := false ;
+ incr(row1) ; incr(row2) ;
+ i := i - 32 ;
+ end ;
+ equal := temp ;
+end ;
+
+@ We now declare a few variables to contain the character width,
+height, offsets, and raster pointer.
+
+@<Glob...@>=
+@!width : integer ; {width of current character}
+@!height : integer ; {height of current character}
+@!c_x_off : integer ; {x offset of current character}
+@!c_y_off : integer ; {y offset of current character}
+
+@ Now we supply the actual routine that compresses and ships the character.
+We also calculate the horizontal escapement in pixels for the character here.
+Since the pixel file format does not supply this information, we approximate
+it like pixel-file reading drivers have to be rounding the \.{TFM} width.
+
+@p procedure ship_character ;
+var
+@!c_raster : integer ; {pointer to raster data of character}
+@!word_width : integer ; {width of character in 32-bit words}
+@!comp_size : integer ; {size of compressed representation}
+@!hor_esc : integer ; {horizontal escapement value}
+@<Locals to |ship_character|@>
+begin
+ hor_esc := round(pxl_conv * tfm_width) ;
+ width := x_size ; height := y_size ;
+ c_x_off := x_offset ; c_y_off := y_offset ;
+ c_raster := raster_pointer ;
+ word_width := (width + 31) div 32 ;
+ @<Create repeat list@> ;
+ @<Create bit counts@> ;
+ @<Calculate |dyn_f| and packed size and write character@> ;
+end ;
+
+@ The |pxl_conv| variable should be a global.
+
+@<Glob...@>=
+@!pxl_conv : real ; {converts TFM widths to pixels}
+
+@ Our first task is to create the list of repeated raster rows. To do this,
+we first create a row of all zeros and a row of all ones to insure that we
+do not flag on these. Next, we simply walk through the raster representation,
+looking for duplicates, and flag them as equal. Finally, we walk through this
+preliminary repeat list and add up all successive equal rows.
+
+@<Create repeat list@>=
+zero_row := next_mem_free ;
+ones_row := next_mem_free + word_width ;
+repeat_pointer := ones_row + word_width ;
+bit_counts := repeat_pointer + height + 1 ;
+for i := zero_row to ones_row - 1 do mem[i] := 0 ;
+for i := ones_row to repeat_pointer - 2 do mem[i] := -1 ;
+i := width mod 32 ;
+if i = 0 then
+ mem[repeat_pointer - 1] := -1
+else if i = 1 then
+ mem[repeat_pointer - 1] := - one_fourth - one_fourth
+else
+ mem[repeat_pointer - 1] := - power[32 - i] ;
+i := 0 ;
+j := height ;
+while i < j do begin
+ if equal(i*word_width+c_raster, zero_row) then
+ mem[repeat_pointer + i] := 0
+ else if equal(i*word_width+c_raster, ones_row) then
+ mem[repeat_pointer + i] := 0
+ else if i + 1 = j then
+ mem[repeat_pointer + i] := 0
+ else if equal(i*word_width+c_raster, (i+1)*word_width+c_raster) then
+ mem[repeat_pointer + i] := 1
+ else mem[repeat_pointer + i] := 0 ;
+ incr(i) ;
+end ;
+i := 0 ;
+while i < j do begin
+ k := i ;
+ while mem[repeat_pointer + k] = 1 do
+ incr(k) ;
+ mem[repeat_pointer + i] := k - i ;
+ i := k + 1 ;
+end ;
+mem[repeat_pointer + i] := 0
+
+@ Of course, we declare some of these locals.
+
+@<Locals...@>=
+i, j, k : integer ; {index variables}
+@!zero_row : integer ; {points to the row of zeros}
+@!ones_row : integer ; {points to the row of ones}
+@!repeat_pointer : integer ; {points to the repeat list}
+@!bit_counts : integer ; {points to the bit count list}
+@!bits_smaller : boolean ; {indicates that bit mapping is shorter}
+@!final_size : integer ; {final total size of character}
+
+@ We also need the |power| array, which contains powers of two.
+
+@<Glob...@>=
+@!power : array [0..31] of integer ;
+
+@ @<Set init...@>=
+power[0] := 1 ;
+for i := 1 to 30 do
+ power[i] := power[i-1] * 2 ;
+power[31] := - power[30] - power[30] ;
+
+@ Now we scan the raster representation, skipping any rows which are
+repeated from previous rows, and put this information in the |mem|
+array starting after |bit_counts|. A 0 terminates the list. The
+basic approach is quite simple, but first we need a few definitions
+to make the type of bit returned more readable.
+
+@d black = 1
+@d white = 0
+@d end_of_glyph = 2
+
+@ And now the actual routine.
+
+@<Create bit counts@>=
+repeat_flag := 0 ;
+bit_ptr := width - 1 ;
+cur_repeat := repeat_pointer ;
+end_raster := c_raster + height * word_width ;
+cur_ptr := bit_counts ;
+count := 0 ;
+test := white ;
+repeat
+ @<Get bit, skipping repeated rows@> ;
+ if bit = test then
+ incr(count)
+ else begin
+ mem[cur_ptr] := count ;
+ incr(cur_ptr) ;
+ if cur_ptr + 3 > max_mem_size then
+ abort('Out of memory while saving character counts!') ;
+ count := 1 ;
+ test := bit ;
+ if repeat_flag > 0 then begin
+ mem[cur_ptr] := - repeat_flag ;
+ repeat_flag := 0 ;
+ incr(cur_ptr) ;
+ end ;
+ end ;
+until test = end_of_glyph ;
+mem[cur_ptr] := 0 ;
+mem[cur_ptr+1] := 0
+
+@ Of course, there is still that get bit macro that needs to be defined.
+We simply pull the bits off one by one, checking the repeat flag and end
+of glyph.
+
+@<Get bit, skipping repeated rows@>=
+incr(bit_ptr) ;
+if bit_ptr = width then begin
+ bit_mod_32 := 0 ;
+ bit_ptr := 0 ;
+ if mem[cur_repeat] > 0 then begin
+ repeat_flag := mem[cur_repeat] ;
+ cur_repeat := cur_repeat + repeat_flag ;
+ c_raster := c_raster + word_width * repeat_flag ;
+ end ;
+ incr(cur_repeat) ;
+end ;
+decr(bit_mod_32) ;
+if bit_mod_32 = -1 then begin
+ bit_mod_32 := 31 ;
+ word := mem[c_raster] ;
+ incr(c_raster) ;
+end ;
+if c_raster > end_raster then
+ bit := end_of_glyph
+else if bit_mod_32 = 31 then begin
+ if word < 0 then begin
+ bit := black ;
+ word := word + one_fourth + one_fourth ;
+ end else
+ bit := white ;
+end else begin
+ if word >= power[bit_mod_32] then begin
+ word := word - power[bit_mod_32] ;
+ bit := black ;
+ end else
+ bit := white ;
+end
+
+@ Now for all of those many locals used but not defined:
+
+@<Locals...@>=
+@!count : integer ; {counts the number of bits}
+@!test : integer ; {what bits we are counting}
+@!cur_ptr : integer ; {where to put the counts}
+@!bit : integer ; {a variable to return the type of bit}
+@!repeat_flag : integer ; {indicates this row is to be repeated.}
+@!word : integer ; {current word to extract bits from}
+@!bit_ptr : integer ; {a bit counter in horizontal bits}
+@!bit_mod_32 : integer ; {the power of two to look for}
+@!cur_repeat : integer ; {index into repeat array}
+@!end_raster : integer ; {the end of the character raster representation}
+
+@ Here is another piece of rather intricate code. Here we determine the
+smallest size in which we can pack the data, calculating |dyn_f| in the
+process. To do this, we calculate the size required if |dyn_f| is 0, and put
+this in |comp_size|. Then, we calculate the changes in the size for each
+increment of |dyn_f|, and stick these values in the |deriv| array. Finally,
+we scan through this array, and find the final minimum value, which we then
+use to send the character data.
+
+@<Calculate |dyn_f| and packed size and write character@>=
+for i := 1 to 13 do deriv[i] := 0 ;
+first_on := mem[bit_counts] = 0 ;
+if first_on then incr(bit_counts) ;
+i := bit_counts ;
+comp_size := 0 ;
+while mem[i] <> 0 do
+ @<Process count for best |dyn_f| value@> ;
+b_comp_size := comp_size ;
+dyn_f := 0 ;
+for i := 1 to 13 do begin
+ comp_size := comp_size + deriv[i] ;
+ if comp_size <= b_comp_size then begin
+ b_comp_size := comp_size ;
+ dyn_f := i ;
+ end ;
+end ;
+comp_size := (b_comp_size + 1) div 2 ;
+if (comp_size > (height * width + 7) div 8) or (height * width = 0) then begin
+ comp_size := (height * width + 7) div 8 ;
+ dyn_f := 14 ;
+end ;
+@<Write character preamble@> ;
+if dyn_f <> 14 then
+ @<Send compressed format@>
+else
+ @<Send bit map@> ;
+if pred_pk_loc <> pk_loc then
+ abort('Bad predicted character length: character ',car:1)
+
+@ When we enter this module, we have a count, at |mem[i]|. First, we add to
+the |comp_size| the number of
+nybbles that this count would require, assuming |dyn_f| to be zero. Since when
+|dyn_f| is zero, there are no one nybble counts, we simply check the two-nybble
+counts, and then the extensible counts.
+
+Next, we take the count value and determine the value of |dyn_f| (if any) that
+would cause this count to take either more or less nybbles. If a valid value
+for |dyn_f| exists in this range, we accumulate this change in the |deriv|
+array.
+
+We know that a repeat count of one will not change the length of the raster
+representation, no matter what |dyn_f| is, because it is always represented
+by the nybble 15, so we do that as a special case.
+
+@<Process count for best |dyn_f| value@>=
+begin
+ j := mem[i] ;
+ if j = -1 then incr(comp_size)
+ else begin
+ if j < 0 then begin
+ incr(comp_size) ;
+ j := - j ;
+ end ;
+ if j < 209 then comp_size := comp_size + 2
+ else begin
+ k := j - 193 ;
+ while k >= 16 do begin
+ k := k div 16 ;
+ comp_size := comp_size + 2 ;
+ end ;
+ comp_size := comp_size + 1 ;
+ end ;
+ if j < 14 then decr(deriv[j])
+ else if j < 209 then incr(deriv[(223 - j) div 15])
+ else begin
+ k := 16 ;
+ while ( k * 16 < j + 3 ) do k := k * 16 ;
+ if j-k <= 192 then deriv[(207-j+k) div 15] := deriv[(207-j+k) div 15]
+ + 2 ;
+ end ;
+ end ;
+ incr(i) ;
+end
+
+@ We need a handful of locals:
+
+@<Locals to |ship_character|@>=
+@!dyn_f : integer ; {packing value}
+@!deriv : array[1..13] of integer ; {derivative}
+@!b_comp_size : integer ; {best size}
+@!first_on : boolean ; {indicates that the first bit is on}
+@!flag_byte : integer ; {flag byte for character}
+@!state : boolean ; {state variable}
+@!on : boolean ; {white or black?}
+
+@ Now we write the character preamble information. First we need to determine
+which of the three formats we should use.
+
+@<Write character preamble@>=
+flag_byte := dyn_f * 16 ;
+if first_on then flag_byte := flag_byte + 8 ;
+if (tfm_width > 16777215) or (tfm_width < 0) or
+ (hor_esc < 0) or (comp_size > 196579) or (width > 65535) or
+ (height > 65535) or (c_x_off > 32767) or (c_y_off > 32767) or
+ (c_x_off < -32768) or (c_y_off < -32768) then
+ @<Write long character preamble@>
+else if (hor_esc > 255) or (width > 255) or (height > 255) or
+ (c_x_off > 127) or (c_y_off > 127) or (c_x_off < -128) or
+ (c_y_off < -128) or (comp_size > 1016) then
+ @<Write two-byte short character preamble@>
+else
+ @<Write one-byte short character preamble@>
+
+@ Here we have determined that we must write a long character preamble. We
+adjust a few parameters, and then must write the data.
+
+@<Write long character preamble@>=
+begin
+ flag_byte := flag_byte + 7 ;
+ pk_byte(flag_byte) ;
+ comp_size := comp_size + 28 ;
+ pk_word(comp_size) ;
+ pk_word(car) ;
+ pred_pk_loc := pk_loc + comp_size ;
+ pk_word(tfm_width) ;
+ pk_word(hor_esc * 65536) ;
+ pk_word(0) ;
+ pk_word(width) ;
+ pk_word(height) ;
+ pk_word(c_x_off) ;
+ pk_word(c_y_off) ;
+end
+
+@ Here we write a short short character preamble, with one-byte size
+parameters.
+
+@<Write one-byte short character preamble@>=
+begin
+ comp_size := comp_size + 8 ;
+ flag_byte := flag_byte + comp_size div 256 ;
+ pk_byte(flag_byte) ;
+ pk_byte(comp_size mod 256) ;
+ pk_byte(car) ;
+ pred_pk_loc := pk_loc + comp_size ;
+ pk_three_bytes(tfm_width) ;
+ pk_byte(hor_esc) ;
+ pk_byte(width) ;
+ pk_byte(height) ;
+ pk_byte(c_x_off) ;
+ pk_byte(c_y_off) ;
+end
+
+@ Here we write a long short character preamble, with two-byte size parameters.
+
+@<Write two-byte short character preamble@>=
+begin
+ comp_size := comp_size + 13 ;
+ flag_byte := flag_byte + comp_size div 65536 + 4 ;
+ pk_byte(flag_byte) ;
+ pk_halfword(comp_size mod 65536) ;
+ pk_byte(car) ;
+ pred_pk_loc := pk_loc + comp_size ;
+ pk_three_bytes(tfm_width) ;
+ pk_halfword(hor_esc) ;
+ pk_halfword(width) ;
+ pk_halfword(height) ;
+ pk_halfword(c_x_off) ;
+ pk_halfword(c_y_off) ;
+end
+
+@ At this point, we have decided that the run-encoded format is smaller. (This
+is almost always the case.) We send out the data, a nybble at a time.
+
+@<Send compressed format@>=
+begin
+ bit_weight := 16 ;
+ max_2 := 208 - 15 * dyn_f ;
+ i := bit_counts ;
+ while mem[i] <> 0 do begin
+ j := mem[i] ;
+ if j = -1 then
+ pk_nyb(15)
+ else begin
+ if j < 0 then begin
+ pk_nyb(14) ;
+ j := - j ;
+ end ;
+ if j <= dyn_f then pk_nyb(j)
+ else if j <= max_2 then begin
+ j := j - dyn_f - 1 ;
+ pk_nyb(j div 16 + dyn_f + 1) ;
+ pk_nyb(j mod 16) ;
+ end else begin
+ j := j - max_2 + 15 ;
+ k := 16 ;
+ while k <= j do begin
+ k := k * 16 ;
+ pk_nyb(0) ;
+ end ;
+ while k > 1 do begin
+ k := k div 16 ;
+ pk_nyb(j div k) ;
+ j := j mod k ;
+ end ;
+ end ;
+ end ;
+ incr(i) ;
+ end ;
+ if bit_weight <> 16 then pk_byte(output_byte) ;
+end
+
+@ This macro is for the case where we have decided to send the character raster
+packed bit-wise. It uses the bit counts as well, sending eight at a time.
+Here we have a miniature packed format interpreter, as we must repeat any rows
+that are repeated. The algorithm to do this was a lot of fun to generate. Can
+you figure out how it works?
+
+@<Send bit map@>=
+begin
+ buff := 0 ;
+ p_bit := 8 ;
+ i := bit_counts ;
+ h_bit := width ;
+ on := not first_on ;
+ state := false ;
+ count := 0 ;
+ repeat_flag := 0 ;
+ while ( mem[i] <> 0 ) or state or ( count > 0 ) do begin
+ if state then begin
+ count := r_count ; i := r_i ; on := r_on ;
+ decr(repeat_flag) ;
+ end else begin
+ r_count := count ; r_i := i ; r_on := on ;
+ end ;
+ @<Send one row by bits@> ;
+ if state and ( repeat_flag = 0 ) then begin
+ count := s_count ; i := s_i ; on := s_on ;
+ state := false ;
+ end else if not state and ( repeat_flag > 0 ) then begin
+ s_count := count ; s_i := i ; s_on := on ;
+ state := true ;
+ end ;
+ end ;
+ if p_bit <> 8 then pk_byte(buff) ;
+end
+
+@ All of the remaining locals:
+
+@<Locals to |ship_character|@>=
+@!h_bit : integer ; {what bit in the character are we on?}
+@!p_bit : integer ; {what bit are we about to send out?}
+@!r_on, @!s_on : boolean ; {state saving variables}
+@!r_count, @!s_count : integer ; {ditto}
+@!r_i, @!s_i : integer ; {and again.}
+@!max_2 : integer ; {the highest count that fits in two bytes}
+@!pred_pk_loc : integer ; {where we think the character will end}
+@!buff : integer ; {buffer for byte output}
+
+@ We are at the beginning of a row; we simply output the next |width| bits.
+We break the possibilities up into three cases; we finish a byte but not
+the row, we finish a row, and we finish neither a row nor a byte. But,
+first, we insure that we have a |count| value.
+
+@<Send one row by bits@>=
+repeat
+ if count = 0 then begin
+ if mem[i] < 0 then begin
+ if not state then repeat_flag := - mem[i] ;
+ incr(i) ;
+ end ;
+ count := mem[i] ;
+ incr(i) ;
+ on := not on ;
+ end ;
+ if ( count >= p_bit ) and ( p_bit < h_bit ) then begin
+{ we end a byte, we don't end the row }
+ if on then buff := buff + power[p_bit] - 1 ;
+ pk_byte(buff) ; buff := 0 ;
+ h_bit := h_bit - p_bit ; count := count - p_bit ; p_bit := 8 ;
+ end else if ( count < p_bit ) and ( count < h_bit ) then begin
+{ we end neither the row nor the byte }
+ if on then buff := buff + power[p_bit] - power[p_bit - count] ;
+ p_bit := p_bit - count ; h_bit := h_bit - count ; count := 0 ;
+ end else begin
+{ we end a row and maybe a byte }
+ if on then buff := buff + power[p_bit] - power[p_bit - h_bit] ;
+ count := count - h_bit ; p_bit := p_bit - h_bit ; h_bit := width ;
+ if p_bit = 0 then begin
+ pk_byte(buff) ; buff := 0 ; p_bit := 8 ;
+ end ;
+ end ;
+until h_bit = width
+
+@* Terminal communication.
+We must get the file names and determine whether output is to be in
+hexadecimal or binary. To do this, we use the standard input path
+name. We need a procedure to flush the input buffer. For most systems,
+this will be an empty statement. For other systems, a |print_ln| will
+provide a quick fix. We also need a routine to get a line of input from
+the terminal. On some systems, a simple |read_ln| will do. Finally,
+a macro to print a string to the first blank is required.
+
+@d flush_buffer == begin end
+@d get_line(#) == if eoln(input) then read_ln(input) ;
+ i := 1 ;
+ while not (eoln(input) or eof(input)) do begin
+ #[i] := input^ ;
+ incr(i) ;
+ get(input) ;
+ end ;
+ #[i] := ' '
+
+@ @p procedure dialog ;
+var i : integer ; {index variable}
+buffer : packed array [1..name_length] of char; {input buffer}
+begin
+ for i := 1 to name_length do begin
+ pxl_name[i] := ' ' ;
+ pk_name[i] := ' ' ;
+ end;
+ print('Input file name: ') ;
+ flush_buffer ;
+ get_line(pxl_name) ;
+ print('Output file name: ') ;
+ flush_buffer ;
+ get_line(pk_name) ;
+ print_ln(' ') ;
+end ;
+
+@* The main program.
+Now that we have all the pieces written, let us put them together.
+
+@p begin
+initialize ;
+dialog ;
+load_pxl_file ;
+pxl_conv := ( design_size div 16 ) / 65536.0 * magnification / 72.27
+ / 5242880.0 ;
+hppp := round(magnification * 65536 / 72.27 / 5) ;
+write_preamble ;
+for car := 0 to 127 do begin
+ if raster_pointer <> 0 then
+ ship_character ;
+ dir_ptr := dir_ptr + 4 ;
+end ;
+write_postamble ;
+final_end :
+end .
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{PXtoPK} work at a particular installation.
+Any additional routines should be inserted here.
+@^system dependencies@>
+
+@* Index.
+Pointers to error messages appear here together with the section numbers
+where each ident\-i\-fier is used.
diff --git a/obsolete/systems/knuth/unsupported/patgen/patgen.web b/obsolete/systems/knuth/unsupported/patgen/patgen.web
new file mode 100644
index 0000000000..3a99986314
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/patgen/patgen.web
@@ -0,0 +1,1978 @@
+% This is PATGEN.WEB in text format, as of October 24, 1996.
+% Version 1.0 was finished in 1983.
+% Version 2.0 major revision for `8-bit TeX' (November 8, 1991).
+% Version 2.1 allows left/right_hypen_min from terminal (April, 1992).
+% Version 2.2 added `close_in(dictionary)' (August, 1996).
+% Version 2.3 avoided division by zero - Karl Berry (October, 1996).
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\def\PASCAL{Pascal}
+
+\def\title{PATGEN}
+\def\contentspagenumber{45} % should be odd
+\def\topofcontents{
+ \line{\tenit Appendix\hfil \mainfont\contentspagenumber}
+ \vfill
+ \null\vskip 40pt
+ \centerline{\titlefont {\ttitlefont PAT}tern {\ttitlefont GEN}eration
+ program}
+ \vskip 8pt
+ \centerline{\titlefont for the \TeX 82 hyphenator}
+ \vskip 15pt
+ \centerline{(Version 2.3, October 1996)}
+ \vfill}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+This program takes a list of hyphenated words and generates a set of
+patterns that can be used by the \TeX 82 hyphenation algorithm.
+
+The patterns consist of strings of letters and digits, where a digit
+indicates a `hyphenation value' for some intercharacter position. For
+example, the pattern \.{3t2ion} specifies that if the string \.{tion}
+occurs in a word, we should assign a hyphenation value of 3 to the
+position immediately before the \.{t}, and a value of 2 to the position
+between the \.{t} and the \.{i}.
+
+To hyphenate a word, we find all patterns that match within the word and
+determine the hyphenation values for each intercharacter position. If
+more than one pattern applies to a given position, we take the maximum of
+the values specified (i.e., the higher value takes priority). If the
+resulting hyphenation value is odd, this position is a feasible
+breakpoint; if the value is even or if no value has been specified, we are
+not allowed to break at this position.
+
+In order to find quickly the patterns that match in a given word and to
+compute the associated hyphenation values, the patterns generated by this
+program are compiled by \.{INITEX} into a compact version of a finite
+state machine. For further details, see the \TeX 82 source.
+
+The |banner| string defined here should be changed whenever \.{PATGEN}
+gets modified.
+
+@d banner=='This is PATGEN, Version 2.3' {printed when the program starts}
+
+@ The original version~1 of \.{PATGEN} was written by Frank~M. Liang
+@^Liang, Franklin Mark@>
+in 1982; a major revision (version~2) by Peter Breitenlohner in 1991
+@^Breitenlohner, Peter@>
+is mostly related to the new features of `8-bit \TeX' (version~3 of
+\TeX 82). The differences between versions~1 and~2 fall into several
+categories (all of Liang's algorithms have been left essentially
+unchanged): (1)~enhancements related to 8-bit \TeX, e.g., the
+introduction of 8-bit |ASCII_code| values and of \.{\\lefthyphenmin} and
+\.{\\righthyphenmin}; (2)~a modification of the input and output
+procedures which should make language specific modifications of this
+program unnecessary (information about the external representation of
+all `letters' used by a particular language is obtained from the
+|translate| file); (3)~removal of ANSI standard \PASCAL\ and range check
+violations; (4)~removal of uninitialized variables; (5)~minor
+modifications in order to simplify system-dependent modifications.
+@^range check violations@>
+
+@ This program is written in standard \PASCAL, except where it is
+necessary to use extensions. All places where nonstandard constructions
+are used have been listed in the index under ``system dependencies.''
+@!@^system dependencies@>
+
+The program uses \PASCAL's standard |input| and |output| files to read
+from and write to the user's terminal.
+
+@d print(#)==write(output,#)
+@d print_ln(#)==write_ln(output,#)
+@d get_input(#)==read(input,#)
+@d get_input_ln(#)==
+ begin if eoln(input) then read_ln(input);
+ read(input,#);
+ end
+@#
+@d end_of_PATGEN=9999
+
+@p @<Compiler directives@>@/
+program PATGEN(@!dictionary,@!patterns,@!translate,@!patout);
+label end_of_PATGEN;
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+ begin print_ln(banner);@/
+ @<Set initial values@>@/
+ end;
+
+@ The patterns are generated in a series of sequential passes through the
+dictionary. In each pass, we collect count statistics for a particular
+type of pattern, taking into account the effect of patterns chosen in
+previous passes. At the end of a pass, the counts are examined and new
+patterns are selected.
+
+Patterns are chosen one level at a time, in order of increasing
+hyphenation value. In the sample run shown below, the parameters
+|hyph_start| and |hyph_finish| specify the first and last levels,
+respectively, to be generated.
+
+Patterns at each level are chosen in order of increasing pattern length
+(usually starting with length~2). This is controlled by the parameters
+|pat_start| and |pat_finish| specified at the beginning of each level.
+
+Furthermore patterns of the same length applying to different
+intercharacter positions are chosen in separate passes through the
+dictionary. Since patterns of length $n$ may apply to $n+1$ different
+positions, choosing a set of patterns of lengths $2$ through $n$ for a
+given level requires $(n+1)(n+2)/2-3$ passes through the word list.
+
+At each level, the selection of patterns is controlled by the three
+parameters |good_wt|, |bad_wt|, and |thresh|. A hyphenating pattern will
+be selected if |good*good_wt-bad*bad_wt>=thresh|, where |good| and
+|bad| are the number of times the pattern could and could not be
+hyphenated, respectively, at a particular point. For inhibiting patterns,
+|good| is the number of errors inhibited, and |bad| is the number of
+previously found hyphens inhibited.
+
+@<Globals...@>=
+@!pat_start, @!pat_finish: dot_type;
+@!hyph_start, @!hyph_finish: val_type;
+@!good_wt, @!bad_wt, @!thresh: integer;
+
+@ The proper choice of the parameters to achieve a desired degree of
+hyphenation is discussed in Chapter~4. Below we show part of a sample run
+of \.{PATGEN}, with the user's inputs underlined.
+$$\vbox{\halign{\.{#\hfil}\cr
+$\underline{\smash{\.{ex patgen}}}$\cr
+DICTIONARY : $\underline{\smash{\.{murray.hyf}}}$\cr
+PATTERNS : $\underline{\smash{\.{nul:}}}$\cr
+TRANSLATE : $\underline{\smash{\.{nul:}}}$\cr
+PATOUT : $\underline{\smash{\.{murray.pat}}}$\cr
+This is PATGEN, Version 2.0\cr
+left\_hyphen\_min = 2, right\_hyphen\_min = 3, 26 letters\cr
+0 patterns read in\cr
+pattern trie has 256 nodes, trie\_max = 256, 0 outputs\cr
+hyph\_start, hyph\_finish: $\underline{\.{1 1}}$\cr
+pat\_start, pat\_finish: $\underline{\.{2 3}}$\cr
+good weight, bad weight, threshold: $\underline{\.{1 3 3}}$\cr
+processing dictionary with pat\_len = 2, pat\_dot = 1\cr
+\cr
+0 good, 0 bad, 3265 missed\cr
+ 0.00 \%, 0.00 \%, 100.00 \%\cr
+338 patterns, 466 nodes in count trie, triec\_max = 983\cr
+46 good and 152 bad patterns added (more to come)\cr
+finding 715 good and 62 bad hyphens, efficiency = 10.72\cr
+pattern trie has 326 nodes, trie\_max = 509, 2 outputs\cr
+processing dictionary with pat\_len = 2, pat\_dot = 0\cr
+\cr
+\hskip 1.5em ...\cr
+\cr
+1592 nodes and 39 outputs deleted\cr
+total of 220 patterns at hyph\_level 1\cr
+hyphenate word list? $\underline{\smash{\.{y}}}$\cr
+writing pattmp.1\cr
+\cr
+2529 good, 243 bad, 736 missed\cr
+ 77.46 \%, 7.44 \%, 22.54 \%\cr}}$$
+
+@ Note that before beginning a pattern selection run, a file of existing
+patterns may be read in. In order for pattern selection to work properly,
+this file should only contain patterns with hyphenation values less than
+|hyph_start|. Each word in the dictionary is hyphenated according to the
+existing set of patterns (including those chosen on previous passes of the
+current run) before pattern statistics are collected.
+
+Also, a hyphenated word list may be written out at the end of a run. This
+list can be read back in as the `dictionary' to continue pattern selection
+from this point. In addition to ordinary hyphens (|'-'|) the new list
+will contain two additional kinds of ``hyphens'' between letters, namely
+hyphens that have been found by previously generated patterns, as well
+as erroneous hyphens that have been inserted by those patterns. These
+are represented by the symbols |'*'| and |'.'|, respectively. The three
+characters |'-'|, |'*'|, and |'.'| are, in fact, just the default values
+used to represent the three kinds of hyphens, the |translate| file may
+specify different characters to be used instead of them.
+
+In addition, a word list can include hyphen weights, both for entire words
+and for individual hyphen positions. (The syntax for this is explained in
+the dictionary processing routines.) Thus common words can be weighted
+more heavily, or, more generally, words can be weighted according to their
+frequency of occurrence, if such information is available. The use of
+hyphen weights combined with an appropriate setting of the pattern
+selection threshold can be used to guarantee hyphenation of certain words
+or certain hyphen positions within a word.
+
+@ Below we show the first few lines of a typical word list,
+before and after generating a level of patterns.
+$$\vbox{\halign{\tabskip 1in\.{#\hfil}&\.{#\hfil}\cr
+abil-i-ty& abil*i*ty\cr
+ab-sence& ab*sence\cr
+ab-stract& ab*stract\cr
+ac-a-dem-ic& ac-a-d.em-ic\cr
+ac-cept& ac*cept\cr
+ac-cept-able& ac*cept-able\cr
+ac-cept-ed& ac*cept*ed\cr
+\hskip 1.5em ...&\hskip 1.5em ...\cr
+}}$$
+
+@ We augment \PASCAL 's control structures a bit using |goto|\unskip's
+and the following symbolic labels.
+
+@d exit=10 {go here to leave a procedure}
+@d continue=22 {go here to resume a loop}
+@d done=30 {go here to exit a loop}
+@d found=40 {go here when you've found it}
+@d not_found=41 {go here when you've found something else}
+
+@ Here are some macros for common programming idioms.
+
+@d incr(#)==#:=#+1 {increase a variable by unity}
+@d decr(#)==#:=#-1 {decrease a variable by unity}
+@#
+@d Incr_Decr_end(#)==#
+@d Incr(#)==#:=#+Incr_Decr_end {we use |Incr(a)(b)| to increase \dots}
+@d Decr(#)==#:=#-Incr_Decr_end {\dots\ and |Decr(a)(b)| to decrease
+ variable |a| by |b|; this can be optimized for some compilers}
+@#
+@d loop == @+ while true do@+ {repeat over and over until a |goto| happens}
+@d do_nothing == {empty statement}
+@d return==goto exit {terminate a procedure call}
+@f return==nil
+@f loop == xclause
+
+@ In case of serious problems \.{PATGEN} will give up, after issuing an
+error message about what caused the error. Such errors might be
+discovered inside of subroutines inside of subroutines, so a \.{WEB}
+macro called |jump_out| has been introduced. This macro, which transfers
+control to the label |end_of_PATGEN| at the end of the program, contains
+the only non-local |@!goto| statement in \.{PATGEN}. Some \PASCAL\
+compilers do not implement non-local |goto| statements. In such cases
+the |goto end_of_PATGEN| in the definition of |jump_out| should simply
+be replaced by a call on some system procedure that quietly terminates
+the program.
+@^system dependencies@>
+
+An overflow stop occurs if \.{PATGEN}'s tables aren't large enough.
+
+@d jump_out==goto end_of_PATGEN {terminates \.{PATGEN}}
+@#
+@d error(#)==begin print_ln(#); jump_out; end
+@d overflow(#)==error('PATGEN capacity exceeded, sorry [',#,'].')
+@.PATGEN capacity exceeded ...@>
+
+@ @<Compiler directives@>=
+@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead}
+@^system dependencies@>
+
+@* The character set.
+Since different \PASCAL\ systems may use different character sets, we use
+the name |text_char| to stand for the data type of characters appearing in
+external text files. We also assume that |text_char| consists of the
+elements |chr(first_text_char)| through |chr(last_text_char)|, inclusive.
+The definitions below should be adjusted if necessary.
+@^system dependencies@>
+@^character set dependencies@>
+
+Internally, characters will be represented using the type |ASCII_code|.
+Note, however, that only some of the standard ASCII characters are
+assigned a fixed |ASCII_code|; all other characters are assigned an
+|ASCII_code| dynamically when they are first read from the |translate|
+file specifying the external representation of the `letters' used by a
+particular language. For the sake of generality the standard version of
+this program allows for 256 different |ASCII_code| values, but 128 of
+them would probably suffice for all practical purposes.
+
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=255 {ordinal number of the largest element of |text_char|}
+@#
+@d last_ASCII_code=255 {the highest allowed |ASCII_code| value}
+
+@<Types...@>=
+@!text_char=char; {the data type of characters in text files}
+@!ASCII_code=0..last_ASCII_code; {internal representation of input characters}
+@!text_file=text;
+
+@ Some \PASCAL s can store only signed eight-bit quantities (|-128..127|)
+but not unsigned ones (|0..255|) in one byte. If storage is tight we
+must, for such \PASCAL s, either restrict |ASCII_code| to the range
+|0..127| (with some loss of generality) or convert between |ASCII_code|
+and |packed_ASCII_code| and vice versa by subtracting or adding an
+offset. (Or we might define |packed_ASCII_code| as |char| and use
+suitable typecasts for the conversion.) Only the type |packed_ASCII_code|
+will be used for large arrays and the \.{WEB} macros |si| and |so| will
+always be used to convert an |ASCII_code| into a |packed_ASCII_code| and
+vice versa.
+@^system dependencies@>
+
+@d min_packed=0 {change this to `$\\{min\_packed}=-128$' when necessary;
+ and don't forget to change the definitions of |si| and |so| below
+ accordingly}
+@#
+@d si(#)==# {converts |ASCII_code| to |packed_ASCII_code|}
+@d so(#)==# {converts |packed_ASCII_code| to |ASCII_code|}
+
+@<Types...@>=
+@!packed_ASCII_code=min_packed..last_ASCII_code+min_packed;
+
+@ We want to make sure that the ``constants'' defined in this program
+satisfy all the required relations. Some of them are needed to avoid
+time-consuming checks while processing the dictionary and\slash or to
+prevent range check and array bound violations.
+@^range check violations@>
+
+Here we check that the definitions of |ASCII_code| and
+|packed_ASCII_code| are consistent with those of |si| and |so|.
+
+@<Set init...@>=
+bad:=0;@/
+if last_ASCII_code<127 then bad:=1;
+if (si(0)<>min_packed)or(so(min_packed)<>0) then bad:=2;@/
+@<Check the ``constant'' values for consistency@>@;
+if bad>0 then error('Bad constants---case ',bad:1);
+@.Bad constants@>
+
+@ @<Local variables for init...@>=
+@!bad:integer;
+@!i:text_char;
+@!j:ASCII_code;
+
+@ We convert between |ASCII_code| and the user's external character set by
+means of arrays |xord| and |xchr| that are analogous to \PASCAL's |ord|
+and |chr| functions.
+
+@<Globals...@>=
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [ASCII_code] of text_char;
+ {specifies conversion of output characters}
+
+@ The following code initializes the |xchr| array with some of the
+standard ASCII characters.
+
+@<Set init...@>=
+for j:=0 to last_ASCII_code do xchr[j]:=' ';
+xchr["."]:='.';@/
+xchr["0"]:='0'; xchr["1"]:='1'; xchr["2"]:='2'; xchr["3"]:='3';
+xchr["4"]:='4'; xchr["5"]:='5'; xchr["6"]:='6'; xchr["7"]:='7';
+xchr["8"]:='8'; xchr["9"]:='9';@/
+xchr["A"]:='A'; xchr["B"]:='B'; xchr["C"]:='C'; xchr["D"]:='D';
+xchr["E"]:='E'; xchr["F"]:='F'; xchr["G"]:='G'; xchr["H"]:='H';
+xchr["I"]:='I'; xchr["J"]:='J'; xchr["K"]:='K'; xchr["L"]:='L';
+xchr["M"]:='M'; xchr["N"]:='N'; xchr["O"]:='O'; xchr["P"]:='P';
+xchr["Q"]:='Q'; xchr["R"]:='R'; xchr["S"]:='S'; xchr["T"]:='T';
+xchr["U"]:='U'; xchr["V"]:='V'; xchr["W"]:='W'; xchr["X"]:='X';
+xchr["Y"]:='Y'; xchr["Z"]:='Z';@/
+xchr["a"]:='a'; xchr["b"]:='b'; xchr["c"]:='c'; xchr["d"]:='d';
+xchr["e"]:='e'; xchr["f"]:='f'; xchr["g"]:='g'; xchr["h"]:='h';
+xchr["i"]:='i'; xchr["j"]:='j'; xchr["k"]:='k'; xchr["l"]:='l';
+xchr["m"]:='m'; xchr["n"]:='n'; xchr["o"]:='o'; xchr["p"]:='p';
+xchr["q"]:='q'; xchr["r"]:='r'; xchr["s"]:='s'; xchr["t"]:='t';
+xchr["u"]:='u'; xchr["v"]:='v'; xchr["w"]:='w'; xchr["x"]:='x';
+xchr["y"]:='y'; xchr["z"]:='z';
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|.
+
+@d invalid_code=0 {|ASCII_code| that should not appear}
+@d tab_char=@'11 {|ord| of tab character; tab characters seem to be
+ unavoidable with files from UNIX systems}
+@^system dependencies@>
+@^character set dependencies@>
+
+@<Set init...@>=
+for i:=chr(first_text_char) to chr(last_text_char) do
+ xord[i]:=invalid_code;
+for j:=0 to last_ASCII_code do xord[xchr[j]]:=j;
+xord[' ']:=" "; xord[chr(tab_char)]:=" ";
+
+@ So far each invalid |ASCII_code| has been assigned the character |' '|
+and all invalid characters have been assigned |ASCII_code=invalid_code|.
+The |get_ASCII| function, used only while reading the |translate| file,
+returns the |ASCII_code| corresponding to a character, assigning a new
+|ASCII_code| first if necessary.
+
+@d num_ASCII_codes=last_ASCII_code+1 {number of different |ASCII_code| values}
+
+@p function get_ASCII(@!c:text_char):ASCII_code;
+label found;
+var i: ASCII_code;
+begin i:=xord[c];
+if i=invalid_code then
+ begin while i<last_ASCII_code do
+ begin incr(i);
+ if (xchr[i]=' ')and(i<>" ") then goto found;
+ end;
+ overflow(num_ASCII_codes:1,' characters');
+ found: xord[c]:=i; xchr[i]:=c;
+ end;
+get_ASCII:=i;
+end;
+
+@ The \TeX 82 hyphenation algorithm operates on `hyphenable words'
+converted temporarily to lower case, i.e., they may consist of up to
+255 different `letters' corresponding to \.{\\lccode}s |1..255|. These
+\.{\\lccode}s could, in principle, be language dependent but this might
+lead to undesirable results when hyphenating multilingual paragraphs.
+No more than 245 different letters can occur in hyphenation patterns
+since the characters |'0'..'9'| and |'.'| play a special r\^^Dole when
+reading patterns. For the purpose of this program each letter is
+represented internally by a unique |internal_code>=2| (|internal_code=1|
+is the |edge_of_word| indicator); |internal_code| values |2..127| will
+probably suffice for all practical purposes, but we allow the range
+|2..last_ASCII_code| for the sake of generality. Syntactically
+|internal_code| and |ASCII_code| are the same, we will use one or the
+other name according to the semantic context.
+
+@d edge_of_word=1 {|internal_code| for start and end of a word}
+
+@<Types...@>=
+@!internal_code=ASCII_code;
+@!packed_internal_code=packed_ASCII_code;
+
+@ Note that an |internal_code| used by this program is in general quite
+different from the |ASCII_code| (or rather \.{\\lccode}) used by \TeX
+82. This program allows the input of characters (from the |dictionary|
+and |patterns| file) corresponding to an |internal_code| in either lower
+or upper case form; the output (to the |patout| and |pattmp| file) will
+always be in lower case form.
+
+Unfortunately there does not (yet?) exist a standardized and widely
+accepted 8-bit character set (or a unique one-to-one translation between
+such sets). On the other hand macro expansion takes place in \TeX 82
+when reading hyphenable words and when reading patterns. Thus the lower
+and upper case versions of all `letters' used by a particular language
+can (and for the sake of portability should) be represented entirely in
+terms of the standard ASCII character set; either directly as characters
+or via macros (or active characters) with or without arguments. The
+macro definitions for such a representation will in general be language
+dependent.
+
+For the purpose of this program the external representation of the lower
+and upper case version of a letter (i.e., |internal_code|) consists of a
+unique sequence of characters (or \\{ASCII\_codes}), the only restriction
+being that no such sequence must be a subsequence of an other one.
+Moreover such sequences must not start with |' '|, |'.'|, |'0'..'9'| or
+with one of the three characters (|'-'|, |'*'|, and |'.'|) representing
+hyphens in the |dictionary| file; a sequence may, however, end with a
+mandatory |' '| as, e.g., the sequence |'\ss '|.
+
+The language dependent values of \.{\\lefthyphenmin} and
+\.{\\righthyphenmin} as well as the external representation of the lower
+and upper case letters and their collating sequence are specified in the
+|translate| file, thus making any language dependent modifications of
+this program unnecessary. If the |translate| file is empty (or does not
+exist) the values \.{\\lefthyphenmin=2} and \.{\\righthyphenmin=3} and
+|internal_code| values |2..27| with the one character external
+representations |'a'..'z'| and |'A'..'Z'| will be used as defaults.
+
+Incidentally this program can be used to convert a |dictionary| and
+|patterns| file from one (``upper case'') to another (``lower case'')
+external representation of letters.
+
+@ When reading the |dictionary| (and |patterns|) file sequences of
+characters must be recognized and converted to their corresponding
+|internal_code|. This conversion is part of \.{PATGEN}s inner loop and
+@^inner loop@>
+must therefore be done as efficient as possible. Thus we will
+mostly bypass the conversion from character to |ASCII_code| and convert
+directly to the corresponding |internal_code| using the |xclass|
+and |xint| arrays. Six types of characters are distinguished by their
+|xclass|:
+
+\yskip\hang |space_class| character |' '| terminates a pattern or word.
+
+\yskip\hang |digit_class| characters |'0'..'9'| are hyphen values for a
+pattern or hyphen weights for a word; their |xint| is the corresponding
+numeric value |0..9|.
+
+\yskip\hang |hyf_class| characters (|'.'|, |'-'|, and |'*'|) are `dots'
+and indicate hyphens in a word; their |xint| is the corresponding
+numeric value |err_hyf..found_hyf|.
+
+\yskip\hang |letter_class| characters represent a letter; their |xint|
+is the corresponding |internal_code|.
+
+\yskip\hang |escape_class| characters indicate the start of a
+multi-character sequence representing a letter.
+
+\yskip\hang |invalid_class| characters should not occur except as part
+of multi-character sequences.
+
+@d space_class=0 {the character |' '|}
+@d digit_class=1 {the characters |'0'..'9'|}
+@d hyf_class=2 {the `hyphen' characters (|'.'|, |'-'|, and |'*'|)}
+@d letter_class=3 {characters representing a letter}
+@d escape_class=4 {characters that start a multi-character sequence
+ representing a letter}
+@d invalid_class=5 {characters that normally should not occur}
+@#
+@d no_hyf=0 {no hyphen}
+@d err_hyf=1 {erroneous hyphen}
+@d is_hyf=2 {hyphen}
+@d found_hyf=3 {found hyphen}
+
+@<Types...@>=
+@!class_type=space_class..invalid_class; {class of a character}
+@!digit=0..9; {a hyphen weight (or word weight)}
+@!hyf_type=no_hyf..found_hyf; {type of a hyphen}
+
+@ In addition we will use the |xext|, |xdig|, and |xdot| arrays to
+convert from the internal representation to the corresponding
+characters.
+
+@<Globals...@>=
+@!xclass: array [text_char] of class_type;
+ {specifies the class of a character}
+@!xint: array [text_char] of internal_code;
+ {specifies the |internal_code| for a character}
+@!xdig: array [0..9] of text_char;
+ {specifies conversion of output characters}
+@!xext: array [internal_code] of text_char;
+ {specifies conversion of output characters}
+@!xhyf: array [err_hyf..found_hyf] of text_char;
+ {specifies conversion of output characters}
+
+@ @<Set init...@>=
+for i:=chr(first_text_char) to chr(last_text_char) do
+ begin xclass[i]:=invalid_class; xint[i]:=0;
+ end;
+xclass[' ']:=space_class;
+for j:=0 to last_ASCII_code do xext[j]:=' ';
+xext[edge_of_word]:='.';
+for j:=0 to 9 do
+ begin xdig[j]:=xchr[j+"0"];
+ xclass[xdig[j]]:=digit_class; xint[xdig[j]]:=j;
+ end;
+xhyf[err_hyf]:='.'; xhyf[is_hyf]:='-'; xhyf[found_hyf]:='*';
+ {default representation for hyphens}
+
+@ We assume that words use only the letters |cmin+1| through |cmax|.
+This allows us to save some time on trie operations that involve
+searching for packed transitions belonging to a particular state.
+
+@d cmin=edge_of_word
+
+@<Globals...@>=
+@!cmax: internal_code; {largest |internal_code| or |ASCII_code|}
+
+@* Data structures.
+The main data structure used in this program is a dynamic packed trie.
+In fact we use two of them, one for the set of patterns selected so far,
+and one for the patterns being considered in the current pass.
+
+For a pattern $p_1\ldots p_k$, the information associated with that
+pattern is accessed by setting |@t$t_1$@>:=trie_root+@t$p_1$@>| and
+then, for |1<i<=k|, setting |@t$t_i$@>:=trie_link(@t$t_{i-1}$@>)+
+@t$p_i$@>|; the pattern information is then stored in a location addressed
+by |@t$t_k$@>|. Since all trie nodes are packed into a single array, in
+order to distinguish nodes belonging to different trie families, a special
+field is provided such that |trie_char@t$(t_i)=si(p_i)$@>| for all |i|.
+
+In addition the trie must support dynamic insertions and deletions. This
+is done by maintaining a doubly linked list of unoccupied cells and
+repacking trie families as necessary when insertions are made.
+
+Each trie node consists of three fields: the character |trie_char|, and
+the two link fields |trie_link| and |trie_back|. In addition there is a
+separate boolean array |trie_base_used|. When a node is unoccupied,
+|trie_char=min_packed| and the link fields point to the next and previous
+unoccupied nodes, respectively, in the doubly linked list. When a node is
+occupied, |trie_link| points to the next trie family, and |trie_back|
+(renamed |trie_outp|) contains the output associated with this transition.
+The |trie_base_used| bit indicates that some family has been packed at
+this base location, and is used to prevent two families from being packed
+at the same location.
+
+@ The sizes of the pattern tries may have to be adjusted depending
+on the particular application (i.e., the parameter settings and the
+size of the dictionary). The sizes below were sufficient to generate
+the original set of english \TeX 82 hyphenation patterns (file
+\.{hyphen.tex}).
+
+@<Constants...@>=
+@!trie_size=55000; {space for pattern trie}
+@!triec_size=26000; {space for pattern count trie, must be less than
+ |trie_size| and greater than the number of occurrences of any pattern in
+ the dictionary}
+@!max_ops=4080; {size of output hash table, should be a multiple of 510}
+@!max_val=10; {maximum number of levels$+1$, also used to denote bad patterns}
+@!max_dot=15; {maximum pattern length, also maximum length of external
+ representation of a `letter'}
+@!max_len=50; {maximum word length}
+@!max_buf_len=80; {maximum length of input lines, must be at least |max_len|}
+
+@ @<Check the ``constant'' values for consistency@>=
+if (triec_size<4096)or(trie_size<triec_size) then bad:=3;
+if max_ops>trie_size then bad:=4;
+if max_val>10 then bad:=5;
+if max_buf_len<max_len then bad:=6;
+
+@ @<Types...@>=
+@!q_index=1..last_ASCII_code; {number of transitions in a state}
+@!val_type=0..max_val; {hyphenation values}
+@!dot_type=0..max_dot; {dot positions}
+@!op_type=0..max_ops; {index into output hash table}
+@!word_index=0..max_len; {index into |word|}
+@!trie_pointer=0..trie_size;
+@!triec_pointer=0..triec_size;@/
+@!op_word=packed record dot: dot_type; val: val_type; op: op_type end;
+
+@ Trie is actually stored with its components in separate packed arrays,
+in order to save space and time (although this depends on the computer's
+word size and the size of the trie pointers).
+
+@<Globals...@>=
+@!trie_c: packed array[trie_pointer] of packed_internal_code;
+@!trie_l, @!trie_r: packed array[trie_pointer] of trie_pointer;
+@!trie_taken: packed array[trie_pointer] of boolean;
+@!triec_c: packed array[triec_pointer] of packed_internal_code;
+@!triec_l, @!triec_r: packed array[triec_pointer] of triec_pointer;
+@!triec_taken: packed array[triec_pointer] of boolean;
+@!ops: array[op_type] of op_word; {output hash table}
+
+@ When some trie state is being worked on, an unpacked version of the
+state is kept in positions |1..qmax| of the global arrays |trieq_c|,
+|trieq_l|, and |trieq_r|. The character fields need not be in any
+particular order.
+
+@<Globals...@>=
+@!trieq_c: array[q_index] of internal_code; {character fields of a
+ single trie state}
+@!trieq_l, @!trieq_r: array[q_index] of trie_pointer; {link fields}
+@!qmax: q_index; {number of transitions in an unpacked state}
+@!qmax_thresh: q_index; {controls density of first-fit packing}
+
+@ Trie fields are accessed using the following macros.
+
+@d trie_char(#)==trie_c[#]
+@d trie_link(#)==trie_l[#]
+@d trie_back(#)==trie_r[#]
+@d trie_outp(#)==trie_r[#]
+@d trie_base_used(#)==trie_taken[#]
+@#
+@d triec_char(#)==triec_c[#]
+@d triec_link(#)==triec_l[#]
+@d triec_back(#)==triec_r[#]
+@d triec_good(#)==triec_l[#]
+@d triec_bad(#)==triec_r[#]
+@d triec_base_used(#)==triec_taken[#]
+@#
+@d q_char(#)==trieq_c[#]
+@d q_link(#)==trieq_l[#]
+@d q_back(#)==trieq_r[#]
+@d q_outp(#)==trieq_r[#]
+@#
+@d hyf_val(#)==ops[#].val
+@d hyf_dot(#)==ops[#].dot
+@d hyf_nxt(#)==ops[#].op
+
+@* Routines for pattern trie.
+The pattern trie holds the set of patterns chosen prior to the current
+pass, including bad or ``hopeless'' patterns at the current level that
+occur too few times in the dictionary to be of use. Each transition of
+the trie includes an output field pointing to the hyphenation information
+associated with this transition.
+
+@<Globals...@>=
+@!trie_max: trie_pointer; {maximum occupied trie node}
+@!trie_bmax: trie_pointer; {maximum base of trie family}
+@!trie_count: trie_pointer; {number of occupied trie nodes, for space usage
+ statistics}
+@!op_count: op_type; {number of outputs in hash table}
+
+@ Initially, the dynamic packed trie has just one state, namely the root,
+with all transitions present (but with null links). This is convenient
+because the root will never need to be repacked and also we won't have to
+check that the base is nonnegative when packing other states.
+Moreover in many cases we need not check for a vanishing link field:
+if |trie_link(t)=0| then a subsequent test for
+|trie_char(trie_link(t)+c)=si(c)| will always fail due to |trie_root=1|.
+
+@d trie_root=1
+
+@p procedure init_pattern_trie;
+var c: internal_code; @!h: op_type;
+begin for c:=0 to last_ASCII_code do
+ begin trie_char(trie_root+c):=si(c); {indicates node occupied;
+ fake for |c=0|}
+ trie_link(trie_root+c):=0;
+ trie_outp(trie_root+c):=0;
+ trie_base_used(trie_root+c):=false;
+ end;
+ trie_base_used(trie_root):=true;
+ trie_bmax:=trie_root;
+ trie_max:=trie_root+last_ASCII_code;
+ trie_count:=num_ASCII_codes;@/
+ qmax_thresh:=5;@/
+ trie_link(0):=trie_max+1;
+ trie_back(trie_max+1):=0;@/
+ {|trie_link(0)| is used as the head of the doubly linked list of
+ unoccupied cells}
+ for h:=1 to max_ops do hyf_val(h):=0; {clear output hash table}
+ op_count:=0;
+end;
+
+@ The |first_fit| procedure finds a hole in the packed trie into which the
+state in |trieq_c|, |trieq_l|, and |trieq_r| will fit. This is normally
+done by going through the linked list of unoccupied cells and testing if
+the state will fit at each position. However if a state has too many
+transitions (and is therefore unlikely to fit among existing
+transitions) we don't bother and instead just pack it immediately to the
+right of the occupied region (starting at |trie_max+1|).
+
+@p function first_fit: trie_pointer;
+label found, not_found;
+var s, @!t: trie_pointer; @!q: q_index;
+begin @<Set |s| to the trie base location at which this state should be
+ packed@>;
+ for q:=1 to qmax do {pack it}
+ begin t:=s+q_char(q);@/
+ trie_link(trie_back(t)):=trie_link(t);
+ trie_back(trie_link(t)):=trie_back(t); {link around
+ filled cell}
+ trie_char(t):=si(q_char(q));
+ trie_link(t):=q_link(q);
+ trie_outp(t):=q_outp(q);
+ if t>trie_max then trie_max:=t;
+ end;
+ trie_base_used(s):=true;
+ first_fit:=s
+end;
+
+@ The threshold for large states is initially 5 transitions. If more than
+one level of patterns is being generated, the threshold is set to 7 on
+subsequent levels because the pattern trie will be sparser after bad
+patterns are deleted (see |delete_bad_patterns|).
+
+@<Set |s| to the trie base location at which this state should be packed@>=
+if qmax>qmax_thresh then t:=trie_back(trie_max+1) @+else t:=0;
+loop begin t:=trie_link(t); s:=t-q_char(1); {get next unoccupied cell}
+ @<Ensure |trie| linked up to |s+num_ASCII_codes|@>;
+ if trie_base_used(s) then goto not_found;
+ for q:=qmax downto 2 do {check if state fits here}
+ if trie_char(s+q_char(q))<>min_packed then goto not_found;
+ goto found;
+ not_found: end;
+found:
+
+@ The trie is only initialized (as a doubly linked list of empty cells) as
+far as necessary. Here we extend the initialization if necessary, and
+check for overflow.
+
+@<Ensure |trie| linked up to |s+num_ASCII_codes|@>=
+if s>trie_size-num_ASCII_codes then
+ overflow(trie_size:1,' pattern trie nodes');
+while trie_bmax<s do
+ begin incr(trie_bmax);
+ trie_base_used(trie_bmax):=false;
+ trie_char(trie_bmax+last_ASCII_code):=min_packed;
+ trie_link(trie_bmax+last_ASCII_code):=trie_bmax+num_ASCII_codes;
+ trie_back(trie_bmax+num_ASCII_codes):=trie_bmax+last_ASCII_code;
+ end
+
+@ The |unpack| procedure finds all transitions associated with the state
+with base |s|, puts them into the arrays |trieq_c|, |trieq_l|, and
+|trieq_r|, and sets |qmax| to one more than the number of transitions
+found. Freed cells are put at the beginning of the free list.
+
+@p procedure unpack(@!s: trie_pointer);
+var c: internal_code; @!t: trie_pointer;
+begin qmax:=1;
+for c:=cmin to cmax do {search for transitions belonging to this state}
+ begin t:=s+c;
+ if so(trie_char(t))=c then {found one}
+ begin q_char(qmax):=c;
+ q_link(qmax):=trie_link(t);
+ q_outp(qmax):=trie_outp(t);
+ incr(qmax);@/
+ {now free trie node}
+ trie_back(trie_link(0)):=t;
+ trie_link(t):=trie_link(0);
+ trie_link(0):=t;
+ trie_back(t):=0;
+ trie_char(t):=min_packed;
+ end;
+ end;
+trie_base_used(s):=false;
+end;
+
+@ The function |new_trie_op| returns the `opcode' for the output
+consisting of hyphenation value~|v|, hyphen position |d|, and next output
+|n|. The hash function used by |new_trie_op| is based on the idea that
+313/510 is an approximation to the golden ratio [cf.\ {\sl The Art of
+Computer Programming \bf3} (1973), 510--512]; but the choice is
+comparatively unimportant in this particular application.
+
+@p function new_trie_op(@!v: val_type; @!d: dot_type; @!n: op_type): op_type;
+label exit;
+var h: op_type;
+begin h:=((n+313*d+361*v) mod max_ops)+1; {trial hash location}
+loop begin if hyf_val(h)=0 then {empty position found}
+ begin incr(op_count);
+ if op_count=max_ops then overflow(max_ops:1,' outputs');
+ hyf_val(h):=v; hyf_dot(h):=d; hyf_nxt(h):=n; new_trie_op:=h; return;
+ end;
+ if (hyf_val(h)=v) and (hyf_dot(h)=d) and
+ (hyf_nxt(h)=n) then {already in hash table}
+ begin new_trie_op:=h; return;
+ end;
+ if h>1 then decr(h) @+else h:=max_ops; {try again}
+ end;
+exit: end;
+
+@ @<Globals...@>=
+@!pat: array[dot_type] of internal_code; {current pattern}
+@!pat_len: dot_type; {pattern length}
+
+@ Now that we have provided the necessary routines for manipulating the
+dynamic packed trie, here is a procedure that inserts a pattern of length
+|pat_len|, stored in the |pat| array, into the pattern trie. It also adds
+a new output.
+
+@p procedure insert_pattern(@!val: val_type; @!dot: dot_type);
+var i: dot_type; @!s, @!t: trie_pointer;
+begin i:=1;
+ s:=trie_root+pat[i]; t:=trie_link(s);
+ while (t>0) and (i<pat_len) do {follow existing trie}
+ begin incr(i); Incr(t)(pat[i]);
+ if so(trie_char(t))<>pat[i] then
+ @<Insert critical transition, possibly repacking@>;
+ s:=t; t:=trie_link(s);
+ end;
+ q_link(1):=0; q_outp(1):=0; qmax:=1;
+ while i<pat_len do {insert rest of pattern}
+ begin incr(i); q_char(1):=pat[i];
+ t:=first_fit;
+ trie_link(s):=t;
+ s:=t+pat[i];
+ incr(trie_count);
+ end;
+ trie_outp(s):=new_trie_op(val,dot,trie_outp(s));
+end;
+
+@ We have accessed a transition not in the trie. We insert it, repacking
+the state if necessary.
+
+@<Insert critical transition, possibly repacking@>=
+begin if trie_char(t)=min_packed then
+ begin {we're lucky, no repacking needed}
+ trie_link(trie_back(t)):=trie_link(t);
+ trie_back(trie_link(t)):=trie_back(t);@/
+ trie_char(t):=si(pat[i]);
+ trie_link(t):=0;
+ trie_outp(t):=0;
+ if t>trie_max then trie_max:=t;
+ end
+else begin {whoops, have to repack}
+ unpack(t-pat[i]);@/
+ q_char(qmax):=pat[i];
+ q_link(qmax):=0;
+ q_outp(qmax):=0;@/
+ t:=first_fit;
+ trie_link(s):=t;
+ Incr(t)(pat[i]);
+ end;
+incr(trie_count);
+end
+
+@* Routines for pattern count trie.
+The pattern count trie is used to store the set of patterns considered in
+the current pass, along with the counts of good and bad instances. The
+fields of this trie are the same as the pattern trie, except that there is
+no output field, and leaf nodes are also used to store counts
+(|triec_good| and |triec_bad|). Except where noted, the following
+routines are analogous to the pattern trie routines.
+
+@<Globals...@>=
+@!triec_max, @!triec_bmax, @!triec_count: triec_pointer; {same as for pattern
+ trie}
+@!triec_kmax: triec_pointer; {shows growth of trie during pass}
+@!pat_count: integer; {number of patterns in count trie}
+
+@ [See |init_pattern_trie|.] The variable |triec_kmax| always contains
+the size of the count trie rounded up to the next multiple of 4096, and is
+used to show the growth of the trie during each pass.
+
+@d triec_root=1
+
+@p procedure init_count_trie;
+var c: internal_code;
+begin for c:=0 to last_ASCII_code do
+ begin triec_char(triec_root+c):=si(c);@/
+ triec_link(triec_root+c):=0;
+ triec_back(triec_root+c):=0;
+ triec_base_used(triec_root+c):=false;
+ end;
+ triec_base_used(triec_root):=true;
+ triec_bmax:=triec_root; triec_max:=triec_root+last_ASCII_code;
+ triec_count:=num_ASCII_codes; triec_kmax:=4096;@/
+ triec_link(0):=triec_max+1; triec_back(triec_max+1):=0;@/
+ pat_count:=0;
+end;
+
+@ [See |first_fit|.]
+
+@p function firstc_fit: triec_pointer;
+label found, not_found;
+var a, @!b: triec_pointer; @!q: q_index;
+begin @<Set |b| to the count trie base location at which this state should
+ be packed@>;
+ for q:=1 to qmax do {pack it}
+ begin a:=b+q_char(q);@/
+ triec_link(triec_back(a)):=triec_link(a);
+ triec_back(triec_link(a)):=triec_back(a);@/
+ triec_char(a):=si(q_char(q));
+ triec_link(a):=q_link(q);
+ triec_back(a):=q_back(q);
+ if a>triec_max then triec_max:=a;
+ end;
+ triec_base_used(b):=true;
+ firstc_fit:=b
+end;
+
+@ The threshold for attempting a first-fit packing is 3 transitions, which
+is lower than for the pattern trie because speed is more important here.
+
+@<Set |b| to the count trie base location...@>=
+if qmax>3 then a:=triec_back(triec_max+1) @+else a:=0;
+loop begin a:=triec_link(a); b:=a-q_char(1);@/
+ @<Ensure |triec| linked up to |b+num_ASCII_codes|@>;
+ if triec_base_used(b) then goto not_found;
+ for q:=qmax downto 2 do
+ if triec_char(b+q_char(q))<>min_packed then goto not_found;
+ goto found;
+ not_found: end;
+found:
+
+@ @<Ensure |triec| linked up to |b+num_ASCII_codes|@>=
+if b>triec_kmax-num_ASCII_codes then
+ begin if triec_kmax=triec_size then
+ overflow(triec_size:1,' count trie nodes');
+ print(triec_kmax div 1024:1, 'K ');
+ if triec_kmax>triec_size-4096 then triec_kmax:=triec_size
+ else Incr(triec_kmax)(4096);
+ end;
+while triec_bmax<b do
+ begin incr(triec_bmax);
+ triec_base_used(triec_bmax):=false;
+ triec_char(triec_bmax+last_ASCII_code):=min_packed;
+ triec_link(triec_bmax+last_ASCII_code):=triec_bmax+num_ASCII_codes;
+ triec_back(triec_bmax+num_ASCII_codes):=triec_bmax+last_ASCII_code;
+ end
+
+@ [See |unpack|.]
+
+@p procedure unpackc(@!b: triec_pointer);
+var c: internal_code; @!a: triec_pointer;
+begin qmax:=1;
+for c:=cmin to cmax do {search for transitions belonging to this state}
+ begin a:=b+c;
+ if so(triec_char(a))=c then {found one}
+ begin q_char(qmax):=c;
+ q_link(qmax):=triec_link(a);
+ q_back(qmax):=triec_back(a);
+ incr(qmax);@/
+ triec_back(triec_link(0)):=a;
+ triec_link(a):=triec_link(0);
+ triec_link(0):=a; triec_back(a):=0;
+ triec_char(a):=min_packed;
+ end;
+ end;
+triec_base_used(b):=false;
+end;
+
+@ [See |insert_pattern|.] Patterns being inserted into the count trie are
+always substrings of the current word, so they are contained in the array
+|word| with length |pat_len| and finishing position |fpos|.
+
+@p function insertc_pat(@!fpos: word_index): triec_pointer;
+var spos: word_index; @!a, @!b: triec_pointer;
+begin spos:=fpos-pat_len; {starting position of pattern}
+ incr(spos); b:=triec_root+word[spos]; a:=triec_link(b);
+ while (a>0) and (spos<fpos) do {follow existing trie}
+ begin incr(spos); Incr(a)(word[spos]);
+ if so(triec_char(a))<>word[spos] then
+ @<Insert critical count transition, possibly repacking@>;
+ b:=a; a:=triec_link(a);
+ end;
+ q_link(1):=0; q_back(1):=0; qmax:=1;
+ while spos<fpos do {insert rest of pattern}
+ begin incr(spos); q_char(1):=word[spos];
+ a:=firstc_fit;
+ triec_link(b):=a;
+ b:=a+word[spos];
+ incr(triec_count);
+ end;
+ insertc_pat:=b;
+ incr(pat_count);
+end;
+
+@ @<Insert critical count transition, possibly repacking@>=
+begin if triec_char(a)=min_packed then {lucky}
+ begin triec_link(triec_back(a)):=triec_link(a);
+ triec_back(triec_link(a)):=triec_back(a);
+ triec_char(a):=si(word[spos]);
+ triec_link(a):=0;
+ triec_back(a):=0;
+ if a>triec_max then triec_max:=a;
+ end
+else begin {have to repack}
+ unpackc(a-word[spos]);@/
+ q_char(qmax):=word[spos];
+ q_link(qmax):=0;
+ q_back(qmax):=0;
+ a:=firstc_fit;
+ triec_link(b):=a;
+ Incr(a)(word[spos]);
+ end;
+incr(triec_count);
+end
+
+@* Input and output.
+For some \PASCAL\ systems output files must be closed before the program
+terminates; it may also be necessary to close input files. Since
+standard \PASCAL\ does not provide for this, we use \.{WEB} macros and
+will say |close_out(f)| resp.\ |close_in(f)|; these macros should not
+produce errors or system messages, even if a file could not be opened
+successfully.
+@^system dependencies@>
+
+@d close_out(#)==close(#) {close an output file}
+@d close_in(#)==do_nothing {close an input file}
+
+@<Globals...@>=
+@!dictionary, @!patterns, @!translate, @!patout, @!pattmp: text_file;
+
+@ When reading a line from one of the input files (|dictionary|,
+|patterns|, or |translate|) the characters read from that line (padded
+with blanks if necessary) are to be placed into the |buf| array. Reading
+lines from the |dictionary| file should be as efficient as possible
+since this is part of \.{PATGEN}'s ``inner loop''. Standard \PASCAL,
+unfortunately, does not provide for this; consequently the \.{WEB} macro
+|read_buf| defined below should be optimized if possible. For many
+\PASCAL's this can be done with |read_ln(f,buf)| where |buf| is declared
+as \PASCAL\ string (i.e., as \&{packed} \&{array} |[1..any]| \&{of}
+|char|), for others a string type with dynamic length can be used.
+@^inner loop@>@^system dependencies@>
+
+@d read_buf(#)== {reads a line from input file |#| into |buf| array}
+ begin buf_ptr:=0;
+ while not eoln(#) do
+ begin if (buf_ptr>=max_buf_len) then bad_input('Line too long');
+@.Line too long@>
+ incr(buf_ptr); read(#,buf[buf_ptr]);
+ end;
+ read_ln(#);
+ while buf_ptr<max_buf_len do
+ begin incr(buf_ptr); buf[buf_ptr]:=' ';
+ end;
+ end
+
+@<Globals...@>=
+@!buf: array[1..max_buf_len] of text_char; {array to hold lines of input}
+@!buf_ptr: 0..max_buf_len; {index into |buf|}
+
+@ When an error is caused by bad input data we say |bad_input(#)| in
+order to disply the contents of the |buf| array before terminating with
+an error message.
+
+@d print_buf== {print contents of |buf| array}
+ begin buf_ptr:=0;
+ repeat incr(buf_ptr); print(buf[buf_ptr]);
+ until buf_ptr=max_buf_len;
+ print_ln(' ');
+ end
+@d bad_input(#)==begin print_buf; error(#); end
+
+@ The |translate| file may specify the values of \.{\\lefthyphenmin} and
+\.{\\righthyphenmin} as well as the external representation and
+collating sequence of the `letters' used by the language. In addition
+replacements may be specified for the characters |'-'|, |'*'|, and |'.'|
+representing hyphens in the word list. If the |translate| file is empty
+(or does not exist) default values will be used.
+
+@p procedure read_translate;
+label done;
+var c: text_char;
+@!n: integer;
+@!j: ASCII_code;
+@!bad: boolean;
+@!lower: boolean;
+@!i: dot_type; @!s, @!t: trie_pointer;
+begin imax:=edge_of_word;
+reset(translate);
+if eof(translate) then
+ @<Set up default character translation tables@>
+else begin read_buf(translate); @<Set up hyphenation data@>;
+ cmax:=last_ASCII_code-1;
+ while not eof(translate) do @<Set up representation(s) for a letter@>;
+ end;
+close_in(translate);
+print_ln('left_hyphen_min = ',left_hyphen_min:1,
+ ', right_hyphen_min = ',right_hyphen_min:1,
+ ', ',imax-edge_of_word:1,' letters');
+cmax:=imax;
+end;
+
+@ @<Globals...@>=
+@!imax: internal_code; {largest |internal_code| assigned so far}
+@!left_hyphen_min, @!right_hyphen_min: dot_type;
+
+@ @<Set up default...@>=
+begin left_hyphen_min:=2; right_hyphen_min:=3;
+for j:="A" to "Z" do
+ begin incr(imax);
+ c:=xchr[j+"a"-"A"]; xclass[c]:=letter_class; xint[c]:=imax;
+ xext[imax]:=c;
+ c:=xchr[j]; xclass[c]:=letter_class; xint[c]:=imax;
+ end;
+end
+
+@ The first line of the |translate| file must contain the values
+of \.{\\lefthyphenmin} and \.{\\righthyphenmin} in columns 1--2 and
+3--4. In addition columns~5, 6, and~7 may (optionally) contain
+replacements for the default characters |'.'|, |'-'|, and |'*'|
+respectively, representing hyphens in the word list.
+If the values specified for \.{\\lefthyphenmin} and \.{\\righthyphenmin}
+are invalid (e.g., blank) new values are read from the terminal.
+
+@<Set up hyphenation...@>=
+bad:=false;
+if buf[1]=' ' then n:=0
+else if xclass[buf[1]]=digit_class then n:=xint[buf[1]]@+
+else bad:=true;
+if xclass[buf[2]]=digit_class then n:=10*n+xint[buf[2]]@+
+else bad:=true;
+if (n>=1)and(n<max_dot) then left_hyphen_min:=n@+else bad:=true;
+if buf[3]=' ' then n:=0
+else if xclass[buf[3]]=digit_class then n:=xint[buf[3]]@+
+else bad:=true;
+if xclass[buf[4]]=digit_class then n:=10*n+xint[buf[4]]@+
+else bad:=true;
+if (n>=1)and(n<max_dot) then right_hyphen_min:=n@+
+else bad:=true;
+if bad then
+ begin bad:=false;
+ repeat print('left_hyphen_min, right_hyphen_min: '); get_input(n1,n2);@/
+ if (n1>=1)and(n1<max_dot)and(n2>=1)and(n2<max_dot) then
+ begin left_hyphen_min:=n1; right_hyphen_min:=n2;
+ end
+ else begin n1:=0;
+ print_ln('Specify 1<=left_hyphen_min,right_hyphen_min<=',
+ max_dot-1:1,' !');
+ end;
+ until n1>0;
+ end;
+for j:=err_hyf to found_hyf do
+ begin if buf[j+4]<>' ' then xhyf[j]:=buf[j+4];
+ if xclass[xhyf[j]]=invalid_class then xclass[xhyf[j]]:=hyf_class@+
+ else bad:=true;
+ end;
+xclass['.']:=hyf_class; {in case the default has been changed}
+if bad then bad_input('Bad hyphenation data')
+@.Bad hyphenation data@>
+
+@ Each following line is either a comment or specifies the external
+representations for one `letter' used by the language. Comment lines
+start with two equal characters (e.g., are blank) and are ignored.
+Other lines contain the external representation of the lower case
+version and an arbitrary number of `upper case versions' of a letter
+preceded and separated by a delimiter and followed by two consecutive
+delimiters; the delimiter may be any character not occuring in either
+version.
+
+@<Set up repres...@>=
+begin read_buf(translate); buf_ptr:=1; lower:=true;
+while not bad do {lower and then upper case version}
+ begin pat_len:=0;
+ repeat if buf_ptr<max_buf_len then incr(buf_ptr) @+ else bad:=true;
+ if buf[buf_ptr]=buf[1] then
+ if pat_len=0 then goto done
+ else begin if lower then
+ begin if imax=last_ASCII_code then
+ begin print_buf; overflow(num_ASCII_codes:1,' letters');
+ end;
+ incr(imax); xext[imax]:=xchr[pat[pat_len]];
+ end;
+ c:=xchr[pat[1]];
+ if pat_len=1 then
+ begin if xclass[c]<>invalid_class then bad:=true;
+ xclass[c]:=letter_class; xint[c]:=imax;
+ end
+ else @<Insert a letter into pattern trie@>;
+ end
+ else if pat_len=max_dot then bad:=true
+ else begin incr(pat_len); pat[pat_len]:=get_ASCII(buf[buf_ptr]);
+ end;
+ until (buf[buf_ptr]=buf[1])or bad;
+ lower:=false;
+ end;
+done: if bad then bad_input('Bad representation');
+@.Bad representation@>
+end
+
+@ When the (lower or upper case) external representation of a letter
+consists of more than one character and the corresponding |ASCII_code|
+values have been placed into the |pat| array we store them in
+the pattern trie. [See |insert_pattern|.] Since this `external subtrie'
+starts at |trie_link(trie_root)| it does not interfere with normal
+patterns. The output field of leaf nodes contains the |internal_code|
+and the link field distinguishes between lower and upper case letters.
+
+@<Insert a letter...@>=
+begin if xclass[c]=invalid_class then xclass[c]:=escape_class;
+if xclass[c]<>escape_class then bad:=true;
+i:=0; s:=trie_root; t:=trie_link(s);
+while (t>trie_root) and (i<pat_len) do {follow existing trie}
+ begin incr(i); Incr(t)(pat[i]);
+ if so(trie_char(t))<>pat[i] then
+ @<Insert critical transition, possibly repacking@>
+ else if trie_outp(t)>0 then bad:=true;
+ s:=t; t:=trie_link(s);
+ end;
+if t>trie_root then bad:=true;
+q_link(1):=0; q_outp(1):=0; qmax:=1;
+while i<pat_len do {insert rest of pattern}
+ begin incr(i); q_char(1):=pat[i];
+ t:=first_fit;
+ trie_link(s):=t;
+ s:=t+pat[i];
+ incr(trie_count);
+ end;
+trie_outp(s):=imax;
+if not lower then trie_link(s):=trie_root;
+end
+
+@ The |get_letter| \.{WEB} macro defined here will be used in
+|read_word| and |read_patterns| to obtain the |internal_code|
+corresponding to a letter externally represented by a multi-character
+sequence (starting with an |escape_class| character).
+
+@d get_letter(#)==
+ begin t:=trie_root;
+ loop begin t:=trie_link(t)+xord[c];
+ if so(trie_char(t))<>xord[c] then bad_input('Bad representation');
+@.Bad representation@>
+ if trie_outp(t)<>0 then
+ begin #:=trie_outp(t); goto done;
+ end;
+ if buf_ptr=max_buf_len then c:=' '
+ else begin incr(buf_ptr); c:=buf[buf_ptr];
+ end;
+ end;
+ done: end
+
+@ In order to prepare for the output phase we store all but the last of
+the \\{ASCII\_codes} of the external representation of each `lower case
+letter' in the pattern count trie which is no longer used at that time.
+The recursive |find_letters| procedure traverses the `external subtrie'.
+
+@p procedure find_letters(@!b: trie_pointer; @!i: dot_type);@/
+ {traverse subtries of family |b|; |i| is current depth in trie}
+var c: ASCII_code; {a local variable that must be saved on recursive calls}
+@!a: trie_pointer; {does not need to be saved}
+@!j: dot_type; {loop index}
+@!l: triec_pointer;
+begin if i=1 then init_count_trie;
+for c:=cmin to last_ASCII_code do {find transitions belonging to this family}
+ begin a:=b+c;
+ if so(trie_char(a))=c then {found one}
+ begin pat[i]:=c;
+ if trie_outp(a)=0 then find_letters(trie_link(a),i+1)
+ else if trie_link(a)=0 then {this is a lower case letter}
+ @<Insert external representation for a letter into count trie@>;
+ end;
+ end;
+end;
+
+@ Starting from |triec_root+trie_outp(a)| we proceed through link fields
+and store all \\{ASCII\_codes} except the last one in the count trie;
+the last character has already been stored in the |xext| array.
+
+@<Insert external...@>=
+begin l:=triec_root+trie_outp(a);
+for j:=1 to i-1 do
+ begin if triec_max=triec_size then
+ overflow(triec_size:1,' count trie nodes');
+ incr(triec_max); triec_link(l):=triec_max; l:=triec_max;
+ triec_char(l):=si(pat[j]);
+ end;
+triec_link(l):=0;
+end
+
+@ During the output phase we will say |write_letter(i)(f)| and
+|write(f,xext[i])| to write the lower case external representation of
+the letter with internal code |i| to file |f|: |xext[i]| is the last
+character of the external representation whereas the \.{WEB} macro
+|write_letter| defined here writes all preceding characters (if any).
+
+@d write_letter_end(#)==while l>0 do
+ begin write(#,xchr[so(triec_char(l))]); l:=triec_link(l);
+ end
+@d write_letter(#)==l:=triec_link(triec_root+#); write_letter_end
+
+@* Routines for traversing pattern tries.
+At the end of a pass, we traverse the count trie using the following
+recursive procedure, selecting good and bad patterns and inserting them
+into the pattern trie.
+
+@p procedure traverse_count_trie(@!b: triec_pointer; @!i: dot_type);@/
+{traverse subtries of family |b|; |i| is current depth in trie}
+var c: internal_code; {a local variable that must be saved on recursive calls}
+ @!a: triec_pointer; {does not need to be saved}
+begin
+for c:=cmin to cmax do {find transitions belonging to this family}
+ begin a:=b+c;
+ if so(triec_char(a))=c then {found one}
+ begin pat[i]:=c;
+ if i<pat_len then traverse_count_trie(triec_link(a),i+1)
+ else @<Decide what to do with this pattern@>;
+ end;
+ end;
+end;
+
+@ When we have come to the end of a pattern, |triec_good(a)| and
+|triec_bad(a)| contain the number of times this pattern helps or hinders
+the cause. We use the counts to determine if this pattern should be
+selected, or if it is hopeless, or if we can't decide yet. In the latter
+case, we set |more_to_come| true to indicate that there might still be
+good patterns extending the current type of patterns.
+
+@<Decide what to do...@>=
+if good_wt*triec_good(a)<thresh then {hopeless pattern}
+begin insert_pattern(max_val,pat_dot);
+ incr(bad_pat_count)
+end else
+if good_wt*triec_good(a)-bad_wt*triec_bad(a)>=thresh then {good pattern}
+begin insert_pattern(hyph_level,pat_dot);
+ incr(good_pat_count);
+ Incr(good_count)(triec_good(a));
+ Incr(bad_count)(triec_bad(a));
+end else
+ more_to_come:=true
+
+@ Some global variables are used to accumulate statistics about the
+performance of a pass.
+
+@<Globals...@>=
+@!good_pat_count, @!bad_pat_count: integer; {number of patterns added at end
+ of pass}
+@!good_count, @!bad_count, @!miss_count: integer; {hyphen counts}
+@!level_pattern_count: integer; {number of good patterns at level}
+@!more_to_come: boolean;
+
+@ The recursion in |traverse_count_trie| is initiated by the following
+procedure, which also prints some statistics about the patterns chosen.
+The ``efficiency'' is an estimate of pattern effectiveness.
+
+@d bad_eff==(thresh/good_wt)
+
+@p procedure collect_count_trie;
+begin good_pat_count:=0; bad_pat_count:=0;
+ good_count:=0; bad_count:=0;
+ more_to_come:=false;
+ traverse_count_trie(triec_root,1); @/
+ print(good_pat_count:1,' good and ',
+ bad_pat_count:1,' bad patterns added');
+ Incr(level_pattern_count)(good_pat_count);
+ if more_to_come then print_ln(' (more to come)') @+else print_ln(' ');
+ print('finding ',good_count:1,' good and ',bad_count:1,' bad hyphens');
+ if good_pat_count>0 then
+ print_ln(', efficiency = ',
+ good_count/(good_pat_count+bad_count/bad_eff):1:2)
+ else print_ln(' ');
+ print_ln('pattern trie has ',trie_count:1,' nodes, ',@|
+ 'trie_max = ',trie_max:1,', ',op_count:1,' outputs');
+end;
+
+@ At the end of a level, we traverse the pattern trie and delete bad
+patterns by removing their outputs. If no output remains, the node is
+also deleted.
+
+@p function delete_patterns(@!s: trie_pointer): trie_pointer;@/
+{delete bad patterns in subtrie |s|, return 0 if entire subtrie freed,
+ otherwise |s|}
+var c: internal_code; @!t: trie_pointer; @!all_freed: boolean;
+ {must be saved on recursive calls}
+ @!h, @!n: op_type; {do not need to be saved}
+begin all_freed:=true;
+ for c:=cmin to cmax do {find transitions belonging to this family}
+ begin t:=s+c;
+ if so(trie_char(t))=c then
+ begin @<Link around bad outputs@>;
+ if trie_link(t)>0 then
+ trie_link(t):=delete_patterns(trie_link(t));
+ if (trie_link(t)>0) or (trie_outp(t)>0) or (s=trie_root) then
+ all_freed:=false
+ else
+ @<Deallocate this node@>;
+ end;
+ end;
+ if all_freed then {entire state is freed}
+ begin trie_base_used(s):=false;
+ s:=0;
+ end;
+ delete_patterns:=s;
+end;
+
+@ @<Link around bad outputs@>=
+begin h:=0;
+ hyf_nxt(0):=trie_outp(t);
+ n:=hyf_nxt(0);
+ while n>0 do
+ begin if hyf_val(n)=max_val then hyf_nxt(h):=hyf_nxt(n)
+ else h:=n;
+ n:=hyf_nxt(h);
+ end;
+ trie_outp(t):=hyf_nxt(0);
+end
+
+@ Cells freed by |delete_patterns| are put at the end of the free list.
+
+@<Deallocate this node@>=
+begin trie_link(trie_back(trie_max+1)):=t;
+ trie_back(t):=trie_back(trie_max+1);
+ trie_link(t):=trie_max+1;
+ trie_back(trie_max+1):=t;
+ trie_char(t):=min_packed;@/
+ decr(trie_count);
+end
+
+@ The recursion in |delete_patterns| is initiated by the following
+procedure, which also prints statistics about the number of nodes deleted,
+and zeros bad outputs in the hash table. Note that the hash table may
+become somewhat disorganized when more levels are added, but this defect
+isn't serious.
+
+@p procedure delete_bad_patterns;
+var old_op_count: op_type;
+ @!old_trie_count: trie_pointer;
+ @!t: trie_pointer; @!h: op_type;
+begin old_op_count:=op_count;
+ old_trie_count:=trie_count;@/
+ t:=delete_patterns(trie_root);
+ for h:=1 to max_ops do
+ if hyf_val(h)=max_val then
+ begin hyf_val(h):=0; decr(op_count);
+ end;
+ print_ln(old_trie_count-trie_count:1,' nodes and ',@|
+ old_op_count-op_count:1,' outputs deleted');
+ qmax_thresh:=7; {pattern trie will be sparser because of deleted
+ patterns}
+end;
+
+@ After all patterns have been generated, we will traverse the pattern
+trie and output all patterns. Note that if a pattern appears more than
+once, only the maximum value at each position will be output.
+
+@p procedure output_patterns(@!s: trie_pointer; @!pat_len: dot_type);@/
+{output patterns in subtrie |s|; |pat_len| is current depth in trie}
+var c: internal_code; {must be saved on recursive calls}
+@!t: trie_pointer; @!h: op_type; @!d: dot_type;@/
+@!l: triec_pointer; {for |write_letter|}
+begin for c:=cmin to cmax do
+ begin t:=s+c;
+ if so(trie_char(t))=c then
+ begin pat[pat_len]:=c;
+ h:=trie_outp(t);
+ if h>0 then @<Output this pattern@>;
+ if trie_link(t)>0 then output_patterns(trie_link(t),pat_len+1);
+ end;
+ end;
+end;
+
+@ @<Output this pattern@>=
+begin for d:=0 to pat_len do hval[d]:=0;
+ repeat d:=hyf_dot(h);
+ if hval[d]<hyf_val(h) then hval[d]:=hyf_val(h);
+ h:=hyf_nxt(h);
+ until h=0;
+ if hval[0]>0 then write(patout,xdig[hval[0]]);
+ for d:=1 to pat_len do
+ begin write_letter(pat[d])(patout); write(patout,xext[pat[d]]);
+ if hval[d]>0 then write(patout,xdig[hval[d]]);
+ end;
+ write_ln(patout);
+end
+
+@* Dictionary processing routines.
+The procedures in this section are the ``inner loop'' of the pattern
+generation process. To speed the program up, key parts of these routines
+could be coded in machine language.
+@^inner loop@>
+
+@<Globals...@>=
+@!word: array[word_index] of internal_code; {current word}
+@!dots: array[word_index] of hyf_type; {current hyphens}
+@!dotw: array[word_index] of digit; {dot weights}
+@!hval: array[word_index] of val_type; {hyphenation values}
+@!no_more: array[word_index] of boolean; {positions `knocked out'}
+@!wlen: word_index; {length of current word}
+@!word_wt: digit; {global word weight}
+@!wt_chg: boolean; {indicates |word_wt| has changed}
+
+@ The words in the |dictionary| consist of the `letters' used by the
+language. ``Dots'' between letters can be one of four possibilities:
+|'-'| indicating a hyphen, |'*'| indicating a found hyphen, |'.'|
+indicating an error, or nothing; these are represented internally by the
+four values |is_hyf|, |found_hyf|, |err_hyf|, and |no_hyf| respectively.
+When reading a word we will, however, convert |err_hyf| into |no_hyf|
+and |found_hyf| into |is_hyf| thus ignoring whether a hyphen has or
+has not been found by a previous set of patterns.
+
+@<Prepare to read dictionary@>=
+xclass['.']:=invalid_class; {in case the default has been changed}
+xclass[xhyf[err_hyf]]:=hyf_class; xint[xhyf[err_hyf]]:=no_hyf;
+xclass[xhyf[is_hyf]]:=hyf_class; xint[xhyf[is_hyf]]:=is_hyf;
+xclass[xhyf[found_hyf]]:=hyf_class; xint[xhyf[found_hyf]]:=is_hyf;
+
+@ Furthermore single-digit word weights are allowed. A digit at
+the beginning of a word indicates a global word weight that is to be
+applied to all following words (until the next global word weight). A
+digit at some intercharacter position indicates a weight for that position
+only.
+
+The |read_word| procedure scans a line of input representing a word,
+and places the letters into the array |word|, with |word[1]=word[wlen]=
+edge_of_word|. The dot appearing between |word[dpos]| and |word[dpos+1]|
+is placed in |dots[dpos]|, and the corresponding dot weight in
+|dotw[dpos]|.
+
+@p procedure read_word;
+label done, found;
+var c: text_char;
+@!t: trie_pointer;
+begin read_buf(dictionary);
+word[1]:=edge_of_word; wlen:=1; buf_ptr:=0;
+repeat incr(buf_ptr); c:=buf[buf_ptr];
+ case xclass[c] of
+ space_class: goto found;
+ digit_class:
+ if wlen=1 then {global word weight}
+ begin if xint[c]<>word_wt then wt_chg:=true;
+ word_wt:=xint[c];
+ end
+ else dotw[wlen]:=xint[c]; {dot weight}
+ hyf_class: dots[wlen]:=xint[c]; {record the dot |c|}
+ letter_class: {record the letter |c|}
+ begin incr(wlen);
+ if wlen=max_len then
+ begin print_buf; overflow('word length=',max_len:1);
+ end;
+ word[wlen]:=xint[c]; dots[wlen]:=no_hyf; dotw[wlen]:=word_wt;
+ end;
+ escape_class: {record a multi-character sequence starting with |c|}
+ begin incr(wlen);
+ if wlen=max_len then
+ begin print_buf; overflow('word length=',max_len:1);
+ end;
+ get_letter(word[wlen]); dots[wlen]:=no_hyf; dotw[wlen]:=word_wt;
+ end;
+ invalid_class: bad_input('Bad character');
+@.Bad character@>
+ end;
+until buf_ptr=max_buf_len;
+found: incr(wlen); word[wlen]:=edge_of_word;
+end;
+
+@ Here is a procedure that uses the existing patterns to hyphenate the
+current word. The hyphenation value applying between the characters
+|word[dpos]| and |word[dpos+1]| is stored in |hval[dpos]|.
+
+In addition, |no_more[dpos]| is set to |true| if this position is
+``knocked out'' by either a good or bad pattern at this level. That is,
+if the pattern with current length and hyphen position is a superstring of
+either a good or bad pattern at this level, then we don't need to collect
+count statistics for the pattern because it can't possibly be chosen in
+this pass. Thus we don't even need to insert such patterns into the count
+trie, which saves a good deal of space.
+
+@p procedure hyphenate;
+label done;
+var spos, @!dpos, @!fpos: word_index;
+ @!t: trie_pointer; @!h: op_type; @!v: val_type;
+begin
+for spos:=wlen-hyf_max downto 0 do
+ begin no_more[spos]:=false; hval[spos]:=0;
+ fpos:=spos+1; t:=trie_root+word[fpos];
+ repeat h:=trie_outp(t);
+ while h>0 do @<Store output |h| in the |hval| and
+ |no_more| arrays, and advance |h|@>;
+ t:=trie_link(t);
+ if t=0 then goto done;
+ incr(fpos); Incr(t)(word[fpos]);
+ until so(trie_char(t))<>word[fpos];
+ done:
+ end;
+end;
+
+@ In order to avoid unnecessary test (and range check violations) the
+globals |hyf_min|, |hyf_max|, and |hyf_len| are set up such that only
+positions from |hyf_min| up to |wlen-hyf_max| of the |word| array need
+to be checked, and that words with |wlen<hyf_len| need not to be checked
+at all.
+
+@<Globals...@>=
+@!hyf_min, @!hyf_max, @!hyf_len: word_index; {limits for legal hyphens}
+
+@ @<Prepare to read dictionary@>=
+hyf_min:=left_hyphen_min+1; hyf_max:=right_hyphen_min+1;
+hyf_len:=hyf_min+hyf_max;
+
+@ @<Store output |h| in the |hval| and |no_more| arrays, and advance |h|@>=
+begin dpos:=spos+hyf_dot(h);
+ v:=hyf_val(h);
+ if (v<max_val) and (hval[dpos]<v) then hval[dpos]:=v;
+ if (v>=hyph_level) then {check if position knocked out}
+ if ((fpos-pat_len)<=(dpos-pat_dot))and((dpos-pat_dot)<=spos) then
+ no_more[dpos]:=true;
+ h:=hyf_nxt(h);
+end
+
+@ The |change_dots| procedure updates the |dots| array representing the
+printing values of the hyphens. Initially, hyphens (and correctly
+found hyphens) in the word list are represented by |is_hyf| whereas
+non-hyphen positions (and erroneous hyphens) are represented by |no_hyf|. A
+Here these values are increased by one for each hyphen found by the
+current patterns, thus changing |no_hyf| into |err_hyf| and |is_hyf|
+into |found_hyf|. The routine also collects statistics about the number
+of good, bad, and missed hyphens.
+
+@d incr_wt(#)==Incr(#)(dotw[dpos])
+
+@p procedure change_dots;
+var dpos: word_index;
+begin for dpos:=wlen-hyf_max downto hyf_min do
+ begin if odd(hval[dpos]) then incr(dots[dpos]);
+ if dots[dpos]=found_hyf then incr_wt(good_count)
+ else if dots[dpos]=err_hyf then incr_wt(bad_count)
+ else if dots[dpos]=is_hyf then incr_wt(miss_count);
+ end;
+end;
+
+@ The following procedure outputs the word as hyphenated by the current
+patterns, including any word weights. Hyphens inhibited by the values of
+\.{\\lefthyphenmin} and \.{\\righthyphenmin} are output as well.
+
+@p procedure output_hyphenated_word;
+var dpos: word_index;@/
+@!l: triec_pointer; {for |write_letter|}
+begin if wt_chg then {output global word weight}
+ begin write(pattmp,xdig[word_wt]); wt_chg:=false
+ end;
+for dpos:=2 to wlen-2 do
+ begin write_letter(word[dpos])(pattmp); write(pattmp,xext[word[dpos]]);
+ if dots[dpos]<>no_hyf then write(pattmp,xhyf[dots[dpos]]);
+ if dotw[dpos]<>word_wt then write(pattmp,xdig[dotw[dpos]]);
+ end;
+write_letter(word[wlen-1])(pattmp); write_ln(pattmp,xext[word[wlen-1]]);
+end;
+
+@ For each dot position in the current word, the |do_word| routine first
+checks to see if we need to consider it. It might be knocked out or a dot
+we don't care about. That is, when considering hyphenating patterns, for
+example, we don't need to count hyphens already found. If a relevant dot
+is found, we increment the count in the count trie for the corresponding
+pattern, inserting it first if necessary. At this point of the program
+range check violations may occur if these counts are incremented beyond
+|triec_max|; it would, however, be too expensive to prevent this.
+@^range check violations@>
+
+@p procedure do_word;
+label continue, done;
+var spos, @!dpos, @!fpos: word_index; @!a: triec_pointer;
+ @!goodp: boolean;
+begin for dpos:=wlen-dot_max downto dot_min do
+ begin spos:=dpos-pat_dot;
+ fpos:=spos+pat_len;
+ @<Check this dot position and |goto continue| if don't care@>;
+ incr(spos); a:=triec_root+word[spos];
+ while spos<fpos do
+ begin {follow existing count trie}
+ incr(spos);
+ a:=triec_link(a)+word[spos];
+ if so(triec_char(a))<>word[spos] then
+ begin {insert new count pattern}
+ a:=insertc_pat(fpos);
+ goto done;
+ end;
+ end;
+ done: if goodp then incr_wt(triec_good(a))
+ @+else incr_wt(triec_bad(a));
+ continue:
+ end;
+end;
+
+@ The globals |good_dot| and |bad_dot| will be set to |is_hyf| and
+|no_hyf|, or |err_hyf| and |found_hyf|, depending on whether the current
+level is odd or even, respectively. The globals |dot_min|, |dot_max|,
+and |dot_len| are analogous to |hyf_min|, |hyf_max|, and |hyf_len|
+defined earlier.
+
+@<Globals...@>=
+@!good_dot, @!bad_dot: hyf_type; {good and bad hyphens at current level}
+@!dot_min, @!dot_max, @!dot_len: word_index; {limits for legal dots}
+
+@ @<Prepare to read dictionary@>=
+if procesp then
+ begin dot_min:=pat_dot; dot_max:=pat_len-pat_dot;
+ if dot_min<hyf_min then dot_min:=hyf_min;
+ if dot_max<hyf_max then dot_max:=hyf_max;
+ dot_len:=dot_min+dot_max;
+ if odd(hyph_level) then
+ begin good_dot:=is_hyf; bad_dot:=no_hyf;
+ end
+ else begin good_dot:=err_hyf; bad_dot:=found_hyf;
+ end;
+ end;
+
+@ If the dot position |dpos| is out of bounds, knocked out, or a ``don't
+care'', we skip this position. Otherwise we set the flag |goodp|
+indicating whether this is a good or bad dot.
+
+@<Check this dot position...@>=
+if no_more[dpos] then goto continue;
+if dots[dpos]=good_dot then goodp:=true else
+if dots[dpos]=bad_dot then goodp:=false else goto continue;
+
+@ If |hyphp| is set to |true|, |do_dictionary| will write out a copy of
+the dictionary as hyphenated by the current set of patterns. If |procesp|
+is set to |true|, |do_dictionary| will collect pattern statistics for
+patterns with length |pat_len| and hyphen position |pat_dot|, at level
+|hyph_level|.
+
+@<Globals...@>=
+@!procesp, @!hyphp: boolean;
+@!pat_dot: dot_type; {hyphen position, measured from beginning of pattern}
+@!hyph_level: val_type; {hyphenation level}
+@!filnam: packed array[1..8] of char; {for |pattmp|}
+
+@ The following procedure makes a pass through the word list, and also
+prints out statistics about number of hyphens found and storage used by
+the count trie.
+
+@p procedure do_dictionary;
+begin good_count:=0; bad_count:=0; miss_count:=0;
+ word_wt:=1; wt_chg:=false;
+ reset(dictionary);@/
+ @<Prepare to read dictionary@>@;@/
+ if procesp then
+ begin init_count_trie;
+ print_ln('processing dictionary with pat_len = ',pat_len:1,
+ ', pat_dot = ',pat_dot:1);
+ end;
+ if hyphp then
+ begin filnam:='pattmp. ';
+ filnam[8]:=xdig[hyph_level];
+ rewrite(pattmp,filnam);
+ print_ln('writing pattmp.', xdig[hyph_level]);
+ end;
+ @<Process words until end of file@>;@/
+ close_in(dictionary);@/
+ print_ln(' ');
+ print_ln(good_count:1,' good, ',bad_count:1,' bad, ',
+ miss_count:1,' missed');
+ if (good_count+miss_count)>0 then
+ print_ln((100*good_count/(good_count+miss_count)):1:2,' %, ',
+ (100*bad_count/(good_count+miss_count)):1:2,' %, ',
+ (100*miss_count/(good_count+miss_count)):1:2,' %');
+ if procesp then
+ print_ln(pat_count:1,' patterns, ',triec_count:1,
+ ' nodes in count trie, ','triec_max = ',triec_max:1);
+ if hyphp then close_out(pattmp);
+end;
+
+@ @<Process words...@>=
+while not eof(dictionary) do
+ begin read_word;
+ if wlen>=hyf_len then {short words are never hyphenated}
+ begin hyphenate; change_dots;
+ end;
+ if hyphp then if wlen>2 then output_hyphenated_word;
+ {empty words are ignored}
+ if procesp then if wlen>=dot_len then do_word;
+ end
+
+@* Reading patterns.
+Before beginning a run, we can read in a file of existing patterns. This
+is useful for extending a previous pattern selection run to get some more
+levels. (Since these runs are quite time-consuming, it is convenient to
+choose patterns one level at a time, pausing to look at the results of the
+previous level, and possibly amending the dictionary.)
+
+@p procedure read_patterns;
+label done, found;
+var c: text_char;
+@!d: digit;
+@!i: dot_type;
+@!t: trie_pointer;
+begin xclass['.']:=letter_class; xint['.']:=edge_of_word;
+level_pattern_count:=0; max_pat:=0;
+reset(patterns);
+while not eof(patterns) do
+ begin read_buf(patterns);
+ incr(level_pattern_count);@/
+ @<Get pattern and dots and |goto found|@>;
+ found: @<Insert pattern@>;
+ end;
+close_in(patterns);
+print_ln(level_pattern_count:1,' patterns read in');@/
+print_ln('pattern trie has ',trie_count:1,' nodes, ',@|
+ 'trie_max = ',trie_max:1,', ',op_count:1,' outputs');
+end;
+
+@ The global variable |max_pat| keeps track of the largest hyphenation
+value found in any pattern.
+
+@<Globals...@>=
+@!max_pat: val_type;
+
+@ When a new pattern has been input into |buf|, we extract the letters of
+the pattern, and insert the hyphenation values (digits) into the |hval|
+array.
+
+@<Get pattern...@>=
+pat_len:=0; buf_ptr:=0; hval[0]:=0;
+repeat incr(buf_ptr); c:=buf[buf_ptr];
+ case xclass[c] of
+ space_class: goto found;
+ digit_class:
+ begin d:=xint[c];
+ if d>=max_val then bad_input('Bad hyphenation value');
+@.Bad hyphenation value@>
+ if d>max_pat then max_pat:=d;
+ hval[pat_len]:=d;
+ end;
+ letter_class:
+ begin incr(pat_len); hval[pat_len]:=0; pat[pat_len]:=xint[c];
+ end;
+ escape_class: {record a multi-character sequence starting with |c|}
+ begin incr(pat_len); hval[pat_len]:=0; get_letter(pat[pat_len]);
+ end;
+ hyf_class, invalid_class: bad_input('Bad character');
+@.Bad character@>
+ end;
+until buf_ptr=max_buf_len
+
+@ Then we insert the pattern for each non-vanishing hyphenation value.
+In addition we check that |edge_of_word| (i.e., |'.'|) occurs only as
+first or last character; otherwise we would have to perform a time
+consuming test for the end of a word in the |hyphenate| procedure.
+
+@<Insert pattern@>=
+if pat_len>0 then {avoid spurious patterns}
+ for i:=0 to pat_len do
+ begin if hval[i]<>0 then insert_pattern(hval[i],i);
+ if i>1 then if i<pat_len then if pat[i]=edge_of_word then
+ bad_input('Bad edge_of_word');
+@.Bad edge_of_word@>
+ end
+
+@* The main program.
+This is where \.{PATGEN} actually starts. We initialize the pattern trie,
+get |hyph_level| and |pat_len| limits from the terminal, and generate
+patterns.
+
+@p begin initialize;
+init_pattern_trie;
+read_translate;
+read_patterns;
+procesp:=true; hyphp:=false;@/
+repeat print('hyph_start, hyph_finish: '); get_input(n1,n2);@/
+ if (n1>=1)and(n1<max_val)and(n2>=1)and(n2<max_val) then
+ begin hyph_start:=n1; hyph_finish:=n2;
+ end
+ else begin n1:=0;
+ print_ln('Specify 1<=hyph_start,hyph_finish<=',max_val-1:1,' !');
+ end;
+until n1>0;
+hyph_level:=max_pat; {in case |hyph_finish<hyph_start|}
+for i:=hyph_start to hyph_finish do
+ begin hyph_level:=i; level_pattern_count:=0;
+ if hyph_level>hyph_start then print_ln(' ')
+ else if hyph_start<=max_pat then
+ print_ln('Largest hyphenation value ',max_pat:1,
+ ' in patterns should be less than hyph_start');@/
+@.Largest hyphenation value@>
+ repeat print('pat_start, pat_finish: '); get_input(n1,n2);@/
+ if (n1>=1)and(n1<=n2)and(n2<=max_dot) then
+ begin pat_start:=n1; pat_finish:=n2;
+ end
+ else begin n1:=0;
+ print_ln('Specify 1<=pat_start<=pat_finish<=',max_dot:1,' !');
+ end;
+ until n1>0;
+ repeat print('good weight, bad weight, threshold: ');
+ get_input(n1,n2,n3);@/
+ if (n1>=1)and(n2>=1)and(n3>=1) then
+ begin good_wt:=n1; bad_wt:=n2; thresh:=n3;
+ end
+ else begin n1:=0;
+ print_ln('Specify good weight, bad weight, threshold>=1 !');
+ end;
+ until n1>0;
+ @<Generate a level@>;
+ delete_bad_patterns;
+ print_ln('total of ',level_pattern_count:1,
+ ' patterns at hyph_level ',hyph_level:1);
+ end;
+find_letters(trie_link(trie_root),1); {prepare for output}
+rewrite(patout);
+output_patterns(trie_root,1);
+close_out(patout);@/
+@<Make final pass to hyphenate word list@>;
+end_of_PATGEN:
+end.
+
+@ The patterns of a given length (at a given level) are chosen with dot
+positions ordered in an ``organ-pipe'' fashion. For example, for
+|pat_len=4| we choose patterns for different dot positions in the order 2,
+1, 3, 0, 4. The variable |dot1| controls this iteration in a clever
+manner.
+
+@<Globals...@>=
+@!n1, @!n2, @!n3: integer; {accumulators}
+@!i: val_type; {loop index: hyphenation level}
+@!j: dot_type; {loop index: pattern length}
+@!k: dot_type; {loop index: hyphen position}
+@!dot1: dot_type;
+@!more_this_level: array[dot_type] of boolean;
+
+@ The array |more_this_level| remembers which positions are permanently
+``knocked out''. That is, if there aren't any possible good patterns
+remaining at a certain dot position, we don't need to consider longer
+patterns at this level containing that position.
+
+@<Generate a level@>=
+for k:=0 to max_dot do more_this_level[k]:=true;
+for j:=pat_start to pat_finish do
+ begin pat_len:=j; pat_dot:=pat_len div 2; dot1:=pat_dot*2;
+ repeat pat_dot:=dot1-pat_dot; dot1:=pat_len*2-dot1-1;
+ if more_this_level[pat_dot] then
+ begin do_dictionary; collect_count_trie;
+ more_this_level[pat_dot]:=more_to_come;
+ end;
+ until pat_dot=pat_len;
+ for k:=max_dot downto 1 do
+ if not more_this_level[k-1] then more_this_level[k]:=false;
+ end
+
+@ When all patterns have been found, the user has a chance to see what
+they do. The resulting \.{pattmp} file can be used as the new
+`dictionary' if we want to continue pattern generation from this point.
+
+@<Make final pass to hyphenate word list@>=
+procesp:=false; hyphp:=true;@/
+print('hyphenate word list? ');
+get_input_ln(buf[1]);
+if (buf[1]='Y') or (buf[1]='y') then do_dictionary
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{PATGEN} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@* Index.
+Pointers to error messages appear here together with the section numbers
+where each ident\-i\-fier is used.
diff --git a/obsolete/systems/knuth/unsupported/tex/tex.cms-changes b/obsolete/systems/knuth/unsupported/tex/tex.cms-changes
new file mode 100644
index 0000000000..06c89648c5
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/tex/tex.cms-changes
@@ -0,0 +1,1855 @@
+TEX.CMS-CHAN - WEB change file for TeX 2.0 for VM/CMS and Pascal/VS.
+Copyright (C) 1984 by David Fuchs. All rights are reserved.
+
+External references: TERMATTN, ATTN202, USESTACK. Assembled
+ text decks of these routines must be linked into module.
+
+Changes to this file since 1.0 version (at SLAC):
+
+ Added increased mem size params etc from VMS-CHAN,
+ XEDIT hook, change ".log" to ".texlog". 11 Feb 84
+ Fixed filemode specifier so you can "\input fn.ft.fm". 9 Mar 84
+ Update line number references from TeX 1.0 to TeX 1.1. 20 Mar 84
+ Increase |buf_size| parameter from 500 to 1024. 24 Apr 84
+ Add CMS hook to send string to CMS using "\write15". 24 Apr 84
+ Various small changes in comments in TeX. 12 Jul 84
+ Change |pool_name| from "TEX.POOL" to "TEX.POOL.*". 21 Aug 84
+ File mode "*" added to |prompt_file_name| on input. 23 Aug 84
+ Allow tab and formfeed characters in input. 23 Aug 84
+ Increase |pool_size| to 40000. 23 Aug 84
+ ONERROR message deleted. 23 Aug 84
+ DVI block size changed to 1024. 24 Aug 84
+ SLAC character translates (hex): 4F->4A, 6A->4F, A1->5F. 27 Sep 84
+ Add SLAC routines for logging use data. 27 Sep 84
+ Update for TeX 1.4. 24 Feb 86
+ Remove |ready_already| as per Klaus Thull's recommendation. 24 Feb 86
+ Increase |hash_size| to 3000. 26 Feb 86
+ Update for TeX 2.0. 10 Mar 86
+ Add Chris Thompson's changes for large arrays, |use_stack|,
+ and do simple array asignments for |do_all_six|. 25 Mar 86
+ Add code in |close_files_and_terminate| to explicitly close
+ all input files. Avoids Pascal/VS loop in AMPXIO. 6 May 86
+ Allow |mem| array to start at negative index. 8 May 86
+ Increase |pool_size| to 50000. 9 May 86
+ Move |ret_code| from |end_of_TEX:| to |final_end:| and make
+ |history|:=|fatal_error_stop| if |bad_fmt|. 15 May 86
+ Remove SLAC-specific routines and character translates
+ to conform to TeX Project (hex): 5F->A1, 4A->5F. 4 Jun 86
+ Change |tfm_file| reading routine to read multiple 1024-byte
+ records. All TeX/MF data files are now RECFM F LRECL 1024. 2 Jul 86
+
+TeX 2.0 WEB source line 34
+@x limbo
+\def\ph{\hbox{Pascal-H}}
+@y
+\def\ph{\hbox{Pascal-H}}
+\def\pvs{\hbox{Pascal/VS}}
+@z
+
+TeX 2.0 WEB source line 60
+@x limbo
+\pageno=3
+@y
+\pageno=3
+\let\maybe=\iffalse % to TeX only the changed sections after WEAV'ing
+\def\title{\TeX\ changes for VM/CMS}
+@z
+
+TeX 2.0 WEB source line 148
+@x
+@d banner=='This is TeX, Version 2.0' {printed when \TeX\ starts}
+@y
+The VM/CMS port of \TeX\ is a combination of efforts of many people.
+\.{WEB} change files for preliminary versions of \TeX\ were brought to
+the \TeX\ Users Group meeting in August 1983 and
+given to David Fuchs, of Stanford
+University Computer Science Department, who combined them into a
+definitive version on the VM system at Stanford Linear Accelerator
+Center. The original change files were supplied by Roger Chaffee of
+SLAC (now at Metaphor), Craig Platt of the University of Manitoba, and
+Peter M.#Sih of IBM Palo Alto Scientific Center. Bernd Schulze of the
+University of Bonn contributed his experience from bringing up a
+preliminary \TeX\ under CMS and has since sent many
+further improvements including the Metafont change file used in this
+implementation and other CMS change files.
+Other CMS change files and suggestions were made by Klaus Thull.
+All of this work was based on preliminary
+work adapting \TeX\ to MVS by Eagle Berns and Susan Plass of Stanford
+University. Peter Sih has donated countless hours of his expertise
+and contributed the device support for the IBM 4250 and APA6670 (and
+3800 model 3) printers. Many valuable revisions and additions to this
+work were made by Robert J.#Creasy.
+Alan Spragens at SLAC coordinated
+communication among the CMS sites and made some enhancements to the
+implementation while revising the CMS change file for \TeX\ versions
+1.1 and 2.0. Significant improvements were contributed for version
+2.0 by Chris Thompson of the University of Cambridge; they are
+described in the ``System-dependent Changes'' section.
+@d banner=='This is TeX, VM/CMS Version 2.0'
+ {printed when \TeX\ starts}
+@d term_in==tty_in
+@d term_out==tty_out
+@d string_length==len @& gth {IBM length function}
+@d string_index ==ind @& ex {IBM index function}
+@z
+
+TeX 2.0 WEB source line 218
+@x
+procedure initialize; {this procedure gets things started properly}
+@y
+@<Large array variables@>@/
+@<VM/CMS procedures@>@/
+@#
+procedure initialize; {this procedure gets things started properly}
+@z
+
+TeX 2.0 WEB source line 261
+@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
+
+TeX 2.0 WEB source line 266
+@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==
+@d tats==
+@z
+
+TeX 2.0 WEB source line 281
+@x
+@d init== {change this to `$\\{init}\equiv\.{@@\{}$' in the production version}
+@d tini== {change this to `$\\{tini}\equiv\.{@@\}}$' in the production version}
+@y virtex: init==@{ tini==@} initex: init== tini==
+@d init==@{
+@d tini==@}
+@z
+
+TeX 2.0 WEB source line 333
+@x
+@d othercases == others: {default for cases not listed explicitly}
+@y
+@d othercases == otherwise {default for cases not listed explicitly}
+@z
+
+TeX 2.0 WEB source line 345
+@x
+@!mem_max=30000; {greatest index in \TeX's internal |mem| array;
+ must be strictly less than |max_halfword|;
+ must be equal to |mem_top| in \.{INITEX}, otherwise |>=mem_top|}
+@!mem_min=0; {smallest index in \TeX's internal |mem| array;
+ must be |min_halfword| or more;
+ must be equal to |mem_bot| in \.{INITEX}, otherwise |<=mem_bot|}
+@!buf_size=500; {maximum number of characters simultaneously present in
+ current lines of open files and in control sequences between
+ \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|}
+@!error_line=72; {width of context lines on terminal error messages}
+@!half_error_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}
+@!stack_size=200; {maximum number of simultaneous input sources}
+@!max_in_open=6; {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@!font_max=75; {maximum internal font number; must not exceed |max_quarterword|
+ and must be at most |font_base+256|}
+@!font_mem_size=20000; {number of words of |font_info| for all fonts}
+@!param_size=60; {maximum number of simultaneous macro parameters}
+@!nest_size=40; {maximum number of semantic levels simultaneously active}
+@!max_strings=3000; {maximum number of strings; must not exceed |max_halfword|}
+@!string_vacancies=8000; {the minimum number of characters that should be
+ available for the user's control sequences and font names,
+ after \TeX's own error messages are stored}
+@!pool_size=32000; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all fonts and
+ control sequences; must exceed |string_vacancies| by the total
+ length of \TeX's own strings, which is currently about 23000}
+@!save_size=600; {space for saving values outside of current group; must be
+ at most |max_halfword|}
+@!trie_size=8000; {space for hyphenation patterns; should be larger for
+ \.{INITEX} than it is in production versions of \TeX}
+@!dvi_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='TeXformats:TEX.POOL ';
+ {string of length |file_name_size|; tells where the string pool appears}
+@.TeXformats@>
+@y
+@!mem_max=32766; {greatest index in \TeX's internal |mem| array;
+ must be strictly less than |max_halfword|;
+ must be equal to |mem_top| in \.{INITEX}, otherwise |>=mem_top|}
+@!mem_min=-32768; {smallest index in \TeX's internal |mem| array;
+ must be |min_halfword| or more;
+ must be equal to |mem_bot| in \.{INITEX}, otherwise |<=mem_bot|}
+@!buf_size=1024; {maximum number of characters simultaneously present in
+ current lines of open files and in control sequences between
+ \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|}
+@!error_line=79; {width of context lines on terminal error messages}
+@!half_error_line=50; {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}
+@!stack_size=200; {maximum number of simultaneous input sources}
+@!max_in_open=6; {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@!font_max=100; {maximum internal font number; must not exceed |max_quarterword|
+ and must be at most |font_base+256|}
+@!font_mem_size=30000; {number of words of |font_info| for all fonts}
+@!param_size=60; {maximum number of simultaneous macro parameters}
+@!nest_size=40; {maximum number of semantic levels simultaneously active}
+@!max_strings=5000; {maximum number of strings; must not exceed |max_halfword|}
+@!string_vacancies=26000; {the minimum number of characters that should be
+ available for the user's control sequences and font names,
+ after \TeX's own error messages are stored}
+@!pool_size=50000; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all fonts and
+ control sequences; must exceed |string_vacancies| by the total
+ length of \TeX's own strings, which is currently about 23000}
+@!save_size=600; {space for saving values outside of current group; must be
+ at most |max_halfword|}
+@!trie_size=8000; {space for hyphenation patterns; should be larger for
+ \.{INITEX} than it is in production versions of \TeX}
+@!dvi_buf_size=2048; {size of the output buffer; must be a multiple of 8}
+@!len_byte_block=1024; {must be half of |dvi_buf_size|}
+@!len_word_block=256; {format file buffer length}
+@!file_name_size=40; {file names shouldn't be longer than this}
+@!pool_name='TEX.POOl.* ';
+ {string of length |file_name_size|; tells where the string pool appears}
+@.TeXformats@>
+@z
+
+TeX 2.0 WEB source line 395
+@x
+@d mem_bot=0 {smallest index in the |mem| array dumped by \.{INITEX};
+ must not be less than |mem_min|}
+@d mem_top==30000 {largest index in the |mem| array dumped by \.{INITEX};
+ must be substantially larger than |mem_bot|
+ and not greater than |mem_max|}
+@d font_base=0 {smallest internal font number; must not be less
+ than |min_quarterword|}
+@d hash_size=2100 {maximum number of control sequences; it should be at most
+ about |(mem_max-mem_min)/10|, but 2100 is already quite generous}
+@d hash_prime=1777 {a prime number equal to about 85\% of |hash_size|}
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@^system dependencies@>
+@y
+@d mem_bot==-32768 {smallest index in the |mem| array dumped by \.{INITEX};
+ must not be less than |mem_min|}
+@d mem_top==32766 {largest index in the |mem| array dumped by \.{INITEX};
+ must be substantially larger than |mem_bot|
+ and not greater than |mem_max|}
+@d font_base=0 {smallest internal font number; must not be less
+ than |min_quarterword|}
+@d hash_size=3000 {maximum number of control sequences; it should be at most
+ about |(mem_max-mem_min)/10|, but 2100 is already quite generous}
+@d hash_prime=2549 {a prime number equal to about 85\% of |hash_size|}
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@^system dependencies@>
+@z
+
+TeX 2.0 WEB source line 503
+@x
+@!ASCII_code=0..127; {seven-bit numbers}
+@y
+@!ASCII_code=packed 0..127; {seven-bit numbers}
+@z
+
+TeX 2.0 WEB source line 533
+@x
+@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
+
+TeX 2.0 WEB source line 689
+@x [2] System-dependent character set changes:
+@^character set dependencies@>
+@^system dependencies@>
+
+@<Set init...@>=
+for i:=1 to @'37 do xchr[i]:=' ';
+@y
+For \pvs\ we allow |form_feed| and |tab| characters in input.
+@^character set dependencies@>
+@^system dependencies@>
+
+@d form_feed=@'14
+@d tab=@'05
+
+@<Set initial values...@>=
+for i:=1 to @'37 do xchr[i]:=' ';
+xchr[form_feed]:=chr(form_feed);
+xchr[tab]:=chr(tab);
+@z
+
+TeX 2.0 WEB source line 737
+@x
+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
+
+TeX 2.0 WEB source line 790
+@x
+begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f);
+@y
+begin okstatus; reset(f,'NAME='ccat@, trim(str(name_of_file)));
+ a_open_in:=status;
+@z
+
+TeX 2.0 WEB source line 795
+@x
+begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f);
+@y
+begin okstatus; rewrite(f,'NAME='ccat@, trim(str(name_of_file)));
+ a_open_out:=status;
+@z
+
+TeX 2.0 WEB source line 800
+@x
+begin reset(f,name_of_file,'/O'); b_open_in:=reset_OK(f);
+@y
+begin okstatus; reset(f,'NAME='ccat@, trim(str(name_of_file) ccat'.*'));
+ b_open_in:=status;
+@z
+
+TeX 2.0 WEB source line 805
+@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
+
+TeX 2.0 WEB source line 810
+@x
+begin reset(f,name_of_file,'/O'); w_open_in:=reset_OK(f);
+@y
+begin okstatus; reset(f,'NAME='ccat@, trim(str(name_of_file) ccat'.*'));
+ w_open_in:=status;
+@z
+
+TeX 2.0 WEB source line 815
+@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
+
+TeX 2.0 WEB source line 855
+@x
+@<Glob...@>=
+@!buffer:array[0..buf_size] of ASCII_code; {lines of characters being read}
+@y
+@d LA_buffer==
+@!buffer:array[0..buf_size] of ASCII_code; {lines of characters being read}
+
+@<Glob...@>=
+@z
+
+TeX 2.0 WEB source line 901
+@x
+@p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean;
+ {inputs the next line or returns |false|}
+var last_nonblank:0..buf_size; {|last| with trailing blanks removed}
+begin if bypass_eoln then if not eof(f) then get(f);
+ {input the first character of the line into |f^|}
+last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
+if eof(f) then input_ln:=false
+else begin last_nonblank:=first;
+ while not eoln(f) do
+ begin if last>=max_buf_stack then
+ begin max_buf_stack:=last+1;
+ if max_buf_stack=buf_size then
+ overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+ end;
+ buffer[last]:=xord[f^]; get(f); incr(last);
+ if buffer[last-1]<>" " then last_nonblank:=last;
+ end;
+ last:=last_nonblank; input_ln:=true;
+ end;
+end;
+@y
+@p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean;
+ {inputs the next line or returns |false|}
+var last_nonblank:0..buf_size; {|last| with trailing blanks removed}
+begin if bypass_eoln then if not eof(f) then get(f);
+ {input the first character of the line into |f^|}
+last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
+if eof(f) then input_ln:=false
+else begin last_nonblank:=first;
+ while not eoln(f) do
+ begin if last>=max_buf_stack then
+ begin max_buf_stack:=last+1;
+ if max_buf_stack=buf_size then
+ overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+ end;
+ buffer[last]:=xord[f@@]; get(f); incr(last); {@@ is \pvs\ pointer notation}
+ if buffer[last-1]<>" " then last_nonblank:=last;
+ end;
+ last:=last_nonblank; input_ln:=true;
+ end;
+end;
+@z
+
+TeX 2.0 WEB source line 933
+@x
+@ Here is how to open the terminal files
+in \ph. The `\.{/I}' switch suppresses the first |get|.
+@^system dependencies@>
+
+@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
+@ Here is how to open the terminal files
+in \pvs. There is no need to do a |reset| or |rewrite| or suppress
+the first |get| as with \ph.
+@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
+
+TeX 2.0 WEB source line 949
+@x
+some instruction to the operating system. The following macros show how
+these operations can be specified in \ph:
+@^system dependencies@>
+
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@d clear_terminal == break_in(term_in,true) {clear the terminal input buffer}
+@d wake_up_terminal == do_nothing {cancel the user's cancellation of output}
+@y
+some instructions to the operating system. The following macros were
+used to specify these operations in \ph\ but have been made into
+``no-ops'' for \pvs.
+@d update_terminal == do_nothing
+@d clear_terminal == do_nothing
+@d wake_up_terminal == do_nothing
+@z
+
+TeX 2.0 WEB source line 1011
+@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;
+var i,j,k: integer;
+ l: string(256);
+begin t_open_in;
+ l:=parms;
+ if l<>'' then begin
+ i:=@=LENGTH@>(l);
+ j:=min(i,buf_size-first); {this much will fit}
+ if j>0 then for k:=0 to j-1 do buffer[first+k]:=xord[l[k+1]];
+ last:=first+j;
+ max_buf_stack:=max(max_buf_stack,last);
+ loc:=first;
+ init_terminal:=true;
+ return
+ end;
+loop@+begin wake_up_terminal; write_ln(term_out,'**'); update_terminal;
+@z
+
+TeX 2.0 WEB source line 1072
+@x
+@ @<Glob...@>=
+@!str_pool:packed array[pool_pointer] of ASCII_code; {the characters}
+@!str_start : array[str_number] of pool_pointer; {the starting pointers}
+@y
+@ @d LA_string==
+@!str_pool:packed array[pool_pointer] of ASCII_code; {the characters}
+@!str_start : array[str_number] of pool_pointer; {the starting pointers}
+
+@<Glob...@>=
+@z
+
+The following change is to use \write15 to send stuff to CMS
+TeX 2.0 WEB source line 1373
+@x
+@ To end a line of text output, we call |print_ln|.
+
+@<Basic print...@>=
+procedure print_ln; {prints an end-of-line}
+begin case selector of
+term_and_log: begin wterm_cr; wlog_cr;
+ term_offset:=0; file_offset:=0;
+ end;
+log_only: begin wlog_cr; file_offset:=0;
+ end;
+term_only: begin wterm_cr; term_offset:=0;
+ end;
+no_print,pseudo,new_string: do_nothing;
+othercases write_ln(write_file[selector])
+endcases;@/
+end; {|tally| is not affected}
+@y
+@ To end a line of text output, we call |print_ln|.
+In CMS \TeX\ we also use |print_ln| to send a message
+to the operating system using the \.{\\write15} stream.
+
+@<Basic print...@>=
+procedure print_ln; {prints an end-of-line}
+var i:integer;
+begin case selector of
+term_and_log: begin wterm_cr; wlog_cr;
+ term_offset:=0; file_offset:=0;
+ end;
+log_only: begin wlog_cr; file_offset:=0;
+ end;
+term_only: begin wterm_cr; term_offset:=0;
+ end;
+no_print,pseudo,new_string: do_nothing;
+15: begin cms(trim(str(cms_buf)), irc); {send \.{\\write15} to CMS}
+ for i:=1 to cms_ptr do cms_buf[i]:=' ';
+ cms_ptr:=1; end;
+othercases write_ln(write_file[selector])
+endcases;@/
+end; {|tally| is not affected}
+@z
+
+The following change is to use \write15 to send stuff to CMS
+TeX 2.0 WEB source line 1394
+@x
+@<Basic printing...@>=
+procedure print_char(@!s:ASCII_code); {prints a single character}
+label exit;
+begin if @<Character |s| is the current new-line character@> then
+ if selector<pseudo then
+ begin print_ln; return;
+ end;
+case selector of
+term_and_log: begin wterm(xchr[s]); wlog(xchr[s]);
+ incr(term_offset); incr(file_offset);
+ if term_offset=max_print_line then
+ begin wterm_cr; term_offset:=0;
+ end;
+ if file_offset=max_print_line then
+ begin wlog_cr; file_offset:=0;
+ end;
+ end;
+log_only: begin wlog(xchr[s]); incr(file_offset);
+ if file_offset=max_print_line then print_ln;
+ end;
+term_only: begin wterm(xchr[s]); incr(term_offset);
+ if term_offset=max_print_line then print_ln;
+ end;
+no_print: do_nothing;
+pseudo: if tally<trick_count then trick_buf[tally mod error_line]:=s;
+new_string: begin if pool_ptr<pool_size then append_char(s);
+ end; {we drop characters if the string space is full}
+othercases write(write_file[selector],xchr[s])
+endcases;@/
+incr(tally);
+exit:end;
+@y
+@<Basic printing...@>=
+procedure print_char(@!s:ASCII_code); {prints a single character}
+label exit;
+begin if @<Character |s| is the current new-line character@> then
+ if selector<pseudo then
+ begin print_ln; return;
+ end;
+case selector of
+term_and_log: begin wterm(xchr[s]); wlog(xchr[s]);
+ incr(term_offset); incr(file_offset);
+ if term_offset=max_print_line then
+ begin wterm_cr; term_offset:=0;
+ end;
+ if file_offset=max_print_line then
+ begin wlog_cr; file_offset:=0;
+ end;
+ end;
+log_only: begin wlog(xchr[s]); incr(file_offset);
+ if file_offset=max_print_line then print_ln;
+ end;
+term_only: begin wterm(xchr[s]); incr(term_offset);
+ if term_offset=max_print_line then print_ln;
+ end;
+no_print: do_nothing;
+pseudo: if tally<trick_count then trick_buf[tally mod error_line]:=s;
+new_string: begin if pool_ptr<pool_size then append_char(s);
+ end; {we drop characters if the string space is full}
+15: begin cms_buf[cms_ptr]:=xchr[s]; incr(cms_ptr); end;
+othercases write(write_file[selector],xchr[s])
+endcases;@/
+incr(tally);
+exit:end;
+@z
+
+The following change is to use \write15 to send stuff to CMS
+TeX 2.0 WEB source line 1623
+@x
+if not input_ln(term_in,true) then fatal_error("End of file on the terminal!");
+@y
+write_ln(term_out);
+if not input_ln(term_in,true) then fatal_error("End of file on the terminal!");
+@z
+
+TeX 2.0 WEB source line 1814
+@x
+wizardry, so the present implementation simply types out what file should be
+edited and the relevant line number.
+@^system dependencies@>
+
+There is a secret `\.D' option available when the debugging routines have
+not been commented out.
+@^debugging@>
+
+@<Interpret code |c| and |return| if done@>=
+case c of
+"0","1","2","3","4","5","6","7","8","9": if deletions_allowed then
+ @<Delete |c-"0"| tokens and |goto continue|@>;
+@t\4\4@>@;@+@!debug "D": begin debug_help; goto continue;@+end;@+gubed@/
+"E": if base_ptr>0 then
+ begin print_nl("You want to edit file ");
+@.You want to edit file x@>
+ print(input_stack[base_ptr].name_field);
+ print(" at line "); print_int(line);
+ interaction:=scroll_mode; jump_out;
+ end;
+"H": @<Print the help information and |goto continue|@>;
+"I":@<Introduce new material from the terminal and |return|@>;
+"Q","R","S":@<Change the interaction level and |return|@>;
+"X":begin interaction:=scroll_mode; jump_out;
+ end;
+othercases do_nothing
+endcases;@/
+@<Print the menu of available options@>
+@y
+wizardry, so the standard implementation simply types out what file should be
+edited and the relevant line number.
+The CMS implementation uses an external assembly routine |attn202| to
+invoke XEDIT with ``:|line|'' in the
+program stack.
+@^system dependencies@>
+
+There is a secret `\.D' option available when the debugging routines have
+not been commented out.
+@^debugging@>
+
+@<Interpret code |c| and |return| if done@>=
+case c of
+"0","1","2","3","4","5","6","7","8","9": if deletions_allowed then
+ @<Delete |c-"0"| tokens and |goto continue|@>;
+@t\4\4@>@;@+@!debug "D": begin debug_help; goto continue;@+end;@+gubed@/
+"E": if base_ptr>0 then
+ begin print_nl("You want to edit file ");
+@.You want to edit file x@>
+ print(input_stack[base_ptr].name_field);
+ print(" at line "); print_int(line);
+ inp_line:='XEDIT ';
+ s1:=selector;
+ tally:=0; selector:=pseudo;
+ print(input_stack[base_ptr].name_field);
+ for s2:=0 to tally-1 do inp_line[s2+7]:=xchr[trick_buf[s2]];
+ s2:=string_index(inp_line,'.'); if s2>0 then inp_line[s2]:=' ';
+ s2:=string_index(inp_line,'.'); if s2>0 then inp_line[s2]:=' ';
+ attn202('FIFO ',inp_line);
+ tally:=0; inp_line:=' ';
+ print_int(line);
+ inp_line[1]:=':';
+ for s2:=0 to tally-1 do inp_line[s2+2]:=xchr[trick_buf[s2]];
+ attn202('FIFO ',inp_line);
+ ret_code(12);
+ selector:=s1;
+ interaction:=scroll_mode; jump_out;
+ end;
+"H": @<Print the help information and |goto continue|@>;
+"I":@<Introduce new material from the terminal and |return|@>;
+"Q","R","S":@<Change the interaction level and |return|@>;
+"X":begin interaction:=scroll_mode; jump_out;
+ end;
+othercases do_nothing
+endcases;@/
+@<Print the menu of available options@>
+@z
+
+TeX 2.0 WEB source line 2030
+@x
+interrupt:=0; OK_to_interrupt:=true;
+@y
+interrupt:=0; OK_to_interrupt:=true;
+term_attn(interrupt);
+@z
+
+TeX 2.0 WEB source line 2277
+@x
+@!glue_ratio=real; {one-word representation of a glue expansion factor}
+@y
+@!glue_ratio=shortreal; {are there any other reals in the program?}
+@z
+
+TeX 2.0 WEB source line 2330
+@x
+@d min_quarterword=0 {smallest allowable value in a |quarterword|}
+@d max_quarterword=255 {largest allowable value in a |quarterword|}
+@d min_halfword==0 {smallest allowable value in a |halfword|}
+@d max_halfword==65535 {largest allowable value in a |halfword|}
+@y
+@d min_quarterword=0 {smallest allowable value in a |quarterword|}
+@d max_quarterword=255 {largest allowable value in a |quarterword|}
+@d min_halfword==-32768 {smallest allowable value in a |halfword|}
+@d max_halfword==32767 {largest allowable value in a |halfword|}
+@z
+
+TeX 2.0 WEB source line 2363
+@x
+@d qi(#)==#+min_quarterword
+ {to put an |eight_bits| item into a quarterword}
+@d qo(#)==#-min_quarterword
+ {to take an |eight_bits| item out of a quarterword}
+@d hi(#)==#+min_halfword
+ {to put a sixteen-bit item into a halfword}
+@d ho(#)==#-min_halfword
+ {to take a sixteen-bit item from a halfword}
+@y
+@d qi(#)==#
+ {to put an |eight_bits| item into a quarterword}
+@d qo(#)==#
+ {to take an |eight_bits| item out of a quarterword}
+@d hi(#)==#+min_halfword
+ {to put a sixteen-bit item into a halfword}
+@d ho(#)==#-min_halfword
+ {to take a sixteen-bit item from a halfword}
+@z
+
+TeX 2.0 WEB source line 2378
+@x
+@!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}
+@!four_choices = 1..4; {used when there are four 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}
+@!four_choices=packed 1..4; {when there are four variants in a record}
+@z
+
+TeX 2.0 WEB source line 2401
+@x
+@!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
+
+TeX 2.0 WEB source line 2466
+@x
+deallocating them after their use.
+
+@<Glob...@>=
+@!mem : array[mem_min..mem_max] of memory_word; {the big dynamic storage area}
+@y
+deallocating them after their use.
+
+For \pvs\ we have declared the big |mem| array in the ``large array
+variables'' module. It is defined here in terms of a macro expanded
+near the end of the program. All such ``large array'' macros begin
+with ``|LA_|.''
+
+@d LA_mem==
+@!mem : array[mem_min..mem_max] of memory_word; {the big dynamic storage area}
+
+@<Glob...@>=
+@z
+
+TeX 2.0 WEB source line 3268
+@x
+been included. (You may want to decrease the size of |mem| while you
+@^debugging@>
+are debugging.)
+
+@<Glob...@>=
+@!debug @!free: packed array [mem_min..mem_max] of boolean; {free cells}
+@t\hskip1em@>@!was_free: packed array [mem_min..mem_max] of boolean;
+ {previously free cells}
+@t\hskip1em@>@!was_mem_end,@!was_lo_max,@!was_hi_min: pointer;
+@y
+been included. (You may want to decrease the size of |mem| while you
+@^debugging@>
+are debugging.)
+
+@d LA_mem_debug==
+@!free: packed array [mem_min..mem_max] of boolean; {free cells}
+@!was_free: packed array [mem_min..mem_max] of boolean;
+ {previously free cells}
+
+@<Glob...@>=
+@!debug @!was_mem_end,@!was_lo_max,@!was_hi_min: pointer;
+@z
+
+TeX 2.0 WEB source line 3653
+@x
+ if abs(mem[p+glue_offset].int)<@'4000000 then print("?.?")
+@y
+ if false then print("?.?") {no need to check value in 370 architecture}
+@z
+
+TeX 2.0 WEB source line 4218
+@x
+@<Glob...@>=
+@!nest:array[0..nest_size] of list_state_record;
+@y
+@d LA_nest==
+@!nest:array[0..nest_size] of list_state_record;
+
+@<Glob...@>=
+@z
+
+TeX 2.0 WEB source line 5085
+@x
+is needed. The program here simply specifies July 4, 1776, at noon; but
+users probably want a better approximation to the truth.
+
+@p procedure fix_date_and_time;
+begin time:=12*60; {minutes since midnight}
+day:=4; {fourth day of the month}
+month:=7; {seventh month of the year}
+year:=1776; {Anno Domini}
+end;
+@y
+is needed. The standard program
+here simply specified July 4, 1776, at noon; but
+we want a better approximation to the truth.
+
+@p procedure fix_date_and_time;
+var date,tod:alfa; hour, minute:integer;
+begin datetime(date,tod);
+readstr(str(date),month:3,day:3,year);
+year:=year+1900;{Bug next century}
+readstr(str(tod),hour:3,minute); time:=hour*60+minute;
+end;
+@z
+
+TeX 2.0 WEB source line 5289
+@x
+called |xeq_level|.
+
+@<Glob...@>=
+@!eqtb:array[active_base..eqtb_size] of memory_word;
+@!xeq_level:array[int_base..eqtb_size] of quarterword;
+@y
+called |xeq_level|.
+
+@d LA_eqtb==
+@!eqtb:array[active_base..eqtb_size] of memory_word;
+@!xeq_level:array[int_base..eqtb_size] of quarterword;
+@z
+
+TeX 2.0 WEB source line 5336
+@x
+@d hash_is_full == (hash_used=hash_base) {test if all positions are occupied}
+@d font_id_text(#) == text(font_id_base+#) {a frozen font identifier's name}
+
+@<Glob...@>=
+@!hash: array[hash_base..undefined_control_sequence-1] of two_halves;
+ {the hash table}
+@y
+@d hash_is_full == (hash_used=hash_base) {test if all positions are occupied}
+@d font_id_text(#) == text(font_id_base+#) {a frozen font identifier's name}
+@#
+@d LA_hash==
+@!hash: array[hash_base..undefined_control_sequence-1] of two_halves;
+ {the hash table}
+
+@<Glob...@>=
+@z
+
+TeX 2.0 WEB source line 5721
+@x
+@ @<Glob...@>=
+@!save_stack : array[0..save_size] of memory_word;
+@y
+@ @d LA_save_stack==
+@!save_stack : array[0..save_size] of memory_word;
+
+@<Glob...@>=
+@z
+
+TeX 2.0 WEB source line 6277
+@x
+@ @<Glob...@>=
+@!input_stack : array[0..stack_size] of in_state_record;
+@y
+@ @d LA_input_stack==
+@!input_stack : array[0..stack_size] of in_state_record;
+
+@<Glob...@>=
+@z
+
+TeX 2.0 WEB source line 6543
+@x
+rate from the others.
+
+@<Glob...@>=
+@!param_stack:array [0..param_size] of pointer;
+ {token list pointers for parameters}
+@y
+rate from the others.
+
+@d LA_param_stack==
+@!param_stack:array [0..param_size] of pointer;
+ {token list pointers for parameters}
+
+@<Glob...@>=
+@z
+
+TeX 2.0 WEB source line 9736
+@x
+@d TEX_area=="TeXinputs:"
+@.TeXinputs@>
+@d TEX_font_area=="TeXfonts:"
+@.TeXfonts@>
+@y
+@d TEX_area==".*"
+@.TeXinputs@>
+@d TEX_font_area==""
+@.TeXfonts@>
+@z
+
+TeX 2.0 WEB source line 9751
+@x
+@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;
+var ret:boolean;
+begin
+if c=" " then ret:=false
+else begin ret:=true;
+ if (c=".")then if ext_delimiter=0 then ext_delimiter:=pool_ptr
+ else if area_delimiter=0 then area_delimiter:=pool_ptr
+ else ret:=false;
+ if ret then begin {contribute |c| to the current string}
+ str_room(1); append_char(c); end;
+ end;
+more_name:=ret;
+end;
+@z
+
+TeX 2.0 WEB source line 9769
+@x
+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;
+end;
+@z
+
+TeX 2.0 WEB source line 9788
+@x
+begin print(a); print(n); print(e);
+@y
+begin print(n); print(e); print(a);
+@z
+
+TeX 2.0 WEB source line 9800
+@x
+@p procedure pack_file_name(@!n,@!a,@!e:str_number);
+@y
+@p procedure pack_file_name(@!a,@!e,@!n:str_number);
+@z
+
+TeX 2.0 WEB source line 9818
+@x
+@d format_default_length=20 {length of the |TEX_format_default| string}
+@d format_area_length=11 {length of its area part}
+@y
+@d format_default_length=9 {length of the |TEX_format_default| string}
+@d format_area_length=0 {length of its area part}
+@z
+
+TeX 2.0 WEB source line 9826
+@x
+TEX_format_default:='TeXformats:plain.fmt';
+@y
+TEX_format_default:='plain.fmt';
+@z
+
+TeX 2.0 WEB source line 9998
+@x
+clear_terminal; prompt_input(": "); @<Scan file name in the buffer@>;
+if cur_ext="" then cur_ext:=e;
+pack_cur_name;
+@y
+clear_terminal; prompt_input(": "); @<Scan file name in the buffer@>;
+if cur_ext="" then cur_ext:=e;
+if (s="input file name") and (cur_area="") then cur_area:=TEX_area;
+pack_cur_name;
+@z
+
+TeX 2.0 WEB source line 10034
+@x
+@p procedure open_log_file;
+var old_setting:0..max_selector; {previous |selector| setting}
+@!k:0..buf_size; {index into |months| and |buffer|}
+@!l:0..buf_size; {end of first input line}
+@!months:packed array [1..36] of char; {abbreviations of month names}
+begin old_setting:=selector;
+if job_name=0 then job_name:="texput";
+@.texput@>
+pack_job_name(".log");
+while not a_open_out(log_file) do @<Try to get a different log file name@>;
+log_name:=a_make_name_string(log_file);
+selector:=log_only;
+@y
+@p procedure open_log_file;
+var old_setting:0..max_selector; {previous |selector| setting}
+@!k:0..buf_size; {index into |months| and |buffer|}
+@!l:0..buf_size; {end of first input line}
+@!months:packed array [1..36] of char; {abbreviations of month names}
+begin old_setting:=selector;
+if job_name=0 then job_name:="texput";
+@.texput@>
+pack_job_name(".texlog");
+while not a_open_out(log_file) do @<Try to get a different log file name@>;
+log_name:=a_make_name_string(log_file);
+selector:=log_only;
+@z
+
+TeX 2.0 WEB source line 10089
+@x
+@p procedure start_input; {\TeX\ will \.{\\input} something}
+label done;
+begin scan_file_name; {set |cur_name| to desired file name}
+if cur_ext="" then cur_ext:=".tex";
+pack_cur_name;
+loop@+ begin begin_file_reading; {set up |cur_file| and new level of input}
+ if a_open_in(cur_file) then goto done;
+ if cur_area="" then
+ begin pack_file_name(cur_name,TEX_area,cur_ext);
+ if a_open_in(cur_file) then goto done;
+ end;
+ end_file_reading; {remove the level that didn't work}
+ prompt_file_name("input file name",".tex");
+ end;
+done: name:=a_make_name_string(cur_file);
+if job_name=0 then
+ begin job_name:=cur_name; open_log_file;
+@y
+@p procedure start_input; {\TeX\ will \.{\\input} something}
+label done;
+begin scan_file_name; {set |cur_name| to desired file name}
+if cur_ext="" then cur_ext:=".tex";
+if cur_area="" then cur_area:=TEX_area;
+pack_cur_name;
+loop@+ begin begin_file_reading; {set up |cur_file| and new level of input}
+ if a_open_in(cur_file) then goto done;
+ end_file_reading; {remove the level that didn't work}
+ prompt_file_name("input file name",".tex");
+ end;
+done: name:=a_make_name_string(cur_file);
+if job_name=0 then
+ begin job_name:=cur_name; open_log_file;
+@z
+
+|flush_string| removed--spoils XEDIT invocation
+TeX 2.0 WEB source line 10110
+@x
+print_char("("); print(name); update_terminal; state:=new_line;
+if name=str_ptr-1 then {we can conserve string pool space now}
+ begin flush_string; name:=cur_name;
+ end;
+@<Read the first line of the new file@>;
+end;
+@y
+print_char("("); print(name); update_terminal; state:=new_line;
+@<Read the first line of the new file@>;
+end;
+@z
+
+TeX 2.0 WEB source line 10399
+@x
+@ Here now is the (rather formidable) array of font arrays.
+
+@<Glob...@>=
+@!font_info:array[0..font_mem_size] of memory_word;
+ {the big collection of font data}
+@!fmem_ptr:0..font_mem_size; {first unused word of |font_info|}
+@!font_ptr:internal_font_number; {largest internal font number in use}
+@!font_check:array[internal_font_number] of four_quarters; {check sum}
+@!font_size:array[internal_font_number] of scaled; {``at'' size}
+@!font_dsize:array[internal_font_number] of scaled; {``design'' size}
+@!font_params:array[internal_font_number] of halfword; {how many font
+ parameters are present}
+@!font_name:array[internal_font_number] of str_number; {name of the font}
+@!font_area:array[internal_font_number] of str_number; {area of the font}
+@!font_bc:array[internal_font_number] of eight_bits;
+ {beginning (smallest) character code}
+@!font_ec:array[internal_font_number] of eight_bits;
+ {ending (largest) character code}
+@!font_glue:array[internal_font_number] of pointer;
+ {glue specification for interword space, |null| if not allocated}
+@!font_used:array[internal_font_number] of boolean;
+ {has a character from this font actually appeared in the output?}
+@!hyphen_char:array[internal_font_number] of integer;
+ {current \.{\\hyphenchar} values}
+@!skew_char:array[internal_font_number] of integer;
+ {current \.{\\skewchar} values}
+@y
+@ Here now is the (rather formidable) array of font arrays.
+
+@d LA_font1==
+@!font_info:array[0..font_mem_size] of memory_word;
+ {the big collection of font data}
+@!font_check:array[internal_font_number] of four_quarters; {check sum}
+@!font_size:array[internal_font_number] of scaled; {``at'' size}
+@!font_dsize:array[internal_font_number] of scaled; {``design'' size}
+@!font_params:array[internal_font_number] of halfword; {how many font
+ parameters are present}
+@!font_name:array[internal_font_number] of str_number; {name of the font}
+@!font_area:array[internal_font_number] of str_number; {area of the font}
+@!font_bc:array[internal_font_number] of eight_bits;
+ {beginning (smallest) character code}
+@!font_ec:array[internal_font_number] of eight_bits;
+ {ending (largest) character code}
+@!font_glue:array[internal_font_number] of pointer;
+ {glue specification for interword space, |null| if not allocated}
+@!font_used:array[internal_font_number] of boolean;
+ {has a character from this font actually appeared in the output?}
+@!hyphen_char:array[internal_font_number] of integer;
+ {current \.{\\hyphenchar} values}
+@!skew_char:array[internal_font_number] of integer;
+ {current \.{\\skewchar} values}
+
+@<Glob...@>=
+@!fmem_ptr:0..font_mem_size; {first unused word of |font_info|}
+@!font_ptr:internal_font_number; {largest internal font number in use}
+@z
+
+TeX 2.0 WEB source line 10435
+@x
+@<Glob...@>=
+@y
+@d LA_font2==
+@z
+
+TeX 2.0 WEB source line 10639
+@x
+@ @<Open |tfm_file| for input@>=
+@y
+@ @<Open |tfm_file| for input@>=
+tfm_count:=0;
+@z
+
+TeX 2.0 WEB source line 10654
+@x
+@d fget==get(tfm_file)
+@d fbyte==tfm_file^
+@y
+@ In CMS we know that \.{TFM} files have a logical record length of
+1024 bytes, so we do one |get(tfm_file)| per CMS record. Then, since
+|tfm_file| is a |byte_file| which is a |file of byte_block| which are
+arrays of 1024 bytes, we refer to each byte in the record while it is
+in the file buffer, avoiding the need to |get(tfm_file)| for each byte.
+Note that |fget| procedure is defined at the end of the program.
+@d fbyte==tfm_file@@[tfm_count] {@@ is \pvs\ pointer notation}
+@z
+
+TeX 2.0 WEB source line 11527
+@x
+@ Some systems may find it more efficient to make |dvi_buf| a |packed|
+array, since output of four bytes at once may be facilitated.
+@^system dependencies@>
+@y
+@ We play a trick with variant records so that we can fill up the
+|dvi_buf| array byte by byte, but write it out in one swell foop.
+@^system dependencies@>
+@d dvi_buf==d_buffer.b {buffer for \.{DVI} output}
+@z
+
+TeX 2.0 WEB source line 11531
+@x
+@!dvi_buf:array[dvi_index] of eight_bits; {buffer for \.{DVI} output}
+@y
+@!d_buffer: packed record
+ case boolean of
+ false:(b:packed array [dvi_index] of eight_bits);
+ true: (l:byte_block; r:byte_block);
+ end;
+@z
+
+TeX 2.0 WEB source line 11547
+@x
+@ The actual output of |dvi_buf[a..b]| to |dvi_file| is performed by calling
+|write_dvi(a,b)|. For best results, this procedure should be optimized to
+run as fast as possible on each particular system, since it is part of
+\TeX's inner loop. It is safe to assume that |a| and |b+1| will both be
+multiples of 4 when |write_dvi(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@>
+@^inner loop@>
+@^defecation@>
+
+@p procedure write_dvi(@!a,@!b:dvi_index);
+var k:dvi_index;
+begin for k:=a to b do write(dvi_file,dvi_buf[k]);
+end;
+@y
+@ The actual output of |dvi_buf[a..b]| to |dvi_file| is performed by calling
+|write| on the other variant of the |dvi_buf| record. Thus, we had
+better be sure things line up properly.
+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@>
+@^inner loop@>
+@^defecation@>
+
+@<Check the ``const...@>=
+if dvi_buf_size<>2*len_byte_block then bad:=223;
+@z
+
+TeX 2.0 WEB source line 11572
+@x
+ begin write_dvi(0,half_buf-1); dvi_limit:=half_buf;
+@y
+ begin write(dvi_file,d_buffer.l); dvi_limit:=half_buf;
+@z
+
+TeX 2.0 WEB source line 11575
+@x
+else begin write_dvi(half_buf,dvi_buf_size-1); dvi_limit:=dvi_buf_size;
+@y
+else begin write(dvi_file,d_buffer.r); dvi_limit:=dvi_buf_size;
+@z
+
+TeX 2.0 WEB source line 11584
+@x
+if dvi_limit=half_buf then write_dvi(half_buf,dvi_buf_size-1);
+if dvi_ptr>0 then write_dvi(0,dvi_ptr-1)
+@y
+if dvi_limit=half_buf then write(dvi_file,d_buffer.r);
+for k:=dvi_ptr to dvi_buf_size do dvi_buf[k]:=223; {bug is |k| ok?}
+if dvi_ptr>0 then write(dvi_file,d_buffer.l);
+if dvi_ptr>half_buf then write(dvi_file,d_buffer.r);
+@z
+
+TeX 2.0 WEB source line 15720
+@x
+@d delta_node=2 {|type| field in a delta node}
+@y
+@d delta_node=2 {|type| field in a delta node}
+
+@<Types...@>=
+@!delta_array=array[1..6] of scaled;
+@z
+
+TeX 2.0 WEB source line 15735
+@x
+@d do_all_six(#)==#(1);#(2);#(3);#(4);#(5);#(6)
+
+@<Glo...@>=
+@!active_width:array[1..6] of scaled;
+ {distance from first active node to#|cur_p|}
+@!cur_active_width:array[1..6] of scaled; {distance from current active node}
+@!background:array[1..6] of scaled; {length of an ``empty'' line}
+@!break_width:array[1..6] of scaled; {length being computed after current break}
+@y
+In standard \TeX\ the |do_all_six| macro is sometimes used just to copy one
+of these arrays to another. In this version, that uses \pvs, these have been
+converted to simple array assignments. This not only produces faster code,
+it decreases the size of the generated procedure: which is important, for
+|try_break| is very nearly too large for \pvs.
+
+@d do_all_six(#)==#(1);#(2);#(3);#(4);#(5);#(6)
+
+@<Glo...@>=
+@!active_width:delta_array; {distance from first active node to#|cur_p|}
+@!cur_active_width:delta_array; {distance from current active node}
+@!background:delta_array; {length of an ``empty'' line}
+@!break_width:delta_array; {length being computed after current break}
+@z
+
+TeX 2.0 WEB source line 15874
+@x
+@<Other local variables for |try_break|@>@;
+@y
+@<Other local variables for |try_break|@>@;
+
+procedure print_new_break; begin
+@<Print a symbolic description of the new break node@>
+end;
+
+procedure print_feasible_break; begin
+ @<Print a symbolic description of this feasible break@>;
+end;
+@z
+
+TeX 2.0 WEB source line 15877
+@x
+do_all_six(copy_to_cur_active);
+@y
+cur_active_width:=active_width; {\pvs\ for |do_all_six(copy_to_cur_active)|}
+@z
+
+TeX 2.0 WEB source line 16020
+@x
+begin no_break_yet:=false; do_all_six(set_break_width_to_background);
+@y
+begin no_break_yet:=false; break_width:=background;
+ {\pvs\ for |do_all_six(set_break_width_to_background)|}
+@z
+
+TeX 2.0 WEB source line 16122
+@x
+ begin do_all_six(store_break_width);
+@y
+ begin active_width:=break_width; {\pvs\ for |do_all_six(store_break_width)|}
+@z
+
+TeX 2.0 WEB source line 16158
+@x
+ @<Print a symbolic description of the new break node@>;
+@y
+ print_new_break;
+@z
+
+TeX 2.0 WEB source line 16343
+@x
+ @<Print a symbolic description of this feasible break@>;
+@y
+ print_feasible_break;
+@z
+
+TeX 2.0 WEB source line 16448
+@x
+ do_all_six(copy_to_cur_active);
+@y
+ cur_active_width:=active_width; {\pvs\ for |do_all_six(copy_to_cur_active)|}
+@z
+
+TeX 2.0 WEB source line 16523
+@x
+do_all_six(store_background);@/
+@y
+active_width:=background; {\pvs\ for |do_all_six(store_background)|}
+@z
+
+TeX 2.0 WEB source line 17394
+@x
+@!trie_pointer=0..trie_size; {an index into |trie|}
+@y
+@!trie_pointer=packed 0..trie_size; {an index into |trie|}
+@z
+
+TeX 2.0 WEB source line 17398
+@x
+@d trie_op(#)==trie[#].b0 {program for hyphenation at this trie location}
+
+@<Glob...@>=
+@y
+@d trie_op(#)==trie[#].b0 {program for hyphenation at this trie location}
+@#
+@d LA_trie==
+@z
+
+TeX 2.0 WEB source line 17457
+@x
+@!hyph_pointer=0..hyph_size; {an index into the ordered hash table}
+
+@ @<Glob...@>=
+@!hyph_word:array[hyph_pointer] of str_number; {exception words}
+@!hyph_list:array[hyph_pointer] of pointer; {list of hyphen positions}
+@y
+@!hyph_pointer=packed 0..hyph_size; {an index into the ordered hash table}
+
+@ @d LA_hyph==
+@!hyph_word:array[hyph_pointer] of str_number; {exception words}
+@!hyph_list:array[hyph_pointer] of pointer; {list of hyphen positions}
+
+@<Glob...@>=
+@z
+
+TeX 2.0 WEB source line 17665
+@x
+@d trie_op_hash_size=quarterword_diff+quarterword_diff {double}
+
+@<Glob...@>=
+@!init@! trie_op_hash:array[0..trie_op_hash_size] of quarterword;
+ {trie op codes for triples}
+tini@;@/
+@t\hskip1em@>@!trie_op_ptr:quarterword; {highest |trie_op| assigned}
+@y
+@d trie_op_hash_size=quarterword_diff+quarterword_diff {double}
+@#
+@d LA_trie_init1==
+@! trie_op_hash:array[0..trie_op_hash_size] of quarterword;
+ {trie op codes for triples}
+
+@<Glob...@>=
+@!trie_op_ptr:quarterword; {highest |trie_op| assigned}
+@z
+
+TeX 2.0 WEB source line 17717
+@x
+@d trie_root==trie_l[0] {root of the linked trie}
+
+@<Glob...@>=
+@!init @!trie_c:packed array[trie_pointer] of ASCII_code; {characters to match}
+@t\hskip1em@>@!trie_o:packed array[trie_pointer] of quarterword;
+ {operations to perform}
+@t\hskip1em@>@!trie_l:packed array[trie_pointer] of trie_pointer;
+ {left subtrie links}
+@t\hskip1em@>@!trie_r:packed array[trie_pointer] of trie_pointer;
+ {right subtrie links}
+@t\hskip1em@>@!trie_ptr:trie_pointer; {the number of nodes in the trie}
+@y
+@d trie_root==trie_l[0] {root of the linked trie}
+@#
+@d LA_trie_init2==
+@!trie_c:packed array[trie_pointer] of ASCII_code; {characters to match}
+@t\hskip1em@>@!trie_o:packed array[trie_pointer] of quarterword;
+ {operations to perform}
+@t\hskip1em@>@!trie_l:packed array[trie_pointer] of trie_pointer;
+ {left subtrie links}
+@t\hskip1em@>@!trie_r:packed array[trie_pointer] of trie_pointer;
+ {right subtrie links}
+
+@<Glob...@>=
+@!init @!trie_ptr:trie_pointer; {the number of nodes in the trie}
+@z
+
+TeX 2.0 WEB source line 17734
+@x
+initialized to zero.
+
+@<Glob...@>=
+@!init @!trie_hash:packed array[trie_pointer] of trie_pointer;
+tini {to identify equivalent subtries}
+@y
+initialized to zero.
+
+@d LA_trie_init3==
+@!trie_hash:packed array[trie_pointer] of trie_pointer;
+ {to identify equivalent subtries}
+@z
+
+TeX 2.0 WEB source line 17809
+@x
+@d trie_back(#)==trie[#].lh {backward links in |trie| holes}
+
+@<Glob...@>=
+@!init@!trie_taken:packed array[trie_pointer] of boolean;
+ {does a family start here?}
+@t\hskip1em@>@!trie_min:trie_pointer;
+@y
+@d trie_back(#)==trie[#].lh {backward links in |trie| holes}
+@#
+@d LA_trie_init4==
+@!trie_taken:packed array[trie_pointer] of boolean;
+ {does a family start here?}
+
+@<Glob...@>=
+@!init @!trie_min:trie_pointer;
+@z
+
+TeX 2.0 WEB source line 22573
+@x
+ if cur_ext="" then cur_ext:=".tex";
+@y
+ if cur_ext="" then cur_ext:=".tex";
+ if cur_area="" then cur_area:=TEX_area;
+@z
+
+TeX 2.0 WEB source line 22865
+@x
+bad_fmt: wake_up_terminal;
+ wterm_ln('(Fatal format file error; I''m stymied)');
+@.Fatal format file error@>
+load_fmt_file:=false;
+exit:end;
+@y
+bad_fmt: wake_up_terminal;
+ wterm_ln('(Fatal format file error; I''m stymied)');
+@.Fatal format file error@>
+history:=fatal_error_stop;
+load_fmt_file:=false;
+exit:end;
+@z
+
+TeX 2.0 WEB source line 22885
+@x
+@d dump_wd(#)==begin fmt_file^:=#; put(fmt_file);@+end
+@d dump_int(#)==begin fmt_file^.int:=#; put(fmt_file);@+end
+@d dump_hh(#)==begin fmt_file^.hh:=#; put(fmt_file);@+end
+@d dump_qqqq(#)==begin fmt_file^.qqqq:=#; put(fmt_file);@+end
+
+@<Glob...@>=
+@y
+@d fmt_word==fmt_file@@[fmt_count]
+
+@d dump_wd(#)==begin fmt_word:=#; put_fmt;@+end
+@d dump_int(#)==begin fmt_word.int:=#; put_fmt;@+end
+@d dump_hh(#)==begin fmt_word.hh:=#; put_fmt;@+end
+@d dump_qqqq(#)==begin fmt_word.qqqq:=#; put_fmt;@+end
+
+@<Glob...@>=
+@!fmt_count:integer;
+@z
+
+TeX 2.0 WEB source line 22897
+@x
+@d undump_wd(#)==begin get(fmt_file); #:=fmt_file^;@+end
+@d undump_int(#)==begin get(fmt_file); #:=fmt_file^.int;@+end
+@d undump_hh(#)==begin get(fmt_file); #:=fmt_file^.hh;@+end
+@d undump_qqqq(#)==begin get(fmt_file); #:=fmt_file^.qqqq;@+end
+@y
+@d undump_wd(#)==begin get_fmt; #:=fmt_word;@+end
+@d undump_int(#)==begin get_fmt; #:=fmt_word.int;@+end
+@d undump_hh(#)==begin get_fmt; #:=fmt_word.hh;@+end
+@d undump_qqqq(#)==begin get_fmt; #:=fmt_word.qqqq;@+end
+@z
+
+TeX 2.0 WEB source line 22912
+@x
+@<Dump constants for consistency check@>=
+@y
+@<Dump constants for consistency check@>=
+fmt_count:=0;
+@z;
+
+TeX 2.0 WEB source line 22927
+@x
+x:=fmt_file^.int;
+@y
+fmt_count:=0;
+x:=fmt_word.int;
+@z
+
+TeX 2.0 WEB source line 23224
+@x
+dump_int(interaction); dump_int(format_ident); dump_int(69069);
+@y
+dump_int(interaction); dump_int(format_ident); dump_int(69069);
+while fmt_count<>0 do dump_int(0); {flush out the buffer}
+@z
+
+TeX 2.0 WEB source line 23309
+@x
+The initial test involving |ready_already| should be deleted if the
+\PASCAL\ runtime system is smart enough to detect such a ``mistake.''
+@^system dependencies@>
+
+@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_TEX;
+@y
+The initial test involving |ready_already| has been deleted here
+since the
+CMS storage management is not smart enough to clean up properly.
+We also declare the procedure |use_stack| which is explained in
+its definition.
+@^system dependencies@>
+
+@p @<Declare the procedure |use_stack|@> @;
+@#
+begin @!{|start_here|}
+use_stack;
+history:=fatal_error_stop; {in case we quit during initialization}
+t_open_out; {open the terminal for output}
+@z
+
+TeX 2.0 WEB source line 23319
+@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
+
+TeX 2.0 WEB source line 23328
+@x
+ready_already:=314159;
+start_of_TEX: @<Initialize the output routines@>;
+@<Get the first line of input and prepare to start@>;
+init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr;@/
+history:=spotless; {ready to go!}
+main_control; {come to life}
+final_cleanup; {prepare for death}
+end_of_TEX: close_files_and_terminate;
+final_end: ready_already:=0;
+@y
+do_nothing; {remove |ready_already:=314159;|}
+start_of_TEX: @<Initialize the output routines@>;
+@<Get the first line of input and prepare to start@>;
+init_str_ptr:=str_ptr; init_pool_ptr:=pool_ptr;@/
+history:=spotless; {ready to go!}
+main_control; {come to life}
+final_cleanup; {prepare for death}
+end_of_TEX: close_files_and_terminate;
+final_end: ret_code(history*4);
+interrupt:=-1;
+term_attn(interrupt);
+@z
+
+TeX 2.0 WEB source line 23348
+@x
+but that can't cause infinite recursion.
+
+@<Last-minute...@>=
+procedure close_files_and_terminate;
+var k:integer; {all-purpose index}
+begin @<Finish the extensions@>;
+@!stat if tracing_stats>0 then @<Output statistics about this job@>;@;@+tats@/
+wake_up_terminal; @<Finish the \.{DVI} file@>;
+if job_name>0 then
+ begin wlog_cr; a_close(log_file); selector:=selector-2;
+@y
+but that can't cause infinite recursion.
+
+For \pvs\ we explicitly close all text input files, which standard
+\TeX\ leaves open, because \pvs\ sometimes(!) cannot manage
+to close them
+after a |jump_out| from an inner-level input file containing a
+\TeX\ error.
+It is (currently) okay to close files that are not open in \pvs.
+
+@<Last-minute...@>=
+procedure close_files_and_terminate;
+var k:integer; {all-purpose index}
+begin @<Finish the extensions@>;
+@!stat if tracing_stats>0 then @<Output statistics about this job@>;@;@+tats@/
+wake_up_terminal; @<Finish the \.{DVI} file@>;
+if job_name>0 then
+ begin wlog_cr; a_close(log_file);
+ for k:=1 to max_in_open do a_close(input_file[k]); {close input files}
+ selector:=selector-2;
+@z
+
+The following change is to use \write15 to send stuff to CMS
+TeX 2.0 WEB source line 23619
+@x
+@ @<Set init...@>=
+for k:=0 to 17 do write_open[k]:=false;
+@y
+@ @<Set init...@>=
+for k:=0 to 17 do write_open[k]:=false;
+write_open[15]:=true; {hack open \.{\\write15} stream for sending
+ messages to CMS}
+cms_ptr:=1; {initialize |cms_buf| pointer and array}
+for k:=1 to buf_size do cms_buf[k]:=' ';
+@z
+
+TeX 2.0 WEB source line 23949
+@x
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \TeX\ work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the published program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@y
+The following sections, as recommended, contain the changes necessary to
+make \TeX\ work under \pvs\ and CMS.
+
+@ The following two sections of code and comment are from Chris Thompson
+of Cambridge University Computing Service:
+
+One of the unfortunate features of the \pvs\ compiler (and, indeed, of
+all known \PASCAL\ compilers for the IBM/370 architecture) is that variables
+in a stack frame are allocated strictly in the order they were declared.
+If the stack frame is more than 4096 bytes long, access to the later variables
+is less efficient, as \pvs\ must generate code to add a suitable multiple
+of 4096 to the base register for the stack frame. If many different multiples
+of 4096 are involved, the situation is correspondingly worse.
+
+Unfortunately, this effect is particularly acute for programs like \TeX.
+The order of the global variable declarations in the program generated by
+\.{TANGLE} is the order they actually occur in the source of \TeX. This order
+is oriented towards a structured exposition of the program. In particular,
+arrays (some of them rather large) and simple variables are mixed up; thus
+some of the most heavily used global variables in \TeX\ not only are not
+assigned addresses in the first 4096 bytes of the global stack frame, but
+even occur in many different 4096-byte sections of that frame, causing
+\pvs\ to have to assign many registers to point at them.
+
+There are many possible ways in which this situation could be improved.
+In this version of \TeX\ the declarations of the largest arrays have been
+removed from the module ``Global variables'' and added to a new one called
+``Large array variables'' which is inserted at the end of the declarations.
+The object is to make the space allocated to the variables left in the first
+module no more than 4096 bytes. Many of the smaller arrays have been left in
+the first module; after all, they too can gain from being directly addressable.
+
+As the individual sections of ``Global variables'' often contain declarations
+of both simple and array variables, the latter have been converted to
+\.{TANGLE} macros which are expanded here, rather than building up
+``Large array variables'' on the way.
+This would also enable us to change the order of
+these arrays on the global stack frame if desired.
+
+@<Large array...@>=
+ LA_buffer @; LA_string @;
+ LA_mem @; debug LA_mem_debug gubed @;
+ LA_nest @; LA_eqtb @; LA_hash @; LA_save_stack @;
+ LA_input_stack @; LA_param_stack @;
+ LA_font1 @; LA_font2 @;
+ LA_trie @; LA_hyph @;
+ init LA_trie_init1 @; LA_trie_init2 @; LA_trie_init3 @; LA_trie_init4 tini
+
+@ Another unfortunate feature of the \pvs\ compiler (this time unique to it)
+is the way it manages the \PASCAL\ stack. Rather than allocating the whole
+stack area at once, it uses \.{GETMAIN} system calls to obtain chunks of store
+for it on demand. If stack overflow is detected on a routine call (i.e., the
+current chunk is not big enough; which, in particular, always happens when
+the main program is called from the runtime system) then a new chunk is made
+current. This is taken from a chain of spare chunks if any of them is big
+enough; if not, a new chunk is obtained, of size
+$$\lceil\max(\hbox{new stack frame}, d)\rceil\quad\hbox{Kbytes}$$
+where $d$ is specified by a runtime option, defaulting to 12\thinspace Kbytes.
+A special dummy procedure is
+placed between the caller and callee. When the callee returns, this procedure
+switches back to the old chunk, placing the new one on the spare list.
+
+Now, consider the case of \TeX. Most of the stack frames are not much larger
+than the \pvs\ minimum of 144 bytes, because they do not contain arrays;
+on the other hand, the global stack frame is enormous. The chunk obtained
+by \pvs\ for the main program will have between 0#and 1\thinspace Kbytes
+left after the global stack frame itself---and exactly how much will be
+quite impossible to keep control of as \TeX\ is altered. This is not
+enough for very many nested routine calls, and \TeX\ will soon use it up
+and obtain a new chunk of 12\thinspace Kbytes; this will suffice for
+nearly all \TeX\ applications (and if it didn't, we could change the
+runtime option).
+
+Some routines will have their stack frames very near the end of the
+first chunk. On every routine call they make, a switch will have to be
+made to the second chunk, and on each return to them a switch back again.
+Although this part of the \pvs\ runtime system is written in assembler,
+this is still a heavy overhead. If the routine involved is one that calls
+many other routines (the worst case may be |main_control|) then this will
+observably degrade the whole performance of \TeX. Experiments have shown
+variations due to this cause in the CPU time used by \TeX\ of 10\% in
+normal applications, and more than that in special cases.
+
+The possible solutions here range from altering the algorithm in \pvs\ to
+use a chunk size of
+$$\lceil\hbox{new stack frame} + d\rceil\quad\hbox{Kbytes}$$
+(which would work quite well for \TeX) to arranging to always specify a
+runtime system \.{STACK=d} option comfortably larger than the global
+stack frame (but then one could hardly hope ever to get another chunk
+if the first one {\sl did} run out). The solution adopted in this version
+of \TeX\ is to use an assembler routine |use_stack| which arranges that
+its caller's stack frame will subsequently be judged by \pvs\ to be as
+high as possible in the current chunk---to do this it has to know more
+than is good for it about the internals of \pvs, of course!
+
+Ideally, this routine would be used as follows. The main program would
+consist of a call of |use_stack|, followed by a call of
+ \\{do\_everything\_else};
+then only one call-return pair gets the overhead. This is awkward for \TeX,
+though, because of the labels in the main program, especially |end_of_TEX|.
+Almost as good is to insert a call of |use_stack| near the beginning of the
+existing main program, and this is what we do here. It works because the
+main program doesn't actually call many other routines, and has no loops---we
+can hope it will stay that way!
+
+@<Declare the procedure |use_stack|@>=
+procedure use_stack; external;
+
+@ Extra type needed for CMS message
+@<Types...@>=
+
+@!cms_buf_type=packed array[1..buf_size] of char;
+
+@ Here are extra global variables for VM/CMS routines
+@<Glob...@>=
+
+@!inp_line:string(255);
+@!cms_buf:cms_buf_type;
+@!cms_ptr:1..buf_size;
+@!irc:integer;
+@!tfm_count:integer;
+@!status: boolean; {did the last |reset| or |rewrite| succeed?}
+
+@ @<VM/CMS...@>=
+procedure term_attn(var interrupt: integer); fortran;
+procedure cms(const s:string; var rc:integer); external;
+procedure attn202(const lifofifo:alfa; const cmd:string); external;
+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 fget; begin {no check done for eof}
+ incr(tfm_count);
+ if tfm_count=len_byte_block then
+ begin get(tfm_file); tfm_count:=0;
+ end;
+ end;
+
+procedure put_fmt; begin
+ incr(fmt_count);
+ if fmt_count=len_word_block then
+ begin put(fmt_file); fmt_count:=0;
+ end;
+ end;
+
+procedure get_fmt; begin
+ incr(fmt_count);
+ if fmt_count=len_word_block then begin
+ get(fmt_file); fmt_count:=0;
+ end;
+ end;
+@z
diff --git a/obsolete/systems/knuth/unsupported/tex/tex.mvs-changes b/obsolete/systems/knuth/unsupported/tex/tex.mvs-changes
new file mode 100644
index 0000000000..8b88dbb0a5
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/tex/tex.mvs-changes
@@ -0,0 +1,663 @@
+TeX change file for MVS.
+Copyright (C) 1984 by David Fuchs. All rights are reserved.
+
+@x
+@d banner=='This is TeX, Version 1.1' {printed when \TeX\ starts}
+@y
+@d banner=='This is TeX, MVS Version 1.1' {printed when -TeX- starts}
+@d ccat==@=^^@>
+@z
+
+@x
+procedure initialize; {this procedure gets things started properly}
+@y
+@<VM/CMS stuff@>
+@#
+procedure initialize; {this procedure gets things started properly}
+@z
+
+@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
+
+@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==
+@d tats==
+@z
+
+@x
+@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
+
+@x
+@d othercases == others: {default for cases not listed explicitly}
+@y
+@d othercases == otherwise {default for cases not listed explicitly}
+@z
+
+@x
+@!mem_max=30000; {greatest index in \TeX's internal |mem| array;
+ must be strictly less than |max_halfword|}
+@!buf_size=500; {maximum number of characters simultaneously present in
+ current lines of open files and in control sequences between
+ \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|}
+@!error_line=72; {width of context lines on terminal error messages}
+@!half_error_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}
+@!stack_size=200; {maximum number of simultaneous input sources}
+@!max_in_open=6; {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@!font_max=75; {maximum internal font number; must not exceed |max_quarterword|
+ and must be at most |font_base+256|}
+@!font_mem_size=20000; {number of words of |font_info| for all fonts}
+@!param_size=60; {maximum number of simultaneous macro parameters}
+@!nest_size=40; {maximum number of semantic levels simultaneously active}
+@!max_strings=3000; {maximum number of strings; must not exceed |max_halfword|}
+@!string_vacancies=8000; {the minimum number of characters that should be
+ available for the user's control sequences and font names,
+ after \TeX's own error messages are stored}
+@!pool_size=32000; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all fonts and
+ control sequences; must exceed |string_vacancies| by the total
+ length of \TeX's own strings, which is currently about 23000}
+@!save_size=600; {space for saving values outside of current group; must be
+ at most |max_halfword|}
+@!trie_size=8000; {space for hyphenation patterns; should be larger for
+ \.{INITEX} than it is in production versions of \TeX}
+@!dvi_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='TeXformats:TEX.POOL ';
+ {string of length |file_name_size|; tells where the string pool appears}
+@.TeXformats@>
+@y
+@!mem_max=60000; {greatest index in \TeX's internal |mem| array;
+ must be strictly less than |max_halfword|}
+@!buf_size=500; {maximum number of characters simultaneously present in
+ current lines of open files and in control sequences between
+ \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|}
+@!error_line=72; {width of context lines on terminal error messages}
+@!half_error_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}
+@!stack_size=200; {maximum number of simultaneous input sources}
+@!max_in_open=6; {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@!font_max=75; {maximum internal font number; must not exceed |max_quarterword|
+ and must be at most |font_base+256|}
+@!font_mem_size=25000; {number of words of |font_info| for all fonts}
+@!param_size=60; {maximum number of simultaneous macro parameters}
+@!nest_size=40; {maximum number of semantic levels simultaneously active}
+@!max_strings=3000; {maximum number of strings; must not exceed |max_halfword|}
+@!string_vacancies=8000; {the minimum number of characters that should be
+ available for the user's control sequences and font names,
+ after \TeX's own error messages are stored}
+@!pool_size=32000; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all fonts and
+ control sequences; must exceed |string_vacancies| by the total
+ length of \TeX's own strings, which is currently about 23000}
+@!save_size=600; {space for saving values outside of current group; must be
+ at most |max_halfword|}
+@!trie_size=8000; {space for hyphenation patterns; should be larger for
+ \.{INITEX} than it is in production versions of \TeX}
+@!dvi_buf_size=4096; {size of the output buffer; must be a multiple of 8}
+@!len_byte_block=2048; {must be half of |dvi_buf_size|}
+@!len_word_block=256; {format file buffer length}
+@!file_name_size=40; {file names shouldn't be longer than this}
+@!pool_name='TEX.POOL ';
+ {string of length |file_name_size|; tells where the string pool appears}
+@.TeXformats@>
+@z
+
+@x
+@d mem_base=0 {smallest index in the |mem| array; must not be less
+ than |min_halfword|}
+@d hi_mem_base=13000 {smallest index in the single-word area of |mem|;
+ must be substantially larger than |mem_base| and smaller than |mem_max|}
+@d font_base=0 {smallest internal font number; must not be less
+ than |min_quarterword|}
+@d hash_size=2100 {maximum number of control sequences; it should be at most
+ about |(mem_max-hi_mem_base)/6|, but 2100 is already quite generous}
+@d hash_prime=1777 {a prime number equal to about 85\% of |hash_size|}
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@^system dependencies@>
+@y
+@d mem_base=0 {smallest index in the |mem| array; must not be less
+ than |min_halfword|}
+@d hi_mem_base=22000 {smallest index in the single-word area of |mem|;
+ must be substantially larger than |mem_base| and smaller than |mem_max|}
+@d font_base=0 {smallest internal font number; must not be less
+ than |min_quarterword|}
+@d hash_size=2100 {maximum number of control sequences; it should be at most
+ about |(mem_max-hi_mem_base)/6|, but 2100 is already quite generous}
+@d hash_prime=1777 {a prime number equal to about 85\% of |hash_size|}
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@^system dependencies@>
+@z
+
+@x
+@!ASCII_code=0..127; {seven-bit numbers}
+@y
+@!ASCII_code=packed 0..127; {seven-bit numbers}
+@z
+
+@x
+@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
+
+@x
+ {ASCII codes 0 and |@'177| do not appear in text}
+@y
+ {ASCII codes 0 and |@'177| do not appear in text}
+parmstring:=parms ccat str('C');
+if parmstring(.1.)='W' then begin
+ xchr(.@'134.):=chr(@"5F); {backslash}
+ xchr(.@'173.):=chr(@"8B); {left curly}
+ xchr(.@'175.):=chr(@"9B); {right curly}
+ xchr(.@'140.):=chr(@"AF); {left single quote}
+ xchr(.@'176.):=chr(@"9C); {tilde}
+ end;
+@z
+
+@x
+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
+do a few simple things with them in this section before they are defined.
+
+@d alpha_file==@= text@>
+
+@<Types...@>=
+@!eight_bits=packed 0..255; {unsigned one-byte quantity}
+@z
+
+@x
+begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f);
+@y
+begin okstatus;
+if dd_name='' then reset(f,'DDNAME='ccat dd_member)
+else pdsin(f,'DDNAME='ccat dd_name ccat ',MEMBER=' ccat dd_member);
+ a_open_in:=status;
+@z
+
+@x
+begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f);
+@y
+begin okstatus;
+if dd_name='' then rewrite(f,'DDNAME='ccat dd_member)
+else pdsout(f,'DDNAME='ccat dd_name ccat ',MEMBER=' ccat dd_member);
+ a_open_out:=status;
+@z
+
+@x
+begin reset(f,name_of_file,'/O'); b_open_in:=reset_OK(f);
+@y
+begin okstatus;
+pdsin(f,'DDNAME='ccat dd_name ccat ',MEMBER=' ccat dd_member);
+ b_open_in:=status;
+@z
+
+@x
+begin rewrite(f,name_of_file,'/O'); b_open_out:=rewrite_OK(f);
+@y
+begin okstatus; rewrite(f,'DDNAME=DVIFILE');
+ b_open_out:=status;
+@z
+
+@x
+begin reset(f,name_of_file,'/O'); w_open_in:=reset_OK(f);
+@y
+begin okstatus; reset(f,'DDNAME=FMTFILE');
+ w_open_in:=status;
+@z
+
+@x
+begin rewrite(f,name_of_file,'/O'); w_open_out:=rewrite_OK(f);
+@y
+begin okstatus; rewrite(f,'DDNAME=FMTOUT');
+ w_open_out:=status;
+@z
+
+@x
+@p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean;
+ {inputs the next line or returns |false|}
+var last_nonblank:0..buf_size; {|last| with trailing blanks removed}
+begin if bypass_eoln then if not eof(f) then get(f);
+ {input the first character of the line into |f^|}
+last:=first; {cf.\ Matthew 19:30}
+if eof(f) then input_ln:=false
+else begin last_nonblank:=first;
+ while not eoln(f) do
+ begin if last>=max_buf_stack then
+ begin max_buf_stack:=last+1;
+ if max_buf_stack=buf_size then
+ overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+ end;
+ buffer[last]:=xord[f^]; get(f); incr(last);
+ if buffer[last-1]<>" " then last_nonblank:=last;
+ end;
+ last:=last_nonblank; input_ln:=true;
+ end;
+end;
+@y
+@p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean;
+ {inputs the next line or returns |false|}
+var last_nonblank:0..buf_size; {|last| with trailing blanks removed}
+begin if bypass_eoln then if not eof(f) then get(f);
+ {input the first character of the line into |f^|}
+last:=first; {cf.\ Matthew 19:30}
+if eof(f) then input_ln:=false
+else begin last_nonblank:=first;
+ while not eoln(f) do
+ begin if last>=max_buf_stack then
+ begin max_buf_stack:=last+1;
+ if max_buf_stack=buf_size then
+ overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+ end;
+ buffer[last]:=xord[f@@]; get(f); incr(last);
+ if buffer[last-1]<>" " then last_nonblank:=last;
+ end;
+ last:=last_nonblank; input_ln:=true;
+ end;
+end;
+@z
+
+@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,'INTERACTIVE')
+@d t_open_out==rewrite(term_out) {open the terminal for text output}
+@z
+
+@x
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@d clear_terminal == break_in(term_in,true) {clear the terminal input buffer}
+@d wake_up_terminal == do_nothing {cancel the user's cancellation of output}
+@y
+@d update_terminal == do_nothing
+@d clear_terminal == do_nothing
+@d wake_up_terminal == do_nothing
+@z
+
+@x
+name_of_file:=pool_name; {we needn't set |name_length|}
+@y
+name_of_file:=pool_name; {we needn't set |name_length|}
+dd_name:=''; dd_member:='POOL';
+@z
+
+@x
+if not input_ln(term_in,true) then fatal_error("End of file on the terminal!");
+@y
+write_ln(term_out);
+if not input_ln(term_in,true) then fatal_error("End of file on the terminal!");
+@z
+
+@x
+interrupt:=0; OK_to_interrupt:=true;
+@y
+interrupt:=0; OK_to_interrupt:=true;
+@z
+
+@x
+@!glue_ratio=real; {one-word representation of a glue expansion factor}
+@y
+@!glue_ratio=shortreal; {are there any other reals in the program?}
+@z
+
+@x
+@d qi(#)==#+min_quarterword
+ {to put an |eight_bits| item into a quarterword}
+@d qo(#)==#-min_quarterword
+ {to take an |eight_bits| item out of a quarterword}
+@d hi(#)==#+min_halfword
+ {to put a sixteen-bit item into a halfword}
+@d ho(#)==#-min_halfword
+ {to take a sixteen-bit item from a halfword}
+@y
+@d qi(#)==#
+@d qo(#)==#
+@d hi(#)==#
+@d ho(#)==#
+@z
+
+@x
+@!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}
+@!four_choices = 1..4; {used when there are four 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}
+@!four_choices=packed 1..4; {when there are four variants in a record}
+@z
+
+@x
+@!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
+
+@x FIX ME!
+ if abs(mem[p+glue_offset].int)<@'4000000 then print("?.?")
+@y
+ if false then print("?.?")
+@z
+
+@x
+@p procedure fix_date_and_time;
+begin time:=12*60; {minutes since midnight}
+day:=4; {fourth day of the month}
+month:=7; {seventh month of the year}
+year:=1776; {Anno Domini}
+end;
+@y
+@p procedure fix_date_and_time;
+var date,tod:alfa; hour, minute:integer;
+begin datetime(date,tod);
+readstr(str(date),month:3,day:3,year);
+year:=year+1900;{Bug next century}
+readstr(str(tod),hour:3,minute); time:=hour*60+minute;
+end;
+@z
+
+@x
+@d TEX_area=="TeXinputs:"
+@y
+@d TEX_area=="TeXinput:"
+@z
+
+@x
+@p procedure pack_file_name(@!n,@!a,@!e:str_number);
+var k:integer; {number of positions filled in |name_of_file|}
+@!c: ASCII_code; {character being packed}
+@!j:pool_pointer; {index into |str_pool|}
+begin k:=0;
+@y
+@p procedure pack_file_name(@!n,@!a,@!e:str_number);
+var k:integer; {number of positions filled in |name_of_file|}
+@!c: ASCII_code; {character being packed}
+@!j:pool_pointer; {index into |str_pool|}
+begin k:=0;
+dd_name:=''; dd_member:='';
+for j:=str_start(.a.) to str_start(.a+1.)-2 do {no colon}
+ dd_name:=dd_name ccat str(xchr(.str_pool(.j.).));
+for j:=str_start(.n.) to str_start(.n+1.)-1 do
+ dd_member:=dd_member ccat str(xchr(.str_pool(.j.).));
+@z
+
+@x
+pack_job_name(".log");
+@y
+cur_area:=""; cur_ext:=".log"; cur_name:="texput";
+pack_cur_name;
+@z
+
+@x
+@ @<Open |tfm_file| for input@>=
+@y
+@ @<Open |tfm_file| for input@>=
+tfm_count:=0;
+@z
+
+%% fget==incr(tfm_count); if tfm_count=len_byte_block then new_tfm
+@x
+@d fget==get(tfm_file)
+@d fbyte==tfm_file^
+@y
+@d fbyte==tfm_file@@[tfm_count]
+@z
+
+@x
+@ Some systems may find it more efficient to make |dvi_buf| a |packed|
+array, since output of four bytes at once may be facilitated.
+@^system dependencies@>
+@y
+@ We play a trick with variant records so that we can fill up the
+|dvi_buf| array byte by byte, but write it out in one swell foop.
+@^system dependencies@>
+@d dvi_buf==d_buffer.b {buffer for \.{DVI} output}
+@z
+
+@x
+@!dvi_buf:array[dvi_index] of eight_bits; {buffer for \.{DVI} output}
+@y
+@!d_buffer: packed record
+ case boolean of
+ false:(b:packed array [dvi_index] of eight_bits);
+ true: (l:byte_block; r:byte_block);
+ end;
+@z
+
+@x
+@ The actual output of |dvi_buf[a..b]| to |dvi_file| is performed by calling
+|write_dvi(a,b)|. For best results, this procedure should be optimized to
+run as fast as possible on each particular system, since it is part of
+\TeX's inner loop. It is safe to assume that |a| and |b+1| will both be
+multiples of 4 when |write_dvi(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@>
+@^inner loop@>
+@^defecation@>
+
+@p procedure write_dvi(@!a,@!b:dvi_index);
+var k:dvi_index;
+begin for k:=a to b do write(dvi_file,dvi_buf[k]);
+end;
+@y
+@ The actual output of |dvi_buf[a..b]| to |dvi_file| is performed by calling
+|write| on the other variant of the |dvi_buf| record. Thus, we had
+better be sure things line up properly.
+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@>
+@^inner loop@>
+@^defecation@>
+
+@<Check the ``const...@>=
+if dvi_buf_size<>2*len_byte_block then bad:=223;
+@z
+
+@x
+ begin write_dvi(0,half_buf-1); dvi_limit:=half_buf;
+@y
+ begin write(dvi_file,d_buffer.l); dvi_limit:=half_buf;
+@z
+
+@x
+else begin write_dvi(half_buf,dvi_buf_size-1); dvi_limit:=dvi_buf_size;
+@y
+else begin write(dvi_file,d_buffer.r); dvi_limit:=dvi_buf_size;
+@z
+
+@x
+if dvi_limit=half_buf then write_dvi(half_buf,dvi_buf_size-1);
+if dvi_ptr>0 then write_dvi(0,dvi_ptr-1)
+@y
+if dvi_limit=half_buf then write(dvi_file,d_buffer.r);
+for k:=dvi_ptr to dvi_buf_size do dvi_buf[k]:=223; {bug is |k| ok?}
+if dvi_ptr>0 then write(dvi_file,d_buffer.l);
+if dvi_ptr>half_buf then write(dvi_file,d_buffer.r);
+@z
+
+@x
+@<Other local variables for |try_break|@>@;
+@y
+@<Other local variables for |try_break|@>@;
+
+procedure now_Print_a_symbolic_description_of_the_new_break_node; begin
+@<Print a symbolic description of the new break node@>
+end;
+
+procedure do_Print_a_symbolic_description_of_this_feasible_break; begin
+ @<Print a symbolic description of this feasible break@>;
+end;
+
+procedure Update_printed_node_for_symbolic_displays; begin
+@<Update |printed_node| for symbolic displays@>;
+end;
+@z
+
+@x
+exit: @!stat @<Update |printed_node| for symbolic displays@>@+tats@;
+@y
+exit: @!stat Update_printed_node_for_symbolic_displays @+tats@;
+@z
+
+@x
+ @<Print a symbolic description of the new break node@>;
+@y
+ now_Print_a_symbolic_description_of_the_new_break_node;
+@z
+
+@x
+ @<Print a symbolic description of this feasible break@>;
+@y
+ do_Print_a_symbolic_description_of_this_feasible_break;
+@z
+
+@x
+@d dump_wd(#)==begin fmt_file^:=#; put(fmt_file);@+end
+@d dump_int(#)==begin fmt_file^.int:=#; put(fmt_file);@+end
+@d dump_hh(#)==begin fmt_file^.hh:=#; put(fmt_file);@+end
+@d dump_qqqq(#)==begin fmt_file^.qqqq:=#; put(fmt_file);@+end
+
+@<Glob...@>=
+@y
+@d fmt_word==fmt_file@@[fmt_count]
+
+@d dump_wd(#)==begin fmt_word:=#; put_fmt;@+end
+@d dump_int(#)==begin fmt_word.int:=#; put_fmt;@+end
+@d dump_hh(#)==begin fmt_word.hh:=#; put_fmt;@+end
+@d dump_qqqq(#)==begin fmt_word.qqqq:=#; put_fmt;@+end
+
+@<Glob...@>=
+@!fmt_count:integer;
+@z
+
+@x
+@d undump_wd(#)==begin get(fmt_file); #:=fmt_file^;@+end
+@d undump_int(#)==begin get(fmt_file); #:=fmt_file^.int;@+end
+@d undump_hh(#)==begin get(fmt_file); #:=fmt_file^.hh;@+end
+@d undump_qqqq(#)==begin get(fmt_file); #:=fmt_file^.qqqq;@+end
+@y
+@d undump_wd(#)==begin get_fmt; #:=fmt_word;@+end
+@d undump_int(#)==begin get_fmt; #:=fmt_word.int;@+end
+@d undump_hh(#)==begin get_fmt; #:=fmt_word.hh;@+end
+@d undump_qqqq(#)==begin get_fmt; #:=fmt_word.qqqq;@+end
+@z
+
+@x
+@<Dump constants for consistency check@>=
+@y
+@<Dump constants for consistency check@>=
+fmt_count:=0;
+@z;
+
+@x
+x:=fmt_file^.int;
+@y
+fmt_count:=0;
+x:=fmt_word.int;
+@z
+
+@x
+dump_int(interaction); dump_int(format_ident); dump_int(69069);
+@y
+dump_int(interaction); dump_int(format_ident); dump_int(69069);
+while fmt_count<>0 do dump_int(0); {flush out the buffer}
+@z
+
+@x
+ wterm('Ouch---my internal constants have been',
+ ' clobbered!---case ',bad:1);
+@y
+ wterm('Ouch---my internal constants have been',
+ ' clobbered!---case ',bad:1);
+ ret_code(100+bad);
+@z
+
+@x
+final_end: ready_already:=0;
+@y
+ret_code(history*4);
+final_end:
+@z
+
+@x
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \TeX\ work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the published program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@y
+@ @<Glob...@>=
+@!tfm_count:integer;
+@!status: boolean; {did the last |reset| or |rewrite| succede?}
+
+@ @<VM/CMS...@>=
+procedure okstatus; begin status:=true; end;
+@\@=%INCLUDE ONERROR;@>@\
+procedure onerror; begin
+{write_ln(term_out,'GOT ERROR ',FERROR:1);}
+if FERROR in [41,48] then begin
+ status:=false;FACTION:=(..); end;
+if FERROR=30 then interrupt:=1;
+end;
+
+procedure fget; begin
+ incr(tfm_count);
+ if tfm_count=len_byte_block then begin
+ get(tfm_file); tfm_count:=0;
+ end;
+ end;
+
+procedure put_fmt; begin
+ incr(fmt_count);
+ if fmt_count=len_word_block then
+ begin put(fmt_file); fmt_count:=0; end;
+ end;
+
+
+procedure get_fmt; begin
+ incr(fmt_count);
+ if fmt_count=len_word_block then begin
+ get(fmt_file); fmt_count:=0;
+ end;
+ end;
+
+@ @<Glob...@>=
+dd_name: string(256);
+dd_member: string(256);
+parmstring: string(256);
+@z
diff --git a/obsolete/systems/knuth/unsupported/tex/tex.tops10-changes b/obsolete/systems/knuth/unsupported/tex/tex.tops10-changes
new file mode 100644
index 0000000000..d658ad752a
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/tex/tex.tops10-changes
@@ -0,0 +1,1034 @@
+(c) Copyright 1983, 1984 by Charles Karney and Phil Andrews
+This is the changes file produced by Phil Andrews and Charles Karney
+for TeX, based on the one for Tops-20 by DRF
+
+When compiling for INITEX, it is necessary to reduce the following constants:
+ mem_max=58000 to mem_max=45000
+ string_vacancies=15000 to string_vacancies=13000
+ pool_size=40000 to pool_size=37000
+
+Here is a description of the changes
+ Print banner line
+ Initialization procedure
+ Compile time constants
+ Make all characters readable
+ File opening and closing
+ File input
+ Open TTY
+ Implement wake_up_terminal
+ Initialize terminal
+ Enter editing hooks
+ 36-bit words; quarter and half words start at zero
+ Date and time
+ Establish system areas and parse file names
+ Type out CPU time & run editor
+
+Besides implementing the various system dependent parts of TeX, this
+implements the following features
+
+(1) All control characters (except null) in files are read
+(2) Command line is scanned and remembered
+(3) CPU time is printed at the end of the run
+(4) The E option for the editor
+(5) Finds system PPNs from logical names
+
+Record of changes (started a bit late)
+83/02/19 Reads all control characters
+ Scans command line
+83/03/23 Remembers command line
+83/03/26 Updated for 0.96 (hi, ho, pool_size)
+ Print out CPU time
+83/03/28 Removed sensitive debug, stats, compile time constants,
+ bad_fonts_code; increased save_size (to match TEX.WEB)
+83/03/29 Changed some directories to aid in porting versions
+83/04/04 Changed PPPL to MFE in Banner
+ Introduced first hooks for calling editor
+ Changed input_ln so that form_feed acts as end-of-line
+ (needed for consistency with FINE)
+83/04/08 Cleaned up editing stuff
+83/04/13 Moved fonts to [120,44,TFM]
+83/04/14 Made INITEX set the system PPNs from logical names
+ (still need to do it for formats)
+83/04/19 Updated for TeX 0.97
+ wake_up_terminal implemented
+83/04/20 Use normal TTY for output (fixes 'Improper mode for file
+ TTY:TTY' bug with detached jobs)
+83/05/01 Use TMP:TEX instead of nnnTEX.TMP, since DELETE no longer
+ works with the new COMPIL.
+83/07/07 Updated for TeX 0.99 and TANGLE 1.7
+83/07/29 Updated for TeX 0.999.
+83/08/02 Updated for TeX 0.9999.
+83/08/03 Allowed fonts names of greater than 6 chars by take first 3
+ and last 3 characters.
+83/08/18 Finish jump-to-editor.
+83/08/22 Support devices in file names. Changed TEX.POO and PLAIN.FMT
+ to be on TEXFMT:. (TEX_area and TEX_font_area can be switched
+ to logical device names when they are eslablished at the system
+ level).
+83/09/09 Change all devices to TeX:
+83/09/31 Remove DISPOSE---not worth the overhead.
+83/11/29 Updated for TeX 1.0. Remove change for line length (since
+ FINE now handles 79 char lines on a 80 wide terminal). Change
+ MFE to TOPS-10 in banner.
+84/01/05 Increased various limits for LaTeX. Values taken from Tops-20
+ change file.
+84/01/14 Changed TEX to LATEX in set_up_editing. Added copyright notice.
+84/04/12 Change set_up_editing to read program name at run-time.
+ Print banner line
+
+@x
+@d banner=='This is TeX, Version 1.0' {printed when \TeX\ starts}
+@y
+@d banner=='This is TeX82, TOPS-10 Version 1.0' {printed when \TeX\ starts}
+@z
+ Initialization procedure
+
+@x
+@d init== {change this to `$\\{init}\equiv\.{@@\{}$' in the production version}
+@d tini== {change this to `$\\{tini}\equiv\.{@@\}}$' in the production version}
+@y CHANGE FOR INITEX
+@d init==@{ {change this to `$\\{init}\eqv\.{@@\{}$' in the production version}
+@d tini==@} {change this to `$\\{tini}\eqv\.{@@\}}$' in the production version}
+@z
+
+ Compile-time constants
+
+@x [1] Compile-time constants:
+@!mem_max=30000; {greatest index in \TeX's internal |mem| array,
+ must be strictly less than |max_halfword|}
+@!buf_size=500; {maximum number of characters simultaneously present in
+ current lines of open files and in control sequences between
+ \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|}
+@!error_line=72; {width of context lines on terminal error messages}
+@!half_error_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}
+@!stack_size=200; {maximum number of simultaneous input sources}
+@!max_in_open=6; {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@!font_max=75; {maximum internal font number, must not exceed |max_quarterword|
+ and must be at most |font_base+256|}
+@!font_mem_size=20000; {number of words of |font_info| for all fonts}
+@!param_size=60; {maximum number of simultaneous macro parameters}
+@!nest_size=40; {maximum number of semantic levels simultaneously active}
+@!max_strings=3000; {maximum number of strings; must not exceed |max_halfword|}
+@!string_vacancies=8000; {the minimum number of characters that should be
+ available for the user's control sequences and font names,
+ after \TeX's own error messages are stored}
+@!pool_size=32000; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all fonts and
+ control sequences; must exceed |string_vacancies| by the total
+ length of \TeX's own strings, which is currently about 23000}
+@!save_size=600; {space for saving values outside of current group, must be
+ at most |max_halfword|}
+@!trie_size=8000; {space for hyphenation patterns, should be larger for
+ \.{INITEX} than it is in production versions of \TeX}
+@!dvi_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='TeXformats:TEX.POOL ';
+ {string of length |file_name_size|, tells where the string pool appears}
+@y CHANGE FOR INITEX
+@!mem_max=58000; {greatest index in \TeX's internal |mem| array,
+ must be strictly less than |max_halfword|}
+@!buf_size=500; {maximum number of characters simultaneously present in
+ current lines of open files and in control sequences between
+ \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|}
+@!error_line=79; {width of context lines on terminal error messages}
+@!half_error_line=50; {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}
+@!stack_size=200; {maximum number of simultaneous input sources}
+@!max_in_open=6; {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@!font_max=100;
+ {maximum internal font number, must not exceed |max_quarterword|}
+@!font_mem_size=25000; {number of words of |font_info| for all fonts}
+@!param_size=60; {maximum number of simultaneous macro parameters}
+@!nest_size=40; {maximum number of semantic levels simultaneously active}
+@!max_strings=4400; {maximum number of strings}
+@!string_vacancies=15000; {the minimum number of characters that should be
+ available for the user's control sequences and font names,
+ after \TeX's own error messages are stored}
+@!pool_size=40000; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all fonts and
+ control sequences; must exceed |string_vacancies| by the total
+ length of \TeX's own strings, which is currently about 23000}
+@!save_size=600; {space for saving values outside of current group, must be
+ at most |max_halfword|}
+@!trie_size=8000; {space for hyphenation patterns, should be larger for
+ \.{INITEX} than it is in production versions of \TeX}
+@!dvi_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='TeX:TEX.POO ';
+ {string of length |file_name_size|, where string pool appears}
+@z
+
+@x [1] TANGLE-time constants:
+@d mem_base=0 {smallest index in the |mem| array, must not be less
+ than |min_halfword|}
+@d hi_mem_base=13000 {smallest index in the single-word area of |mem|,
+ must be substantially larger than |mem_base| and smaller than |mem_max|}
+@d font_base=0 {smallest internal font number, must not be less
+ than |min_quarterword|}
+@d hash_size=2100 {maximum number of control sequences; it should be at most
+ about |(mem_max-hi_mem_base)/6|, but 2100 is already quite generous}
+@d hash_prime=1777 {a prime number equal to about 85\% of |hash_size|}
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@y
+@d mem_base=0 {smallest index in the |mem| array, must not be less
+ than |min_halfword|}
+@d hi_mem_base=25000 {smallest index in the single-word area of |mem|,
+ must be substantially larger than |mem_base| and smaller than |mem_max|}
+@d font_base=0 {smallest internal font number, must not be less
+ than |min_quarterword|}
+@d hash_size=2500 {maximum number of control sequences; it should be at most
+ about |(mem_max-hi_mem_base)/6|, but 2500 is already quite generous}
+@d hash_prime=2129 {a prime number equal to about 85\% of |hash_size|}
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@z
+
+ Make all characters readable.
+
+@x
+for i:=1 to @'37 do xchr[i]:=' ';
+@y
+for i:=1 to @'37 do xchr[i]:=chr(i);
+@z
+ File opening and closing
+
+@x
+@d reset_OK(#)==erstat(#)=0
+@y
+@d reset_OK(#)==(erstat(#)=0) or (erstat(#)=@'20000) {empty file}
+@z
+
+@x
+@p function a_open_in(var f:alpha_file):boolean;
+ {open a text file for input}
+begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f);
+@y
+@p function erstat(var f:file):integer; extern; {in the runtime library}
+function a_open_in(var f:alpha_file):boolean;
+ {open a text file for input}
+begin reset(f,name_of_file,'/O/E'); a_open_in:=reset_OK(f);
+{/E turns off end-of-line censor}
+@z
+
+@x
+function b_open_in(var f:byte_file):boolean;
+ {open a binary file for input}
+begin reset(f,name_of_file,'/O'); b_open_in:=reset_OK(f);
+@y
+function b_open_in(var f:byte_file):boolean;
+ {open a binary file for input}
+begin reset(f,name_of_file,'/O/B:8'); b_open_in:=reset_OK(f);
+@z
+
+@x
+function b_open_out(var f:byte_file):boolean;
+ {open a binary file for output}
+begin rewrite(f,name_of_file,'/O'); b_open_out:=rewrite_OK(f);
+@y
+function b_open_out(var f:byte_file):boolean;
+ {open a binary file for output}
+begin rewrite(f,name_of_file,'/O/B:8'); b_open_out:=rewrite_OK(f);
+@z
+ File input
+
+@x
+@ Input from text files is read one line at a time, using a routine called
+|input_ln|. This function is defined in terms of global variables called
+|buffer|, |first|, and |last| that will be described in detail later; for
+now, it suffices for us to know that |buffer| is an array of |ASCII_code|
+values, and that |first| and |last| are indices into this array
+representing the beginning and ending of a line of text.
+
+@<Glob...@>=
+@!buffer:array[0..buf_size] of ASCII_code; {lines of characters being read}
+@!first:0..buf_size; {the first unused position in |buffer|}
+@!last:0..buf_size; {end of the line just input to |buffer|}
+@!max_buf_stack:0..buf_size; {largest index used in |buffer|}
+@y
+@ Input from text files is read one line at a time, using a routine called
+|input_ln|. This function is defined in terms of global variables called
+|buffer|, |first|, and |last| that will be described in detail later; for
+now, it suffices for us to know that |buffer| is an array of |ASCII_code|
+values, and that |first| and |last| are indices into this array
+representing the beginning and ending of a line of text.
+
+We will read the lines first into an auxiliary buffer, in order to
+save the running time of procedure-call overhead.
+@^Knuth, Donald Ervin@>
+@d line_feed=@'12 {ASCII code for line feed}
+@d form_feed=@'14 {ditto for form feed}
+@d ASCII_space=@'40 {ditto for space}
+@d aux_buf_size=80
+
+@<Glob...@>=
+@!buffer:array[0..buf_size] of ASCII_code; {lines of characters being read}
+@!first:0..buf_size; {the first unused position in |buffer|}
+@!last:0..buf_size; {end of the line just input to |buffer|}
+@!max_buf_stack:0..buf_size; {largest index used in |buffer|}
+@!aux_buf:array[0..aux_buf_size-1] of text_char; {where the characters go
+ first}
+@!cpu_time:nonnegative_integer; {cumulative runtime in ms}
+@z
+
+@x
+@p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean;
+ {inputs the next line or returns |false|}
+var last_nonblank:0..buf_size; {|last| with trailing blanks removed}
+begin if bypass_eoln then if not eof(f) then get(f);
+ {input the first character of the line into |f^|}
+last:=first; {cf.\ Matthew 19:30}
+if eof(f) then input_ln:=false
+else begin last_nonblank:=first;
+ while not eoln(f) do
+ begin if last>=max_buf_stack then
+ begin max_buf_stack:=last+1;
+ if max_buf_stack=buf_size then
+ overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+ end;
+ buffer[last]:=xord[f^]; get(f); incr(last);
+ if buffer[last-1]<>" " then last_nonblank:=last;
+ end;
+ last:=last_nonblank; input_ln:=true;
+ end;
+end;
+@y
+@p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean;
+ {inputs the next line or returns |false|}
+label 1,2,3;
+var n: integer; @!full,@!fake_eol,@!form_eol:boolean;
+@!k,@!m: 0..buf_size; {indices into |buffer|}
+begin if bypass_eoln then {input the first character of the line into |f^|}
+ begin if not eof(f) then get(f);
+ if not eof(f) then if f^=chr(line_feed) then get(f);
+ {skip past a |line_feed|}
+ end;
+last:=first;
+if eof(f) then input_ln:=false
+else begin
+1: full:=false; fake_eol:=false; form_eol:=false;
+ read(f,aux_buf:n);
+2: if (n>aux_buf_size) then begin n:=n-1; full:=true end;
+ {aux_buf overflowed}
+ if last+n>max_buf_stack then
+ if last+n>=buf_size then
+ begin max_buf_stack:=buf_size;
+ overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+ end
+ else max_buf_stack:=last+n;
+ if n>0 then
+ begin m:=last;
+ last:=m+n;
+ for k:=m to last-1 do buffer[k]:=xord[aux_buf[k-m]];
+ if full then {there's more on this line} goto 1;
+ end;
+ if form_eol then goto 3; {simulate new line with formfeed}
+ if fake_eol then goto 1;
+ if (f^<>chr(carriage_return)) and (f^<>chr(ASCII_space)) then
+ {only allow carriage_return or space (for TTY) as end-of-line}
+ begin aux_buf[0]:=f^; n:=1;
+ if f^=chr(form_feed) then form_eol:=true else
+ begin get(f); fake_eol:=true end;
+ goto 2 end;
+ while last>first do if buffer[last-1]<>" " then goto 3
+ else decr(last);
+3: input_ln:=true;
+ end;
+end;
+@z
+
+ Open TTY
+
+@x
+@ The user's terminal acts essentially like other files of text, except
+that it is used both for input and for output. When the terminal is
+considered an input file, the file variable is called |term_in|, and when it
+is considered an output file the file variable is |term_out|.
+@^system dependencies@>
+
+@<Glob...@>=
+@!term_in:alpha_file; {the terminal as an input file}
+@!term_out:alpha_file; {the terminal as an output file}
+@y
+@ The user's terminal acts essentially like other files of text, except
+that it is used both for input and for output. When the terminal is
+considered an input file, the file variable is called |term_in|, and when it
+is considered an output file the file variable is |term_out|.
+Here, we use the built-in |TTY| file for output, but open a file
+explicitly for input. On input this allows ^Z to be used as an
+end-of-file character. If a file is explicity opened for terminal
+output, then the output happens even when the \TeX82 is |CCONT|ed.
+If the job is then detached, you get an `Improper mode' error.
+@^system dependencies@>
+
+@d term_out==TTY {the terminal as an output file}
+
+@<Glob...@>=
+@!term_in:alpha_file; {the terminal as an input file}
+@z
+
+@x
+@d t_open_out==rewrite(term_out,'TTY:','/O') {open the terminal for text output}
+@y
+@d t_open_out==do_nothing {open the terminal for text output}
+@z
+
+ Implement wake_up_terminal and call_fine
+
+@x
+@d wake_up_terminal == do_nothing {cancel the user's cancellation of output}
+@y
+@d wake_up_terminal == undo_ctrl_O {cancel the user's cancellation of output}
+
+@p procedure undo_ctrl_O;
+var val:integer; arg:array[0..2] of integer; success:boolean;
+begin
+calli(@'115,,-1,val,success);{TRMNO gets UDX code for 0=this terminal}
+if (val<>0) then begin {0 is returned for detached jobs}
+ arg[0]:=@'2045; {.TOOSU=1045+.TOSET=1000 sets the ^O state}
+ arg[1]:=val; {UDX code}
+ arg[2]:=0; {0 means output switched on}
+ {TRMOP does the action, 3 is the number of arguments}
+ calli(@'116,3,arg,val,success)
+end
+end;
+
+procedure call_fine; {procedure to call the editor FINE on exit}
+mtype name_type = (dev, fil_name, ext, dummy, ppn_no, core);
+pack6 = packed array[1..6] of char;
+var val: integer; skipp : boolean;
+run_name : array[name_type] of integer;
+
+function conv_six_bit(line_in : pack6):integer;
+mtype
+six_bit = 0..63;
+word = record case boolean of
+ true : ( line : packed array[1..6] of six_bit;);
+ false : ( int : integer;);
+end;
+var temp : word;
+i :integer;
+begin
+ for i := 1 to 6 do temp.line[i] := ord(line_in[i]) - @'40;
+ conv_six_bit := temp.int;
+end;
+begin
+ run_name[dev] := conv_six_bit('SYS ');
+ run_name[fil_name] := conv_six_bit('FINE ');
+ run_name[ext] := conv_six_bit('EXE ');
+ run_name[dummy] := 0;
+ run_name[ppn_no] := 0;
+ run_name[core] := 0;
+ calli(@'35, 1, run_name, val, skipp);
+end;
+@z
+
+ Initialize terminal
+
+@x
+@ The following program does the required initialization
+without retrieving a possible command line.
+It should be clear how to modify this routine to deal with command lines,
+if the system permits them.
+@^system dependencies@>
+
+@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;
+@.**@>
+ if not input_ln(term_in,true) then {this shouldn't happen}
+ begin write_ln(term_out);
+ write(term_out,'! End of file on the terminal... why?');
+@.End of file on the terminal@>
+ init_terminal:=false; return;
+ end;
+ loc:=first;
+ while (loc<last)and(buffer[loc]=" ") do incr(loc);
+ if loc<last then
+ begin init_terminal:=true;
+ return; {return unless the line was all blank}
+ end;
+ write_ln(term_out,'Please type the name of your input file.');
+ end;
+exit:end;
+@y
+@ The following program does the required initialization
+retrieves a possible command line using rescan or remembers
+the comand line. The way this is done is:
+
+(a) Rescan command line. (Two variants are considered: (1) .TEX PAPER
+and (2) .R TEX;PAPER. The first line then consists of everything after
+the "TEX " or "R TEX;".)
+
+(b) If the rescanning finds something it is put in the file TMP:TEX.
+An exception is if the line just consists of "\". In that case
+TMP:TEX is deleted. (This allows TEX to forget the remembered command
+line.)
+
+(c) If no command line is found and if TMP:TEX contains something,
+then TMP:TEX is used.
+
+(d) Otherwise prompt for input from the terminal.
+
+@^system dependencies@>
+
+@p function rescan:boolean; extern; @t\2@>@;
+ {puts the command line into the terminal buffer,
+ or returns |false| if there was no command line}
+@#
+function init_terminal:boolean; {gets the terminal files started}
+mtype
+@!lin=record blank:integer; txt:packed array[0..aux_buf_size-1] of char end;
+@!args=packed record nam:halfword;blank:halfword;
+ len:halfword;ptr:^lin end;
+var @!xblock:args;@!lina:^lin;
+@!val,i,j:integer;
+@!success:boolean;
+@!delim_char:char;
+@#
+procedure init_tmp_cor;
+begin
+new(lina);
+xblock.nam:=@'644570; {SIXBIT /TEX/}
+xblock.blank:=0; {zero out rest of word}
+xblock.ptr:=lina; {pointer to word before text}
+end;
+@#
+function read_tmp_file:boolean;
+begin
+val:=aux_buf_size div 5;
+xblock.len:=@'1000000-val;
+calli(@'44,1,xblock,val,success); {TMPCOR call, 1 => read}
+if val=0 then success:=false;
+if success then begin
+ j:=5*val; {number of characters in file}
+ loc:=first;
+ last:=first+j;
+ for i:=0 to j-1 do buffer[loc+i]:=ord(xblock.ptr^.txt[i]);
+end;
+read_tmp_file:=success;
+end;
+@#
+procedure write_tmp_file;
+begin
+j:=last-loc;
+if j>aux_buf_size then j:=aux_buf_size;
+for i:=0 to j-1 do xblock.ptr^.txt[i]:=chr(buffer[loc+i]);
+val:=(j+4) div 5;
+for i:=j to 5*val-1 do xblock.ptr^.txt[i]:=' ';{pad to end of word}
+xblock.len:=@'1000000-val; {-length in words}
+if val<>0 then {if empty, delete file}
+ calli(@'44,3,xblock,val,success) {TMPCOR call, 3 => write}
+else
+ calli(@'44,2,xblock,val,success); {TMPCOR call, 2 => delete}
+end;
+@#
+function read_jcl:boolean;
+begin
+read_jcl:=false;
+debug if false then@;@+gubed@;@/
+if rescan then begin
+loc:=first;
+last:=first;
+read_ln(term_in); {get first character into |term_in^|}
+while (not eoln(term_in)) and (term_in^=' ') do get(term_in);
+ {skip leading spaces}
+if ((term_in^='R') or (term_in^='r')) then delim_char:=';'
+ else delim_char:=' ';
+while (not eoln(term_in)) and (term_in^<>delim_char) do
+ get(term_in); {skip TEX or R TEX}
+if not eoln(term_in) then get(term_in); {skip delim_char}
+while not eoln(term_in) do begin
+ buffer[last]:=xord[term_in^];
+ incr(last); get(term_in)
+end;
+end;
+while (loc<last) and (buffer[loc]=" ") do incr(loc); {skip spaces}
+if (loc=last-1) and (buffer[loc]="\") then begin
+last:=loc; write_tmp_file {a lone \ causes temp file to be forgotten}
+end;
+if loc<last then begin write_tmp_file; read_jcl:=true end
+end;
+@#
+procedure read_first_line;
+label exit;
+begin
+loop@+ begin
+ wake_up_terminal; write(term_out,'**'); update_terminal;
+@.**@>
+ if not input_ln(term_in,true) then {this shouldn't happen}
+ begin write_ln(term_out);
+ write(term_out,'! End of file on the terminal... why?');
+@.End of file on the terminal@>
+ init_terminal:=false; return;
+ end;
+ loc:=first;
+ while (loc<last)and(buffer[loc]=" ") do incr(loc);
+ if loc<last then return; {return unless the line was all blank}
+ write_ln(term_out,'Please type the name of your input file.');
+ end;
+exit:end;
+@#
+begin
+cpu_time:=runtime;
+t_open_in;
+init_tmp_cor;
+init_terminal:=true;
+if not read_jcl then if not read_tmp_file then read_first_line;
+end;
+@z
+
+ Enter editing hooks
+
+@x
+@!error_count:-1..100; {the number of scrolled errors since the
+ last paragraph ended}
+@y
+@!error_count:-1..100; {the number of scrolled errors since the
+ last paragraph ended}
+@!run_editor:boolean; {should the editor be run on exiting?}
+@z
+
+@x
+deletions_allowed:=true; error_count:=0; {|history| is initialized elsewhere}
+@y
+deletions_allowed:=true; error_count:=0; {|history| is initialized elsewhere}
+run_editor:=false;
+@z
+
+@x
+@<Error hand...@>=
+procedure jump_out;
+begin goto end_of_TEX;
+end;
+@y
+The procedure |set_up_editing|, writes out a TMP: file for FINE to
+read. This causes FINE to read in the file to be edited and the
+position the cursor at the right line. It will also cause FINE to run TEX
+when exited.
+
+@<Error hand...@>=
+procedure jump_out;
+begin goto end_of_TEX;
+end;
+@#
+{Declare this here for use by error procedures}
+procedure undo_ctrl_O; forward;
+@#
+procedure set_up_editing;
+const
+this_buf_size = 150;
+mtype
+halfword = 0..@'777777;
+lin=record blank:integer; txt:packed array[0..this_buf_size] of char end;
+args=packed record nam:halfword;blank:halfword;
+ len:halfword;ptr:^lin end;
+var xblock:args;lina:^lin;
+
+procedure init_commands;
+begin
+ new(lina);
+ xblock.nam:= @'454464; {SIXBIT /EDT/}
+ xblock.blank:=0; {zero out rest of word}
+ xblock.ptr:=lina; {pointer to word before text}
+end;
+
+procedure write_commands;
+const ctrl_u = @'25; ctrl_n = @'16; esc = @'33;
+mtype
+six_bit = 0..63;
+word = record case boolean of
+ true : ( line : packed array[1..6] of six_bit;);
+ false : ( int : integer;);
+end;
+var success : boolean; i, s, val : integer;
+dummy : file of char; j:pool_pointer; temp : word;
+begin
+ strwrite(dummy, xblock.ptr^.txt); {fake file}
+ write(dummy, 's'); {precursor to file name}
+ s:=input_stack[base_ptr].name_field;
+ for j:=str_start[s] to str_start[s+1]-1 do
+ write(dummy,xchr[str_pool[j]]); {file name}
+ write(dummy, chr(@'15), chr(@'12));
+ calli(@'41,-1,3,temp.int,success); {GETTAB call to read program name}
+ for i:=1 to 6 do if (temp.line[i]>0)
+ then write(dummy, chr(@'40+temp.line[i]));
+ write(dummy, '!',chr(@'15), chr(@'12)); {run tex on exit from fine}
+ write(dummy, chr(esc), '<', chr(ctrl_u), (line-1):1,
+ chr(ctrl_n), chr(0)); { go down line-1 lines }
+ getindex(dummy, i);
+ xblock.len:=@'1000000-((i+4) div 5); {-length in words}
+ calli(@'44,3,xblock,val,success) {TMPCOR call, 3 => write}
+end;
+
+begin
+ init_commands;
+ write_commands;
+ run_editor:=true;
+end;
+@z
+
+@x
+@ It is desirable to provide an `\.E' option here that gives the user
+an easy way to return from \TeX\ to the system editor, with the offending
+line ready to be edited. But such an extension requires some system
+wizardry, so the present implementation simply types out what file should be
+edited and the relevant line number.
+@y
+@ It is desirable to provide an `\.E' option here that gives the user
+an easy way to return from \TeX\ to the system editor, with the offending
+line ready to be edited. What we do here is write a TMP: file which will
+be read by FINE when we call with an offset of 1 on leaving \TeX.
+FINE will then read in the source file and position the cursor at the
+correct line. Note that on leaving FINE \TeX\ will be run automatically.
+@z
+
+@x
+ begin print_nl("You want to edit file ");
+@.You want to edit file x@>
+ print(input_stack[base_ptr].name_field);
+ print(" at line "); print_int(line);
+ interaction:=scroll_mode; jump_out;
+@y
+ begin print_nl("Calling FINE to edit file ");
+@.You want to edit file x@>
+ print(input_stack[base_ptr].name_field);
+ print(" at line "); print_int(line);
+ interaction:=scroll_mode; set_up_editing; jump_out;
+@z
+
+@x
+if base_ptr>0 then print("E to edit your file,");
+@y
+if base_ptr>0 then print("E to edit your file using FINE,");
+@z
+
+ 36-bit words; quarter and half words start at zero
+
+@x
+It is usually most efficient to have |min_quarterword=min_halfword=0|,
+so one should try to achieve this unless it causes a severe problem.
+The values defined here are recommended for most 32-bit computers.
+
+@d min_quarterword=0 {smallest allowable value in a |quarterword|}
+@d max_quarterword=255 {largest allowable value in a |quarterword|}
+@d min_halfword==0 {smallest allowable value in a |halfword|}
+@d max_halfword==65535 {largest allowable value in a |halfword|}
+@y
+It is usually most efficient to have |min_quarterword=min_halfword=0|,
+so one should try to achieve this unless it causes a severe problem.
+The values defined here are recommended for most 36-bit computers.
+
+@d min_quarterword=0 {smallest allowable value in a |quarterword|}
+@d max_quarterword=511 {largest allowable value in a |quarterword|}
+@d min_halfword==0 {smallest allowable value in a |halfword|}
+@d max_halfword==262143 {largest allowable value in a |halfword|}
+@z
+
+@x
+@d qi(#)==#+min_quarterword
+ {to put an |eight_bits| item into a quarterword}
+@d qo(#)==#-min_quarterword
+ {to take an |eight_bits| item out of a quarterword}
+@d hi(#)==#+min_halfword
+ {to put a sixteen-bit item into a halfword}
+@d ho(#)==#-min_halfword
+ {to take a sixteen-bit item from a halfword}
+@y
+@d qi(#)==# {to put an |eight_bits| item into a quarterword}
+@d qo(#)==# {to take an |eight_bits| item from a quarterword}
+@d hi(#)==# {to put a sixteen-bit item into a halfword}
+@d ho(#)==# {to take a sixteen-bit item from a halfword}
+@z
+
+ Date and time
+
+@x
+Since standard \PASCAL\ cannot provide such information, something special
+is needed. The program here simply specifies July 4, 1776, at noon; but
+users probably want a better approximation to the truth.
+
+@p procedure fix_date_and_time;
+begin time:=12*60; {minutes since midnight}
+day:=4; {fourth day of the month}
+month:=7; {seventh month of the year}
+year:=1776; {Anno Domini}
+end;
+@y
+@d ptime==t@&i@&m@&e
+@p procedure do_date(var min_since_midnite:integer);
+{
+ DATE result is a PACKED ARRAY [1..9] OF CHAR. The date
+ is returned in the form 'DD-Mmm-YY'.
+ Here we use CALLI 14,ac. This means we don't have to decode the Mmm.
+ TIME current time in msec (type integer)
+ }
+var success:boolean; date_code : integer;
+begin
+ calli(@'14,0,0,date_code,success);
+ { returns 31*(12*(year-1964)+(month-1))+(day-1) in date_code }
+ day := (date_code mod 31)+1;
+ month := ((date_code div 31) mod 12)+1;
+ year := (date_code div (31*12))+1964;
+ min_since_midnite := ptime div (1000*60);
+ end;
+procedure fix_date_and_time;
+begin
+do_date(time);
+end;
+@z
+
+ Establish system areas and parse file names
+
+@x
+@ The file names we shall deal with have the following structure:
+If the name contains `\.>' or `\.:', the file area consists of all characters
+up to and including the final such character; otherwise the file area is null.
+If the remaining file name contains `\..', the file extension consists of all
+such characters from the first `\..' to the end, otherwise the file extension
+is null.
+@^system dependencies@>
+
+We can scan such file names easily by using two global variables that keep track
+of the occurrences of area and extension delimiters:
+
+@<Glob...@>=
+@!area_delimiter:pool_pointer; {the most recent `\.>' or `\.:', if any}
+@!ext_delimiter:pool_pointer; {the relevant `\..', if any}
+@y
+@ The file names we shall deal with have the following structure:
+If the name contains `\.:' or `\.[', the file area consists of all
+characters before and including the `\.:' concatenated with everything
+beyond (and including) the `.['. If the remaining file name contains
+`\..', the file extension consists of all such characters from this
+character to the @\.[' or end, otherwise the file extension
+is null. We can assume that there is at most one of each of \.:', `\.['
+and `\..'.
+
+This is all compliciated by the presence of device and PPN specifications
+at opposite ends of the file names. The trick is to combine them together
+for internal TeX consumption, and split them apart in |print_file_name| and
+|pack_file_name|.
+
+We can scan such file names easily by using three global variables that keep
+track of the occurrences of area and extension delimiters:
+
+@d file_buf_size=40
+
+@<Global...@>=
+@!dev_delimiter:-1..file_buf_size; {the most recent `\.:', if any}
+@!area_delimiter:-1..file_buf_size; {the most recent `\.[', if any}
+@!ext_delimiter:-1..file_buf_size; {the relevant `\..', if any}
+@!file_buf:packed array[0..file_buf_size-1] of 0..127; {where the file names
+ first}
+@!file_index:0..file_buf_size; {index into file_buf}
+@^system dependencies@>
+@z
+
+@x
+@d TEX_area=="TeXinputs:"
+@.TeXinputs@>
+@d TEX_font_area=="TeXfonts:"
+@.TeXfonts@>
+@y
+@d TEX_area=="TeX:"
+@.TeXinputs@>
+@d TEX_font_area=="TeX:[,,TFM]"
+@.TeXfonts@>
+@z
+
+@x
+@p procedure begin_name;
+begin area_delimiter:=0; ext_delimiter:=0;
+end;
+
+@ And here's the second.
+@^system dependencies@>
+
+@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;
+
+@ The third.
+@^system dependencies@>
+
+@p procedure end_name;
+begin if str_ptr+3>max_strings then
+ overflow("number of strings",max_strings-init_str_ptr);
+@:TeX capacity exceeded number of strings}{\quad number of strings@>
+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
+@p procedure begin_name;
+begin
+ dev_delimiter:=-1;
+ area_delimiter:=-1;
+ ext_delimiter:=-1;
+ file_index:=0
+end;
+
+@ And here's the second.
+@^system dependencies@>
+
+@p function more_name(@!c:ASCII_code):boolean;
+begin if (c<=" ") or (c>"~") or (file_index=file_buf_size) then
+ more_name:=false
+else
+ begin if (c=":") and (ext_delimiter<0) and (area_delimiter<0)
+ then dev_delimiter:=file_index
+ else if (c=".") and (area_delimiter<0) then ext_delimiter:=file_index
+ else if (c="[") then area_delimiter:=file_index;
+ file_buf[file_index]:=c; incr(file_index);
+ more_name:=true;
+ end;
+end;
+
+@ The third.
+@^system dependencies@>
+
+@p procedure end_name;
+var j:0..file_buf_size-1;
+begin if str_ptr+3>max_strings then
+ overflow("number of strings",max_strings-init_str_ptr);
+@:TeX capacity exceeded number of strings}{\quad number of strings@>
+if (area_delimiter<0) and (dev_delimiter<0) then cur_area:=""
+else begin if dev_delimiter>=0 then begin
+ str_room(dev_delimiter+1);
+ for j:=0 to dev_delimiter do append_char(file_buf[j]) end;
+ if area_delimiter>=0 then begin
+ str_room(file_index-area_delimiter);
+ for j:=area_delimiter to file_index-1 do append_char(file_buf[j]) end;
+ cur_area:=make_string
+end;
+if area_delimiter<0 then area_delimiter:=file_index;
+if (ext_delimiter<0) then
+ begin cur_ext:=""; ext_delimiter:=area_delimiter end
+else begin
+ str_room(area_delimiter-ext_delimiter);
+ for j:=ext_delimiter to area_delimiter-1 do append_char(file_buf[j]);
+ cur_ext:=make_string
+end;
+str_room(ext_delimiter-dev_delimiter-1);
+for j:=dev_delimiter+1 to ext_delimiter-1 do append_char(file_buf[j]);
+cur_name:=make_string
+end;
+@z
+
+@x
+procedure print_file_name(@!n,@!a,@!e:integer);
+begin print(a); print(n); print(e);
+end;
+@y
+procedure print_file_name(@!n,@!a,@!e:str_number);
+var delim,j:pool_pointer;
+begin delim:=str_start[a+1]-1;
+ while (delim>=str_start[a]) and (str_pool[delim]<>":") do decr(delim);
+ for j:=str_start[a] to delim do print_char(str_pool[j]);
+ print(n); print(e);
+ for j:=delim+1 to str_start[a+1]-1 do print_char(str_pool[j]);
+end;
+@z
+
+@x
+@p procedure pack_file_name(@!n,@!a,@!e:str_number);
+var k:integer; {number of positions filled in |name_of_file|}
+@!c: ASCII_code; {character being packed}
+@!j:pool_pointer; {index into |str_pool|}
+begin k:=0;
+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]);
+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_file[k]:=' ';
+end;
+@y
+@p procedure pack_file_name(@!n,@!a,@!e:str_number);
+var k:integer; {number of positions filled in |name_of_file|}
+@!c: ASCII_code; {character being packed}
+@!delim,j:pool_pointer; {index into |str_pool|}
+begin
+ delim:=str_start[a+1]-1;
+ while (delim>=str_start[a]) and (str_pool[delim]<>":") do decr(delim);
+ k:=0;
+ for j:=str_start[a] to delim do append_to_name(str_pool[j]);
+{Handle fonts whose names are longer than 6 characters by taking the
+first 3 and last 3 characters only.}
+if (e=".tfm") and (length(n)>6) then
+ begin for j:=str_start[n] to str_start[n]+2 do
+ append_to_name(str_pool[j]);
+ for j:=str_start[n+1]-3 to str_start[n+1]-1 do
+ append_to_name(str_pool[j]);
+ end
+else 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]);
+for j:=delim+1 to str_start[a+1]-1 do append_to_name(str_pool[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_file[k]:=' ';
+end;
+@z
+
+@x
+@d format_default_length=20 {length of the |TEX_format_default| string}
+@d format_area_length=11 {length of its area part}
+@d format_ext_length=4 {length of its `\.{.fmt}' part}
+@y
+@d format_default_length=13 {length of the |TEX_format_default| string}
+@d format_area_length=4 {length of its area part}
+@d format_ext_length=4 {length of its `\.{.fmt}' part}
+@z
+
+@x
+TEX_format_default:='TeXformats:PLAIN.fmt';
+@y
+TEX_format_default:='TeX:plain.fmt';
+@z
+
+ Type out CPU time & run editor
+
+@x
+wake_up_terminal; @<Finish the \.{DVI} file@>;
+if job_name>0 then
+ begin wlog_cr; a_close(log_file); selector:=selector-2;
+ if selector=term_only then
+ begin print_nl("Transcript written on ");
+ print(log_name); print_char(".");
+ end;
+ end;
+end;
+@y
+wake_up_terminal; @<Finish the \.{DVI} file@>;
+cpu_time:=runtime-cpu_time;
+print_nl("CPU time = "); print_int(cpu_time div 1000); print_char(".");
+print_two(cpu_time div 10); print(" s.");
+if job_name>0 then
+ begin wlog_cr; a_close(log_file); selector:=selector-2;
+ if selector=term_only then
+ begin print_nl("Transcript written on ");
+ print(log_name); print_char(".");
+ end;
+ end;
+ if run_editor then call_fine;
+end;
+@z
diff --git a/obsolete/systems/knuth/unsupported/tex/tex.tops20-changes b/obsolete/systems/knuth/unsupported/tex/tex.tops20-changes
new file mode 100644
index 0000000000..3b62c16a72
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/tex/tex.tops20-changes
@@ -0,0 +1,1308 @@
+This change file is for the TOPS-20 version of TeX.
+
+Copyright (C) 1983 by David Fuchs. All rights are reserved.
+
+Problem areas are marked with `fix me'. Please report any bugs to
+DRF@SU-AI and DRF@SU-SCORE.
+
+This file makes an INITeX. To get a production TeX, change the INIT and
+TINI macros to @{ and @}, respectively, and likewise for DEBUG and GUBED.
+You may also wish to decrease |trie_size| to about 6000 for English.
+
+
+@x [0] Tell WEAVE to print only the changes:
+ \def\?##1]{\hbox to 1in{\hfil##1.\ }}
+ }
+@y
+ \def\?##1]{\hbox{Changes to \hbox to 1em{\hfil##1}.\ }}
+ }
+\let\maybe=\iffalse
+\def\ttw{{\mc TOPS-20}}
+\def\title{\TeX82 changes for \ttw}
+@z
+
+@x [1] TOPS-20's banner:
+@d banner=='This is TeX, Version 2.93' {printed when \TeX\ starts}
+@y
+
+Comments on the \ttw\ implementation (by David Fuchs) of \TeX\ follow:
+@^Fuchs, David Raymond@>
+
+Firstly, input files are considered to have pages, which are delimited with
+form-feeds. All error messages give the page number, along with the line
+number on that page (if the page number is one, then the page number is
+not printed, to avoid confusing people who do not use form-feeds).
+
+Secondly, the areas \.{TeX:}, \.{TeXFormats:}, \.{TeXFonts:}, and
+\.{TeXInputs:} are where \TeX\ looks for \.{.pool}, \.{.fmt}, \.{.tfm}, and
+\.{.tex} files, respectively. In all but the last case, \TeX\ prepends
+the logical name to the name supplied by the user, and if the open fails,
+then \TeX\ tries to use the supplied file name unadorned; while in the
+case of {.tex} files, first the file is looked for as specified, and if it
+is not found, \.{TeXInputs:} is prepended).
+
+Thirdly, \TeX\ reads your \ttw\ command line that invoked it, and uses
+everything after the command name as input. For instance, you might say
+`\.{TeX\ foo}' to \ttw, and \TeX\ will act the same as if you had
+started it and then said `\.{foo}' to the initial \.{**} prompt. You can
+also say more complicated things,
+like `\.{TeX\ \&myfmt\ \\def\\foo\{T\}\ \\input bar}'.
+Moreover, \TeX\ tries to remember your entire incantation,
+so that the next time you can simply say `\.{TeX}', and \TeX\ will pretend
+you had repeated the stuff you said last time. Note that if you give a
+new, nonempty command line, it will be paid attention to, and the new
+command line will then be remembered for next time. If you want to get a
+\TeX\ that ignores any previous command line, say `\.{TeX\ \\}' to \ttw,
+and \TeX\ will totally forget any old command line you gave it.
+The command line memory is implemented with logical names
+$\hbox{TeXMEM}x,\,x\in\{0,1,\ldots\}$,
+so when you log out, the memory fades.
+
+Fourthly, the interrupt feature is activated by typing control-G.
+
+Fifthly, \TeX\ will suggest a spooling command when it is done with
+your job. It will `STI' the line `\.{TeXSpool:\ FOO.DVI.1}' if it wrote
+said dvi file; thus users can send their output by default to their
+favorite device by appropriatly defining \.{TeXSpool:}.
+
+Sixthly, \TeX\ allows you to use logical names where file names
+normally go; for instance you can say `\.{TeX Foo:}' when you've
+already done a \.{DEFINE FOO: BAR} or \.{DEF FOO: ADISK:<ME>X.TEX}
+or even \.{DEF FOO: BAR:} followed by \.{DEF BAR: <YOU>X}. Don't
+expect \.{TeX Foo:.X} to work, though.
+
+Lastly, \TeX\ tries to be smart about swapping to your favorite editor
+when you reply `E' to one of its error messages. Unfortunatly, there is
+no good system interface for doing this sort of thing, so the technique is
+both fallible, and special code needs to be added for each editor supported
+(currently, EMACS, EDIT, TVEDIT and ZED). \TeX\ looks at the
+logical name \.{EDITOR:} and tries to figure out which one you've got so that it
+can \.{STI} the appropriate commands.
+
+@d banner=='This is TeX, Tops-20 Version 2.93' {printed when \TeX\ starts}
+@d max_TOPS20_file_name_length = 300 {That ought to be big enough}
+@z
+
+@x [1] Switches for debugging and statistics:
+@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
+@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
+@f debug==begin
+@f gubed==end
+@#
+@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}
+@f stat==begin
+@f tats==end
+@y
+@d debug==
+@d gubed==
+@f debug==begin
+@f gubed==end
+@#
+@d stat==
+@d tats==
+@f stat==begin
+@f tats==end
+@z
+
+@x [1] The INITeX switch:
+@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
+
+@x [1] 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 The space after the B is due to a compiler bug.
+@{@&$C-,A+,D-,P:520000@&B@= @>@}
+ {no range check, catch arithmetic overflow, no debug overhead,
+ move the code up to make room for the global data in production}
+@!debug @{@&$C+,D+,X+,P:400000@&B@= @>@}@+ gubed
+ {we turn everything on when debugging and we use extended addressing
+ (otherwise there's not enough room with all the debug stuff)}
+@z
+
+@x [1] Compile-time constants:
+@!mem_max=30000; {greatest index in \TeX's internal |mem| array;
+ must be strictly less than |max_halfword|;
+ must be equal to |mem_top| in \.{INITEX}, otherwise |>=mem_top|}
+@!mem_min=0; {smallest index in \TeX's internal |mem| array;
+ must be |min_halfword| or more;
+ must be equal to |mem_bot| in \.{INITEX}, otherwise |<=mem_bot|}
+@!buf_size=500; {maximum number of characters simultaneously present in
+ current lines of open files and in control sequences between
+ \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|}
+@!error_line=72; {width of context lines on terminal error messages}
+@!half_error_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}
+@!stack_size=200; {maximum number of simultaneous input sources}
+@!max_in_open=6; {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@!font_max=75; {maximum internal font number; must not exceed |max_quarterword|
+ and must be at most |font_base+256|}
+@!font_mem_size=20000; {number of words of |font_info| for all fonts}
+@!param_size=60; {maximum number of simultaneous macro parameters}
+@!nest_size=40; {maximum number of semantic levels simultaneously active}
+@!max_strings=3000; {maximum number of strings; must not exceed |max_halfword|}
+@!string_vacancies=8000; {the minimum number of characters that should be
+ available for the user's control sequences and font names,
+ after \TeX's own error messages are stored}
+@!pool_size=32000; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all fonts and
+ control sequences; must exceed |string_vacancies| by the total
+ length of \TeX's own strings, which is currently about 23000}
+@!save_size=600; {space for saving values outside of current group; must be
+ at most |max_halfword|}
+@!trie_size=8000; {space for hyphenation patterns; should be larger for
+ \.{INITEX} than it is in production versions of \TeX}
+@!dvi_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='TeXformats:TEX.POOL ';
+ {string of length |file_name_size|; tells where the string pool appears}
+@y
+@!mem_max=65500; {greatest index in \TeX's internal |mem| array;
+ must be strictly less than |max_halfword|;
+ must be equal to |mem_top| in \.{INITEX}, otherwise |>=mem_top|}
+@!mem_min=0; {smallest index in \TeX's internal |mem| array;
+ must be |min_halfword| or more;
+ must be equal to |mem_bot| in \.{INITEX}, otherwise |<=mem_bot|}
+@!buf_size=500; {maximum number of characters simultaneously present in
+ current lines of open files and in control sequences between
+ \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|}
+@!error_line=79; {width of context lines on terminal error messages}
+@!half_error_line=50; {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}
+@!stack_size=200; {maximum number of simultaneous input sources}
+@!max_in_open=6; {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@!font_max=100;
+ {maximum internal font number; must not exceed |max_quarterword|}
+@!font_mem_size=35000; {number of words of |font_info| for all fonts}
+@!param_size=60; {maximum number of simultaneous macro parameters}
+@!nest_size=40; {maximum number of semantic levels simultaneously active}
+@!max_strings=5400; {maximum number of strings}
+@!string_vacancies=26000; {the minimum number of characters that should be
+ available for the user's control sequences and font names,
+ after \TeX's own error messages are stored}
+@!pool_size=65500; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all fonts and
+ control sequences; must exceed |string_vacancies| by the total
+ length of \TeX's own strings, which is currently about 23000}
+@!save_size=600; {space for saving values outside of current group; must be
+ at most |max_halfword|}
+@!trie_size=8000; {space for hyphenation patterns; should be larger for
+ \.{INITEX} than it is in production versions of \TeX}
+@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8}
+@!file_name_size=69; {file names shouldn't be longer than this}
+@!pool_name=
+ 'TeX:TeX.POOL ';
+ {string of length |file_name_size|; tells where the string pool appears}
+@!max_rescan=500; {maximum length of the rescan buffer}
+@z
+
+@x [1] TANGLE-time constants:
+@d mem_bot=0 {smallest index in the |mem| array dumped by \.{INITEX};
+ must not be less than |mem_min|}
+@d mem_top==30000 {largest index in the |mem| array dumped by \.{INITEX};
+ must be substantially larger than |mem_bot|
+ and not greater than |mem_max|}
+@d font_base=0 {smallest internal font number; must not be less
+ than |min_quarterword|}
+@d hash_size=2100 {maximum number of control sequences; it should be at most
+ about |(mem_max-mem_min)/10|, but 2100 is already quite generous}
+@d hash_prime=1777 {a prime number equal to about 85\% of |hash_size|}
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@y
+@d mem_bot=0 {smallest index in the |mem| array dumped by \.{INITEX};
+ must not be less than |mem_min|}
+@d mem_top==65500 {largest index in the |mem| array dumped by \.{INITEX};
+ must be substantially larger than |mem_bot|
+ and not greater than |mem_max|}
+@d font_base=0 {smallest internal font number; must not be less
+ than |min_quarterword|}
+@d hash_size=3300 {maximum number of control sequences; it should be at most
+ about |(mem_max-mem_min)/10|, but 2100 is already quite generous}
+@d hash_prime=2803 {a prime number equal to about 85\% of |hash_size|}
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@z
+
+@x [2] System-dependent character set changes:
+@^character set dependencies@>
+@^system dependencies@>
+
+@<Set init...@>=
+for i:=1 to @'37 do xchr[i]:=' ';
+@y
+@^character set dependencies@>
+@^system dependencies@>
+
+The code shown here is intended to be used on \ttw\ systems,
+and at other installations where only the printable ASCII set, plus
+|carriage_return|, |tab|, and |form_feed| will show up in text files.
+All |line_feed| and |null| characters are skipped.
+
+Note that |form_feed|'s are considered to be page delimiters, and this version
+of \TeX\ will keep track of which page of input it is on, for use in error
+messages, as well as in swapping to various editors.
+
+@d form_feed=@'14 {ASCII code used at end of a page}
+@d tab=@'11
+
+@<Set initial values...@>=
+for i:=1 to @'37 do xchr[i]:=' ';
+xchr[form_feed]:=chr(form_feed);
+xchr[tab]:=chr(tab);
+@z
+
+@x [3] Opening files:
+@d reset_OK(#)==erstat(#)=0
+@d rewrite_OK(#)==erstat(#)=0
+
+@p function a_open_in(var f:alpha_file):boolean;
+ {open a text file for input}
+begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f);
+end;
+@#
+function a_open_out(var f:alpha_file):boolean;
+ {open a text file for output}
+begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f);
+end;
+@#
+function b_open_in(var f:byte_file):boolean;
+ {open a binary file for input}
+begin reset(f,name_of_file,'/O'); b_open_in:=reset_OK(f);
+end;
+@#
+function b_open_out(var f:byte_file):boolean;
+ {open a binary file for output}
+begin rewrite(f,name_of_file,'/O'); b_open_out:=rewrite_OK(f);
+end;
+@#
+function w_open_in(var f:word_file):boolean;
+ {open a word file for input}
+begin reset(f,name_of_file,'/O'); w_open_in:=reset_OK(f);
+end;
+@#
+function w_open_out(var f:word_file):boolean;
+ {open a word file for output}
+begin rewrite(f,name_of_file,'/O'); w_open_out:=rewrite_OK(f);
+end;
+@y
+@d reset_OK(#)==(erstat(#)=0) or (erstat(#)=@'0600220) {empty file}
+@d rewrite_OK(#)==erstat(#)=0
+
+@p function erstat(var f:file):integer; extern; {in the runtime library}
+
+function a_open_in(var f:alpha_file):boolean;
+ {open a text file for input}
+begin reset(f,name_of_file,'/E/O');
+ {the \.{/E} switch distinguishes |form_feed| from |carriage_return|;
+ the \.{/O} switch gives error control to us}
+a_open_in:=reset_OK(f);
+end;
+@#
+function a_open_out(var f:alpha_file):boolean;
+ {open a text file for output}
+begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f);
+end;
+@#
+function b_open_in(var f:byte_file):boolean;
+ {open a binary file for input}
+begin reset(f,name_of_file,'/B:8/O'); b_open_in:=reset_OK(f);
+end; {the \.{/B} switch is necessary to get byte packing}
+@#
+function b_open_out(var f:byte_file):boolean;
+ {open a binary file for output}
+begin rewrite(f,name_of_file,'/B:8/O'); b_open_out:=rewrite_OK(f);
+end;
+@#
+function w_open_in(var f:word_file):boolean;
+ {open a word file for input}
+begin reset(f,name_of_file,'/O'); w_open_in:=reset_OK(f);
+end;
+@#
+function w_open_out(var f:word_file):boolean;
+ {open a word file for output}
+begin rewrite(f,name_of_file,'/O'); w_open_out:=rewrite_OK(f);
+end;
+@z
+
+@x [3] New input_ln:
+representing the beginning and ending of a line of text.
+
+@<Glob...@>=
+@y
+representing the beginning and ending of a line of text.
+
+We will read the lines first into an auxiliary buffer, in order to
+save the running time of procedure-call overhead. This uses a nice
+feature of \ph\ that Knuth chose not to mention in \TeX82.
+@^Knuth, Donald Ervin@>
+
+On \ttw\ we want to recognize page marks (indicated by |form_feed|
+characters), and keep track of the current page number. EDIT-type
+line number are skipped over automatically.
+
+@d aux_buf_len=80 {length of the auxiliary buffer}
+
+@<Glob...@>=
+@!aux_buf:array[0..aux_buf_len-1] of text_char; {where the characters go first}
+@^system dependencies@>
+@z
+
+@x
+@p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean;
+ {inputs the next line or returns |false|}
+var last_nonblank:0..buf_size; {|last| with trailing blanks removed}
+begin if bypass_eoln then if not eof(f) then get(f);
+ {input the first character of the line into |f^|}
+last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
+if eof(f) then input_ln:=false
+else begin last_nonblank:=first;
+ while not eoln(f) do
+ begin if last>=max_buf_stack then
+ begin max_buf_stack:=last+1;
+ if max_buf_stack=buf_size then
+ overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+ end;
+ buffer[last]:=xord[f^]; get(f); incr(last);
+ if buffer[last-1]<>" " then last_nonblank:=last;
+ end;
+ last:=last_nonblank; input_ln:=true;
+ end;
+end;
+@y
+On \ttw, we do just that, using |aux_buf|.
+
+@p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean;
+ {inputs the next line or returns |false|}
+label 1,done;
+var n: integer;
+@!k,@!m: 0..buf_size; {indices into |buffer|}
+@!more: boolean; {is there more on the line that didn't get into |aux_buf|?}
+begin if bypass_eoln then {input the first character of the line into |f^|}
+ begin if not eof(f) then get(f);
+ if not eof(f) then if f^=chr(@'12) then get(f); {skip past a |line_feed|}
+ end;
+last:=first;
+if eof(f) then input_ln:=false
+else begin
+ read(f,aux_buf:n);
+ more:=n=aux_buf_len+1;
+ if more then n:=aux_buf_len;
+1: if last+n>max_buf_stack then
+ if last+n>=buf_size then
+ begin max_buf_stack:=buf_size;
+ overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+ end
+ else max_buf_stack:=last+n;
+ if n>0 then
+ begin m:=last;
+ last:=m+n;
+ for k:=m to last-1 do buffer[k]:=xord[aux_buf[k-m]];
+ if more then begin
+ read(f,aux_buf:n);
+ more:=n=aux_buf_len+1;
+ if more then n:=aux_buf_len;
+ goto 1;
+ end;
+ end;
+ if (f^<>chr(carriage_return)) and (not eof(f)) then begin
+ if f^=chr(form_feed) then begin page:=page+1; line:=0; end;
+ aux_buf[0]:=f^; n:=1; more:=true; get(f); goto 1;
+ end;
+ loop@+ begin if last=first then goto done;
+ if buffer[last-1]<>" " then goto done;
+ decr(last);
+ end;
+done: input_ln:=true;
+ end;
+end;
+@^system dependencies@>
+@z
+
+@x [3] Terminal I/O:
+is considered an output file the file variable is |term_out|.
+@^system dependencies@>
+
+@<Glob...@>=
+@!term_in:alpha_file; {the terminal as an input file}
+@!term_out:alpha_file; {the terminal as an output file}
+
+@ Here is how to open the terminal files
+in \ph. The `\.{/I}' switch suppresses the first |get|.
+@^system dependencies@>
+
+@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
+is considered an output file the file variable is |term_out|.
+On \ttw, this point is moot, since we use the built-in |TTY| file.
+@^system dependencies@>
+
+@d term_in==TTY {the terminal as an input file}
+@d term_out==TTY {the terminal as an output file}
+
+@ Here is how to open the terminal files on \ttw: we don't do anything,
+since |TTY| is always open. Note that |eoln(term_in)| is initially |true|.
+(Acutally, some very picky people might want to be able to distinguish
+between different |eoln| characters on terminal input, so we have to
+re-reset the |term_in| file with a few magic switches)
+
+@^system dependencies@>
+
+@d t_open_in == reset(term_in,'','/I/E') {distinguish |eoln| characters}
+@d t_open_out==do_nothing {open the terminal for text output}
+@z
+
+@x [3] Special terminal controls:
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@d clear_terminal == break_in(term_in,true) {clear the terminal input buffer}
+@d wake_up_terminal == do_nothing {cancel the user's cancellation of output}
+@y
+@d CFIBF=@'100 {Clear File Input BuFfer JSYS}
+@d PRIIN=@'100 {PRImary INput JFN JSYS}
+@d PRIOUT=@'101 {PRImary OUTput JFN JSYS}
+@d RFMOD=@'107 {Return File MODe word JSYS}
+@d SFMOD=@'110 {Set File MODe word JSYS}
+@#
+@d update_terminal == {the terminal output buffer is always emptied}
+@d clear_terminal == jsys(CFIBF;PRIIN) {clear the terminal input buffer}
+@d wake_up_terminal == begin {cancel the user's cancellation of output}
+ jsys(RFMOD;PRIOUT;wake_up_junk,wake_up_junk);
+ wake_up_junk:=wake_up_junk-[0]; {turn off TT\%OSP}
+ jsys(SFMOD;PRIOUT,wake_up_junk);
+ end
+@^system dependencies@>
+
+@<Glob...@>=
+@!wake_up_junk: set of 0..35;
+@z
+
+@x [3] Initializing the terminal:
+@ The following program does the required initialization
+without retrieving a possible command line.
+It should be clear how to modify this routine to deal with command lines,
+if the system permits them.
+@^system dependencies@>
+
+@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;
+@.**@>
+ if not input_ln(term_in,true) then {this shouldn't happen}
+ begin write_ln(term_out);
+ write(term_out,'! End of file on the terminal... why?');
+@.End of file on the terminal@>
+ init_terminal:=false; return;
+ end;
+ loc:=first;
+ while (loc<last)and(buffer[loc]=" ") do incr(loc);
+ if loc<last then
+ begin init_terminal:=true;
+ return; {return unless the line was all blank}
+ end;
+ write_ln(term_out,'Please type the name of your input file.');
+ end;
+exit:end;
+@y
+@ The following program does the required initialization
+and accepts interrupts and also retrieves a possible command line, using
+a fair bit of system stuff to get and remember them.
+@^system dependencies@>
+
+@p function init_terminal:boolean; {gets the terminal input started}
+label exit,done; {|done| is for the command line code}
+var @<Command line variables@>@/
+@!line_found:boolean; {is there a spceial command line?}
+begin t_open_in;
+@<Set up Control-G@>;
+last:=first; {|buffer| empty}
+@<Process possible command line@>;
+line_found:=(last>first); {did we put anything into |buffer|?}
+loop@+ begin loc:=first;
+ while (loc<last)and(buffer[loc]=" ") do incr(loc);
+ if loc<last then
+ begin init_terminal:=true;
+ return; {return unless the line was all blank}
+ end;
+ if line_found then
+ write_ln(term_out,'Please type the name of your input file.');
+ wake_up_terminal;
+ write(term_out,'**'); update_terminal;
+@.**@>
+ if not input_ln(term_in,true) then {this shouldn't happen}
+ begin write_ln(term_out);
+ write(term_out,'! End of file on the terminal... why?');
+@.End of file on the terminal@>
+ init_terminal:=false; return;
+ end;
+ line_found:=true;
+ end;
+exit:end;
+@z
+
+@x [6] The `E' option:
+line ready to be edited. But such an extension requires some system
+wizardry, so the present implementation simply types out what file should be
+edited and the relevant line number.
+@y
+line ready to be edited. The present implementation does this by loading
+the line editor with the appropriate call to the editor. We treat `\.T'
+the same as `\.E', because other programs invoke the editor when the user
+says `\.T'.
+@z
+@x
+"E": if base_ptr>0 then
+ begin print_nl("You want to edit file ");
+@.You want to edit file x@>
+ print(input_stack[base_ptr].name_field);
+ print(" at line "); print_int(line);
+ interaction:=scroll_mode; jump_out;
+ end;
+@y
+"E","T": if base_ptr>0 then
+ begin
+ set_pseudo_to_edit_commands;
+ jump_out;
+ end;
+@z
+
+@x [8] Changes for 36-bit machines:
+The values defined here are recommended for most 32-bit computers.
+
+@d min_quarterword=0 {smallest allowable value in a |quarterword|}
+@d max_quarterword=255 {largest allowable value in a |quarterword|}
+@d min_halfword==0 {smallest allowable value in a |halfword|}
+@d max_halfword==65535 {largest allowable value in a |halfword|}
+@y
+The values defined here are recommended for most 36-bit computers.
+
+@d min_quarterword=0 {smallest allowable value in a |quarterword|}
+@d max_quarterword=511 {largest allowable value in a |quarterword|}
+@d min_halfword==0 {smallest allowable value in a |halfword|}
+@d max_halfword==262143 {largest allowable value in a |halfword|}
+@z
+
+@x [6] Eliminating addition/subtraction of zero:
+The inner loop of \TeX\ will run faster with respect to compilers
+that don't optimize expressions like `|x+0|' and `|x-0|', if these
+macros are simplified in the obvious way when |min_quarterword=0|.
+@^inner loop@>@^system dependencies@>
+
+@d qi(#)==#+min_quarterword
+ {to put an |eight_bits| item into a quarterword}
+@d qo(#)==#-min_quarterword
+ {to take an |eight_bits| item out of a quarterword}
+@d hi(#)==#+min_halfword
+ {to put a sixteen-bit item into a halfword}
+@d ho(#)==#-min_halfword
+ {to take a sixteen-bit item from a halfword}
+@y
+The inner loop of \TeX\ will run faster with respect to compilers
+that don't optimize expressions like `|x+0|' and `|x-0|', if these
+macros are simplified in the obvious way when |min_quarterword=0|.
+So they have been simplified here in the obvious way.
+@^inner loop@>@^system dependencies@>
+
+@d qi(#)==# {to put an |eight_bits| item into a quarterword}
+@d qo(#)==# {to take an |eight_bits| item from a quarterword}
+@d hi(#)==# {to put a sixteen-bit item into a halfword}
+@d ho(#)==# {to take a sixteen-bit item from a halfword}
+@z
+
+@x [17] Special form_feed initialization:
+cat_code("\"):=escape; cat_code("%"):=comment;
+@y
+cat_code("\"):=escape; cat_code("%"):=comment;
+cat_code(form_feed):=car_ret;
+@z
+
+@x [17] Date and time:
+Since standard \PASCAL\ cannot provide such information, something special
+is needed. The program here simply specifies July 4, 1776, at noon; but
+users probably want a better approximation to the truth.
+
+@p procedure fix_date_and_time;
+begin time:=12*60; {minutes since midnight}
+day:=4; {fourth day of the month}
+month:=7; {seventh month of the year}
+year:=1776; {Anno Domini}
+end;
+@y
+It uses a \ttw\ monitor call that returns various data and time
+information in three variables.
+
+@d ODCNV=@'222 {Output Date and time CoNVersion JSYS}
+
+@p procedure fix_date_and_time;
+var y,d,t:integer; {raw year/month, day and time}
+g:integer; {garbage}
+begin jsys(ODCNV;0,-1,0,0;g,y,d,t);
+year:=y div @'1000000; {year in left half-word}
+month:=(y mod @'1000000)+1; {month in right half-word, zero means January}
+day:=(d div @'1000000)+1;
+ {day in left half-word, zero means the first of the month}
+time:=((t+@'377777*@'1000000) mod @'1000000) div 60; {sign bit was on}
+end;
+@^system dependencies@>
+@z
+
+@x [22] Page number maintenance:
+If more information about the input state is needed, it can be
+included in small arrays like those shown here. For example,
+the current page or segment number in the input file might be
+put into a variable |@!page|, maintained for enclosing levels in
+`\ignorespaces|@!page_stack:array[1..max_in_open] of integer|\unskip'
+by analogy with |line_stack|.
+@y
+Similarly, we maintain a global variable |page| and a corresponding
+|page_stack|.
+@z
+@x
+@!line_stack : array[1..max_in_open] of integer;
+@y
+@!line_stack : array[1..max_in_open] of integer;
+@!page : integer; {current page number in the current source file}
+@!page_stack : array[1..max_in_open] of integer;
+@z
+
+@x [22] Printing the page number:
+else begin print_nl("l."); print_int(line);
+@y
+else begin if page>1 then
+ begin print_nl("p."); print_int(page); print(",l.");
+ end
+ else print_nl("l.");
+ print_int(line);
+@z
+
+@x [23] More page number maintenance:
+or |limit| or |line|.
+@y
+or |limit| or |line| or |page|.
+@z
+@x
+line_stack[index]:=line; start:=first; state:=mid_line;
+@y
+line_stack[index]:=line; start:=first; state:=mid_line;
+page_stack[index]:=page;
+@z
+@x
+begin first:=start; line:=line_stack[index];
+@y
+begin first:=start; page:=page_stack[index]; line:=line_stack[index];
+@z
+
+@x [24] More page number printing:
+ print("; all text was ignored after line "); print_int(skip_line);
+@y
+ print("; all text was ignored after line "); print_int(skip_line);
+ if skip_page>1 then
+ begin print(", p."); print_int(skip_page);
+ end;
+@z
+@x
+where skipping began, for use in error messages.
+
+@<Glob...@>=
+@!skip_line:integer; {skipping began here}
+@y
+where skipping began, for use in error messages. Also the page number.
+
+@<Glob...@>=
+@!skip_line,@!skip_page:integer; {skipping began here}
+@z
+@x
+skip_line:=line;
+@y
+skip_line:=line; skip_page:=page;
+@z
+
+@x [29] Logical name translation:
+@ The third.
+@^system dependencies@>
+
+@p procedure end_name;
+begin if str_ptr+3>max_strings then
+ overflow("number of strings",max_strings-init_str_ptr);
+@:TeX capacity exceeded number of strings}{\quad number of strings@>
+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
+@ The third. We have to check to see if a logical name has been
+referred to, and if so, translate it.
+@^system dependencies@>
+
+@d LNMST=@'504 {convert Logical NaMe to STring JSYS}
+
+@p procedure end_name;
+label restart,exit;
+var s,t:packed array[1..max_TOPS20_file_name_length+1] of char;
+@!LNMST_return: integer; {which skip return did the LNMST jsys take?}
+@!i:pool_pointer;
+begin
+restart:
+if (str_pool[area_delimiter]=":") and (pool_ptr=area_delimiter+1) then
+ begin
+ cur_area:=make_string;
+ for i:=1 to length(cur_area)-1 do
+ s[i]:=xchr[str_pool[str_start[cur_area]+i-1]];
+ s[length(cur_area)]:=chr(0); {ASCIZ it}
+ jsys(LNMST,-2,LNMST_return;0,s,t); {job-wide}
+ if LNMST_return<>2 then
+ jsys(LNMST,-2,LNMST_return;1,s,t); {system-wide}
+ if LNMST_return<>2 then begin
+ cur_ext:=""; cur_name:=""; {silly case}
+ return;
+ end;
+ flush_string; {needn't remember logical name in |cur_area|}
+ begin_name;
+ i:=1;
+ while ord(t[i])>0 do
+ if more_name(xord[t[i]]) then incr(i)
+ else goto restart;
+ goto restart; {heavy!}
+ end;
+if str_ptr+3>max_strings then
+ overflow("number of strings",max_strings-init_str_ptr);
+@:TeX capacity exceeded number of strings}{\quad number of strings@>
+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;
+exit:
+end;
+@z
+
+@x [29] The real file names:
+@ Operating systems often make it possible to determine the exact name (and
+possible version number) of a file that has been opened. The following routine,
+which simply makes a \TeX\ string from the value of |name_of_file|, should
+ideally be changed to deduce the full name of file~|f|, which is the file
+most recently opened, if it is possible to do this in a \PASCAL\ program.
+@^system dependencies@>
+
+This routine might be called after string memory has overflowed, hence
+we dare not use `|str_room|'.
+
+@p function make_name_string:str_number;
+var k:1..file_name_size; {index into |name_of_file|}
+begin if (pool_ptr+name_length>pool_size)or(str_ptr=max_strings)or
+ (cur_length>0) then
+ make_name_string:="?"
+else begin for k:=1 to name_length do append_char(xord[name_of_file[k]]);
+ make_name_string:=make_string;
+ end;
+end;
+function a_make_name_string(var f:alpha_file):str_number;
+begin a_make_name_string:=make_name_string;
+end;
+function b_make_name_string(var f:byte_file):str_number;
+begin b_make_name_string:=make_name_string;
+end;
+function w_make_name_string(var f:word_file):str_number;
+begin w_make_name_string:=make_name_string;
+end;
+@y
+
+@ Operating systems often make it possible to determine the exact name (and
+possible version number) of a file that has been opened. The following routine,
+shows how to deduce the full name of file~|f|, which is the file most recently
+opened, using \ttw\ system calls.
+@^system dependencies@>
+
+This routine might be called after string memory has overflowed, hence
+we dare not use `|str_room|'.
+
+@d JFNS=@'30 {translage JFN to String JSYS}
+
+@p function make_name_string(var f:f@&i@&l@&e):str_number;
+var s:packed array[1..max_TOPS20_file_name_length+1] of char;
+@!j,k:1..max_TOPS20_file_name_length;
+begin jsys(JFNS;s,0:f,@'111110:1);
+j:=1; while (ord(s[j+1])<>0) and (j<max_TOPS20_file_name_length) do incr(j);
+if (pool_ptr+j>pool_size)or(str_ptr=max_strings)or
+ (cur_length>0) then
+ make_name_string:="?"
+else begin
+ for k:=1 to j do append_char(xord[s[k]]);
+ make_name_string:=make_string;
+ end;
+end;
+function a_make_name_string(var f:alpha_file):str_number;
+begin a_make_name_string:=make_name_string(f);
+end;
+function b_make_name_string(var f:byte_file):str_number;
+begin b_make_name_string:=make_name_string(f);
+end;
+function w_make_name_string(var f:word_file):str_number;
+begin w_make_name_string:=make_name_string(f);
+end;
+@z
+
+@x [29] LST instead of LOG:
+@p procedure pack_job_name(@!s:str_number); {|s = ".log"|, |".dvi"|, or
+@y
+@p procedure pack_job_name(@!s:str_number); {|s = ".lst"|, |".dvi"|, or
+@z
+
+@x
+pack_job_name(".log");
+@y
+pack_job_name(".lst");
+@z
+
+@x
+prompt_file_name("transcript file name",".log");
+@y
+prompt_file_name("transcript file name",".lst");
+@z
+
+@x [29] Start page number at 1:
+first:=limit+1; loc:=start; line:=1;
+@y
+first:=limit+1; loc:=start; line:=1; page:=1;
+@z
+
+@x [32] Pack dvi_buf
+@!dvi_buf:array[dvi_index] of eight_bits; {buffer for \.{DVI} output}
+@y
+@!dvi_buf:packed array [dvi_index] of eight_bits; {buffer for \.{DVI} output}
+@z
+
+@x [32] "TeXspool":
+ b_close(dvi_file);
+@y
+ b_close(dvi_file);
+ if pseudo_typein=0 then
+ begin k:=selector; selector:=new_string;
+ pool_ptr:=str_start[str_ptr];
+ print("TeXspool: "); print(output_file_name);
+ selector:=k;
+ if (pool_ptr<pool_size) and (str_ptr<max_strings) then
+ {|overflow| can't occur}
+ pseudo_typein:=make_string;
+ end;
+@z
+
+@x [33] Page numbers on over/underfull box messages:
+ print_int(line);
+@y
+ print_int(line);
+ if page>1 then
+ begin print(", p."); print_int(page);
+ end;
+@z
+@x
+ print_int(line);
+@y
+ print_int(line);
+ if page>1 then
+ begin print(", p."); print_int(page);
+ end;
+@z
+
+@x [51] The endgame:
+@ Here we do whatever is needed to complete \TeX's job gracefully on the
+local operating system. The code here might come into play after a fatal
+error; it must therefore consist entirely of ``safe'' operations that
+cannot produce error messages. For example, it would be a mistake to call
+|str_room| or |make_string| at this time, because a call on |overflow|
+might lead to an infinite loop.
+@^system dependencies@>
+
+Actually there's one way to get error messages, via |prepare_mag|;
+but that can't cause infinite recursion.
+
+This program doesn't bother to close the input files that may still be open.
+
+@<Last-minute...@>=
+procedure close_files_and_terminate;
+var k:integer; {all-purpose index}
+begin @<Finish the extensions@>;
+@!stat if tracing_stats>0 then @<Output statistics about this job@>;@;@+tats@/
+wake_up_terminal; @<Finish the \.{DVI} file@>;
+if job_name>0 then
+ begin wlog_cr; a_close(log_file); selector:=selector-2;
+ if selector=term_only then
+ begin print_nl("Transcript written on ");
+@.Transcript written...@>
+ print(log_name); print_char(".");
+ end;
+ end;
+end;
+@y
+@ Here we do whatever is needed to complete \TeX's job gracefully on \ttw.
+The code here might come into play after a fatal
+error; it must therefore consist entirely of ``safe'' operations that
+cannot produce error messages. For example, it would be a mistake to call
+|str_room| or |make_string| without checking, because a call on |overflow|
+might lead to an infinite loop.
+@^system dependencies@>
+
+Actually there's one way to get error messages, via |prepare_mag|;
+but that can't cause infinite recursion.
+
+This program doesn't bother to close the input files that may still be open.
+
+@d STI=@'114 {Simulate Terminal Input JSYS}
+@d SIBE=@'102 {See If Buffer Empty JSYS}
+
+@<Last-minute...@>=
+procedure close_files_and_terminate;
+label done;
+var j,@!k:integer; {all-purpose index}
+@!SIBE_return: integer; {did the SIBE skip?}
+@!temp_file: alpha_file; {read unbuffered from |term_in|}
+@!old_mode,@!new_mode:set of 0..35; {a word by the bits}
+begin @<Finish the extensions@>;
+@!stat if tracing_stats>0 then @<Output statistics about this job@>;@;@+tats@/
+wake_up_terminal; @<Finish the \.{DVI} file@>;
+if job_name>0 then
+ begin wlog_cr; a_close(log_file); selector:=selector-2;
+ if selector=term_only then
+ begin print_nl("Transcript written on ");
+ print(log_name); print_char(".");
+ end;
+ end;
+{note we don't use |xchr[str_pool[k]]| here because of ESC and CR characters}
+if (pseudo_typein<>0) and (interaction>batch_mode) then
+ begin
+ j:=str_start[pseudo_typein+1]-1; {last character to STI}
+ jsys(SIBE,2,SIBE_return;PRIIN);
+ if SIBE_return<>1 then goto done;
+ reset(temp_file,'tty:','/I/M:1'); {read unbuffered from the terminal}
+ jsys(RFMOD;PRIIN;old_mode); {get terminal mode}
+ new_mode:=old_mode-[24]; {TT\%ECO bit}
+ jsys(SFMOD;PRIIN;new_mode); {turn off echo}
+ while SIBE_return=1 do begin
+ get(temp_file); {there must be user input}
+ incr(j);
+ if eoln(temp_file) then str_pool[j]:=13
+ else str_pool[j]:=ord(temp_file^);
+ jsys(SIBE,2,SIBE_return;PRIIN);
+ end;
+ done:
+ jsys(SFMOD;PRIIN;old_mode); {turn echo back on}
+ for k:=str_start[pseudo_typein] to j do jsys(STI;PRIIN,str_pool[k]);
+ end;
+end;
+@z
+
+@x [54] Final system-dependent changes:
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \TeX\ work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the published program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@y
+Here are the remaining things needed to make the implementation
+complete on \ttw.
+@^system dependencies@>
+
+@d ESC=@'33
+@d CR=@'15
+@d control_R=@'22
+@d control_Z=@'32
+
+@<Basic printing...@>=
+procedure@?set_pseudo_to_edit_commands; forward;@t\2@>@/
+
+@ The |pseudo_typein| variable is set nonzero if the |error| routine
+uses the `\.E' option to exit and edit.
+
+@<Glob...@>=
+@!pseudo_typein:str_number;
+
+@ @<Set init...@>=
+pseudo_typein:=0; page:=0;
+
+@ This procedure gets called when the user wants to set up to swap to the
+editor upon seeing an error. It figures out which editor the user wants,
+and then prints the proper command to start up that editor on the correct
+file at the correct position.
+
+@d edit_file==input_stack[base_ptr] {file to edit}
+
+@<Last-minute procedures@>=
+procedure set_pseudo_to_edit_commands;
+label done;
+var @!LNMST_return: integer; {which skip return did the LNMST jsys take?}
+@!edit_name: packed array[1..max_TOPS20_file_name_length] of ASCII_code;
+@!short_name: str_number; {|edit_name| with directory, etc. removed}
+@!from_here, @!to_there, @!i: integer; {help turn |edit_name| into |shorname|}
+begin
+selector:=new_string; pool_ptr:=str_start[str_ptr];
+@<Set |edit_name| to the full file name of user's favorite editor@>;
+@<Make |from_here| and |to_there| delimit the short editor name@>;
+@<Put the name of the editor into |short_name|@>;
+with edit_file do {avoid typeing |edit_file| alot}
+if str_eq_str(short_name,"EMACS") then @<Print EMACS startup commands@>
+else if str_eq_str(short_name,"TVEDIT") then @<Print TVEDIT startup commands@>
+else if str_eq_str(short_name,"EDIT") then @<Print EDIT startup commands@>
+else if str_eq_str(short_name,"ZED") then @<Print ZED startup commands@>
+else @<Print unfound editor message@>;
+done:
+pseudo_typein:=make_string;
+selector:=term_and_log; interaction:=scroll_mode;
+end;
+
+@ There is a bug here if the logical name for the editor points to
+another logical name which then points to the real editor name.
+
+@<Set |edit_name| to the full file name of user's favorite editor@>=
+logical_name:='EDITOR '; logical_name[7]:=chr(0); {ASCIZ it}
+jsys(LNMST,-2,LNMST_return;0,logical_name,edit_name); {job-wide}
+if LNMST_return<>2 then
+ jsys(LNMST,-2,LNMST_return;1,logical_name,edit_name);
+ {system-wide}
+if LNMST_return<>2 then begin
+ print("; You must DEFINE EDITOR: before TeX knows who to swap to.");
+ print_char(CR); goto done;
+ end;
+
+@ @<Make |from_here| and |to_there|...@>=
+from_here:=1;
+i:=1;
+while edit_name[i]>0 do begin
+ if (edit_name[i]=":") or (edit_name[i]=">") then from_here:=i+1;
+ incr(i);
+ end;
+decr(i);
+to_there:=i;
+while i>from_here do begin
+ if edit_name[i]="." then to_there:=i-1;
+ decr(i);
+ end;
+
+@ @<Put the name of the editor...@>=
+str_room(to_there-from_here+1);
+for i:=from_here to to_there do append_char(edit_name[i]);
+short_name:=make_string;
+
+@ @<Print unfound editor message@>=
+begin
+print("; Sorry, but TeX doesn't know about EDITOR: ");
+print(short_name);
+print_char(CR);
+print("; You want to edit file ");
+print(name_field);
+print(" on page ");
+print_int(page);
+print(", line ");
+print_int(line);
+print_char(".");
+print_char(CR);
+end
+
+@ @<Print EMACS startup commands@>=
+begin
+print("EDIT"); print_char(CR);
+print_char(control_Z); print("x^r execute minibuffer"); print_char(CR);
+print("mmFind file"); print_char(ESC);
+jsys(JFNS;edit_name,0:input_file[index_field],@'221100:1);
+{Get file name without device and directory if possible, and no version number}
+i:=1; while edit_name[i]>0 do begin print_char(edit_name[i]); incr(i); end;
+print_char(ESC); print_char(CR);
+print_int(curpos(input_file[index_field])-(limit_field-loc_field)-1);
+print_char("j"); print_char(control_Z); print_char(control_Z);
+end
+
+@ @<Print ZED startup commands@>=
+begin
+print("EDIT "); print(name_field); print_char(CR);
+print("XTECO"); print_char(ESC);
+print_int(curpos(input_file[index_field])-(limit_field-loc_field)-1);
+print_char("j"); print_char(control_R); print_char(control_Z);
+end
+
+@ @<Print TVEDIT startup commands@>=
+begin
+print("EDIT "); print(name_field); print_char(CR);
+print_char(ESC); print_char(ESC); print_int(page); print_char(".");
+ print_int(line); print_char("G"); {diabolical!}
+if loc_field>start_field then begin
+ print_char(ESC); print_char(ESC);
+ print_int(loc_field-start_field); print_char(" ");
+ end;
+end
+
+@ @<Print EDIT startup commands@>=
+begin
+print("EDIT "); print(name_field); print_char(CR);
+{fix me -- there's a bug if EDIT decides to split a very large page}
+print("P^+"); print_int(line-1);
+if page>1 then begin
+ print_char("/"); print_int(page);
+ end;
+print_char(CR);
+end
+
+@ This is the actual Control-G interrupt routine, and two system routines
+used to enable it. We have to put them somewhere, so pardon the little
+lie\dots
+
+@<Basic printing...@>=
+procedure cntl_G; begin interrupt:=interrupt+1; end; {non-interruptable}
+procedure psidefine(chan,level:integer;procedure p); extern; @t\2@>@;
+procedure psienable(chan:integer); extern; @t\2@>@;
+
+@ This code sets things up such that each time the user types control-G,
+the procedure |cntl_G| gets called, and |interrupt| gets incremented.
+The program can change |interrupt| whenever it wants to,
+but |interrupt| had better be a global variable.
+
+@d ATI=@'137 {Assign Terminal code to Interrupt channel JSYS}
+@d cntl_G_chan=34 {Channel for Control-G interrupts}
+
+@<Set up Control-G@>=
+begin
+psidefine(cntl_G_chan,1,cntl_G); {call |cntl_G| on interrupt, level 1}
+psienable(cntl_G_chan); {turn on those interrupts}
+jsys(ATI;7:cntl_G_chan); {assign control-G to channel}
+end
+
+@ Here is the code that does all the command line system magic.
+@d RSCAN=@'500 {ReSCAN buffer JSYS}
+@d CRLNM=@'502 {CReate Logical NaMe JSYS}
+
+@<Command line variables@>=
+@!ac1: integer; {AC1 from Rescan}
+@!rescan: packed array[1..max_rescan] of char; {rescan buffer}
+@!rescan_len: integer; {amount of |rescan| used}
+@!definition: packed array [1..79] of char; {ASCIZ, with control-V's}
+@!i,@!j: integer; {temporary}
+
+@ The array |logical_name| holds the logical name that we use to implement
+\TeX's memory from run to run. Actually, we may have to use a series of
+logical names, since we only get to save 39 characters in each one.
+
+@d next_logical_name==logical_name[7]:=chr(ord(logical_name[7])+1)
+
+@<Glob...@>=
+@!logical_name: packed array[1..8] of char; {ASCIZ ``TeXMEMx'', x=0,1,etc.}
+
+@ @<Set init...@>=
+logical_name:='TeXMEM0 '; logical_name[8]:=chr(0); {ASCIZ it}
+
+@ \ttw\ puts the user command line into the so-called rescan buffer.
+Actually, we have to use a real hack to see if it's a bogus Execute,
+Start, Continue, Debug, etc.\ command, in which case we should pretend
+there was no command line, since the command line that was there was
+not intended for \TeX.
+
+@<Get the |rescan| buffer and check that it's for us@>=
+jsys(RSCAN,1,i;0;ac1); {put the command line into the |TTY| input buffer}
+if (i<>2) or (ac1<=0) then goto done; {RSCAN failed, somehow}
+if eoln(term_in) then read_ln(term_in); {for some TOPS-20's}
+read(term_in,rescan:rescan_len); {read in rescan buffer}
+if rescan_len>max_rescan then begin
+ write_ln(term_out,'Command line longer than ',max_rescan:0,
+ 'characters, so I''m ignoring it');
+ read_ln(term_in); goto done; end;
+@/{The following line is based upon experimentation with \ttw!}
+if rescan_len=ac1-2 then goto done; {EX, ST, DEB commands}
+
+
+@ Now that we have a command line, we have to strip off the TeX command
+and see if there is a lone backslash (which means that the user wanted
+us to ignore the stuff in the logical name memory.
+
+@<Make |i| point to the actual command text@>=
+i:=1; while rescan[i]>' ' do incr(i); {skip the command name, presumably TeX}@/
+while (i<=rescan_len) and (rescan[i]=' ') do incr(i); {skip spaces}@/
+if (i=rescan_len) and (rescan[i]='\') then
+ begin @<Unremember logical names@>;
+ goto done; end; {escape to ignore memory}
+
+@ Here's where we actually do the command line stuff. Various parts of the
+code go to the label |done| if they realize that no special command line
+processing should happen.
+
+@<Process possible command line@>=
+@<Get the |rescan| buffer...@>;
+@<Make |i| point to the actual command text@>;
+if i<=rescan_len then @<We got command text@>
+else @<Use the memorized command text, if any@>;
+done:
+
+@ We get here if there was command text for \TeX. It gets put into |buffer|
+and into the logical name(s). We need to intersperse the characters with
+Control-V's so that they don't get capitalized and so that non-alphabetic
+characters get remembered properly. `Why doesn't \ttw\ have variables
+that can be defined?' you may ask; and well you may.
+
+@<We got command text@>=
+begin
+j:=1;
+while i<=rescan_len do begin
+ buffer[last]:=xord[rescan[i]]; incr(last);
+ definition[j]:=chr(@'26); {control-V}
+ incr(j);
+ definition[j]:=rescan[i];
+ incr(j);
+ incr(i);
+ if (j=79) or (i>rescan_len) then begin
+ definition[j]:=chr(0);
+ jsys(CRLNM,2,j;4,logical_name,definition;ac1);
+ if j=1 then write_ln(term_out,'CRLNM returned ',ac1:12:O);
+ j:=1;
+ next_logical_name;
+ end;
+ end;
+@<Unremember...@>; {In case the old one was longer than this one.}
+end
+
+@ We get here if we should put the memorized command line into |buffer|.
+
+@<Use the memorized command text, if any@>=
+loop@+begin
+ jsys(LNMST,2,j;0,logical_name,definition);
+ if j<>2 then goto done;
+ j:=1;
+ while (definition[j]<>chr(0)) do begin
+ buffer[last]:=xord[definition[j]];
+ incr(last); incr(j);
+ end;
+ next_logical_name;
+ end
+
+@ This code makes \TeX\ wipe out all logical names beginnig with the current
+one.
+
+@<Unremember...@>=
+repeat
+ jsys(CRLNM,2,j;0,logical_name);
+ next_logical_name;
+until j<>2
+
+@z
diff --git a/obsolete/systems/knuth/unsupported/tex/tex.vms-changes b/obsolete/systems/knuth/unsupported/tex/tex.vms-changes
new file mode 100644
index 0000000000..35e203cc2e
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/tex/tex.vms-changes
@@ -0,0 +1,1092 @@
+This change file is for the Vax/VMS vesion of TeX.
+Copyright (C) 1983 by David Fuchs. All rights are reserved.
+14May85 JLC .Increased string_vacancies and pool_size as in 1.1.
+ ? VLJ .Modified to handle tabs and form-feeds in input.
+
+@x
+\pageno=3
+@y
+\pageno=3
+\let\maybe=\iffalse
+\def\title{\TeX82 changes for Vax/VMS}
+@z
+
+@x
+@d banner=='This is TeX, Version 2.9' {printed when \TeX\ starts}
+@y
+@d banner=='This is TeX, Vax/VMS Version 2.9'
+@z
+
+@x
+procedure initialize; {this procedure gets things started properly}
+@y
+@<Vax/VMS procedures@>@/
+procedure initialize; {this procedure gets things started properly}
+@z
+
+@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==@{
+@d gubed==@}
+@z
+
+@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==
+@d tats==
+@z
+
+@x
+@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
+
+@x compiler directives== starlet and vax reserved words
+@<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
+On Vax/VMS, there are no compiler directives that can be introduced in this
+way, but we take this opportunity to include a few sysetem dependent goodies.
+
+@d VAX_text==@= text @>
+@d VAX_new==@= new @>
+@d VAX_none==@= none @>
+@d VAX_word==@= word @>
+@d VAX_error==@= error @>
+@d VAX_length==@= length @>
+@d VAX_syi_sid==@= syi$_sid @>
+@d VAX_continue==@= continue @>
+@d VAX_external==@= external @>
+@d VAX_readonly==@= readonly @>
+@d VAX_volatile==@= volatile @>
+@d VAX_aligned==@= aligned @>
+@d VAX_static==@= static @>
+@d VAX_unsigned==@= unsigned @>
+@d VAX_carriage_control==@= carriage_control @>
+@d VAX_io_setmode==@= io$_setmode @>
+@d VAX_iom_ctrlcast==@= io$m_ctrlcast @>
+@d VAX_immed==@= %immed @>
+@d VAX_stdescr==@= %stdescr @>
+@d VAX_ref==@= %ref @>
+@d VAX_qiow==@= $qiow @>
+@d VAX_assign==@= $assign @>
+@d VAX_numtim==@= $numtim @>
+@d VAX_getsyi==@= $getsyi @>
+@d VAX_lib_get_foreign==@= lib$get_foreign @>
+@d VAX_disposition==@= disposition @>
+@d VAX_delete==@= delete @>
+@d VAX_save==@= save @>
+@d VAX_varying==@= varying @>
+@d VAX_substr==@= substr @>
+@d VAX_trnlog==@= $trnlog @>
+@d VAX_ss_normal==@= ss$_normal @>
+@d VAX_user_action==@=user_action@>
+@d VAX_create==@=$create@>
+@d VAX_connect==@=$connect@>
+@d VAX_open==@=$open@>
+@d VAX_FAB_type==@= FAB$type @>
+@d VAX_RAB_type==@= RAB$type @>
+@d VAX_NAM_type==@= NAM$type @>
+@d VAX_PAS_FAB==@= PAS$FAB @>
+@d VAX_PAS_RAB==@= PAS$RAB @>
+@d VAX_undefined==@= undefined@>
+@d VAX_FAB_L_NAM== @=FAB$L_NAM@>
+@d VAX_NAM_B_RSL== @=NAM$B_RSL@>
+@d VAX_NAM_L_RSA== @=NAM$L_RSA@>
+
+@<Compiler directives@>=
+@\@=[inherit('sys$library:starlet')]@>@\
+ {allows us to use system symbols and routines}
+@z
+
+@x
+@d othercases == others: {default for cases not listed explicitly}
+@y
+@d othercases == otherwise {default for cases not listed explicitly}
+@z
+
+@x [1] compile-time constants
+@!mem_max=30000; {greatest index in \TeX's internal |mem| array;
+ must be strictly less than |max_halfword|;
+ must be equal to |mem_top| in \.{INITEX}, otherwise |>=mem_top|}
+@!mem_min=0; {smallest index in \TeX's internal |mem| array;
+ must be |min_halfword| or more;
+ must be equal to |mem_bot| in \.{INITEX}, otherwise |<=mem_bot|}
+@!buf_size=500; {maximum number of characters simultaneously present in
+ current lines of open files and in control sequences between
+ \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|}
+@!error_line=72; {width of context lines on terminal error messages}
+@!half_error_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}
+@!stack_size=200; {maximum number of simultaneous input sources}
+@!max_in_open=6; {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@!font_max=75; {maximum internal font number; must not exceed |max_quarterword|
+ and must be at most |font_base+256|}
+@!font_mem_size=20000; {number of words of |font_info| for all fonts}
+@!param_size=60; {maximum number of simultaneous macro parameters}
+@!nest_size=40; {maximum number of semantic levels simultaneously active}
+@!max_strings=3000; {maximum number of strings; must not exceed |max_halfword|}
+@!string_vacancies=8000; {the minimum number of characters that should be
+ available for the user's control sequences and font names,
+ after \TeX's own error messages are stored}
+@!pool_size=32000; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all fonts and
+ control sequences; must exceed |string_vacancies| by the total
+ length of \TeX's own strings, which is currently about 23000}
+@!save_size=600; {space for saving values outside of current group; must be
+ at most |max_halfword|}
+@!trie_size=8000; {space for hyphenation patterns; should be larger for
+ \.{INITEX} than it is in production versions of \TeX}
+@!dvi_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='TeXformats:TEX.POOL ';
+ {string of length |file_name_size|; tells where the string pool appears}
+@y
+@!mem_max=65500; {greatest index in \TeX's internal |mem| array;
+ must be strictly less than |max_halfword|;
+ must be equal to |mem_top| in \.{INITEX}, otherwise |>=mem_top|}
+@!mem_min=0; {smallest index in \TeX's internal |mem| array;
+ must be |min_halfword| or more;
+ must be equal to |mem_bot| in \.{INITEX}, otherwise |<=mem_bot|}
+@!buf_size=500; {maximum number of characters simultaneously present in
+ current lines of open files and in control sequences between
+ \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|}
+@!error_line=79; {width of context lines on terminal error messages}
+@!half_error_line=50; {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}
+@!stack_size=200; {maximum number of simultaneous input sources}
+@!max_in_open=6; {maximum number of input files and error insertions that
+ can be going on simultaneously}
+@!font_max=100; {maximum internal font number; must not exceed |max_quarterword|
+ and must be at most |font_base+256|}
+@!font_mem_size=35000; {number of words of |font_info| for all fonts}
+@!param_size=60; {maximum number of simultaneous macro parameters}
+@!nest_size=40; {maximum number of semantic levels simultaneously active}
+@!max_strings=5400; {maximum number of strings; must not exceed |max_halfword|}
+@!string_vacancies=26000; {the minimum number of characters that should be
+ available for the user's control sequences and font names,
+ after \TeX's own error messages are stored}
+@!pool_size=65500; {maximum number of characters in strings, including all
+ error messages and help texts, and the names of all fonts and
+ control sequences; must exceed |string_vacancies| by the total
+ length of \TeX's own strings, which is currently about 22500}
+@!save_size=600; {space for saving values outside of current group; must be
+ at most |max_halfword|}
+@!trie_size=8000; {space for hyphenation patterns; should be larger for
+ \.{INITEX} than it is in production versions of \TeX}
+@!dvi_buf_size=1024; {size of the output buffer; must be a multiple of 8}
+@!VAX_block_length=512; {must be half |dvi_buf_size| on Vax/VMS}
+@!file_name_size=69; {file names shouldn't be longer than this}
+@!pool_name=
+ 'TeX$formats:TEX.POO ';
+ {string of length |file_name_size|; tells where the string pool appears}
+@.TeX{\$}formats@>
+@z
+
+@x [1] Tangle-time constants
+@d mem_bot=0 {smallest index in the |mem| array dumped by \.{INITEX};
+ must not be less than |mem_min|}
+@d mem_top==30000 {largest index in the |mem| array dumped by \.{INITEX};
+ must be substantially larger than |mem_bot|
+ and not greater than |mem_max|}
+@d font_base=0 {smallest internal font number; must not be less
+ than |min_quarterword|}
+@d hash_size=2100 {maximum number of control sequences; it should be at most
+ about |(mem_max-mem_min)/10|, but 2100 is already quite generous}
+@d hash_prime=1777 {a prime number equal to about 85\% of |hash_size|}
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@y
+@d mem_bot=0 {smallest index in the |mem| array dumped by \.{INITEX};
+ must not be less than |mem_min|}
+@d mem_top==65500 {largest index in the |mem| array dumped by \.{INITEX};
+ must be substantially larger than |mem_bot|
+ and not greater than |mem_max|}
+@d font_base=0 {smallest internal font number; must not be less
+ than |min_quarterword|}
+@d hash_size=2500 {maximum number of control sequences; it should be at most
+ about |(mem_max-mem_min)/10|, but 2100 is already quite generous}
+@d hash_prime=2113 {a prime number equal to about 85\% of |hash_size|}
+@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions}
+@z
+
+@x [2] System-dependent character set changes:
+@^character set dependencies@>
+@^system dependencies@>
+
+@<Set init...@>=
+for i:=1 to @'37 do xchr[i]:=' ';
+@y
+@^character set dependencies@>
+@^system dependencies@>
+
+The code shown here is intended to be used on VAX/VMS systems,
+and at other installations where only the printable ASCII set, plus
+|carriage_return|, |tab|, and |form_feed| will show up in text files.
+All |line_feed| and |null| characters are skipped.
+
+@d form_feed=@'14 {ASCII code used at end of a page}
+@d tab=@'11
+
+@<Set initial values...@>=
+for i:=1 to @'37 do xchr[i]:=chr(i);
+xchr[form_feed]:=chr(form_feed);
+xchr[tab]:=chr(tab);
+@z
+
+@x [3] alpha files are text and byte files are blocks
+@!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
+@!alpha_file=VAX_text; {files that contain textual data}
+@!byte_block=packed array [0..VAX_block_length-1] of eight_bits;
+@!byte_file=packed file of byte_block; {files that contain binary data}
+@z
+
+
+@x
+@d reset_OK(#)==erstat(#)=0
+@d rewrite_OK(#)==erstat(#)=0
+
+@p function a_open_in(var f:alpha_file):boolean;
+@y
+@p function user_reset
+ (var FAB:VAX_FAB_type;
+ var RAB:VAX_RAB_type;
+ var F:unsafe_file):integer;
+var status:integer; NAM:NAM_ptr; p:charptr; i:integer;
+begin
+last_length:=0;
+status:=VAX_open(FAB);
+if odd(status) then status:=VAX_connect(RAB);
+if odd(status) then begin
+ NAM:=FAB.VAX_FAB_L_NAM::NAM_ptr;
+ if NAM<>nil then last_length:=NAM^.VAX_NAM_B_RSL;
+ for i:=1 to last_length do begin
+ p:=(NAM^.VAX_NAM_L_RSA::integer+i-1)::charptr;
+ last_name[i]:=p^;
+ end;
+ end;
+user_reset:=status;
+end;
+@#
+function user_rewrite
+ (var FAB:VAX_FAB_type;
+ var RAB:VAX_RAB_type;
+ var F:unsafe_file):integer;
+var status:integer; NAM:NAM_ptr; p:charptr; i:integer;
+begin
+status:=VAX_create(FAB);
+if odd(status) then status:=VAX_connect(RAB);
+if odd(status) then begin
+ NAM:=FAB.VAX_FAB_L_NAM::NAM_ptr;
+ if NAM<>nil then last_length:=NAM^.VAX_NAM_B_RSL;
+ for i:=1 to last_length do begin
+ p:=(NAM^.VAX_NAM_L_RSA::integer+i-1)::charptr;
+ last_name[i]:=p^;
+ end;
+ end;
+user_rewrite:=status;
+end;
+@#
+function a_open_in(var f:alpha_file):boolean;
+@z
+
+@x [3] file opening
+begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f);
+@y
+begin
+open(f,name_of_file,VAX_readonly,VAX_user_action:=user_reset,
+ VAX_error:=VAX_continue);
+if status(f)>0 then a_open_in:=false
+else begin
+ reset(f,VAX_error:=VAX_continue);
+ a_open_in:=status(f)<=0;
+ end;
+@z
+
+@x
+begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f);
+@y
+begin
+open(f,name_of_file,VAX_new,16383,VAX_disposition:=VAX_delete,
+ VAX_user_action:=user_rewrite,VAX_error:=VAX_continue);
+if status(f)>0 then a_open_out:=false
+else begin
+ linelimit(f,maxint);
+ rewrite(f,VAX_error:=VAX_continue);
+ a_open_out:=status(f)<=0;
+ end;
+@z
+
+@x
+begin reset(f,name_of_file,'/O'); b_open_in:=reset_OK(f);
+@y
+begin
+open(f,name_of_file,VAX_readonly,VAX_user_action:=user_reset,
+ VAX_error:=VAX_continue);
+if status(f)>0 then b_open_in:=false
+else begin
+ reset(f,VAX_error:=VAX_continue);
+ b_open_in:=status(f)<=0;
+ end;
+@z
+
+@x
+begin rewrite(f,name_of_file,'/O'); b_open_out:=rewrite_OK(f);
+@y
+begin
+open(f,name_of_file,VAX_new,VAX_disposition:=VAX_delete,
+ VAX_user_action:=user_rewrite,VAX_error:=VAX_continue);
+if status(f)>0 then b_open_out:=false
+else begin
+ rewrite(f,VAX_error:=VAX_continue);
+ b_open_out:=status(f)<=0;
+ end;
+@z
+
+@x
+begin reset(f,name_of_file,'/O'); w_open_in:=reset_OK(f);
+@y
+begin
+open(f,name_of_file,VAX_readonly,VAX_user_action:=user_reset,
+ VAX_error:=VAX_continue);
+if status(f)>0 then w_open_in:=false
+else begin
+ reset(f,VAX_error:=VAX_continue);
+ w_open_in:=status(f)<=0;
+ end;
+fmt_count:=0; {hack}
+@z
+
+@x
+begin rewrite(f,name_of_file,'/O'); w_open_out:=rewrite_OK(f);
+@y
+begin
+open(f,name_of_file,VAX_new,VAX_disposition:=VAX_delete,
+ VAX_user_action:=user_rewrite,VAX_error:=VAX_continue);
+if status(f)>0 then w_open_out:=false
+else begin
+ rewrite(f,VAX_error:=VAX_continue);
+ w_open_out:=status(f)<=0;
+ end;
+fmt_count:=0; {hack}
+@z
+
+@x [3] file closing
+begin close(f);
+@y
+begin close(f,VAX_disposition:=VAX_save,VAX_error:=VAX_continue);
+@z
+
+@x
+begin close(f);
+@y
+begin close(f,VAX_disposition:=VAX_save,VAX_error:=VAX_continue);
+@z
+
+@x
+begin close(f);
+@y
+begin close(f,VAX_disposition:=VAX_save,VAX_error:=VAX_continue);
+@z
+
+@x [3] read into auxiliary buffer first
+representing the beginning and ending of a line of text.
+
+@<Glob...@>=
+@y
+representing the beginning and ending of a line of text.
+
+On Vax/VMS, we will read the lines first into an auxiliary buffer, in
+order to save the running time of procedure-call overhead. We have
+to be very carefull to handle lines longer than the arbitrarily chosen
+length of the |aux_buf|.
+
+@<Glob...@>=
+@!aux_buf:VAX_varying [133] of char; {where the characters go first}
+@z
+
+@x [3] ditto
+@p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean;
+ {inputs the next line or returns |false|}
+var last_nonblank:0..buf_size; {|last| with trailing blanks removed}
+begin if bypass_eoln then if not eof(f) then get(f);
+ {input the first character of the line into |f^|}
+last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
+if eof(f) then input_ln:=false
+else begin last_nonblank:=first;
+ while not eoln(f) do
+ begin if last>=max_buf_stack then
+ begin max_buf_stack:=last+1;
+ if max_buf_stack=buf_size then
+ overflow("buffer size",buf_size);
+@:TeX capacity exceeded buffer size}{\quad buffer size@>
+ end;
+ buffer[last]:=xord[f^]; get(f); incr(last);
+ if buffer[last-1]<>" " then last_nonblank:=last;
+ end;
+ last:=last_nonblank; input_ln:=true;
+ end;
+end;
+@y
+@p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean;
+ {inputs the next line or returns |false|}
+label found;
+var @!len:integer; {length of line input}
+@!k:0..buf_size; {index into |buffer|}
+begin
+last:=first; {cf.\ Matthew 19\thinspace:\thinspace30}
+if status(f)<>0 then input_ln:=false
+else begin
+ while not eoln(f) do
+ begin read(f,aux_buf,VAX_error:=VAX_continue);
+ len:=VAX_length(aux_buf);
+ if last+len>=max_buf_stack then
+ begin
+ if last+len<buf_size then max_buf_stack:=last+len
+ else overflow("buffer size",buf_size);
+ end;
+ for k:=last to last+len-1 do buffer[k]:=xord[aux_buf[k-last+1]];
+ last:=last+len;
+ end;
+ found: if last>first then if buffer[last-1]=" " then begin
+ decr(last); goto found; end;
+ input_ln:=true;
+ read_ln(f,VAX_error:=VAX_continue);
+ end;
+end;
+@z
+
+@x [3] terminal file opening
+@ Here is how to open the terminal files
+in \ph. The `\.{/I}' switch suppresses the first |get|.
+@^system dependencies@>
+
+@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
+@ Here is how to open the terminal files
+under Vax/VMS.
+@^system dependencies@>
+
+@d t_open_in==begin open(term_in,'SYS$INPUT');
+ reset(term_in);
+ in_FAB:=VAX_PAS_FAB(term_in);
+ in_RAB:=VAX_PAS_RAB(term_in);
+ end {open the terminal for text input}
+@d t_open_out==begin
+ open(term_out,'SYS$OUTPUT',VAX_carriage_control:=VAX_none);
+ linelimit(term_out,maxint);
+ rewrite(term_out);
+ out_FAB:=VAX_PAS_FAB(term_out);
+ out_RAB:=VAX_PAS_RAB(term_out);
+ end {open the terminal for text output}
+@z
+
+@x [3] terminal hacks: clear and update
+these operations can be specified in \ph:
+@^system dependencies@>
+
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@d clear_terminal == break_in(term_in,true) {clear the terminal input buffer}
+@d wake_up_terminal == do_nothing {cancel the user's cancellation of output}
+@y
+these operations can be specified in Vax/VMS Pascal:
+@^system dependencies@>
+
+@d update_terminal == write_ln(term_out) {empty the terminal output buffer}
+@d clear_terminal == in_RAB^.@=RAB$V_PTA@>:=true
+ {clear the terminal input buffer}
+@.PTA@>
+@d wake_up_terminal == begin
+ out_RAB^.@=RAB$V_CCO@>:=true;
+ write_ln(term_out);
+ out_RAB^.@=RAB$V_CCO@>:=false;
+ end {cancel the user's cancellation of output}
+@.CCO@>
+@d crlf == chr(13),chr(10)
+@z
+
+@x [3] terminal initialization
+@ The following program does the required initialization
+without retrieving a possible command line.
+It should be clear how to modify this routine to deal with command lines,
+if the system permits them.
+@^system dependencies@>
+
+@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;
+@.**@>
+ if not input_ln(term_in,true) then {this shouldn't happen}
+ begin write_ln(term_out);
+ write(term_out,'! End of file on the terminal... why?');
+@.End of file on the terminal@>
+ init_terminal:=false; return;
+ end;
+ loc:=first;
+ while (loc<last)and(buffer[loc]=" ") do incr(loc);
+ if loc<last then
+ begin init_terminal:=true;
+ return; {return unless the line was all blank}
+ end;
+ write_ln(term_out,'Please type the name of your input file.');
+ end;
+exit:end;
+@y
+@ The following program does the required initialization
+by retrieving a possible command line, and if none exists,
+prompting the user for the first line of input.
+@^system dependencies@>
+
+@p
+[VAX_external] function VAX_lib_get_foreign(
+ VAX_stdescr cmdlin:[VAX_volatile] packed array [$l1..$u1:integer] of char
+ := VAX_immed 0;
+ VAX_stdescr prompt:[VAX_volatile] packed array [$l2..$u2:integer] of char
+ := VAX_immed 0;
+ var len : [VAX_volatile] sixteen_bits := VAX_immed 0;
+ var flag : [VAX_volatile] integer := VAX_immed 0)
+ :integer; extern;
+
+function init_terminal:boolean; {gets the terminal input started}
+label exit;
+var command_line: packed array[1..300] of char;
+@!len: sixteen_bits;
+@!i: integer;
+begin t_open_in;
+i:=0;
+VAX_lib_get_foreign(command_line,,len,i);
+i:=1; while (i<=len) and (command_line[i]=' ') do incr(i);
+if i<=len then begin
+ loc:=first;
+ last:=first;
+ while i<=len do begin
+ buffer[last]:=xord[command_line[i]];
+ if (buffer[last]>="A") and (buffer[last]<="Z")
+ then buffer[last]:=buffer[last]+"a"-"A";
+ incr(last); incr(i);
+ end;
+ init_terminal:=true; return;
+ end;
+loop@+begin wake_up_terminal; write(term_out,'**'); update_terminal;
+@.**@>
+ if not input_ln(term_in,true) then {this shouldn't happen}
+ begin write(term_out,crlf);
+ write_ln(term_out,'! End of file on the terminal... why?',crlf);
+@.End of file on the terminal@>
+ init_terminal:=false; return;
+ end;
+ loc:=first;
+ while (loc<last)and(buffer[loc]=" ") do incr(loc);
+ if loc<last then
+ begin init_terminal:=true;
+ return; {return unless the line was all blank}
+ end;
+ write_ln(term_out,'Please type the name of your input file.',crlf);
+ end;
+exit:end;
+@z
+
+@x [4] bad_pool needs real crlf
+@ @d bad_pool(#)==begin wake_up_terminal; write_ln(term_out,#);
+@y
+@ @d bad_pool(#)==begin wake_up_terminal; write_ln(term_out,#,crlf);
+@z
+
+@x [5] real crlf for terminal
+@d wterm(#)==write(term_out,#)
+@d wterm_ln(#)==write_ln(term_out,#)
+@d wterm_cr==write_ln(term_out)
+@y
+@d wterm(#)==write(term_out,#)
+@d wterm_ln(#)==write_ln(term_out,#,crlf)
+@d wterm_cr==write_ln(term_out,crlf)
+@z
+
+@x [5] Turn off clearing typeahead after terminal input
+term_offset:=0; {the user's line ended with \<\rm return>}
+@y
+in_RAB^.@=RAB$V_PTA@>:=false; {turn off purging of typeahead}
+@.PTA@>
+term_offset:=0; {the user's line ended with \<\rm return>}
+@z
+
+@x [6] interrupts
+@d check_interrupt==begin if interrupt<>0 then pause_for_instructions;
+ end
+
+@<Global...@>=
+@!interrupt:integer; {should \TeX\ pause for instructions?}
+@y
+@d check_interrupt==begin if interrupt<>0 then pause_for_instructions;
+ end
+@d enable_control_C==
+VAX_qiow(,tt_chan,VAX_io_setmode+VAX_iom_ctrlcast,,,,
+ VAX_immed ctrlc_rout,,VAX_immed 3,,,);
+
+@<Global...@>=
+@!interrupt:[VAX_volatile]integer; {should \TeX\ pause for instruction?}
+@z
+
+@x
+interrupt:=0; OK_to_interrupt:=true;
+@y
+interrupt:=0; OK_to_interrupt:=true;
+if VAX_assign('TT',tt_chan,,)=1 then enable_control_C;
+@z
+
+@x [7] double precision reals
+@d set_glue_ratio_zero(#) == #:=0.0 {store the representation of zero ratio}
+@d set_glue_ratio_one(#) == #:=1.0 {store the representation of unit ratio}
+@d float(#) == # {convert from |glue_ratio| to type |real|}
+@d unfloat(#) == # {convert from |real| to type |glue_ratio|}
+@d float_constant(#) == #.0 {convert |integer| constant to |real|}
+
+@<Types...@>=
+@!glue_ratio=real; {one-word representation of a glue expansion factor}
+@y
+On Vax/VMS, we use some hackery to cause floating point numbers stored in
+|mem| to be |single|, but other |real| variables and expressions are
+done as |double| length reals.
+
+@d set_glue_ratio_zero(#) == #:=0.0 {store the representation of zero ratio}
+@d set_glue_ratio_one(#) == #:=1.0 {store the representation of unit ratio}
+@d real == double {use double precision reals for computation}
+@d float(#) == dble(#) {convert from |glue_ratio| to type |real|}
+{FIX ME}
+@d unfloat(#) == sngl(1.0@&D0 * #) {convert from |real| to type |glue_ratio|}
+@d float_constant(#) == #.0@&D0 {convert |integer| constant to |real|}
+
+@<Types...@>=
+@!glue_ratio=r@&e@&a@&l; {one-word representation of a glue expansion factor}
+@z
+
+@x
+@d qi(#)==#+min_quarterword
+ {to put an |eight_bits| item into a quarterword}
+@d qo(#)==#-min_quarterword
+ {to take an |eight_bits| item out of a quarterword}
+@d hi(#)==#+min_halfword
+ {to put a sixteen-bit item into a halfword}
+@d ho(#)==#-min_halfword
+ {to take a sixteen-bit item from a halfword}
+@y
+@d qi(#)==#
+@d qo(#)==#
+@d hi(#)==#
+@d ho(#)==#
+@z
+
+@x [8] block up word files
+@!word_file = file of memory_word;
+@y
+@!word_block = packed array [0..VAX_block_length-1] of memory_word;
+@!word_file = packed file of word_block;
+@z
+
+@x [12] check glue ratio for REALness
+arbitrary random value. The following code assumes that a properly
+formed nonzero |real| number has absolute value $2^{20}$ or more when
+it is regarded as an integer; this precaution was adequate to prevent
+floating point underflow on the author's computer.
+@y
+arbitrary random value. The following code uses the Vax/VMS predeclared
+routine |undefined|.
+@z
+
+@x
+ if abs(mem[p+glue_offset].int)<@'4000000 then print("?.?")
+@y
+ if VAX_undefined(mem[p+glue_offset].gr) then print("?.?")
+@z
+
+@x [17] Special form_feed initialization:
+cat_code("\"):=escape; cat_code("%"):=comment;
+@y
+cat_code("\"):=escape; cat_code("%"):=comment;
+cat_code(form_feed):=car_ret;
+@z
+
+@x [17] date/time
+Since standard \PASCAL\ cannot provide such information, something special
+is needed. The program here simply specifies July 4, 1776, at noon; but
+users probably want a better approximation to the truth.
+
+@p procedure fix_date_and_time;
+begin time:=12*60; {minutes since midnight}
+day:=4; {fourth day of the month}
+month:=7; {seventh month of the year}
+year:=1776; {Anno Domini}
+@y
+@p procedure fix_date_and_time;
+var t:array[1..7] of signed_halfword; {raw year, month, day and time}
+begin VAX_numtim(t);
+year:=t[1]; month:=t[2]; day:=t[3];
+time:=t[4]*60+t[5]; {minutes since midnight}
+@z
+
+@x [28] file names and default areas
+following structure: If the name contains `\.>' or `\.:', the file area
+@y
+following structure: If the name contains `\.]' or `\.:', the file area
+@z
+
+@x [28] system logical names
+@d TEX_area=="TeXinputs:"
+@.TeXinputs@>
+@d TEX_font_area=="TeXfonts:"
+@.TeXfonts@>
+@y
+@d TEX_area=="TeX$inputs:"
+@.TeXinputs@>
+@.TeX{\$}inputs@>
+@d TEX_font_area=="TeX$fonts:"
+@.TeXfonts@>
+@.TeX{\$}fonts@>
+@z
+
+@x [28] directories delimited with square brackets
+else begin if (c=">")or(c=":") then
+@y
+else begin if (c="]")or(c=":") then
+@z
+
+@x [29] Logical name translation:
+@ The third.
+@^system dependencies@>
+
+@p procedure end_name;
+begin if str_ptr+3>max_strings then
+ overflow("number of strings",max_strings-init_str_ptr);
+@:TeX capacity exceeded number of strings}{\quad number of strings@>
+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
+@ The third. We have to check to see if a logical name has been
+referred to, and if so, translate it.
+@^system dependencies@>
+
+@p procedure end_name;
+label restart,exit;
+var s,@!u:VAX_varying[file_name_size] of char;
+@!t:packed array[1..file_name_size] of char;
+@!TRNLOG_return: integer; {what did the TRNLOG return?}
+@!i:pool_pointer;
+@!len:signed_halfword;
+@!c:char;
+begin
+restart:
+if (str_pool[area_delimiter]=":") and (pool_ptr=area_delimiter+1) then
+ begin
+ cur_area:=make_string;
+ len:=length(cur_area)-1; {don't include the colon}
+ for i:=1 to len do begin
+ c:=xchr[str_pool[str_start[cur_area]+i-1]];
+ if ('a'<=c) and (c<='z') then c:=chr(ord(c)+ord('A')-ord('a'));
+ t[i]:=c;
+ end;
+ s:=VAX_substr(t,1,len);
+ TRNLOG_return:=VAX_trnlog(s,len,t,,,);
+ if TRNLOG_return<>VAX_ss_normal then begin
+ cur_ext:=""; cur_name:=""; {silly case}
+ return;
+ end;
+ flush_string; {needn't remember logical name in |cur_area|}
+ begin_name;
+ for i:=1 to len do
+ if not more_name(xord[t[i]]) then goto restart;
+ goto restart; {heavy!}
+ end;
+if str_ptr+3>max_strings then
+ overflow("number of strings",max_strings-init_str_ptr);
+@:TeX capacity exceeded number of strings}{\quad number of strings@>
+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;
+exit:
+end;
+@z
+
+@x [28] system logical names
+@d format_default_length=20 {length of the |TEX_format_default| string}
+@d format_area_length=11 {length of its area part}
+@y
+@d format_default_length=21 {length of the |TEX_format_default| string}
+@d format_area_length=12 {length of its area part}
+@z
+
+@x [28] system logical names
+TEX_format_default:='TeXformats:plain.fmt';
+@y
+TEX_format_default:='TeX$formats:plain.fmt';
+@.TeX{\$}formats@>
+@z
+
+@x [28] get file name from system
+begin if (pool_ptr+name_length>pool_size)or(str_ptr=max_strings) then
+ make_name_string:="?"
+else begin for k:=1 to name_length do append_char(xord[name_of_file[k]]);
+ make_name_string:=make_string;
+ end;
+@y
+begin if (pool_ptr+last_length>pool_size)or(str_ptr=max_strings) then
+ make_name_string:="?"
+else begin for k:=1 to last_length do append_char(xord[last_name[k]]);
+ make_name_string:=make_string;
+ end;
+@z
+
+@x
+@p procedure pack_job_name(@!s:str_number); {|s = ".log"|, |".dvi"|, or
+@y
+@p procedure pack_job_name(@!s:str_number); {|s = ".lis"|, |".dvi"|, or
+@z
+
+@x
+pack_job_name(".log");
+@y
+pack_job_name(".lis");
+@z
+
+@x
+prompt_file_name("transcript file name",".log");
+@y
+prompt_file_name("transcript file name",".lis");
+@z
+
+@x [29] tfm blocking
+if not b_open_in(tfm_file) then abort;
+@y
+if not b_open_in(tfm_file) then abort;
+tfm_count:=0;
+@z
+
+@x [29] tfm blocked
+@d fget==get(tfm_file)
+@d fbyte==tfm_file^
+@y
+@d fget==begin incr(tfm_count);
+ if tfm_count=VAX_block_length then begin
+ get(tfm_file,VAX_error:=VAX_continue); tfm_count:=0; end
+ end
+@d fbyte==tfm_file^[tfm_count]
+@z
+
+@x [29] tfm blocked
+if eof(tfm_file) then abort;
+@y
+if status(tfm_file)<>0 then abort;
+if eof(tfm_file) then abort;
+@z
+
+@x [31] dvi blocked
+@ Some systems may find it more efficient to make |dvi_buf| a |packed|
+array, since output of four bytes at once may be facilitated.
+@^system dependencies@>
+
+@<Glob...@>=
+@!dvi_buf:array[dvi_index] of eight_bits; {buffer for \.{DVI} output}
+@y
+@ Some systems may find it more efficient to make |dvi_buf| a |packed|
+array, since output of four bytes at once may be facilitated. On Vax/VMS,
+we get even more complicated than that, for efficiency.
+
+@d dvi_buf==d_buffer.b {buffer for \.{DVI} output}
+
+@<Glob...@>=
+@!d_buffer: [VAX_volatile,VAX_aligned(9)] packed record
+ case boolean of
+ false: (b:packed array[dvi_index] of eight_bits);
+ true: (l:byte_block; r:byte_block; j:eight_bits);
+ end;
+@z
+
+@x [31] dvi blocked
+@ The actual output of |dvi_buf[a..b]| to |dvi_file| is performed by calling
+|write_dvi(a,b)|. For best results, this procedure should be optimized to
+run as fast as possible on each particular system, since it is part of
+\TeX's inner loop. It is safe to assume that |a| and |b+1| will both be
+multiples of 4 when |write_dvi(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@>
+@^inner loop@>
+@^defecation@>
+
+@p procedure write_dvi(@!a,@!b:dvi_index);
+var k:dvi_index;
+begin for k:=a to b do write(dvi_file,dvi_buf[k]);
+end;
+@y
+@ The actual output of |dvi_buf[a..b]| to |dvi_file| is performed by calling
+|write| on the other variant of the |dvi_buf| record. Thus, we have to be
+sure that things line up properly.
+@^system dependencies@>
+@^inner loop@>
+@^defecation@>
+
+@<Check the ``co...@>=
+if dvi_buf_size<>2*VAX_block_length then bad:=223;
+@z
+
+% [31] dvi blocked
+@x
+ begin write_dvi(0,half_buf-1); dvi_limit:=half_buf;
+@y
+ begin write(dvi_file,d_buffer.l); dvi_limit:=half_buf;
+@z
+
+@x
+else begin write_dvi(half_buf,dvi_buf_size-1); dvi_limit:=dvi_buf_size;
+@y
+else begin write(dvi_file,d_buffer.r); dvi_limit:=dvi_buf_size;
+@z
+
+@x [31] dvi blocked
+if dvi_limit=half_buf then write_dvi(half_buf,dvi_buf_size-1);
+if dvi_ptr>0 then write_dvi(0,dvi_ptr-1)
+@y
+if dvi_limit=half_buf then write(dvi_file,d_buffer.r);
+for k:=dvi_ptr to dvi_buf_size do dvi_buf[k]:=223;
+if dvi_ptr>0 then write(dvi_file,d_buffer.l);
+if dvi_ptr>half_buf then write(dvi_file,d_buffer.r);
+@z
+
+@x [50] block fmt files
+@d dump_wd(#)==begin fmt_file^:=#; put(fmt_file);@+end
+@d dump_int(#)==begin fmt_file^.int:=#; put(fmt_file);@+end
+@d dump_hh(#)==begin fmt_file^.hh:=#; put(fmt_file);@+end
+@d dump_qqqq(#)==begin fmt_file^.qqqq:=#; put(fmt_file);@+end
+@y
+@d fmt_put==begin incr(fmt_count);
+ if fmt_count=VAX_block_length then begin
+ put(fmt_file,VAX_error:=VAX_continue); fmt_count:=0; end
+ end
+@d fmt_word==fmt_file^[fmt_count]
+
+@d dump_wd(#)==begin fmt_word:=#; fmt_put;@+end
+@d dump_int(#)==begin fmt_word.int:=#; fmt_put;@+end
+@d dump_hh(#)==begin fmt_word.hh:=#; fmt_put;@+end
+@d dump_qqqq(#)==begin fmt_word.qqqq:=#; fmt_put;@+end
+@z
+
+@x
+@d undump_wd(#)==begin get(fmt_file); #:=fmt_file^;@+end
+@d undump_int(#)==begin get(fmt_file); #:=fmt_file^.int;@+end
+@d undump_hh(#)==begin get(fmt_file); #:=fmt_file^.hh;@+end
+@d undump_qqqq(#)==begin get(fmt_file); #:=fmt_file^.qqqq;@+end
+@y
+@d fmt_get==begin incr(fmt_count);
+ if fmt_count=VAX_block_length then begin
+ get(fmt_file,VAX_error:=VAX_continue); fmt_count:=0; end
+ end
+@d undump_wd(#)==begin fmt_get; #:=fmt_word;@+end
+@d undump_int(#)==begin fmt_get; #:=fmt_word.int;@+end
+@d undump_hh(#)==begin fmt_get; #:=fmt_word.hh;@+end
+@d undump_qqqq(#)==begin fmt_get; #:=fmt_word.qqqq;@+end
+@z
+
+@x
+x:=fmt_file^.int;
+@y
+x:=fmt_word.int;
+@z
+
+@x [50] fmt file blocked
+w_close(fmt_file)
+@y
+while fmt_count>0 do dump_int(0); {flush out the buffer}
+w_close(fmt_file)
+@z
+
+@x
+@!ready_already:integer; {a sacrifice of purity for economy}
+@y
+@!ready_already:[VAX_static]integer := 0; {a sacrifice of purity for economy}
+@z
+
+@x [54] left overs
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \TeX\ work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the published program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@y
+Here are the remaining changes to the program
+that are necessary to make \.{TeX} work on Vax/VMS.
+
+@ Here are the things we need for |byte_file| and |word_file| files:
+
+@<Glob...@>=
+@!tfm_count: 0..VAX_block_length;
+@!fmt_count: 0..VAX_block_length;
+
+@ Here's the interrupt stuff.
+
+@<Types...@>=
+@!signed_halfword=[VAX_word] -32768..32767;
+@!sixteen_bits=[VAX_word] 0..65535;
+
+@ @<Glob...@>=
+@!itm: array [1..4] of VAX_unsigned;
+@!res:[VAX_volatile] integer;
+@!tt_chan: [VAX_volatile] signed_halfword;
+
+@ @<Vax/VMS procedures@>=
+[asynchronous] procedure @!ctrlc_rout;
+begin
+interrupt:=1;
+enable_control_C;
+end;
+
+@ Here is the stuff for magic file operations.
+@<Types...@>=
+unsafe_file = [unsafe] file of char;
+FAB_ptr = ^VAX_FAB_type;
+RAB_ptr = ^VAX_RAB_type;
+NAM_ptr = ^VAX_NAM_type;
+charptr = ^char;
+
+@ @<Vax/VMS procedures@>=
+function VAX_PAS_FAB(var foobar:unsafe_file):FAB_ptr; extern;
+function VAX_PAS_RAB(var foobar:unsafe_file):RAB_ptr; extern;
+
+@ @<Glob...@>=
+in_FAB,out_FAB: FAB_ptr;
+in_RAB,out_RAB: RAB_ptr;
+last_length: integer;
+last_name:packed array [1..file_name_size] of char;
+@z
diff --git a/obsolete/systems/knuth/unsupported/texware/dviimp.tops20-changes b/obsolete/systems/knuth/unsupported/texware/dviimp.tops20-changes
new file mode 100644
index 0000000000..42a0eb748b
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/texware/dviimp.tops20-changes
@@ -0,0 +1,406 @@
+% Change file for TOPS-20 by Tomas Rokicki. Send bug reports to
+% ROKICKI@SU-SCORE.
+
+@x [1] Tell WEAVE to print only the changes:
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\ttw{{\mc TOPS-20}}
+\def\title{DVIIMP changes for \ttw}
+@z
+
+@x [2]
+@d banner=='This is DVIIMP, Version 0.94' {printed when the program starts}
+@y
+@d banner=='This is DVIIMP, TOPS-20 Version 0.94'
+ {printed when the program starts}
+@z
+
+@x [3]
+@ The binary input comes from |dvi_file|, and the symbolic output is written
+on \PASCAL's standard |output| file. The term |print| is used instead of
+|write| when this program writes on |output|, so that all such output
+could easily be redirected if desired.
+
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+@d print_nl==write_ln
+@y
+@ The binary input comes from |dvi_file|, and the symbolic output is written
+on TOPS-20's standard |tty| file. The term |print| is used instead of
+|write| when this program writes on |tty|, so that all such output
+could easily be redirected if desired.
+
+@d print(#)==write(tty,#)
+@d print_ln(#)==write_ln(tty,#)
+@d print_nl==write_ln(tty)
+@z
+
+@x [4]
+@p program DVI_IMP(@!dvi_file,@!im_file,@!output);
+@y
+@p program DVI_IMP ;
+@z
+
+@x [30]
+@p function read_int:integer;
+var i:integer;
+@!neg_flag:boolean;
+begin
+neg_flag:=false; i:=0;
+get(tty);
+while tty^=' ' do get(tty);
+if (tty^='-') then neg_flag:=true;
+while (tty^='-') or (tty^='+') do get(tty);
+while (tty^>='0') and (tty^<='9') do begin
+ i:=i*10+xord[tty^]-"0"; get(tty);
+ end;
+if neg_flag then i:=-i;
+read_int:=i;
+end;
+@y
+@p function read_int:integer;
+var i:integer;
+@!neg_flag:boolean;
+begin
+neg_flag:=false; i:=0;
+if rescan[rsp]='-' then neg_flag := true ;
+if (rescan[rsp]='-') or (rescan[rsp]='+') then incr(rsp) ;
+while (rescan[rsp]>='0') and (rescan[rsp]<='9') do begin
+ i:=i*10+xord[rescan[rsp]]-"0"; incr(rsp);
+end;
+if neg_flag then i:=-i;
+read_int:=i;
+end;
+@z
+
+@x [31]
+@p procedure open_dvi_file; {prepares to read packed bytes in |dvi_file|}
+begin reset(dvi_file);
+cur_loc:=0;
+end;
+@#
+procedure open_gf_file; {prepares to read packed bytes in |gf_file|}
+begin reset(gf_file,cur_name);
+cur_gf_loc:=0;
+end;
+@#
+procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|}
+begin reset(tfm_file,cur_tfm_name);
+end;
+@y
+@p procedure open_dvi_file; {prepares to read packed bytes in |dvi_file|}
+begin reset(dvi_file,dvi_name,'/O/B:8');
+cur_loc:=0;
+end;
+@#
+procedure open_gf_file; {prepares to read packed bytes in |gf_file|}
+begin reset(gf_file,cur_name,'/O/B:8');
+cur_gf_loc:=0;
+end;
+@#
+procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|}
+begin reset(tfm_file,cur_tfm_name,'/O/B:8');
+end;
+@z
+
+@x [32]
+@p procedure open_im_file; {prepares to write packed bytes in |im_file|}
+begin rewrite(im_file); im_byte_no:=0;
+end;
+@y
+@p procedure open_im_file; {prepares to write packed bytes in |im_file|}
+begin rewrite(im_file,im_name,'/O/B:8'); im_byte_no:=0;
+end;
+@z
+
+@x [32]
+it, we will also declare |cur_gf_loc|.
+@y
+it, we will also declare |cur_gf_loc|, |dvi_name|, and |im_name|.
+@z
+
+@x [32]
+@!cur_name:packed array[1..name_length] of char; {external name,
+ with no lower case letters}
+@!cur_tfm_name:packed array[1..name_length] of char; {external name,
+ with no lower case letters}
+@y
+@!cur_name:packed array[1..name_length] of char; {external name,
+ with no lower case letters}
+@!cur_tfm_name:packed array[1..name_length] of char; {external name,
+ with no lower case letters}
+@!dvi_name,@!im_name:packed array[1..name_length] of char;
+ {external name, with no lower case letters}
+@z
+
+<><>@x [49]
+@!font_m_val:array [0..max_fonts] of integer; {overall font magnification}
+<><>@y
+@!font_m_val:array [0..max_fonts] of integer; {overall font magnification}
+@!font_d_val:array [0..max_fonts] of integer; {directory size of font}
+<><>@z
+
+@x [66]
+and |term_out| for terminal output.
+@^system dependencies@>
+
+@<Glob...@>=
+@!buffer:array[0..terminal_line_length] of ASCII_code;
+@!term_in:text_file; {the terminal, considered as an input file}
+@!term_out:text_file; {the terminal, considered as an output file}
+@y
+and |term_out| for terminal output.
+@^system dependencies@>
+
+@d term_in==tty {the terminal, considered as an input file}
+@d term_out==tty {the terminal, considered as an output file}
+
+@<Glob...@>=
+@!buffer:array[0..terminal_line_length] of ASCII_code;
+@z
+
+@x [66]
+begin update_terminal; reset(term_in);
+@y
+begin update_terminal;
+@z
+
+@x [67]
+begin rewrite(term_out); {prepare the terminal for output}
+write_ln(term_out,banner);
+@y
+begin
+@<Determine the desired |dvi_name|@> ;
+@z
+
+@x [67]
+ repeat if buffer[buf_ptr]="*" then
+@y
+ begin f_flag := true ;
+ repeat if buffer[buf_ptr]="*" then
+@z
+
+@x [67]
+ until start_vals=k
+@y
+ until start_vals=k ; start_page := start_count[0] ; end
+@z
+
+@x [68]
+ begin max_pages:=get_integer;
+@y
+ begin n_flag := true ; max_pages := get_integer ; num_pages := max_pages ;
+@z
+
+<><>@x [72]
+m:=round((0.3*mag*q)/d);
+<><>@y
+m:=round((0.3*mag*q)/d);font_d_val[nf]:=round((1.5*mag*q)/d);
+<><>@z
+
+@x [73]
+@!k:0..name_size; {indices into |names|}
+@y
+@!i:integer; {general index}
+@!k:0..name_size; {indices into |names|}
+@z
+
+@x [74]
+ print(' not found');
+@y
+ print('gf not found');
+@z
+
+@x [75]
+cur_name[r+1]:='.'; cur_name[r+2]:='G'; cur_name[r+3]:='F';
+@y
+ incr(r) ; cur_name[r] := '.' ;
+ i := font_m_val[cur_font] ; incr(r) ;
+ if i > 1000 then begin
+ cur_name[r] := xchr["0"+i div 1000] ; incr(r) ; i := i mod 1000 ;
+ end ;
+ cur_name[r] := xchr["0"+i div 100] ; incr(r) ; i := i mod 100 ;
+ cur_name[r] := xchr["0"+i div 10] ; incr(r) ;
+ cur_name[r] := xchr["0"+i mod 10] ;
+cur_name[r+1]:='G'; cur_name[r+2]:='F';
+@z
+
+@x [98]
+@p begin initialize; {get all variables initialized}
+@y
+@p begin initialize; {get all variables initialized}
+@<Get file name and options@> ;
+@z
+
+@x
+final_end:end.
+@y
+if spoolit then @<Send the job to the printer@>;
+final_end:end.
+@z
+
+@x [99]
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{DVIIMP} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+@y
+These are the changes that are necessary to make \.{DVIIMP} work on
+TOPS-20. This just means getting the file name from the command line
+currently, but additional code to parse options needs to be added.
+@^system dependencies@>
+
+@ On TOPS-20, we can get the command line using the so-called rescan buffer.
+Thus, the command line actually becomes the first part of input seen in the
+file \.{TTY}. We need to skip over to the file name, then parse the file
+name and any options that may be specified.
+
+@d RSCAN=@'500 {ReSCAN buffer JSYS}
+
+@<Get file name and options...@>=
+jsys(RSCAN,1,i;0;ac1); {put the command line into the |TTY| input buffer}
+if (i<>2) or (ac1<=0) then
+ abort('Couldn''t get a command line, somehow.'); {RSCAN failed, somehow}
+if eoln(term_in) then read_ln(term_in); {for some TOPS-20's}
+read(term_in,rescan:rescan_len); {read in rescan buffer}
+if rescan_len>max_rescan then
+ abort('command line too long!') ;
+read_ln(term_in) ;
+if rescan_len=ac1-2 then dialog
+else begin
+ i:=1; while rescan[i]>' ' do incr(i) ; { skip invocation name }
+ while(i<=rescan_len) and (rescan[i]=' ') do incr(i) ; {skip spaces}
+ if (i>rescan_len) then dialog
+ else
+ @<Parse file name and options@> ;
+end ;
+
+@ Now we define the routine in dialog which gets the file name from the
+terminal.
+
+@<Determine the desired |dvi_name|@>=
+print('DVI file name: ') ;
+input_ln ;
+@<Get the |dvi_name| and create the |im_name|@>
+
+@ We had something on the command line. Now we try to figure out what
+it was. For now we assume that the whole command line option is the name
+of the file, so we copy it into |dvi_name|. We then try to figure out
+where the extension begins, so we can tack on the extension \.{IMP} and use
+that as the file name.
+
+@<Parse file name and options@>=
+begin
+spoolit:=true;
+j := 0 ; last_ext := 0 ;
+rescan[rescan_len+1] := '!' ;
+while (i <= rescan_len) and (j < terminal_line_length) and
+ (rescan[i] <> '/') do begin
+ buffer[j] := xord[rescan[i]] ;
+ incr(i) ; incr(j) ;
+end ;
+rsp := i ;
+while (rescan[rsp]='/') do
+ @<Parse option@> ;
+if j >= terminal_line_length then abort('File name too long!') ;
+buffer[j] := " " ;
+@<Get the |dvi_name| and create the |im_name|@>;
+end
+
+@ Now we parse the desired option. This can be any of C, F, or N, for
+copies, starting page, and maximum pages, respectively.
+
+@<Parse option@>=
+begin
+incr(rsp) ; {skip "/"}
+i := rsp ; while (rescan[i] <> '/') and (rescan[i] <> '!') do incr(i) ;
+ {now |i| points after option spec}
+opt:=rescan[rsp]; incr(rsp);
+if (opt>='A') and (opt<='Z') then opt:=chr(ord(opt)-ord('A')+ord('a'));
+if (opt='c') then read_c
+else if (opt='f') then read_f
+else if (opt='n') then read_n
+else if (opt='h') then read_h
+else if (opt='v') then read_v
+else if (opt='i') then spoolit:=false
+else
+ print_ln('Did not understand ',opt,' option. Ignoring.') ;
+rsp := i ;
+end
+
+@ Now we parse the name of the file, finding the extension (if any),
+suffixing one if there wasn't, and creating the |im_name|.
+
+@<Get the |dvi_name| and create the |im_name|@>=
+i := 1 ; last_ext := 0 ;
+while (buffer[i-1] <> " ") and (i <= terminal_line_length) and
+ (i <= name_length) do begin
+ if (buffer[i-1] <= "z") and (buffer[i-1] >= "a") then
+ buffer[i-1] := buffer[i-1] - 32 ;
+ dvi_name[i] := xchr[buffer[i-1]] ;
+ im_name[i] := xchr[buffer[i-1]] ;
+ if (buffer[i-1] = ".") and (last_ext = 0) then
+ last_ext := i
+ else if buffer[i-1] = ">" then
+ last_ext := 0 ;
+ incr(i) ;
+end ;
+if (i > name_length) then abort('File name too long!') ;
+if last_ext = 0 then begin
+ last_ext := i ;
+ dvi_name[i] := '.' ; incr(i) ;
+ dvi_name[i] := 'D' ; incr(i) ;
+ dvi_name[i] := 'V' ; incr(i) ;
+ dvi_name[i] := 'I' ; incr(i) ;
+end ;
+for j := i to name_length do
+ dvi_name[j] := chr(0) ;
+i := last_ext ;
+im_name[i] := '.' ; incr(i) ;
+im_name[i] := 'I' ; incr(i) ;
+im_name[i] := 'M' ; incr(i) ;
+im_name[i] := 'P' ; incr(i) ;
+for j := i to name_length do
+ im_name[j] := chr(0)
+
+@ Magic.
+@d STI=@'114 {Simulate Terminal Input JSYS}
+@d PRIIN=@'100 {PRImary INput JFN JSYS}
+@<Send the job to the printer@>=
+begin
+jsys(STI;PRIIN,ord('I'));
+jsys(STI;PRIIN,ord('M'));
+jsys(STI;PRIIN,ord('P'));
+jsys(STI;PRIIN,ord('S'));
+jsys(STI;PRIIN,ord('P'));
+jsys(STI;PRIIN,ord('O'));
+jsys(STI;PRIIN,ord('O'));
+jsys(STI;PRIIN,ord('L'));
+jsys(STI;PRIIN,ord(':'));
+jsys(STI;PRIIN,ord(' '));
+for i:=1 to name_length do
+ if im_name[i]>chr(0) then jsys(STI;PRIIN,ord(im_name[i]));
+jsys(STI;PRIIN,13);
+end
+
+@ Now we declare all of those variables we used.
+
+@<Constants...@>=
+@!max_rescan = 300 ; {maximum command line length}
+
+@ @<Glob...@>=
+i, j : integer ; {temporary indices}
+@!rsp : integer ; {rescan line pointer}
+@!option : 1..3 ; {what option was selected}
+@!last_ext : integer ; {where we saw an extension}
+@!ac1, @!rescan_len : integer ; {system call variables}
+@!rescan : packed array [1..max_rescan] of char ; {rescan buffer}
+@!spoolit: boolean;
+@!opt: char;
+@z
diff --git a/obsolete/systems/knuth/unsupported/texware/dviimp.web b/obsolete/systems/knuth/unsupported/texware/dviimp.web
new file mode 100644
index 0000000000..5e5c5c803e
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/texware/dviimp.web
@@ -0,0 +1,4261 @@
+% This program by A. L. Samuel is not copyrighted and can be used freely.
+% This program depends heavily on DVItype.WEB by D. E. Knuth for much of
+% the basic material relating to the reading of DVI files and on GFtoDOVER
+% for much of the basic material relating to the reading of GF files.
+% The idea of getting the font information directly from the GF files
+% rather than from PXL and TFM files was suggested by D. E. Knuth,
+% Several people have contributed ideas as to fast methods of doing this.
+
+% Version 0.3 now accepts as many as 50 256-character fonts and it does an
+% automatic spooling job for the Imagen with the pages properly collated.
+% Version 0.4 Corrections for the new_row_69 bug and a major clean-up by
+% D.R.Fuchs with the introduction of |debug| and |gubed| instead of the
+% earlier temporary fix.
+% Version 0.5 Fix to get TFM widths for fonts with no GF file available.
+% Version 0.6 Fix to handle |empty_glyph| cases properly, and a minor
+% change to the |reconcile_scale| routine.
+% Version 0.7 Major change to |m_store| now |mm_store|, making it to
+% store from |[0,4] through |[0,85999]| then to |[1,4]| through |[1,85999]|.
+% Version 0.8 Added switches /f, /n, and /c, being respectively, the number
+% count[0] of the first page to be printed, the total number of pages and the
+% number of copies desired.
+% Version 0.9 Added xxx{point <number>} and xxx{join <pen size> number1>
+% <number2>... special commands to locate points and draw lines.
+% Also improved /f and /n to allow for Roman and Arabic page number mixes.
+% Version 0.91 Added Imagen's version of circ_arc and ellipse_arc and made
+% several very minor bug fixes.
+% Version 0.92 Added on-line disagreement reports for check_sum, design_size,
+% and at-size. Also deleted a number of unneeded variables and cleaned things
+% up a bit.
+% Version 0.93 Fixed some off-by-one bugs in indexing the |mm_store| array.
+% (JJW)
+% Version 0.94 Fixed tfm loading ala TeX 2.7. (TGR)
+
+% Here is TeX material that gets inserted after \input webmac
+\def\hang{\hangindent 3em\indent\ignorespaces}
+\font\ninerm=cmr9
+\let\mc=\ninerm % medium caps for names like PASCAL
+\def\PASCAL{{\mc PASCAL}}
+\let\swap=\leftrightarrow
+\font\logo=logo10 % font used for the METAFONT logo
+\def\MF{{\logo META}\-{\logo FONT}}
+
+\def\(#1){} % this is used to make section names sort themselves better
+\def\9#1{} % this is used for sort keys in the index
+
+\def\title{DVIIMP}
+\def\contentspagenumber{1}
+\def\topofcontents{\null
+ \def\titlepage{F} % include headline on the contents page
+ \def\rheader{\mainfont\hfil \contentspagenumber}
+ \vfill
+ \centerline{\titlefont The {\ttitlefont DVIIMP} processor}
+ \vskip 15pt
+ \centerline{(Version 0.94, November 1987)}
+ \vfill}
+\def\botofcontents{\vfill
+ \centerline{\hsize 5in\baselineskip9pt
+ \vbox{\ninerm\noindent
+ The preparation of this report
+ was supported in part by the National Science
+ Foundation under grants IST-8201926 and MCS-8300984,
+ and by the System Development Foundation. `\TeX' is a
+ trademark of the American Mathematical Society.}}}
+\pageno=\contentspagenumber \advance\pageno by 1
+
+@* Introduction.
+
+This \.{DVIIMP} program reads binary device-independent (``\.{DVI}'')
+files that are produced by document compilers such as \TeX, and converts
+them into a form acceptable to the \.{IMAGEN} printer. The primary use of
+this program will be to print documents that use a large variety of
+different fonts that are freshly prepared by the \MF\ program and with
+this use in mind the program gets the needed font information directly
+from \.{GF} files. This direct use of \.{GF} font information may set a
+trend but it should be noted that many older but still useful fonts may
+not be available in \.{GF} form. \.{DVIIMP} has been written in the
+\.{WEB} language to conform with the general practice for other programs
+of this general type and to simplify the task of adapting it for use on a
+variety of different computers and different operating systems.
+
+This program reads the \.{GF} files and stores the font information
+(somewhat compressed and simplified from the \.{GF} file format) in an
+array called |mm_store|, and only translates the detailed raster
+information into the needed \.{imPRESS} format a glyph at a time on the first
+occurence of each needed glyph in the document being translated. This
+requires a rather involved procedure for keeping a record of those glyphs
+that have already been transmitted and of providing for the possibilities
+that the memory space allowed for fonts in the main memory associated with
+this program and the internal memory within the \.{IMAGEN} for glyphs may
+not be large enough for the job without arranging for the deletion of some
+font information and its possible replacement should it again prove to be
+needed.
+
+There seems to be a 2-to-the-17th-pixel limit to the maximum permitted
+size of glyph that IMAGEN will accept, measured as the product of the
+glyph's width (rounded up to a whole number of bytes) and its height.
+
+The |banner| string defined here should be changed whenever \.{DVIIMP}
+gets modified.
+
+@d banner=='This is DVIIMP, Version 0.94' {printed when the program starts}
+@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
+@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
+@f debug==begin
+@f gubed==end
+
+@ This program is written in standard \PASCAL, except where it is necessary
+to use extensions; for example, \.{DVIIMP} must read files whose names
+are dynamically specified, and that would be impossible in pure \PASCAL.
+All places where nonstandard constructions are used have been listed in
+the index under ``system dependencies.''
+@!@^system dependencies@>
+
+One of the extensions to standard \PASCAL\ that we shall deal with is the
+ability to move to a random place in a binary file; another is to
+determine the length of a binary file. If \.{DVIIMP} is being used
+with \PASCAL s for which random file positioning is not efficiently
+available, the following definition should be changed from |true| to
+|false|; in such cases, \.{DVIIMP} will not include the optional feature
+that reads the postamble first.
+
+Another extension is to use a default |case| as in \.{TANGLE}, \.{WEAVE},
+etc.
+
+@d random_reading==true {should we skip around in the file?}
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+
+@ The binary input comes from |dvi_file|, and the symbolic output is written
+on \PASCAL's standard |output| file. The term |print| is used instead of
+|write| when this program writes on |output|, so that all such output
+could easily be redirected if desired.
+
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+@d print_nl==write_ln
+
+@p program DVI_IMP(@!dvi_file,@!im_file,@!output);
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ jj:real; {a real variable}
+ begin print_ln(banner);@/
+ @<Set initial values@>@/
+ end;
+
+@ If the program has to stop prematurely, it goes to the
+`|final_end|'. Another label, |done|, is used when stopping normally.
+
+@d final_end=9999 {label for the end of it all}
+@d done=30 {go here when finished with a subtask}
+@d restart=40 {go here to restart an operation}
+
+@<Labels...@>=final_end;
+
+@ The following parameters can be changed at compile time to extend or
+reduce \.{DVIIMP}'s capacity.
+
+@<Constants...@>=
+@!max_fonts=100; {maximum number of distinct fonts per \.{DVI} file}
+@!max_glyphs=7680; {maximum number of different characters among all fonts}
+@!line_length=320; {bracketed lines of output will be at most this long}
+@!terminal_line_length=150; {maximum number of characters input in a single
+ line of input from the terminal}
+@!stack_size=200; {\.{DVI} files shouldn't |push| beyond this depth}
+@!name_size=1000; {total length of all font file names}
+@!name_length=50; {a file name shouldn't be longer than this}
+@!m1_max=3; {max first |mm_store| index}
+@!m2_size=86000; {used as multiplier or divider}
+@!m2_max= 85999; {max second |mm_store| index}
+@!mm_size=344000; {bytes in |mm_store|}
+@!mm_max= 343999; {max location in |mm_store|}
+@!max_char_no=255; {largest allowed char number}
+
+@ Here are some macros for common programming idioms. We will have occasion,
+both in the |do_page| and the |do_char| routines, to group certain cases
+together and so we will also define these groupings at this time.
+
+@d incr(#) == #:=#+1 {increase a variable by unity}
+@d decr(#) == #:=#-1 {decrease a variable by unity}
+@d do_nothing == {empty statement}
+@d unity == @'200000 {$2^{16}$, represents 1.00000}
+@d three_cases(#)==#,#+1,#+2
+@d four_cases(#)==#,#+1,#+2,#+3
+@d eight_cases(#)==four_cases(#),four_cases(#+4)
+@d nine_cases(#)==eight_cases(#),#+8
+@d sixteen_cases(#)==eight_cases(#),eight_cases(#+8)
+@d nineteen_cases(#)==nine_cases(#),nine_cases(#+9),#+18
+@d thirty_two_cases(#)==sixteen_cases(#),sixteen_cases(#+16)
+@d thirty_seven_cases(#)==thirty_two_cases(#),four_cases(#+32),#+36
+@d sixty_four_cases(#)==thirty_two_cases(#),thirty_two_cases(#+32)
+@d eighty_three_cases(#)==sixty_four_cases(#),nineteen_cases(#+64)
+@d one_sixty_five_cases(#)==
+ sixty_four_cases(#), sixty_four_cases(#+64),
+ thirty_seven_cases(#+128)
+
+@ If the \.{DVI} file is badly malformed, the whole process must be aborted;
+\.{DVIIMP} will give up, after issuing an error message about the symptoms
+that were noticed.
+
+Such errors might be discovered inside of subroutines inside of subroutines,
+so a procedure called |jump_out| has been introduced. This procedure, which
+simply transfers control to the label |final_end| at the end of the program,
+contains the only non-local |goto| statement in \.{DVIIMP}.
+@^system dependencies@>
+
+@d abort(#)==begin print(' ',#); jump_out;
+ end
+@d bad_dvi(#)==abort('Bad DVI file: ',#,'!')
+@.Bad DVI file@>
+
+@p procedure jump_out;
+begin goto final_end;
+end;
+
+@* The character set.
+Like all programs written with the \.{WEB} system, \.{DVIIMP} can be
+used with any character set. But it uses ASCII code internally, because
+the programming for portable input-output is easier when a fixed internal
+code is used, and because \.{DVI} files use ASCII code for file names
+and certain other strings.
+
+The next few sections of \.{DVIIMP} have therefore been copied from the
+analogous ones in the \.{WEB} system routines. They have been considerably
+simplified, since \.{DVIIMP} need not deal with the controversial
+ASCII codes less than @'40. If such codes appear in the \.{DVI} file,
+they will be printed as question marks.
+
+@<Types...@>=
+@!ASCII_code=" ".."~"; {a subrange of the integers}
+
+@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit
+character sets were common, so it did not make provision for lower case
+letters. Nowadays, of course, we need to deal with both upper and lower case
+alphabets in a convenient way, especially in a program like \.{DVIIMP}.
+So we shall assume that the \PASCAL\ system being used for \.{DVIIMP}
+has a character set containing at least the standard visible characters
+of ASCII code (|"!"| through |"~"|).
+
+Some \PASCAL\ compilers use the original name |char| for the data type
+associated with the characters in text files, while other \PASCAL s
+consider |char| to be a 64-element subrange of a larger data type that has
+some other name. In order to accommodate this difference, we shall use
+the name |text_char| to stand for the data type of the characters in the
+output file. We shall also assume that |text_char| consists of
+the elements |chr(first_text_char)| through |chr(last_text_char)|,
+inclusive. The following definitions should be adjusted if necessary.
+@^system dependencies@>
+
+@d text_char == char {the data type of characters in text files}
+@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
+@d last_text_char=127 {ordinal number of the largest element of |text_char|}
+
+@<Types...@>=
+@!text_file=packed file of text_char;
+
+@ The \.{DVIIMP} processor converts between ASCII code and
+the user's external character set by means of arrays |xord| and |xchr|
+that are analogous to \PASCAL's |ord| and |chr| functions.
+
+@<Globals...@>=
+@!xord: array [text_char] of ASCII_code;
+ {specifies conversion of input characters}
+@!xchr: array [0..255] of text_char;
+ {specifies conversion of output characters}
+
+@ Under our assumption that the visible characters of standard ASCII are
+all present, the following assignment statements initialize the
+|xchr| array properly, without needing any system-dependent changes.
+
+@<Set init...@>=
+for i:=0 to @'37 do xchr[i]:='?';
+xchr[@'40]:=' ';
+xchr[@'41]:='!';
+xchr[@'42]:='"';
+xchr[@'43]:='#';
+xchr[@'44]:='$';
+xchr[@'45]:='%';
+xchr[@'46]:='&';
+xchr[@'47]:='''';@/
+xchr[@'50]:='(';
+xchr[@'51]:=')';
+xchr[@'52]:='*';
+xchr[@'53]:='+';
+xchr[@'54]:=',';
+xchr[@'55]:='-';
+xchr[@'56]:='.';
+xchr[@'57]:='/';@/
+xchr[@'60]:='0';
+xchr[@'61]:='1';
+xchr[@'62]:='2';
+xchr[@'63]:='3';
+xchr[@'64]:='4';
+xchr[@'65]:='5';
+xchr[@'66]:='6';
+xchr[@'67]:='7';@/
+xchr[@'70]:='8';
+xchr[@'71]:='9';
+xchr[@'72]:=':';
+xchr[@'73]:=';';
+xchr[@'74]:='<';
+xchr[@'75]:='=';
+xchr[@'76]:='>';
+xchr[@'77]:='?';@/
+xchr[@'100]:='@@';
+xchr[@'101]:='A';
+xchr[@'102]:='B';
+xchr[@'103]:='C';
+xchr[@'104]:='D';
+xchr[@'105]:='E';
+xchr[@'106]:='F';
+xchr[@'107]:='G';@/
+xchr[@'110]:='H';
+xchr[@'111]:='I';
+xchr[@'112]:='J';
+xchr[@'113]:='K';
+xchr[@'114]:='L';
+xchr[@'115]:='M';
+xchr[@'116]:='N';
+xchr[@'117]:='O';@/
+xchr[@'120]:='P';
+xchr[@'121]:='Q';
+xchr[@'122]:='R';
+xchr[@'123]:='S';
+xchr[@'124]:='T';
+xchr[@'125]:='U';
+xchr[@'126]:='V';
+xchr[@'127]:='W';@/
+xchr[@'130]:='X';
+xchr[@'131]:='Y';
+xchr[@'132]:='Z';
+xchr[@'133]:='[';
+xchr[@'134]:='\';
+xchr[@'135]:=']';
+xchr[@'136]:='^';
+xchr[@'137]:='_';@/
+xchr[@'140]:='`';
+xchr[@'141]:='a';
+xchr[@'142]:='b';
+xchr[@'143]:='c';
+xchr[@'144]:='d';
+xchr[@'145]:='e';
+xchr[@'146]:='f';
+xchr[@'147]:='g';@/
+xchr[@'150]:='h';
+xchr[@'151]:='i';
+xchr[@'152]:='j';
+xchr[@'153]:='k';
+xchr[@'154]:='l';
+xchr[@'155]:='m';
+xchr[@'156]:='n';
+xchr[@'157]:='o';@/
+xchr[@'160]:='p';
+xchr[@'161]:='q';
+xchr[@'162]:='r';
+xchr[@'163]:='s';
+xchr[@'164]:='t';
+xchr[@'165]:='u';
+xchr[@'166]:='v';
+xchr[@'167]:='w';@/
+xchr[@'170]:='x';
+xchr[@'171]:='y';
+xchr[@'172]:='z';
+xchr[@'173]:='{';
+xchr[@'174]:='|';
+xchr[@'175]:='}';
+xchr[@'176]:='~';
+for i:=@'177 to 255 do xchr[i]:='?';
+
+@ The following system-independent code makes the |xord| array contain a
+suitable inverse to the information in |xchr|.
+
+@<Set init...@>=
+for i:=first_text_char to last_text_char do xord[chr(i)]:=@'40;
+for i:=" " to "~" do xord[xchr[i]]:=i;
+
+@* Device-independent file format.
+Before we get into the details of \.{DVIIMP}, we need to know exactly
+what \.{DVI} files are. The form of such files was designed by David R.
+@^Fuchs, David Raymond@>
+Fuchs in 1979. Almost any reasonable typesetting device can be driven by
+a program that takes \.{DVI} files as input, and dozens of such
+\.{DVI}-to-whatever programs have been written. Thus, it is possible to
+print the output of document compilers like \TeX\ on many different kinds
+of equipment.
+
+A \.{DVI} file is a stream of 8-bit bytes, which may be regarded as a
+series of commands in a machine-like language. The first byte of each command
+is the operation code, and this code is followed by zero or more bytes
+that provide parameters to the command. The parameters themselves may consist
+of several consecutive bytes; for example, the `|set_rule|' command has two
+parameters, each of which is four bytes long. Parameters are usually
+regarded as nonnegative integers; but four-byte-long parameters,
+and shorter parameters that denote distances, can be
+either positive or negative. Such parameters are given in two's complement
+notation. For example, a two-byte-long distance parameter has a value between
+$-2^{15}$ and $2^{15}-1$.
+@.DVI {\rm files}@>
+
+A \.{DVI} file consists of a ``preamble,'' followed by a sequence of one
+or more ``pages,'' followed by a ``postamble.'' The preamble is simply a
+|pre| command, with its parameters that define the dimensions used in the
+file; this must come first. Each ``page'' consists of a |bop| command,
+followed by any number of other commands that tell where characters are to
+be placed on a physical page, followed by an |eop| command. The pages
+appear in the order that they were generated, not in any particular
+numerical order. If we ignore |nop| commands and \\{fnt\_def} commands
+(which are allowed between any two commands in the file), each |eop|
+command is immediately followed by a |bop| command, or by a |post|
+command; in the latter case, there are no more pages in the file, and the
+remaining bytes form the postamble. Further details about the postamble
+will be explained later.
+
+Some parameters in \.{DVI} commands are ``pointers.'' These are four-byte
+quantities that give the location number of some other byte in the file;
+the first byte is number~0, then comes number~1, and so on. For example,
+one of the parameters of a |bop| command points to the previous |bop|;
+this makes it feasible to read the pages in backwards order, in case the
+results are being directed to a device that stacks its output face up.
+Suppose the preamble of a \.{DVI} file occupies bytes 0 to 99. Now if the
+first page occupies bytes 100 to 999, say, and if the second
+page occupies bytes 1000 to 1999, then the |bop| that starts in byte 1000
+points to 100 and the |bop| that starts in byte 2000 points to 1000. (The
+very first |bop|, i.e., the one that starts in byte 100, has a pointer of $-1$.)
+
+@ The \.{DVI} format is intended to be both compact and easily interpreted
+by a machine. Compactness is achieved by making most of the information
+implicit instead of explicit. When a \.{DVI}-reading program reads the
+commands for a page, it keeps track of several quantities: (a)~The current
+font |f| is an integer; this value is changed only
+by \\{fnt} and \\{fnt\_num} commands. (b)~The current position on the page
+is given by two numbers called the horizontal and vertical coordinates,
+|h| and |v|. Both coordinates are zero at the upper left corner of the page;
+moving to the right corresponds to increasing the horizontal coordinate, and
+moving down corresponds to increasing the vertical coordinate. Thus, the
+coordinates are essentially Cartesian, except that vertical directions are
+flipped; the Cartesian version of |(h,v)| would be |(h,-v)|. (c)~The
+current spacing amounts are given by four numbers |w|, |x|, |y|, and |z|,
+where |w| and~|x| are used for horizontal spacing and where |y| and~|z|
+are used for vertical spacing. (d)~There is a stack containing
+|(h,v,w,x,y,z)| values; the \.{DVI} commands |push| and |pop| are used to
+change the current level of operation. Note that the current font~|f| is
+not pushed and popped; the stack contains only information about
+positioning.
+
+The values of |h|, |v|, |w|, |x|, |y|, and |z| are signed integers having up
+to 32 bits, including the sign. Since they represent physical distances,
+there is a small unit of measurement such that increasing |h| by~1 means
+moving a certain tiny distance to the right. The actual unit of
+measurement is variable, as explained below.
+
+@ Here is a list of all the commands that may appear in a \.{DVI} file. Each
+command is specified by its symbolic name (e.g., |bop|), its opcode byte
+(e.g., 139), and its parameters (if any). The parameters are followed
+by a bracketed number telling how many bytes they occupy; for example,
+`|p[4]|' means that parameter |p| is four bytes long. (A somewhat
+similar set of commands is used in \.{GF} files, as will be
+explained in a later section).
+
+\yskip\hang|set_char_0| 0. Typeset character number~0 from font~|f|
+such that the reference point of the character is at |(h,v)|. Then
+increase |h| by the width of that character. Note that a character may
+have zero or negative width, so one cannot be sure that |h| will advance
+after this command; but |h| usually does increase.
+
+\yskip\hang|set_char_1| through |set_char_127| (opcodes 1 to 127).
+Do the operations of |set_char_0|; but use the character whose number
+matches the opcode, instead of character~0.
+
+\yskip\hang|set1| 128 |c[1]|. Same as |set_char_0|, except that character
+number~|c| is typeset. \TeX82 uses this command for characters in the
+range |128<=c<256|.
+
+\yskip\hang|set2| 129 |c[2]|. Same as |set1|, except that |c|~is two
+bytes long, so it is in the range |0<=c<65536|. \TeX82 never uses this
+command, which is intended for processors that deal with oriental languages;
+but \.{DVIIMP} will allow character codes greater than 255, assuming that
+they all have the same width as the character whose code is $c \bmod 256$.
+@^oriental characters@>@^Chinese characters@>@^Japanese characters@>
+
+\yskip\hang|set3| 130 |c[3]|. Same as |set1|, except that |c|~is three
+bytes long, so it can be as large as $2^{24}-1$.
+
+\yskip\hang|set4| 131 |c[4]|. Same as |set1|, except that |c|~is four
+bytes long, possibly even negative. Imagine that.
+
+\yskip\hang|set_rule| 132 |a[4]| |b[4]|. Typeset a solid black rectangle
+of height |a| and width |b|, with its bottom left corner at |(h,v)|. Then
+set |h:=h+b|. If either |a<=0| or |b<=0|, nothing should be typeset. Note
+that if |b<0|, the value of |h| will decrease even though nothing else happens.
+Programs that typeset from \.{DVI} files should be careful to make the rules
+line up carefully with digitized characters, as explained in connection with
+the |rule_pixels| subroutine below.
+
+\yskip\hang|put1| 133 |c[1]|. Typeset character number~|c| from font~|f|
+such that the reference point of the character is at |(h,v)|. (The `put'
+commands are exactly like the `set' commands, except that they simply put out a
+character or a rule without moving the reference point afterwards.)
+
+\yskip\hang|put2| 134 |c[2]|. Same as |set2|, except that |h| is not changed.
+
+\yskip\hang|put3| 135 |c[3]|. Same as |set3|, except that |h| is not changed.
+
+\yskip\hang|put4| 136 |c[4]|. Same as |set4|, except that |h| is not changed.
+
+\yskip\hang|put_rule| 137 |a[4]| |b[4]|. Same as |set_rule|, except that
+|h| is not changed.
+
+\yskip\hang|nop| 138. No operation, do nothing. Any number of |nop|'s
+may occur between \.{DVI} commands, but a |nop| cannot be inserted between
+a command and its parameters or between two parameters.
+
+\yskip\hang|bop| 139 $c_0[4]$ $c_1[4]$ $\ldots$ $c_9[4]$ $p[4]$. Beginning
+of a page: Set |(h,v,w,x,y,z):=(0,0,0,0,0,0)| and set the stack empty. Set
+the current font |f| to an undefined value. The ten $c_i$ parameters can
+be used to identify pages, if a user wants to print only part of a \.{DVI}
+file; \TeX82 gives them the values of \.{\\count0} $\ldots$ \.{\\count9}
+at the time \.{\\shipout} was invoked for this page. The parameter |p|
+points to the previous |bop| command in the file, where the first |bop|
+has $p=-1$.
+
+\yskip\hang|eop| 140. End of page: Print what you have read since the
+previous |bop|. At this point the stack should be empty. (The \.{DVI}-reading
+programs that drive most output devices will have kept a buffer of the
+material that appears on the page that has just ended. This material is
+largely, but not entirely, in order by |v| coordinate and (for fixed |v|) by
+|h|~coordinate; so it usually needs to be sorted into some order that is
+appropriate for the device in question. \.{DVIIMP} does not do such sorting.)
+
+\yskip\hang|push| 141. Push the current values of |(h,v,w,x,y,z)| onto the
+top of the stack; do not change any of these values. Note that |f| is
+not pushed.
+
+\yskip\hang|pop| 142. Pop the top six values off of the stack and assign
+them to |(h,v,w,x,y,z)|. The number of pops should never exceed the number
+of pushes, since it would be highly embarrassing if the stack were empty
+at the time of a |pop| command.
+
+\yskip\hang|right1| 143 |b[1]|. Set |h:=h+b|, i.e., move right |b| units.
+The parameter is a signed number in two's complement notation, |-128<=b<128|;
+if |b<0|, the reference point actually moves left.
+
+\yskip\hang|right2| 144 |b[2]|. Same as |right1|, except that |b| is a
+two-byte quantity in the range |-32768<=b<32768|.
+
+\yskip\hang|right3| 145 |b[3]|. Same as |right1|, except that |b| is a
+three-byte quantity in the range |@t$-2^{23}$@><=b<@t$2^{23}$@>|.
+
+\yskip\hang|right4| 146 |b[4]|. Same as |right1|, except that |b| is a
+four-byte quantity in the range |@t$-2^{31}$@><=b<@t$2^{31}$@>|.
+
+\yskip\hang|w0| 147. Set |h:=h+w|; i.e., move right |w| units. With luck,
+this parameterless command will usually suffice, because the same kind of motion
+will occur several times in succession; the following commands explain how
+|w| gets particular values.
+
+\yskip\hang|w1| 148 |b[1]|. Set |w:=b| and |h:=h+b|. The value of |b| is a
+signed quantity in two's complement notation, |-128<=b<128|. This command
+changes the current |w|~spacing and moves right by |b|.
+
+\yskip\hang|w2| 149 |b[2]|. Same as |w1|, but |b| is a two-byte-long
+parameter, |-32768<=b<32768|.
+
+\yskip\hang|w3| 150 |b[3]|. Same as |w1|, but |b| is a three-byte-long
+parameter, |@t$-2^{23}$@><=b<@t$2^{23}$@>|.
+
+\yskip\hang|w4| 151 |b[4]|. Same as |w1|, but |b| is a four-byte-long
+parameter, |@t$-2^{31}$@><=b<@t$2^{31}$@>|.
+
+\yskip\hang|x0| 152. Set |h:=h+x|; i.e., move right |x| units. The `|x|'
+commands are like the `|w|' commands except that they involve |x| instead
+of |w|.
+
+\yskip\hang|x1| 153 |b[1]|. Set |x:=b| and |h:=h+b|. The value of |b| is a
+signed quantity in two's complement notation, |-128<=b<128|. This command
+changes the current |x|~spacing and moves right by |b|.
+
+\yskip\hang|x2| 154 |b[2]|. Same as |x1|, but |b| is a two-byte-long
+parameter, |-32768<=b<32768|.
+
+\yskip\hang|x3| 155 |b[3]|. Same as |x1|, but |b| is a three-byte-long
+parameter, |@t$-2^{23}$@><=b<@t$2^{23}$@>|.
+
+\yskip\hang|x4| 156 |b[4]|. Same as |x1|, but |b| is a four-byte-long
+parameter, |@t$-2^{31}$@><=b<@t$2^{31}$@>|.
+
+\yskip\hang|down1| 157 |a[1]|. Set |v:=v+a|, i.e., move down |a| units.
+The parameter is a signed number in two's complement notation, |-128<=a<128|;
+if |a<0|, the reference point actually moves up.
+
+\yskip\hang|down2| 158 |a[2]|. Same as |down1|, except that |a| is a
+two-byte quantity in the range |-32768<=a<32768|.
+
+\yskip\hang|down3| 159 |a[3]|. Same as |down1|, except that |a| is a
+three-byte quantity in the range |@t$-2^{23}$@><=a<@t$2^{23}$@>|.
+
+\yskip\hang|down4| 160 |a[4]|. Same as |down1|, except that |a| is a
+four-byte quantity in the range |@t$-2^{31}$@><=a<@t$2^{31}$@>|.
+
+\yskip\hang|y0| 161. Set |v:=v+y|; i.e., move down |y| units. With luck,
+this parameterless command will usually suffice, because the same kind of motion
+will occur several times in succession; the following commands explain how
+|y| gets particular values.
+
+\yskip\hang|y1| 162 |a[1]|. Set |y:=a| and |v:=v+a|. The value of |a| is a
+signed quantity in two's complement notation, |-128<=a<128|. This command
+changes the current |y|~spacing and moves down by |a|.
+
+\yskip\hang|y2| 163 |a[2]|. Same as |y1|, but |a| is a two-byte-long
+parameter, |-32768<=a<32768|.
+
+\yskip\hang|y3| 164 |a[3]|. Same as |y1|, but |a| is a three-byte-long
+parameter, |@t$-2^{23}$@><=a<@t$2^{23}$@>|.
+
+\yskip\hang|y4| 165 |a[4]|. Same as |y1|, but |a| is a four-byte-long
+parameter, |@t$-2^{31}$@><=a<@t$2^{31}$@>|.
+
+\yskip\hang|z0| 166. Set |v:=v+z|; i.e., move down |z| units. The `|z|' commands
+are like the `|y|' commands except that they involve |z| instead of |y|.
+
+\yskip\hang|z1| 167 |a[1]|. Set |z:=a| and |v:=v+a|. The value of |a| is a
+signed quantity in two's complement notation, |-128<=a<128|. This command
+changes the current |z|~spacing and moves down by |a|.
+
+\yskip\hang|z2| 168 |a[2]|. Same as |z1|, but |a| is a two-byte-long
+parameter, |-32768<=a<32768|.
+
+\yskip\hang|z3| 169 |a[3]|. Same as |z1|, but |a| is a three-byte-long
+parameter, |@t$-2^{23}$@><=a<@t$2^{23}$@>|.
+
+\yskip\hang|z4| 170 |a[4]|. Same as |z1|, but |a| is a four-byte-long
+parameter, |@t$-2^{31}$@><=a<@t$2^{31}$@>|.
+
+\yskip\hang|fnt_num_0| 171. Set |f:=0|. Font 0 must previously have been
+defined by a \\{fnt\_def} instruction, as explained below.
+
+\yskip\hang|fnt_num_1| through |fnt_num_63| (opcodes 172 to 234). Set
+|f:=1|, \dots, |f:=63|, respectively.
+
+\yskip\hang|fnt1| 235 |k[1]|. Set |f:=k|. \TeX82 uses this command for font
+numbers in the range |64<=k<256|.
+
+\yskip\hang|fnt2| 236 |k[2]|. Same as |fnt1|, except that |k|~is two
+bytes long, so it is in the range |0<=k<65536|. \TeX82 never generates this
+command, but large font numbers may prove useful for specifications of
+color or texture, or they may be used for special fonts that have fixed
+numbers in some external coding scheme.
+
+\yskip\hang|fnt3| 237 |k[3]|. Same as |fnt1|, except that |k|~is three
+bytes long, so it can be as large as $2^{24}-1$.
+
+\yskip\hang|fnt4| 238 |k[4]|. Same as |fnt1|, except that |k|~is four
+bytes long; this is for the really big font numbers (and for the negative ones).
+
+\yskip\hang|xxx1| 239 |k[1]| |x[k]|. This command is undefined in
+general; it functions as a $(k+2)$-byte |nop| unless special \.{DVI}-reading
+programs are being used. \TeX82 generates |xxx1| when a short enough
+\.{\\special} appears, setting |k| to the number of bytes being sent. It
+is recommended that |x| be a string having the form of a keyword followed
+by possible parameters relevant to that keyword.
+
+\yskip\hang|xxx2| 240 |k[2]| |x[k]|. Like |xxx1|, but |0<=k<65536|.
+
+\yskip\hang|xxx3| 241 |k[3]| |x[k]|. Like |xxx1|, but |0<=k<@t$2^{24}$@>|.
+
+\yskip\hang|xxx4| 242 |k[4]| |x[k]|. Like |xxx1|, but |k| can be ridiculously
+large. \TeX82 uses |xxx4| when |xxx1| would be incorrect.
+
+\yskip\hang|fnt_def1| 243 |k[1]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |0<=k<256|; font definitions will be explained shortly.
+
+\yskip\hang|fnt_def2| 244 |k[2]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |0<=k<65536|.
+
+\yskip\hang|fnt_def3| 245 |k[3]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |0<=k<@t$2^{24}$@>|.
+
+\yskip\hang|fnt_def4| 246 |k[4]| |c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.
+Define font |k|, where |@t$-2^{31}$@><=k<@t$2^{31}$@>|.
+
+\yskip\hang|pre| 247 |i[1]| |num[4]| |den[4]| |mag[4]| |k[1]| |x[k]|.
+Beginning of the preamble; this must come at the very beginning of the
+file. Parameters |i|, |num|, |den|, |mag|, |k|, and |x| are explained below.
+
+\yskip\hang|post| 248. Beginning of the postamble, see below.
+
+\yskip\hang|post_post| 249. Ending of the postamble, see below.
+
+\yskip\noindent Commands 250--255 are undefined at the present time.
+
+@ @d set_char_0=0 {typeset character 0 and move right}
+@d set1=128 {typeset a character and move right}
+@d set_rule=132 {typeset a rule and move right}
+@d put1=133 {typeset a character}
+@d put_rule=137 {typeset a rule}
+@d nop=138 {no operation}
+@d bop=139 {beginning of page}
+@d eop=140 {ending of page}
+@d push=141 {save the current positions}
+@d pop=142 {restore previous positions}
+@d right1=143 {move right}
+@d w0=147 {move right by |w|}
+@d w1=148 {move right and set |w|}
+@d x0=152 {move right by |x|}
+@d x1=153 {move right and set |x|}
+@d down1=157 {move down}
+@d y0=161 {move down by |y|}
+@d y1=162 {move down and set |y|}
+@d z0=166 {move down by |z|}
+@d z1=167 {move down and set |z|}
+@d fnt_num_0=171 {set current font to 0}
+@d fnt1=235 {set current font}
+@d xxx1=239 {extension to \.{DVI} primitives}
+@d xxx4=242 {potentially long extension to \.{DVI} primitives}
+@d fnt_def1=243 {define the meaning of a font number}
+@d pre=247 {preamble}
+@d post=248 {postamble beginning}
+@d post_post=249 {postamble ending}
+@d undefined_commands==250,251,252,253,254,255
+
+@ The preamble contains basic information about the file as a whole. As
+stated above, there are six parameters:
+$$\hbox{|@!i[1]| |@!num[4]| |@!den[4]| |@!mag[4]| |@!k[1]| |@!x[k]|.}$$
+The |i| byte identifies \.{DVI} format; currently this byte is always set
+to~2. (Some day we will set |i=3|, when \.{DVI} format makes another
+incompatible change---perhaps in 1992.)
+
+The next two parameters, |num| and |den|, are positive integers that define
+the units of measurement; they are the numerator and denominator of a
+fraction by which all dimensions in the \.{DVI} file could be multiplied
+in order to get lengths in units of $10^{-7}$ meters. (For example, there are
+exactly 7227 \TeX\ points in 254 centimeters, and \TeX82 works with scaled
+points where there are $2^{16}$ sp in a point, so \TeX82 sets |num=25400000|
+and $|den|=7227\cdot2^{16}=473628672$.)
+@^sp@>
+
+The |mag| parameter is what \TeX82 calls \.{\\mag}, i.e., 1000 times the
+desired magnification. The actual fraction by which dimensions are
+multiplied is therefore $mn/1000d$. Note that if a \TeX\ source document
+does not call for any `\.{true}' dimensions, and if you change it only by
+specifying a different \.{\\mag} setting, the \.{DVI} file that \TeX\
+creates will be completely unchanged except for the value of |mag| in the
+preamble and postamble. (Fancy \.{DVI}-reading programs allow users to
+override the |mag|~setting when a \.{DVI} file is being printed.)
+
+Finally, |k| and |x| allow the \.{DVI} writer to include a comment, which is not
+interpreted further. The length of comment |x| is |k|, where |0<=k<256|.
+
+@d id_byte=2 {identifies the kind of \.{DVI} files described here}
+
+@ Font definitions for a given font number |k| contain further parameters
+$$\hbox{|c[4]| |s[4]| |d[4]| |a[1]| |l[1]| |n[a+l]|.}$$
+The four-byte value |c| is the check sum that \TeX\ (or whatever program
+generated the \.{DVI} file) found in the \.{GF} file for this font;
+|c| should match the check sum of the font found by programs that read
+this \.{DVI} file.
+@^check sum@>
+
+Parameter |s| contains a fixed-point scale factor that is applied to the
+character widths in font |k|; font dimensions in \.{GF} files and other
+font files are relative to this quantity, which is always positive and
+less than $2^{27}$. It is given in the same units as the other dimensions
+of the \.{DVI} file. Parameter |d| is similar to |s|; it is the ``design
+size,'' and it is given in \.{DVI} units that have not been corrected for
+the magnification~|mag| found in the preamble. Thus, font |k| is to be
+used at $|mag|\cdot s/1000d$ times its normal size.
+
+The remaining part of a font definition gives the external name of the font,
+which is an ASCII string of length |a+l|. The number |a| is the length
+of the ``area'' or directory, and |l| is the length of the font name itself;
+the standard local system font area is supposed to be used when |a=0|.
+The |n| field contains the area in its first |a| bytes.
+
+Font definitions must appear before the first use of a particular font number.
+Once font |k| is defined, it must not be defined again; however, we
+shall see below that font definitions appear in the postamble as well as
+in the pages, so in this sense each font number is defined exactly twice,
+if at all. Like |nop| commands and \\{xxx} commands, font definitions can
+appear before the first |bop|, or between an |eop| and a |bop|.
+
+@ The last page in a \.{DVI} file is followed by `|post|'; this command
+introduces the postamble, which summarizes important facts that \TeX\ has
+accumulated about the file, making it possible to print subsets of the data
+with reasonable efficiency. The postamble has the form
+$$\vbox{\halign{\hbox{#\hfil}\cr
+ |post| |p[4]| |num[4]| |den[4]| |mag[4]| |l[4]| |u[4]| |s[2]| |t[2]|\cr
+ $\langle\,$font definitions$\,\rangle$\cr
+ |post_post| |q[4]| |i[1]| 223's$[{\G}4]$\cr}}$$
+Here |p| is a pointer to the final |bop| in the file. The next three
+parameters, |num|, |den|, and |mag|, are duplicates of the quantities that
+appeared in the preamble.
+
+Parameters |l| and |u| give respectively the height-plus-depth of the tallest
+page and the width of the widest page, in the same units as other dimensions
+of the file. These numbers might be used by a \.{DVI}-reading program to
+position individual ``pages'' on large sheets of film or paper.
+
+Parameter |s| is the maximum stack depth (i.e., the largest excess of
+|push| commands over |pop| commands) needed to process this file. Then
+comes |t|, the total number of pages (|bop| commands) present.
+
+The postamble continues with font definitions, which are any number of
+\\{fnt\_def} commands as described above, possibly interspersed with |nop|
+commands. Each font number that is used in the \.{DVI} file must be defined
+exactly twice: Once before it is first selected by a \\{fnt} command, and once
+in the postamble.
+
+@ The last part of the postamble, following the |post_post| byte that
+signifies the end of the font definitions, contains |q|, a pointer to the
+|post| command that started the postamble. An identification byte, |i|,
+comes next; this currently equals~2, as in the preamble.
+
+The |i| byte is followed by four or more bytes that are all equal to
+the decimal number 223 (i.e., @'337 in octal). \TeX\ puts out four to seven of
+these trailing bytes, until the total length of the file is a multiple of
+four bytes, since this works out best on machines that pack four bytes per
+word; but any number of 223's is allowed, as long as there are at least four
+of them. In effect, 223 is a sort of signature that is added at the very end.
+@^Fuchs, David Raymond@>
+
+This curious way to finish off a \.{DVI} file makes it feasible for
+\.{DVI}-reading programs to find the postamble first, on most computers,
+even though \TeX\ wants to write the postamble last. Most operating
+systems permit random access to individual words or bytes of a file, so
+the \.{DVI} reader can start at the end and skip backwards over the 223's
+until finding the identification byte. Then it can back up four bytes, read
+|q|, and move to byte |q| of the file. This byte should, of course,
+contain the value 248 (|post|); now the postamble can be read, so the
+\.{DVI} reader discovers all the information needed for typesetting the
+pages. Note that it is also possible to skip through the \.{DVI} file at
+reasonably high speed to locate a particular page, if that proves
+desirable. This saves a lot of time, since \.{DVI} files used in production
+jobs tend to be large.
+
+Unfortunately, however, standard \PASCAL\ does not include the ability to
+@^system dependencies@>
+access a random position in a file, or even to determine the length of a file.
+Almost all systems nowadays provide the necessary capabilities, so \.{DVI}
+format has been designed to work most efficiently with modern operating systems.
+As noted above, \.{DVIIMP} will limit itself to the restrictions of standard
+\PASCAL\ if |random_reading| is defined to be |false|.
+
+@* The imPRESS file format.
+The format of an \.{imPRESS} file is quite similar in many ways to the
+format of \.{DVI} files although, of course, the commands are all related
+to the specific properties of the \.{IMAGEN} printer. For example,
+dimensions are all in units that are derived from the inter-pixel distance
+for the printer that is being used (1/300 of an inch on a 300
+pixels-per-inch printer). As far as we are concerned, an \.{imPRESS} file
+consists of a sequence of bytes although, for some instructions the
+associated parameters are made up of a collection of bits that are packed,
+rather arbitrarily,
+into one or more complete bytes (the commands themselves are never
+split between bytes).
+
+As will be explained in more detail later, the \.{IMAGEN} printer provides
+facilities for defining certain state variables and for saving and
+restoring sets of these variable through the use of push and pop commands.
+
+The Imagen Corporation provides a publication-form-name that is used for
+describing the commands and we will, so far as practical, use modified
+forms of these publification-form-namess as our names for these commands,
+simply prefacing the \.{IMAGEN} command name with \.{im} when this can be done
+without making the name too long.
+For consistancy, the same conventions are used to
+specify the parameters as were used in module 15.
+
+For the reader's convenience, we will list these commands under the same
+headings as used in the \.{imPRESS} Programmer's Manual.
+
+Document Structure Commands
+
+\yskip\hang|set_char_0| 0. Typeset character number~0 from font~|f|
+such that the reference point of the character is at |(h,v)|. Then
+increase |h| by the width of that character. Note that a character may
+have zero or negative width, so one cannot be sure that |h| will advance
+after this command; but |h| usually does increase.
+
+\yskip\hang|im_end_page| 219. This command declares the current page ready
+for printing and starts page layout on a new page. State variables, which
+are set once and remain in effect until changed, remain unchanged. These
+include the current (|h|,|v|) position so these need to be reset as
+desired. Note that some manipulation of data may be needed between a
+\.{DVI} |eop| and an \.{imPRESS} |im_end_page|.
+
+\yskip\hang|im_eof| 255. Marks the end of the \.{imPRESS} document. Any
+text after this command in the input file will be ignored.
+
+\yskip\hang|im_no_op| 254. May be used for padding and is ignored. May be
+used as a direct translation for \.{DVI}'s |nop|.
+
+Coordinate System Commands
+
+\yskip\hang|set_hv_system| 205 [1]. This command selects the logical
+coordinate that is to be used to lay out the pages. This command need not
+be given if the default coordinates are to be used (with |h| and |v| axes
+equivalent to those for |x| and |y|). The associated byte has a zero
+first bit, the next two bits specify the origin, the next two bits specify
+the axes and the final three bits specify the orientation.
+For details, see the \.{imPRESS} User's Manual.
+
+\yskip\hang|set_abs_h| 135 [2]. Set the |h| to the value given in the
+following 16-bit signed word.
+
+\yskip\hang|set_rel_h| 136 [2]. Add the value given in the following
+16-bit signed word to |h|,
+
+\yskip\hang|set_abs_v| 137 [2]. Set the |v| to the value given in the
+following 16-bit signed word.
+
+\yskip\hang|set_rel_v| 138 [2]. Add the value given in the following
+16-bit signed word to |v|,
+
+Text Positioning Commands
+
+\yskip\hang|im_page| 213. Set both |h| and |v| to zero.
+
+\yskip\hang|im_set_adv_dirs| 206 [1]. Set the main and secondary advance
+directions as specified in the following byte. The default direction
+corresponde to normal english usage.
+For details, see the \.{imPRESS} User's Manual.
+
+\yskip\hang|im_mmove| 133 [2]. Displace the current |h|,|v| position in the
+main advance direction by the value in the following signed 16notbit
+word. With the default value for |im_set_adv_dirs| this command is the
+same as |im_set_rel_h|.
+
+\yskip\hang|im_smove| 134 [2]. Displace the current |h|,|v| position in the
+secondary advance direction by the value in the following signed 16notbit
+word. With the default value for |im_set_adv_dirs| this command is the
+same as |im_set_rel_v|.
+
+\yskip\hang|im_set_sp| 210 [2]. Set the current inter-word spacing to
+the value in the following 16-bit signed word.
+We will not use this command as \TeX\ normally handles this matter.
+
+\yskip\hang|im_sp| 128. This command performs an inter-word space of the
+size specified by the |im_set_sp| command.
+We will not use this command as \TeX\ normally handles this matter.
+
+\yskip\hang|im_sp1| 129. This command performs an inter-word space of the
+size one pixel greater than that specified by the |im_set_sp| command.
+We will not use this command as \TeX\ normally handles this matter.
+
+\yskip\hang|im_mplus| 131. This command adjusts the current position by one
+pixel in the main advance direction, that is normally to add one to the
+current value of |h|.
+
+\yskip\hang|im_mminus| 132. This command adjusts the current position by
+minus one pixel in the main advance direction, that is normally to
+subtract one from the current value of |h|.
+
+\yskip\hang|im_crlf| 197. With no special advance directions, this command
+sets |h| to the beginning-of-line value and advances |v| by the inter-line
+space amount.
+
+\yskip\hang|im_set_bol| 209 [2]. Set the beginning-of-line margin to the
+value specified in the following signed 16-bit word.
+
+\yskip\hang|im_set_il| 208 [2]. Set the inter-line space to the value
+given in the following signed 16-bit word.
+
+Text Printing Commnds
+
+\yskip\hang|im_bgly| 199 [12 plus mask]. This command is used to download
+glyphs defined by two bytes specifying <rotation, family, and member>, and
+specified by two bytes each for the following four parameters,
+width, left-offset, height, and top-offset, and finally by a mask
+specifying the complete raster for the glyph within a minimum sized
+bounding box (padded at the right with enough empty (white) pixels to
+complete an otherwise partially filled byte). The rows are orderd starting
+with the top row. The number of bits for this mask is then |((width+7) div
+8)*height|. Once the rotation and family have been stated, a series of glyphs
+from this family may be printed by a string of bytes containing their member
+numbers.
+
+\yskip\hang|set_family| 207 [1]. This command sets the current-family to
+|family| which must lie in the range from 0 to 95.
+
+\yskip\hang|im_member| 0-127. An \.{imPRESS} command code in the range
+from 0 and 127 is a member command, calling for the designated member of
+the current family to be printed at the current position and for the
+printer to advance in the main advance direction by the glyph's associated
+advance-width value.
+
+Resident Glyphs
+
+Normally, we will make no use of the resident glyphs provided by the
+\.{IMAGEN} processor, since \TeX\ has no knowledge of these. These fonts
+are not accessed directly but must be referenced indirectly through member
+maps and family tables. For completeness, the commands that are used to
+create these maps and family tables are here listed. For details see the
+\.{imPRESS} User's Manual.
+
+\yskip\hang|create_map| 222
+
+\yskip\hang|create_family_table| 221.
+
+Text Rule Command
+
+\yskip\hang|im_brule| 193 w[2] h[2] t[2]. This command prints a rectangle
+(either in black or textured) of width w and height h with a top-offset
+of t where a positive value means below the current position.
+
+State Saving and Restoring
+
+\yskip\hang|set_push_mask| 214 [2]. This command specifies which of the
+various state variables are to be saved. Nine variables, set by the last 9
+bits (with the first 7 bits set to zero) of the associated 16-bit word are
+involved, these being: pen-and-texture, interword-space,
+beginning-of-line, family, hv-position, advance-direction, origin, and
+orientation. These are all marked for saving (set to one) at the beginning
+of each document and remain so unless changed by this command.
+
+\yskip\hang|im_push| 211. Save the state variables as prespecified
+originally or as altered by the |set_push_mask| command.
+
+\yskip\hang|im_pop| 212. Restore the state variables saved by the most
+recent unmatched |im_push| command.
+
+
+@ @d im_sp=128 {advance one space}
+@d im_sp1=129 {advance one space plus 1 pixel}
+@d im_mplus=131 {advance one pixel}
+@d im_mminus=132 {back up one pixel}
+@d im_mmove=133 {move in the main advance direction}
+@d im_smove=134 {move in the secondary advance direction}
+@d set_abs_h=135 {move to |h| position}
+@d set_rel_h=136 {move in the |h| direction}
+@d set_abs_v=137 {move to |v| position}
+@d set_rel_v=138 {move in the |v| direction}
+@d circ_arc=150 {define a circular path}
+@d ellipse_arc=151 {define an eliptical path}
+@d circ_segm=160 {define a pie-shaped path}
+@d im_brule=193 {print a rule}
+@d im_crlf=197 {move to the beginning of th next line}
+@d im_bgly=199 {define a downloaded glyph}
+@d set_hv_system=205 {select a logical coordinate system}
+@d im_set_adv_dirs=206 {set the advance directions}
+@d set_family=207 {set current-family to family}
+@d im_set_il=208 {set inter-line spacing}
+@d im_set_bol=209 {set margin}
+@d im_set_sp=210 {set inter-word spacing}
+@d im_push=211 {save the state variables}
+@d im_pop=212 {restore the state variables}
+@d im_page=213 {set both |h| and |v| to zero}
+@d set_push_mask=214 {specify variables to save}
+@d im_end_page=219 {end the page}
+@d create_family_table=221 {define a family table}
+@d create_map=222 {create a member map}
+@d set_pum=225 {append new path or replace path}
+@d create_path=230 {define a path of segments}
+@d set_texture=231 {select a texture for drawing}
+@d set_pen=232 {select a pen width (in pixels)}
+@d fill_path=233 {shade the ares inside the path}
+@d draw_path=234 {draw the current path (a line)}
+@d bitmap=235 {print a full bitmap}
+@d set_magnification=236 {magnify the page (by 1, 2, or 4)}
+@d define_macro=242 {define a macro}
+@d execute_macro=243 {execute the named macro}
+@d im_no_op=254 {no operation}
+@d im_eof=255 {end the document}
+
+
+@* Input and Output for binary files.
+We have seen that a \.{DVI} file is a sequence of 8-bit bytes. The bytes
+appear physically in what is called a `|packed file of 0..255|'
+in \PASCAL\ lingo.
+
+Packing is system dependent, and many \PASCAL\ systems fail to implement
+such files in a sensible way (at least, from the viewpoint of producing
+good production software). For example, some systems treat all
+byte-oriented files as text, looking for end-of-line marks and such
+things. Therefore some system-dependent code is often needed to deal with
+binary files, even though most of the program in this section of
+\.{DVIIMP} is written in standard \PASCAL.
+@^system dependencies@>
+
+One common way to solve the problem is to consider files of |integer|
+numbers, and to convert an integer in the range $-2^{31}\L x<2^{31}$ to
+a sequence of four bytes $(a,b,c,d)$ using the following code, which
+avoids the controversial integer division of negative numbers:
+$$\vbox{\halign{#\hfil\cr
+|if x>=0 then a:=x div @'100000000|\cr
+|else begin x:=(x+@'10000000000)+@'10000000000; a:=x div @'100000000+128;|\cr
+\quad|end|\cr
+|x:=x mod @'100000000;|\cr
+|b:=x div @'200000; x:=x mod @'200000;|\cr
+|c:=x div @'400; d:=x mod @'400;|\cr}}$$
+The four bytes are then kept in a buffer and output one by one. (On 36-bit
+computers, an additional division by 16 is necessary at the beginning.
+Another way to separate an integer into four bytes is to use/abuse
+\PASCAL's variant records, storing an integer and retrieving bytes that are
+packed in the same place; {\sl caveat implementor!\/}) It is also desirable
+in some cases to read a hundred or so integers at a time, maintaining a
+larger buffer.
+
+We shall stick to simple \PASCAL\ in this program, for reasons of clarity,
+even if such simplicity is sometimes unrealistic.
+
+@<Types...@>=
+@!eight_bits=0..255; {unsigned one-byte quantity}
+@!byte_file=packed file of eight_bits; {files that contain binary data}
+
+@ The program deals with four binary file variables: |dvi_file| is the main
+input file that we are translating into symbolic form, |gf_file| is
+the generic font file from which the font information is being read,
+|tfm_file| is the font-metric file that is used for width information
+in those cases where this information is available but the corresponding
+|gf_file| is not, and
+|im_file| is the output file that is to be sent to the \.{IMAGEN} printer.
+
+@<Glob...@>=
+@!dvi_file:byte_file; {the stuff we are transcribing to the IMAGEN}
+@!gf_file:byte_file; {a generic font file}
+@!tfm_file:byte_file; {a generic font file}
+@!im_file:byte_file; {the output file}
+
+@ Special considerations are involved in restricting the range of pages
+that one may want to print since the |count[0]| numbers that the |dvi|
+file reports may be either positive (the usual case) or negative to signal
+that the page numbers are to be printed in italics. We will assume that the
+user will specify, 1) the |count[0]| number of the first page that he or
+she will wants printed, by typing `/f' followed by this number, and 2) the
+tolal number of pages to be printed (in the order that they occur in the
+\.{DVI} file), by typing `/n' again followed by the number wanted. The
+\.{Imagen} will, of course, actually deliver these pages in reverse order.
+The method of reading these numbers is system dependent and the procedures
+for calling |read_f|, etc., will be found in the change file.
+Note that only |count[0]| will be used (as defined
+in \.{PLAIN} and the remaining |count| numbers will be ignored.
+
+@<Glob...@>=
+@!start_page:integer; {the requested starting page |count[0]| number}
+@!num_pages:integer; {the requested number of pages to be printed}
+@!f_count,l_count:integer; {backward counts used when printing partial file}
+@!f_flag,n_flag:boolean; {true when /f and /n are specified}
+@!page_match:boolean; {true when starting page is found}
+@!counter:integer; {used in back-counting pages}
+@!copies:integer; {the number of copies requested}
+
+@ @<Set init...@>=
+counter:=0; f_count:=max_pages; l_count:=0;
+num_pages:=max_pages; copies:=1;
+f_flag:=false; n_flag:=false;
+resolution:=300.0;
+h_org:=round(resolution); v_org:=round(resolution);
+
+@ The following procedures will be needed.
+
+@p function read_int:integer;
+var i:integer;
+@!neg_flag:boolean;
+begin
+neg_flag:=false; i:=0;
+get(tty);
+while tty^=' ' do get(tty);
+if (tty^='-') then neg_flag:=true;
+while (tty^='-') or (tty^='+') do get(tty);
+while (tty^>='0') and (tty^<='9') do begin
+ i:=i*10+xord[tty^]-"0"; get(tty);
+ end;
+if neg_flag then i:=-i;
+read_int:=i;
+end;
+@#
+procedure read_f;
+begin
+start_page:=read_int;
+f_flag:=true;
+end;
+@#
+procedure read_n;
+begin
+num_pages:=read_int;
+if num_pages=0 then num_pages:=max_pages;
+n_flag:=true;
+end;
+@#
+procedure read_c;
+begin
+copies:=read_int;
+end;
+@#
+procedure read_h;
+begin
+h_org:=read_int;
+end;
+@#
+procedure read_v;
+begin
+v_org:=read_int;
+end;
+
+@ To prepare the input files, we |reset| them. An extension of
+\PASCAL\ is needed in the case of |gf_file| and of |tfm_file|,
+since we want to associate them
+with external files whose names are specified dynamically (i.e., not
+known at compile time). The following code assumes that `|reset(f,s)|'
+does this, when |f| is a file variable and |s| is a string variable that
+specifies the file name. If |eof(f)| is true immediately after
+|reset(f,s)| has acted, we assume that no file named |s| is accessible.
+@^system dependencies@>
+
+@p procedure open_dvi_file; {prepares to read packed bytes in |dvi_file|}
+begin reset(dvi_file);
+cur_loc:=0;
+end;
+@#
+procedure open_gf_file; {prepares to read packed bytes in |gf_file|}
+begin reset(gf_file,cur_name);
+cur_gf_loc:=0;
+end;
+@#
+procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|}
+begin reset(tfm_file,cur_tfm_name);
+end;
+
+@ To prepare the |im_file| for output, we |rewrite| it.
+
+@p procedure open_im_file; {prepares to write packed bytes in |im_file|}
+begin rewrite(im_file); im_byte_no:=0;
+end;
+
+@ If you looked carefully at the preceding code, you probably asked,
+``What are |cur_loc| and |cur_name|?'' Good question. They're global
+variables: |cur_loc| is the number of the byte about to be read next from
+|dvi_file|, and |cur_name| is a string variable that will be set to the
+generic font file name before |open_gf_file| is called. While we are at
+it, we will also declare |cur_gf_loc|.
+
+@<Glob...@>=
+@!cur_loc:integer; {where we are about to look, in |dvi_file|}
+@!cur_gf_loc:integer; {where we are about to look, in |gf_file|}
+@!cur_name:packed array[1..name_length] of char; {external name,
+ with no lower case letters}
+@!cur_tfm_name:packed array[1..name_length] of char; {external name,
+ with no lower case letters}
+@!im_byte_no:integer; {where we are about to write, in |im_file|}
+
+@ We shall use a set of simple functions to read the next byte or bytes
+from a |gf_file|.
+@^system dependencies@>
+
+@p function gf_byte:integer; {returns the next byte, unsigned}
+var b:eight_bits;
+begin if eof(gf_file) then gf_byte:=0
+else begin read(gf_file,b); incr(cur_gf_loc); gf_byte:=b;
+ end;
+end;
+@#
+function gf_two_bytes:integer; {returns the next two bytes, unsigned}
+var a,@!b:eight_bits;
+begin read(gf_file,a); read(gf_file,b);
+cur_gf_loc:=cur_gf_loc+2;
+gf_two_bytes:=a*256+b;
+end;
+@#
+function gf_three_bytes:integer; {returns the next three bytes, unsigned}
+var a,@!b,@!c:eight_bits;
+begin read(gf_file,a); read(gf_file,b); read(gf_file,c);
+cur_gf_loc:=cur_gf_loc+3;
+gf_three_bytes:=(a*256+b)*256+c;
+end;
+@#
+function gf_signed_quad:integer; {returns the next four bytes, signed}
+var a,@!b,@!c,@!d:eight_bits;
+begin read(gf_file,a); read(gf_file,b); read(gf_file,c); read(gf_file,d);
+cur_gf_loc:=cur_gf_loc+4;
+if a<128 then gf_signed_quad:=((a*256+b)*256+c)*256+d
+else gf_signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+end;
+
+@ We will refer to \.{TFM} files for character width information in those
+cases where \.{.GF} files are not available. We read four bytes at a
+time, putting the input into global
+variables |b0|, |b1|, |b2|, and |b3|, with |b0| getting the first byte and
+|b3| the fourth.
+
+@<Glob...@>=
+@!b0,@!b1,@!b2,@!b3: eight_bits; {four bytes input at once}
+
+@ The |read_tfm_word| procedure sets |b0| through |b3| to the next
+four bytes in the current \.{TFM} file.
+@^system dependencies@>
+
+@p procedure read_tfm_word;
+begin read(tfm_file,b0); read(tfm_file,b1);
+read(tfm_file,b2); read(tfm_file,b3);
+end;
+
+@ We shall use another set of simple functions to read the next byte or
+bytes from |dvi_file|. There are seven possibilities, each of which is
+treated as a separate function in order to minimize the overhead for
+subroutine calls.
+@^system dependencies@>
+
+@p function get_byte:integer; {returns the next byte, unsigned}
+var b:eight_bits;
+begin if eof(dvi_file) then get_byte:=0
+else begin read(dvi_file,b); incr(cur_loc); get_byte:=b;
+ end;
+end;
+@#
+function signed_byte:integer; {returns the next byte, signed}
+var b:eight_bits;
+begin read(dvi_file,b); incr(cur_loc);
+if b<128 then signed_byte:=b @+ else signed_byte:=b-256;
+end;
+@#
+function get_two_bytes:integer; {returns the next two bytes, unsigned}
+var a,@!b:eight_bits;
+begin read(dvi_file,a); read(dvi_file,b);
+cur_loc:=cur_loc+2;
+get_two_bytes:=a*256+b;
+end;
+@#
+function signed_pair:integer; {returns the next two bytes, signed}
+var a,@!b:eight_bits;
+begin read(dvi_file,a); read(dvi_file,b);
+cur_loc:=cur_loc+2;
+if a<128 then signed_pair:=a*256+b
+else signed_pair:=(a-256)*256+b;
+end;
+@#
+function get_three_bytes:integer; {returns the next three bytes, unsigned}
+var a,@!b,@!c:eight_bits;
+begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c);
+cur_loc:=cur_loc+3;
+get_three_bytes:=(a*256+b)*256+c;
+end;
+@#
+function signed_trio:integer; {returns the next three bytes, signed}
+var a,@!b,@!c:eight_bits;
+begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c);
+cur_loc:=cur_loc+3;
+if a<128 then signed_trio:=(a*256+b)*256+c
+else signed_trio:=((a-256)*256+b)*256+c;
+end;
+@#
+function signed_quad:integer; {returns the next four bytes, signed}
+var a,@!b,@!c,@!d:eight_bits;
+begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c); read(dvi_file,d);
+cur_loc:=cur_loc+4;
+if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
+else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+end;
+
+@ Finally we come to the routines that are used only if |random_reading| is
+|true|. The driver program below needs two such routines: |dvi_length| should
+compute the total number of bytes in |dvi_file|, possibly also
+causing |eof(dvi_file)| to be true; and |move_to_byte(n)|
+should position |dvi_file| so that the next |get_byte| will read byte |n|,
+starting with |n=0| for the first byte in the file.
+@^system dependencies@>
+
+Such routines are, of course, highly system dependent. They are implemented
+here in terms of two assumed system routines called |set_pos| and |cur_pos|.
+The call |set_pos(f,n)| moves to item |n| in file |f|, unless |n| is
+negative or larger than the total number of items in |f|; in the latter
+case, |set_pos(f,n)| moves to the end of file |f|.
+The call |cur_pos(f)| gives the total number of items in |f|, if
+|eof(f)| is true; we use |cur_pos| only in such a situation.
+
+@p function dvi_length:integer;
+begin set_pos(dvi_file,-1); dvi_length:=cur_pos(dvi_file);
+end;
+@#
+procedure move_to_byte(n:integer);
+begin set_pos(dvi_file,n); cur_loc:=n;
+end;
+
+@ We face a similar problem in dealing with the \.{GF} files so perhaps we
+should deal with this problem at this time. We will need two special
+routines, one to determine the byte length of the individual \.{GF} files
+and the second to position |gf_file| so that the next |gf_byte| will read
+byte |n|, starting with |n=0| for the first byte in the file.
+@^system dependencies@>
+
+@p function gf_length:integer;
+begin set_pos(gf_file,-1); gf_length:=cur_pos(gf_file);
+end;
+@#
+procedure move_to_gf_byte(n:integer);
+begin set_pos(gf_file,n); cur_gf_loc:=n;
+end;
+
+@ We will also need a simple way of sending bytes, unsigned bytes, and signed
+16-bit words to the |im_file|. While the \.{imPRESS} manual user |u_byte|
+for an unsigned byte, we will attach an `s' prefix for the signed case, leaving
+|im_byte| to mean an unsigned byte as used elsewhere in this program.
+
+@d im_byte(#)==begin write(im_file,#);
+ incr(im_byte_no); end
+
+@p procedure im_sbyte(@!w:integer);
+begin
+if w<0 then w:=w+@"100;
+im_byte(w);
+end;
+@#
+procedure im_halfword(@!w:integer);
+begin
+if w<0 then w:=w+@"10000;
+im_byte(w div @"100);
+im_byte(w mod @"100);
+end;
+
+@* GF file format.
+This program, in contrast with many device drivers, gets its font
+information directly from the ``generic font'' (\.{GF}) files that are the
+most important output produced by the \MF\ program. The term {\sl
+generic\/} indicates that this file format doesn't match the conventions
+of any name-brand manufacturer; but it is easy to convert \.{GF} files to
+the special format required by almost all digital phototypesetting
+equipment, if these devices are designed to accept fonts directly.
+Alternately, one can translate the \.{GF} and pass the needed raster
+information on to the printer at the time that a \.{DVI} file is being
+processed, as is done in this program.
+
+There's a strong analogy
+between the \.{DVI} files written by \TeX\ and the \.{GF} files written
+by \MF; and, in fact, the file formats have a lot in common.
+
+A \.{GF} file is a stream of 8-bit bytes that may be
+regarded as a series of commands in a machine-like language. The first
+byte of each command is the operation code, and this code is followed by
+zero or more bytes that provide parameters to the command. The parameters
+themselves may consist of several consecutive bytes; for example, the
+`|boc|' (beginning of character) command has six parameters, each of
+which is four bytes long, while the shortened, more ofter used, form, `|boc1|'
+has five parameters, each of which is only one byte long.
+Parameters are usually regarded as nonnegative
+integers; but four-byte-long parameters can be either positive or
+negative, hence they range in value from $-2^{31}$ to $2^{31}-1$.
+As in \.{TFM} files, numbers that occupy
+more than one byte position appear in BigEndian order,
+and negative numbers appear in two's complement notation.
+
+A \.{GF} file consists of a ``preamble,'' followed by a sequence of one or
+more ``characters,'' followed by a ``postamble.'' The preamble is simply a
+|pre| command, with its parameters that introduce the file; this must come
+first. Each ``character'' consists of a |boc| or a |boc1|
+command, followed by any
+number of other commands that specify ``black'' pixels,
+followed by an |eoc| command. The characters appear in the order that \MF\
+generated them. If we ignore no-op commands (which are allowed between any
+two commands in the file), each |eoc| command is immediately followed by a
+|boc| or a |boc1|
+command, or by a |post| command; in the latter case, there are no
+more characters in the file, and the remaining bytes form the postamble.
+Further details about the postamble will be explained later.
+
+Some parameters in \.{GF} commands are ``pointers.'' These are four-byte
+quantities that give the location number of some other byte in the file;
+the first file byte is number~0, then comes number~1, and so on.
+
+@ The \.{GF} format is intended to be both compact and easily interpreted
+by a machine. Compactness is achieved by making most of the information
+relative instead of absolute. When a \.{GF}-reading program reads the
+commands for a character, it keeps track of two quantities: (a)~the current
+column number,~|m|; and (b)~the current row number,~|n|. These are 32-bit
+signed integers, although most actual font formats produced from \.{GF}
+files will need to curtail this vast range because of practical
+limitations. (\MF\ output will never allow $\vert m\vert$ or $\vert
+n\vert$ to exceed 4096, but the \.{GF} format tries to be more general.)
+
+How do \.{GF}'s row and column numbers correspond to the conventions
+of \TeX\ and \MF? Well, the ``reference point'' of a character, in \TeX's
+view, is considered to be at the lower left corner of the pixel in row~0
+and column~0. This point is the intersection of the baseline with the left
+edge of the type; it corresponds to location $(0,0)$ in \MF\ programs.
+Thus the pixel in \.{GF} row~0 and column~0 is \MF's unit square, comprising the
+region of the plane whose coordinates both lie between 0 and~1. The
+pixel in \.{GF} row~|n| and column~|m| consists of the points whose \MF\
+coordinates |(x,y)| satisfy |m<=x<=m+1| and |n<=y<=n+1|. Negative values of
+|m| and~|x| correspond to columns of pixels {\sl left\/} of the reference
+point; negative values of |n| and~|y| correspond to rows of pixels {\sl
+below\/} the baseline.
+
+Besides |m| and |n|, there's also a third aspect of the current
+state, namely the @!|paint_switch|, which is always either \\{black} or
+\\{white}. Each \\{paint} command advances |m| by a specified amount~|d|,
+and blackens the intervening pixels if |paint_switch=black|; then
+the |paint_switch| changes to the opposite state. \.{GF}'s commands are
+designed so that |m| will never decrease within a row, and |n| will never
+increase within a character; hence there is no way to whiten a pixel that
+has been blackened. \.{DVIIMP} does not use a |paint_switch| parameter,
+as such, but other programs do and the concept is useful in following
+the way that the |paint| commands are handled.
+
+@ Here is a list of all the commands that may appear in a \.{GF} file. Each
+command is specified by its symbolic name (e.g., |boc|), its opcode byte
+(e.g., 67), and its parameters (if any). The parameters are followed
+by a bracketed number telling how many bytes they occupy; for example,
+`|d[2]|' means that parameter |d| is two bytes long.
+
+\yskip\hang|paint_0| 0. This is a \\{paint} command with |d=0|; it does
+nothing but change the |paint_switch| from \\{black} to \\{white} or vice~versa.
+
+\yskip\hang\\{paint\_1} through \\{paint\_63} (opcodes 1 to 63).
+These are \\{paint} commands with |d=1| to~63, defined as follows: If
+|paint_switch=black|, blacken |d|~pixels of the current row~|n|,
+in columns |m| through |m+d-1| inclusive. Then, in any case,
+complement the |paint_switch| and advance |m| by~|d|.
+
+\yskip\hang|paint1| 64 |d[1]|. This is a \\{paint} command with a specified
+value of~|d|; \MF\ uses it to paint when |64<=d<256|.
+
+\yskip\hang|@!paint2| 65 |d[2]|. Same as |paint1|, but |d|~can be as high
+as~65535.
+
+\yskip\hang|@!paint3| 66 |d[3]|. Same as |paint1|, but |d|~can be as high
+as $2^{24}-1$. \MF\ never needs this command, and it is hard to imagine
+anybody making practical use of it; surely a more compact encoding will be
+desirable when characters can be this large. But the command is there,
+anyway, just in case.
+
+\yskip\hang|boc| 67 |c[4]| |p[4]| |min_m[4]| |max_m[4]| |min_n[4]|
+|max_n[4]|. Beginning of a character: Here |c| is the character code, and
+|p| points to the previous character beginning (if any) for characters having
+this code number modulo 256. (The pointer |p| is |-1| if there was no
+prior character with an equivalent code.) The values of registers |m| and |n|
+defined by the instructions that follow for this character must
+satisfy |min_m<=m<=max_m| and |min_n<=n<=max_n|. (The values of |max_m| and
+|min_n| need not be the tightest bounds possible.) When a \.{GF}-reading
+program sees a |boc|, it can use |min_m|, |max_m|, |min_n|, and |max_n| to
+initialize the bounds of an array. Then it sets |m:=min_m|, |n:=max_n|, and
+|paint_switch:=white|.
+
+\yskip\hang|boc1| 68 |c[1]| |@!del_m[1]| |max_m[1]| |@!del_n[1]| |max_n[1]|.
+Same as |boc|, but |p| is assumed to be~$-1$; also |del_m=max_m-min_m|
+and |del_n=max_n-min_n| are given instead of |min_m| and |min_n|.
+The one-byte parameters must be between 0 and 255, inclusive.
+\ (This abbreviated |boc| saves 19~bytes per character, in common cases.)
+
+\yskip\hang|eoc| 69. End of character: All pixels blackened so far
+constitute the pattern for this character. In particular, a completely
+blank character might have |eoc| immediately following |boc|.
+
+\yskip\hang|skip0| 70. Decrease |n| by 1 and set |m:=min_m|,
+|paint_switch:=white|. \ (This finishes one row and begins another,
+ready to whiten the leftmost pixel in the new row.)
+
+\yskip\hang|skip1| 71 |d[1]|. Decrease |n| by |d+1|, set |m:=min_m|, and set
+|paint_switch:=white|. This is a way to produce |d| all-white rows.
+
+\yskip\hang|@!skip2| 72 |d[2]|. Same as |skip1|, but |d| can be as large
+as 65535.
+
+\yskip\hang|@!skip3| 73 |d[3]|. Same as |skip1|, but |d| can be as large
+as $2^{24}-1$. \MF\ obviously never needs this command.
+
+\yskip\hang|new_row_0| 74. Decrease |n| by 1 and set |m:=min_m|,
+|paint_switch:=black|. \ (This finishes one row and begins another,
+ready to {\sl blacken\/} the leftmost pixel in the new row.)
+
+\yskip\hang|@!new_row_1| through |@!new_row_164| (opcodes 75 to 238). Same as
+|new_row_0|, but with |m:=min_m+1| through |min_m+164|, respectively.
+
+\yskip\hang|xxx1| 239 |k[1]| |x[k]|. This command is undefined in
+general; it functions as a $(k+2)$-byte |no_op| unless special \.{GF}-reading
+programs are being used. \MF\ generates \\{xxx} commands when encountering
+a \&{special} string; this occurs in the \.{GF} file only between
+characters, after the preamble, and before the postamble. However,
+\\{xxx} commands might appear anywhere in \.{GF} files generated by other
+processors. It is recommended that |x| be a string having the form of a
+keyword followed by possible parameters relevant to that keyword.
+
+\yskip\hang|@!xxx2| 240 |k[2]| |x[k]|. Like |xxx1|, but |0<=k<65536|.
+
+\yskip\hang|xxx3| 241 |k[3]| |x[k]|. Like |xxx1|, but |0<=k<@t$2^{24}$@>|.
+\MF\ uses this when sending a \&{special} string whose length exceeds~255.
+
+\yskip\hang|@!xxx4| 242 |k[4]| |x[k]|. Like |xxx1|, but |k| can be
+ridiculously large; |k| mustn't be negative.
+
+\yskip\hang|yyy| 243 |y[4]|. This command is undefined in general;
+it functions as a 5-byte |no_op| unless special \.{GF}-reading programs
+are being used. \MF\ puts |scaled| numbers into |yyy|'s, as a
+result of \&{numspecial} commands; the intent is to provide numeric
+parameters to \\{xxx} commands that immediately precede.
+
+\yskip\hang|no_op| 244. No operation, do nothing. Any number of |no_op|'s
+may occur between \.{GF} commands, but a |no_op| cannot be inserted between
+a command and its parameters or between two parameters.
+
+\yskip\hang|char_loc| 245 |c[1]| |dx[4]| |dy[4]| |w[4]| |p[4]|.
+This command will appear only in the postamble, which will be explained shortly.
+
+\yskip\hang|@!char_loc0| 246 |c[1]| |@!dm[1]| |w[4]| |p[4]|.
+Same as |char_loc|, except that |dy| is assumed to be zero, and the value
+of~|dx| is taken to be |65536*dm|, where |0<=dm<256|.
+
+\yskip\hang|pre| 247 |i[1]| |k[1]| |x[k]|.
+Beginning of the preamble; this must come at the very beginning of the
+file. Parameter |i| is an identifying number for \.{GF} format, currently
+131. The other information is merely commentary; it is not given
+special interpretation like \\{xxx} commands are. (Note that \\{xxx}
+commands may immediately follow the preamble, before the first |boc|.)
+
+\yskip\hang|post| 248. Beginning of the postamble, see below.
+
+\yskip\hang|post_post| 249. Ending of the postamble, see below.
+
+\yskip\noindent Commands 250--255 are undefined at the present time.
+
+@d gf_id_byte=131 {identifies the kind of \.{GF} files described here}
+
+@ Here are the opcodes that \.{DVIIMP} actually refers to.
+
+@d paint_0=0 {beginning of the \\{paint} commands}
+@d paint1=64 {move right a given number of columns, then
+ black${}\swap{}$white}
+@d paint2=65
+@d boc=67 {beginning of a character}
+@d boc1=68 {abbreviated |boc|}
+@d eoc=69 {end of a character}
+@d skip0=70 {skip no blank rows}
+@d skip1=71 {skip over blank rows}
+@d skip2=72 {skip over blank rows}
+@d new_row_0=74 {move down one row and then right}
+@d new_row_164=238 {move down 164 rows and then right}
+{xxx1=239 defined previously}
+@d yyy=243 {for \&{numspecial} numbers}
+@d no_op=244 {no operation}
+@d char_loc=245 {character locators in the postamble}
+{pre=247 (preamble) defined previously}
+{post 248 (postamble beginning) defined previously}
+{|post_post|=249 (postamble ending) defined previously}
+{undefined commands==250,251,252,253,254,255}
+
+@ The last character in a \.{GF} file is followed by `|post|'; this command
+introduces the postamble, which summarizes important facts that \MF\ has
+accumulated. The postamble has the form
+$$\vbox{\halign{\hbox{#\hfil}\cr
+ |post| |p[4]| |@!ds[4]| |@!cs[4]| |@!hppp[4]| |@!vppp[4]|
+ |min_m[4]| |max_m[4]| |min_n[4]| |max_n[4]|\cr
+ $\langle\,$character locators$\,\rangle$\cr
+ |post_post| |q[4]| |i[1]| 223's$[{\G}4]$\cr}}$$
+Here |p| is a pointer to the byte following the final |eoc| in the file
+(or to the byte following the preamble, if there are no characters);
+it can be used to locate the beginning of \\{xxx} commands
+that might have preceded the postamble. The |ds| and |cs| parameters
+@^design size@> @^check sum@>
+give the design size and check sum, respectively, which are exactly the
+values put into the header of any \.{TFM} file that shares information with this
+\.{GF} file. Parameters |hppp| and |vppp| are the ratios of
+pixels per point, horizontally and vertically, expressed as |scaled| integers
+(i.e., multiplied by $2^{16}$); they can be used to correlate the font
+with specific device resolutions, magnifications, and ``at sizes.'' Then
+come |min_m|, |max_m|, |min_n|, and |max_n|, which bound the values that
+registers |m| and~|n| assume in all characters in this \.{GF} file.
+(These bounds need not be the best possible; |max_m| and |min_n| may, on the
+other hand, be tighter than the similar bounds in |boc| commands. For
+example, some character may have |min_n=-100| in its |boc|, but it might
+turn out that |n| never gets lower than |-50| in any character; then
+|min_n| can have any value |<=-50|. If there are no characters in the file,
+it's possible to have |min_m>max_m| and/or |min_n>max_n|.)
+
+@ Character locators are introduced by |char_loc| commands,
+which specify a character residue~|c|, character displacements (|dx,dy|),
+a character width~|w|, and a pointer~|p|
+to the beginning of that character. (If two or more characters have the
+same code~|c| modulo 256, only the last will be indicated; the others can be
+located by following backpointers. Characters whose codes differ by a
+multiple of 256 are assumed to share the same font metric information,
+hence the \.{TFM} file contains only residues of character codes modulo~256.
+This convention is intended for oriental languages, when there are many
+character shapes but few distinct widths.)
+@^oriental characters@>@^Chinese characters@>@^Japanese characters@>
+
+The character displacements (|dx,dy|) are the values of \MF's \&{chardx}
+and \&{chardy} parameters; they are in units of |scaled| pixels;
+i.e., |dx| is in horizontal pixel units times $2^{16}$, and |dy| is in
+vertical pixel units times $2^{16}$. This is the intended amount of
+displacement after typesetting the character; for \.{DVI} files, |dy|
+should be zero, but other document file formats allow nonzero vertical
+displacement.
+
+The character width~|w| duplicates the information in the \.{TFM} file; it
+is $2^{24}$ times the ratio of the true width to the font's design size.
+
+The backpointer |p| points to the character's |boc|, or to the first of
+a sequence of consecutive \\{xxx} or |yyy| or |no_op| commands that
+immediately precede the |boc|, if such commands exist; such ``special''
+commands essentially belong to the characters, while the special commands
+after the final character belong to the postamble (i.e., to the font
+as a whole). This convention about |p| applies also to the backpointers
+in |boc| commands, even though it wasn't explained in the description
+of~|boc|. @^backpointers@>
+@^oriental characters@>@^Chinese characters@>@^Japanese characters@>
+
+Pointer |p| might be |-1| if the character exists in the \.{TFM} file
+but not in the \.{GF} file. This unusual situation can arise in \MF\ output
+if the user had |proofing<0| when the character was being shipped out,
+but then made |proofing>=0| in order to get a \.{GF} file.
+
+These |p| pointers are not currently being used in this program, instead we
+store all rasters as received in the |mm_store| and index then by
+|glyph_ptr|. The role of a |-1| value for |p| is take over by a |-1| in
+the |glyph_ptr| array.
+
+@ The last part of the postamble, following the |post_post| byte that
+signifies the end of the character locators, contains |q|, a pointer to the
+|post| command that started the postamble. An identification byte, |i|,
+comes next; this currently equals~131, as in the preamble.
+
+The |i| byte is followed by four or more bytes that are all equal to
+the decimal number 223 (i.e., @'337 in octal). \MF\ puts out four to seven of
+these trailing bytes, until the total length of the file is a multiple of
+four bytes, since this works out best on machines that pack four bytes per
+word; but any number of 223's is allowed, as long as there are at least four
+of them. In effect, 223 is a sort of signature that is added at the very end.
+@^Fuchs, David Raymond@>
+
+This curious way to finish off a \.{GF} file makes it feasible for
+\.{GF}-reading programs to find the postamble first, on most computers,
+even though \MF\ wants to write the postamble last. Most operating
+systems permit random access to individual words or bytes of a file, so
+the \.{GF} reader can start at the end and skip backwards over the 223's
+until finding the identification byte. Then it can back up four bytes, read
+|q|, and move to byte |q| of the file. This byte should, of course,
+contain the value 248 (|post|); now the postamble can be read, so the
+\.{GF} reader can discover all the information needed for individual characters.
+
+Unfortunately, however, standard \PASCAL\ does not include the ability to
+@^system dependencies@>
+access a random position in a file, or even to determine the length of a file.
+Almost all systems nowadays provide the necessary capabilities, so \.{GF}
+format has been designed to work most efficiently with modern operating systems.
+But if \.{GF} files have to be processed under the restrictions of standard
+\PASCAL, one can simply read them from front to back. This will
+be adequate for most applications. However, the postamble-first approach
+would facilitate a program that merges two \.{GF} files, replacing data
+from one that is overridden by corresponding data in the other.
+
+@* Reading the font information.
+\.{DVI} file format does not include information about character widths
+nor the detailed raster information. \.{DVIIMP} gets this information
+directly from the (\.{GF}) files.
+@.GF {\rm files}@>
+
+The task facing \.{DVIIMP} is quite different from that facing \.{DVItype}
+which has a comparatively easy task in this regard, since it needs only a
+few words of information from each font. We will follow this earlier
+program as much as possible in our use of file names and related details
+but our data structure will necessarily be somewhat more complicated.
+
+We follow \.{DVItype} to the extent of listing the current number of known
+fonts as |nf|. Each known font has an internal number |f|, where |0<=f<nf|;
+the external number of this font, i.e., its font identification number in
+the \.{DVI} file, is |font_num[f]|, and the external name of this font is
+the string that occupies positions |font_name[f]| through
+|font_name[f+1]-1| of the array |names|. The latter array consists of
+|ASCII_code| characters, and |font_name[nf]| is its first unoccupied
+position.
+
+Fonts containing more than 128 characters require special attention since
+\.{Imagen} will only accept 0 to 127 as valid character numbers. An easy
+way out of this difficulty is to assign |f| numbers starting at the
+largest font number (95) that \.{Imagen} will accept (and progressing
+downward) as |im_extension| family numbers that can be assigned to the
+over 127 characters of large fonts and that can be downloaded with |c-128|
+as the \.{Imagen} identification. A record of this relationship is
+maintained in an |im_extension[cur_font]| array.
+
+We will find it necessary, occasionally, to reuse the |mm_store| space
+and to make this possible we define a |free_limit| parameter.
+This parameter is set initially to |mm_max|. The following
+|make_space| procedure is used to free space.
+Note that this does not prevent the printing of those glyphs that have
+been downloaded but the raster data for those glyphs that have not been
+downloaded will have to be reread from the |gf| file should any of these
+be subsequently requested.
+
+@p procedure make_space;
+var i,j,k,q: integer;
+begin
+@!debug
+print(' overwriting font ');
+print_ln(font_order[0]:1,' ');
+gubed@/
+j:=data_start[font_order[0]];
+k:=data_start[font_order[1]];
+q:=glyph_ptr[k];
+if q>12 then free_limit:=q-1 else free_limit:=mm_size;
+for i:=j to k-1 do
+ if glyph_ptr[i]>=4 then glyph_ptr[i]:=0; {mark as no longer available}
+for i:=0 to max_fonts-1 do font_order[i]:=font_order[i+1];
+end;
+
+@ We also follow the \.{DVItype} example of storing the glyph widths
+(measured in \.{DVI} units) in a |width| array that is indexed by values
+stored in a |data_base| array. This |data_base| is in turn indexed by the
+internal font number and its values point to pseudo starting locations in
+the |width| array where the first glyph widths for the fonts would be
+stored were there a zero numbered glyph in the font. The actualy starting
+location for each font's data in the |width| table is displaced forward
+by |font_bc| where |font_bc| is the lowest character number that is
+contained in each particular font. The values in the |data_base| array
+are, of course, also used to access the |pixel_width| values (measured in
+pixels) since it will be organized in an identical way to that used with
+the |width| table.
+
+Gaining access to the font raster details, stored in |mm_store|, is a
+slightly longer process because the spaces occupied by the raster details
+will usually vary from glyph to glyph. We handle this matter by having
+yet another indexing stage where the starting location in |mm_store| for
+each individual glyph is stored in a |glyph_ptr| array that is accessed,
+in turn, by using the same |data_base| value that is used to locate the
+|width| and |pixel_width| values.
+
+Normally, this double-indexing recall needs be done but once for
+each used glyph since all glyphs are stored internally in the \.{IMAGEN}
+on the first occasions when they are used. As will be noted later, we
+signal the fact that any particular glyph has been down-loaded by
+negating its reference number in the |glyph_ptr| array.
+
+@d char_width_end(#)==#]
+@d char_width(#)==width[data_base[#]+char_width_end
+@d invalid_width==@'17777777777
+@d stow(#)==begin mm_store[m1,m2]:=#;
+ if (mm<free_limit) and ((mm+8)>free_limit) then make_space;
+ if m2<m2_max then begin incr(m2); incr(mm); end
+ else
+ begin
+ m2:=4; {|-4<m2<4| freed for down-loading and |make_space| signs}
+ mm:=mm+5;
+ if m1<m1_max then incr(m1) else begin m1:=0; mm:=4; end;
+ end;
+ end
+
+@<Glob...@>=
+@!font_num:array [0..max_fonts] of integer; {external font numbers}
+@!font_m_val:array [0..max_fonts] of integer; {overall font magnification}
+@!font_name:array [0..max_fonts] of 0..name_size; {starting positions
+ of external font names}
+@!names:array [0..name_size] of ASCII_code; {characters of names}
+@!font_check_sum:array [0..max_fonts] of integer; {check sums}
+@!font_scaled_size:array [0..max_fonts] of integer; {scale factors}
+@!font_design_size:array [0..max_fonts] of integer; {design sizes}
+@!font_space:array [0..max_fonts] of integer; {boundary between ``small''
+ and ``large'' spaces}
+@!font_bc:array [0..max_fonts] of integer; {beginning characters in fonts}
+@!font_ec:array [0..max_fonts] of integer; {ending characters in fonts}
+@!data_base:array [0..max_fonts] of integer; {index into font data tables}
+@!width:array [0..max_glyphs] of integer; {character widths, in \.{DVI} units}
+@!in_width:array[0..255] of integer; {\.{TFM} width data in \.{DVI} units}
+@!tfm_check_sum:integer; {check sum found in |tfm_file|}
+@!nf:0..max_fonts; {the number of known fonts}
+@!nf2: 0..95; {the lower limit of font extension numbers}
+@!im_extension: array[0..max_fonts] of integer; {relating extension numbers}
+@!width_ptr:0..max_glyphs; {the number of known character widths}
+@!bc,ec:integer; {beginning and ending c in current font}
+@!w_byte: array[0..max_char_no, 0..3] of eight_bits; {to hold |width| bytes}
+@!gf_ptr: array[0..max_char_no] of integer; {to hold valid glyph indicators}
+
+@ @<Set init...@>=
+nf:=0; width_ptr:=0; font_name[0]:=0; font_space[0]:=0;
+nf2:=95; {limit to usable font numbers set by Imagen}
+for i:=0 to max_fonts do im_extension[i]:=-1; {marked as not assigned}
+
+@ It is, of course, a simple matter to print the name of a given font.
+
+@p procedure print_font(@!f:integer); {|f| is an internal font number}
+var k:0..name_size; {index into |names|}
+begin if f=nf then print('UNDEFINED!')
+@.UNDEFINED@>
+else begin for k:=font_name[f] to font_name[f+1]-1 do
+ print(xchr[names[k]]);
+ end;
+end;
+
+@ The following procedure is used to print the font-name extension as
+used on the \.{SAIL} computer at Stanford. It condenses a possibly 4-digit
+number into three characters by using the letters A to Z for the first character
+for extensions in the range from 1000 to 3599 and simply reporting an extension
+of .GF for those unlikely cases where the value is 3600 or greater.
+@^system dependencies@>
+
+@p procedure print_extension(m:integer);
+begin
+print('.');
+if m < 3600 then
+ begin
+ if m < 1000 then print(xchr[(m div 100)+@'60])
+ else print(xchr[(m div 100)+@'67]);
+ print(xchr[(m mod 100) div 10+@'60]);
+ print(xchr[m mod 10+@'60]);
+ end
+else print('GF');
+end;
+
+@ The global variable |gf_check_sum| is set to the check sum that
+appears in the current \.{GF} file.
+
+@<Glob...@>=
+@!gf_check_sum:integer; {check sum found in |gf_file|}
+
+@ We will need a number of procedures to extract the necessary inforation
+fron a \.{GF} file, assuming that the file has just been successfully
+reset so that we are ready to read its first byte. Only a limited amount
+of validity checking of the \.{GF} file will be done since \.{GF} files
+are almost always valid, and since the \.{GFtype} utility program has been
+specifically designed to diagnose \.{GF} errors. The procedure simply
+returns |false| if it detects anything amiss in the \.{GF} data.
+
+Since we are going to defer the creation of an \.{imPRESS} |bgly| command
+for each glyph until the first time that it is actually called, we will
+now only decipher the |gf| commands far enough to determine if they are to
+be saved and to store them away in as compact a form as possible.
+
+As mentioned earlier, raster determining commands are stored in a large
+array, |mm_store|. This information is stored serially, as it is received,
+together with 8 bytes of preliminary information that must also be
+transmitted. The location of the first byte of information is recorded
+in the |glyph_ptr| array. To insure that this number will always be greater
+than 3 (since numbers in the range between -3 and +3 are used as special
+signals) we do not use the first 4 cells in |mm_store| (actually, the first
+4 cells in each of the four sections into which |mm_store| is divided).
+Later, when the glyph is first called for
+by the \.{DVI} file, we will generate an appropriate \.{IMAGEN} |bgly|
+command and complement the pointer value in the |glyph_ptr| array to show
+that this has been done. Finally, as will be explained in more detail
+later, we will have to arrange for the removal of the raster information
+for one or more fonts, to make space for other fonts. and we will have to
+store a record of this removal.
+
+We will find it convenient to define a |find_gf_postamble| function and a
+|read_gf_postamble| procedure. Since we will have occasion to deal with
+parameters associated with the GF commands, we will also define a function
+|first_gf_par| analogous to the |first_par| that we defined earlier.
+
+@p function find_gf_postamble:boolean;
+var q,@!k: integer;
+begin
+find_gf_postamble:=true;
+gf_post_loc:=gf_length-4;
+repeat if gf_post_loc=0 then find_gf_postamble:=false;
+move_to_gf_byte(gf_post_loc); k:=gf_byte; decr(gf_post_loc);
+until k<>223;
+if k<>gf_id_byte then find_gf_postamble:=false;
+move_to_gf_byte(gf_post_loc-3); q:=gf_signed_quad;
+if (q<0)or(q>gf_post_loc-3) then find_gf_postamble:=false;
+move_to_gf_byte(q); k:=gf_byte;
+if k<>post then find_gf_postamble:=false;
+@!debug
+print_ln( ' gf postamble at ',cur_gf_loc:1);
+gubed
+end;
+
+@ Having found the |gf_postamble|, we must now read it and stow the
+data away as as halfwords as required later by \.{IMAGEN}.
+
+@p procedure read_gf_postamble;
+var k,l:integer; {loop indices}
+@!p,q,@!m,@!c:integer; {general purpose registers}
+begin gf_post_loc:=cur_gf_loc-1;
+@.gf_postamble starts at byte n@>
+p:=gf_signed_quad;
+design_size:=gf_signed_quad; check_sum:=gf_signed_quad;@/
+hppp:=gf_signed_quad; vppp:=gf_signed_quad;@/
+magnification:=hppp/(65536.0*resolution/72.27);
+@<Report font specification disagreements@>;
+min_m:=gf_signed_quad; max_m:=gf_signed_quad;
+min_n:=gf_signed_quad; max_n:=gf_signed_quad;@/
+bc:=max_char_no; ec:=0;
+ {prepare for a determination in Process the character loc}
+@<Clear |w_byte| array@>;
+@<Process the character locations in the postamble@>;
+while not eof(gf_file) do m:=gf_byte; {to close out file}
+end;
+@#
+function first_gf_par(o:eight_bits):integer;
+begin case o of
+sixty_four_cases(paint_0): first_gf_par:=o-paint_0;
+paint1,skip1,char_loc,char_loc+1,xxx1: first_gf_par:=gf_byte;
+paint2,skip2,xxx1+1: first_gf_par:=gf_two_bytes;
+paint1+2,skip1+2,xxx1+2: first_gf_par:=gf_three_bytes;
+xxx1+3,yyy: first_gf_par:=gf_signed_quad;
+boc,boc1,eoc,skip0,no_op,pre,post,post_post,undefined_commands: first_gf_par:=0;
+one_sixty_five_cases(new_row_0): first_gf_par:=o-new_row_0;
+end;
+end;
+@#
+procedure copy_byte;
+var w:eight_bits;
+begin
+w:=gf_byte; stow(w);
+end;
+@#
+procedure stow_pair(@!w:integer);
+begin
+stow(w div @"100);
+stow(w mod @"100);
+end;
+@#
+procedure stow_signed_pair(@!w:integer);
+begin
+if w<0 then w:=w+@"10000;
+stow(w div @"100);
+stow(w mod @"100);
+end;
+
+@ @<Report font specification disagreements@>=
+if design_size<>font_design_size[cur_font]*16 then
+ begin print_nl; print('design sizes for font '); print_font(cur_font);
+ print_extension(font_m_val[cur_font]); print(' do not agree. ');
+ end;
+if (check_sum<>font_check_sum[cur_font]) and (check_sum<>0)
+ and (font_check_sum[cur_font]<>0) then
+ begin print_nl; print('check sums for font '); print_font(cur_font);
+ print_extension(font_m_val[cur_font]); print(' do not agree. ');
+ end;
+q:=round((resolution*65536/72.27)*(mag/1000.0)*
+ font_scaled_size[cur_font]/font_design_size[cur_font]);
+if ((q-(q div 100))>hppp) or ((q+(q div 100))<hppp) then
+ begin print_nl; print('at size values for font '); print_font(cur_font);
+ print_extension(font_m_val[cur_font]);
+ print(' disagree by more than one percent. ');
+ end;
+
+@ @<Clear |w_byte| array@>=
+for k:=0 to max_char_no do
+ begin
+ for l:=0 to 3 do w_byte[k,l]:=0;
+ gf_ptr[k]:=0; {so data of missing glyphs will be made available}
+ end;
+
+@ @<Process the character locations in the postamble@>=
+repeat k:=gf_byte;
+if (k=char_loc) or (k=char_loc+1) then
+ begin
+ c:=gf_byte;
+ if c>max_char_no then abort('Character number too large');
+ if c<bc then bc:=c; if c>ec then ec:=c;
+ if k=char_loc then
+ begin dx[c]:=gf_signed_quad div 65536; dy:=gf_signed_quad;
+ end
+ else begin dx[c]:=gf_byte; dy:=0;
+ end;
+@!debug
+ print(' k=',k:1,' c=',c:1,' dx=',dx[c]:1);
+gubed@/
+ w_byte[c,0]:=gf_byte;
+ w_byte[c,1]:=gf_byte;
+ w_byte[c,2]:=gf_byte;
+ w_byte[c,3]:=gf_byte;
+ gf_ptr[c]:=gf_signed_quad; {the |>0| values will mark existing glyphs}
+@!debug
+ print_ln(' k=',k:1,' gfptr=',gf_ptr[c]:1);
+gubed@/
+ k:=no_op;
+ end;
+until k<>no_op;
+
+@ Here is the main information we glean from the postamble together with
+some auxiliary parameters.
+
+@<Glob...@>=
+@!design_size: integer;
+@!hppp, @!vppp: integer;
+@!check_sum: integer;
+@!gf_post_loc: integer;
+@!magnification: real;
+@!dx: array [0..max_char_no] of integer;
+@!dy: integer; {not used since value should always be zero}
+@!total_glyphs:integer; {the total number of glyphs stored in |mm_store|}
+@!mm_store:packed array [0..m1_max,4..m2_max] of eight_bits;
+ {to store glyph information}
+@!mm,@!m1,@!m2:integer; {indices for |mm_store|}
+@!free_limit:integer; {|mm| value of last free location in |mm_store|}
+@!data_start:array [0..max_fonts] of integer; {|data_base+bc| for fonts}
+@!font_order:array [0..max_fonts] of integer; {font numbers in loaded order}
+@!gf_prev_ptr: integer; {location of next character}
+@!char_code: integer; {current character number}
+@!glyph_ptr: array[0..max_glyphs] of integer;
+ {pointers to |mm_store|}
+@!max_m,@!min_m,@!max_n,@!min_n: integer; {raster bounding parameters}
+@!row_count: integer; {used to correct the raster height figure}
+@!column_count:integer; {used to accumulate column counts}
+@!max_column_count:integer; {used to correct the raster width figure}
+
+@ @<Set init...@>=
+for i:=0 to max_glyphs do glyph_ptr[i]:=-1;
+ {mark glyphs as not being in the file}
+total_glyphs:=0;
+mm:=4; m1:=0; m2:=4; {|-4<mm<4| saved for signalling purposes}
+free_limit:=mm_max;
+for i:=0 to max_fonts do font_order[i]:=-1;
+
+@ A temporary procedure.
+
+@p
+@!debug
+procedure tabulate;
+var i,j,k,l:integer;
+begin
+print_nl;
+print_ln(' Contents of the glyph ptr table');
+print(' ');
+for j:=0 to 9 do print(j:7);
+print_nl;
+for i:=0 to 29 do
+ begin
+ print(i*10:3,' ');
+ for j:=0 to 9 do
+ begin
+ k:=glyph_ptr[10*i+j];
+ l:=k div m2_size;
+ k:=k mod m2_size;
+ print(l:1,',',k:1);
+ end;
+ print_nl;
+ end;
+end;
+gubed
+
+@ Here is the long awaited |in_gf| routine.
+
+@p function in_gf(@!z:integer):boolean; {input \.{GF} data or return |false|}
+label done,restart,
+ 9997, {go here when the format is bad}
+ 9998, {go here when the information cannot be loaded}
+ 9999; {go here to exit}
+var k:integer; {index for loops}
+@!nw:integer; {number of words in the width table}
+@!wp:0..max_glyphs; {new value of |width_ptr| after successful input}
+@!alpha,@!beta:integer; {quantities used in the scaling computation}
+@!c: integer; { used it index character number}
+@!o:integer; {used to hold |gf| commands}
+@!p:integer; {used to hold |gf| parameter}
+@!del_m:integer; {used to hold |gf| parameter}
+@!del_n:integer; {used to hold |gf| parameter}
+@!mm_save,@!m1_save,@!m2_save:integer; {temp save to allow for corrections}
+begin
+if not find_gf_postamble then
+ begin print_ln(' Trouble with postamble');
+ goto 9997;
+ end;
+read_gf_postamble;
+@<Check |width| table and |goto 9997| if there is a problem@>;
+@<Convert and store the width values@>;
+@<Process the gf preamble@>;
+@<Stow all of the glyph-raster info@>;
+@!debug
+tabulate; {Used to show the start of the |glyph_ptr| array}
+print_ln(' glyph-raster done');
+gubed@/
+width_ptr:=wp;
+in_gf:=true; goto 9999;
+9997: print_ln('---not loaded, GF file is bad');
+@.GF file is bad@>
+9998: in_gf:=false;
+9999: end;
+
+@ @<Check |width| table and...@>=
+font_bc[cur_font]:=bc; font_ec[cur_font]:=ec;
+if font_ec[cur_font]<font_bc[cur_font] then
+ font_bc[cur_font]:=font_ec[cur_font]+1;
+if width_ptr+font_ec[cur_font]-font_bc[cur_font]+1>max_glyphs then
+ begin print_ln('---not loaded, DVIIMP needs larger width table');
+ goto 9998;
+ end;
+wp:=width_ptr+font_ec[cur_font]-font_bc[cur_font]+1;
+nw:=ec+1-bc;
+@!debug
+print_ln(' bc=',bc:1,' ec=',ec:1,' nw=',nw:1);
+gubed@/
+if (nw=0)or(nw>256) then goto 9997;
+
+@ @<Process the gf preamble@>=
+open_gf_file;
+o:=gf_byte; {fetch the first byte}
+if o<>pre then begin
+ print_ln(' GF file does not start with |pre|');
+ goto 9997;
+ end;
+o:=gf_byte; {fetch the identification byte}
+if o<>gf_id_byte then begin
+ print_ln(' id =',o:1,' should be ',gf_id_byte:1);
+ goto 9997;
+ end;
+o:=gf_byte; {fetch the length of the introductory comment}
+while o>0 do
+ begin decr(o); p:=gf_byte;
+ end;
+
+@ An important part of |in_gf| is the width computation, which
+involves multiplying the relative widths in the \.{GF} file by the
+scaling factor in the \.{DVI} file. This fixed-point multiplication
+must be done with precisely the same accuracy by all \.{DVI}-reading programs,
+in order to validate the assumptions made by \.{DVI}-writing programs
+like \TeX82.
+
+Let us therefore summarize what needs to be done. Each width in a \.{GF}
+file appears as a four-byte quantity called a |fix_word|. A |fix_word|
+whose respective bytes are $(a,b,c,d)$ represents the number
+$$x=\left\{\vcenter{\halign{$#$,\hfil\qquad&if $#$\hfil\cr
+b\cdot2^{-4}+c\cdot2^{-12}+d\cdot2^{-20}&a=0;\cr
+-16+b\cdot2^{-4}+c\cdot2^{-12}+d\cdot2^{-20}&a=255.\cr}}\right.$$
+(No other choices of $a$ are allowed, since the magnitude of a \.{GF}
+dimension must be less than 16.) We want to multiply this quantity by the
+integer~|z|, which is known to be less than $2^{27}$. Let $\alpha=16z$.
+If $|z|<2^{23}$, the individual multiplications $b\cdot z$, $c\cdot z$,
+$d\cdot z$ cannot overflow; otherwise we will divide |z| by 2, 4, 8, or
+16, to obtain a multiplier less than $2^{23}$, and we can compensate for
+this later. If |z| has thereby been replaced by $|z|^\prime=|z|/2^e$, let
+$\beta=2^{4-e}$; we shall compute
+$$\lfloor(b+c\cdot2^{-8}+d\cdot2^{-16})\,z^\prime/\beta\rfloor$$ if $a=0$,
+or the same quantity minus $\alpha$ if $a=255$. This calculation must be
+done exactly, for the reasons stated above; the following program does the
+job in a system-independent way, assuming that arithmetic is exact on
+numbers less than $2^{31}$ in magnitude.
+
+Whereas \.{DVItype} obtained the |pixel_width|s by rounding the |width|
+value, we obtain these values from the |dx| parameter associated with the
+|char_loc| command. It should be noted that |width[k]| is the
+device-independent width of some character in \.{DVI} units while
+|pixel_width[k]| is the corresponding pixel width of that character in an
+actual font.
+
+The macro |char_pixel_width| is set up to be analogous to |char_width|.
+
+@d char_pixel_width(#)==pixel_width[data_base[#]+char_width_end
+
+@d pixel_round(#)==round(conv*(#))
+
+@<Glob...@>=
+@!pixel_width:array[0..max_glyphs] of integer; {actual character widths,
+ in pixels}
+@!conv:real; {converts \.{DVI} units to pixels}
+@!true_conv:real; {converts unmagnified \.{DVI} units to pixels}
+@!numerator,@!denominator:integer; {stated conversion ratio}
+@!mag:integer; {magnification factor times 1000}
+@!empty_glyph: boolean; {foxing Imagen into accepting an empty glyph}
+
+@ @<Convert and store the width values@>=
+@<Replace |z| by $|z|^\prime$ and compute $\alpha,\beta$@>;
+data_base[cur_font]:=width_ptr-bc;
+data_start[cur_font]:=width_ptr;
+wp:=width_ptr+ec-bc+1;
+c:=bc;
+for k:=width_ptr to wp-1 do begin
+ if gf_ptr[c]=0 then begin
+ width[k]:=invalid_width; pixel_width[k]:=0;
+@!debug
+ print(' invalid width for c=',c:1);
+gubed
+ end
+ else begin
+ width[k]:=(((((w_byte[c,3]*z)div@'400)
+ +(w_byte[c,2]*z))div@'400)+(w_byte[c,1]*z))div beta;
+ if (w_byte[c,0]>0) then
+ if (w_byte[c,0]<255) then begin
+ print_ln(' w byte=',w_byte[c,0]:1);
+ goto 9997
+ end
+ else width[k]:=width[k]-alpha;
+ pixel_width[k]:=dx[c];
+ end;
+@!debug
+ print(' dx=',dx[c]:1,' for ',c:1);
+ print(' [ ',c:1,']');
+gubed@/
+ incr(c);
+ end;
+
+@ @<Replace |z| by $|z|^\prime$ and compute $\alpha,\beta$@>=
+begin alpha:=16;
+while z>=@'40000000 do
+ begin z:=z div 2; alpha:=alpha+alpha;
+ end;
+beta:=256 div alpha; alpha:=alpha*z;
+end
+
+
+@ In those few cases (we hope) where a \.{GF} file is not available we
+will want to refer to the \.{TFM} file and leave space in the document for
+the missing glyphs. The following procedure is used for this purpose.
+
+@p function in_tfm(@!z:integer):boolean; {input \.{TFM} data or return |false|}
+label 9997, {go here when the format is bad}
+ 9998, {go here when the information cannot be loaded}
+ 9999; {go here to exit}
+var k:integer; {index for loops}
+@!lh:integer; {length of the header data, in four-byte words}
+@!nw:integer; {number of words in the width table}
+@!wp:0..max_glyphs; {new value of |width_ptr| after successful input}
+@!alpha,@!beta:integer; {quantities used in the scaling computation}
+begin @<Read past the header data; |goto 9997| if there is a problem@>;
+@<Store character-width indices at the end of the |width| table@>;
+@<Read and convert the width values, setting up the |in_width| table@>;
+@<Move the widths from |in_width| to |width|,
+ and append |pixel_width| values@>;
+width_ptr:=wp; in_tfm:=true; goto 9999;
+9997: print_ln('---not loaded, TFM file is bad');
+@.TFM file is bad@>
+9998: in_tfm:=false;
+9999: end;
+
+@ @<Read past the header...@>=
+read_tfm_word; lh:=b2*256+b3;
+read_tfm_word; font_bc[cur_font]:=b0*256+b1;
+font_ec[cur_font]:=b2*256+b3;
+if font_ec[cur_font]<font_bc[cur_font] then
+ font_bc[cur_font]:=font_ec[cur_font]+1;
+if width_ptr+font_ec[cur_font]-font_bc[cur_font]+1>max_glyphs then
+ begin print_ln('---not loaded, DVItype needs larger width table');
+@.DVItype needs larger...@>
+ goto 9998;
+ end;
+wp:=width_ptr+font_ec[cur_font]-font_bc[cur_font]+1;
+read_tfm_word; nw:=b0*256+b1;
+if (nw=0)or(nw>256) then goto 9997;
+for k:=1 to 3+lh do
+ begin if eof(tfm_file) then goto 9997;
+ read_tfm_word;
+ if k=4 then
+ if b0<128 then tfm_check_sum:=((b0*256+b1)*256+b2)*256+b3
+ else tfm_check_sum:=(((b0-256)*256+b1)*256+b2)*256+b3;
+ end;
+
+@ @<Store character-width indices...@>=
+if wp>0 then for k:=width_ptr to wp-1 do
+ begin read_tfm_word;
+ if b0>nw then goto 9997;
+ width[k]:=b0;
+ end;
+
+@ @<Read and convert the width values...@>=
+@<Replace |z| by $|z|^\prime$ and compute $\alpha,\beta$@>;
+for k:=0 to nw-1 do
+ begin read_tfm_word;
+ in_width[k]:=(((((b3*z)div@'400)+(b2*z))div@'400)+(b1*z))div beta;
+ if b0>0 then if b0<255 then goto 9997
+ else in_width[k]:=in_width[k]-alpha;
+ end
+
+@ @<Move the widths from |in_width| to |width|,
+ and append |pixel_width| values@>=
+if in_width[0]<>0 then goto 9997; {the first width should be zero}
+data_base[cur_font]:=width_ptr-font_bc[cur_font];
+if wp>0 then for k:=width_ptr to wp-1 do
+ if width[k]=0 then
+ begin width[k]:=invalid_width; pixel_width[k]:=0;
+ end
+ else begin width[k]:=in_width[width[k]];
+ pixel_width[k]:=pixel_round(width[k]);
+ glyph_ptr[k]:=-1;
+ end
+
+@ @<Stow all...@>=
+@!debug
+print_ln(' loading font ',cur_font:1,'[',m1:1,',',m2:1,'] ');
+print((free_limit div m2_size):1,'-',(free_limit mod m2_size):1,' ');
+gubed@/
+k:=0; while font_order[k]>=0 do incr(k);
+font_order[k]:=cur_font; {add this font to ordered list}
+repeat gf_prev_ptr:=cur_gf_loc;
+@<Pass |no_op|, |xxx| and |yyy| commands@>;
+if (o=boc) or (o=boc1) then
+ begin
+ m1_save:=m1; m2_save:=m2; {for width and height corrections}
+ mm_save:=m1*m2_size+m2; {to be stored in |glyph_ptr| when |c| is known}
+ if o=boc then begin @<Stow the |boc| information@> end
+ else begin @<Stow the |boc1| information@>;
+ end;
+glyph_ptr[data_base[cur_font]+c]:=mm_save; {save glyph start address}
+@!debug
+print(' (',cur_font:1,')',c:1,'[',m1:1,',',m2:1,']');
+gubed@/
+if empty_glyph then
+ begin
+ glyph_ptr[data_base[cur_font]+c]:=-1;
+ empty_glyph:=false;
+ end;
+ @<Stow the glyph details@>;
+ end;
+until o=post;
+
+@ As noted earlier, the parameters associated with the |boc| command are
+received from the |gf| file as |signed_quad|s and are converted into the
+form needed by the \.{IMAGEN} and then stowed into |mm_store| as
+|signed_pairs|, in keeping with the restricted range of value that the
+\.{IMAGEN} allows.
+
+@ @<Stow the |boc| information@>=
+incr(total_glyphs);
+char_code:=gf_signed_quad;
+p:=gf_signed_quad;
+c:=char_code mod 256;
+if c<0 then c:=c+256;
+if c>127 then if im_extension[cur_font]=-1 then
+ begin
+ if nf2=nf then
+ begin
+ print_ln(' ---Out of font storage space');
+ goto 9998;
+ end;
+ im_extension[cur_font]:=nf2; decr(nf2);
+ end;
+@!debug
+print(' boc[',c:1,']');
+if char_code<>c then
+ print(' in family ',(char_code-c) div 256 : 1);
+gubed@/
+min_m:=gf_signed_quad; max_m:=gf_signed_quad;
+min_n:=gf_signed_quad; max_n:=gf_signed_quad;
+if max_m-min_m<=0 then empty_glyph:=true else empty_glyph:=false;
+stow_signed_pair(max_m-min_m+1); {width}
+stow_signed_pair(-min_m); {left offset}
+stow_signed_pair(max_n-min_n+1); {height}
+stow_signed_pair(max_n); {top offset}
+
+@ Similarly, the one byte parameters associated with the
+|boc1| command are converted into the required form and stored into
+|mm_store| as |signed_pairs|.
+
+@ @<Stow the |boc1| information@>=
+incr(total_glyphs);
+char_code:=gf_byte;
+p:=-1;
+c:=char_code;
+if c>127 then if im_extension[cur_font]=-1 then
+ begin
+ if nf2=nf then
+ begin
+ print_ln(' ---Out of font storage space');
+ goto 9998;
+ end;
+ im_extension[cur_font]:=nf2; decr(nf2);
+ end;
+@!debug
+print_nl; print_nl;
+print(' boc1[',c:1,']');
+gubed@/
+del_m:=gf_byte; max_m:=gf_byte;
+del_n:=gf_byte; max_n:=gf_byte;
+if del_m<=0 then empty_glyph:=true else empty_glyph:=false;
+stow_signed_pair(del_m+1);
+stow_signed_pair(del_m-max_m);
+stow_signed_pair(del_n+1);
+stow_signed_pair(max_n);
+@!debug
+print_ln(' c=',c:1,' del_m+1=',del_m+1:1,' del_m-max_m=',del_m-max_m:1,
+' del_n+1=',del_n+1:1,' max_n=',max_n:1);
+gubed@/
+
+@ Having deciphered a |boc| command or a |boc1| command and having stored
+the necessary information that precedes the mask information in a |bgly|
+command, we can limit the variety of commands that are to be stored to
+only those commands actually needed to specify the mask portion of a
+|bgly| command.
+
+@ @<Pass |no_op|, |xxx| and |yyy| commands@>=
+repeat
+ o:=gf_byte;
+ if (o=yyy) then begin
+ p:=first_gf_par(o); o:=no_op;
+ end
+ else if (o>=xxx1) and (o<=xxx1+3) then begin
+ p:=first_gf_par(o);
+ while p>0 do begin q:=gf_byte; decr(p); end;
+ o:=no_op;
+ end;
+until o<>no_op;
+
+@ @<Stow the glyph details@>=
+max_column_count:=0; {set for the glyph}
+column_count:=0;
+row_count:=0;
+while true do begin
+ restart:
+ o:=gf_byte;
+ case o of
+ sixty_four_cases(paint_0): begin
+ column_count:=column_count+o-paint_0;
+{|print_ln(' s0 ',o:1);|}
+ end;
+ paint1: begin
+ stow(o); o:=gf_byte; column_count:=column_count+o;
+{|print_ln(' s1 ',o:1);|}
+ end;
+ paint2: begin
+ stow(o); o:=gf_byte;
+ stow(o); column_count:=column_count+256*o;
+ o:=gf_byte; column_count:=column_count+o;
+ end;
+ skip0: begin
+ incr(row_count);
+ if column_count>max_column_count then
+ max_column_count:=column_count;
+ column_count:=0;
+ end;
+ skip1: begin
+ stow(o); o:=gf_byte;
+ row_count:=row_count+1+o;
+ if column_count>max_column_count then
+ max_column_count:=column_count;
+ column_count:=0;
+ end;
+ one_sixty_five_cases(new_row_0): begin
+ incr(row_count);
+ if column_count>max_column_count then
+ max_column_count:=column_count;
+ column_count:=o-new_row_0;
+ end;
+ xxx1: begin
+ o:=gf_byte;
+ while o>0 do begin q:=gf_byte; decr(o); end;
+ goto restart;
+ end;
+ yyy: begin
+ o:=5;
+ while o>0 do begin q:=gf_byte; decr(o); end;
+ goto restart;
+ end;
+ no_op: goto restart;
+ eoc: goto done;
+ othercases
+ print_ln('! Unexpected command: ',o:1)
+ endcases;
+ stow(o);
+ end;
+done:
+stow(o); {this should be an |eoc| command}
+{|print_ln('S EOC');|}
+if column_count>0 then incr(row_count); {last row isn't terminated}
+if column_count>max_column_count then max_column_count:=column_count;
+mm_store[m1_save,m2_save]:=max_column_count div 256;
+if m2_save<m2_max then incr(m2_save) else
+ begin m2_save:=4; if m1_save<m1_max then incr(m1_save)
+ else m1_save:=0;
+ end;
+mm_store[m1_save,m2_save]:=max_column_count mod 256;
+if m2_save+3<m2_size then m2_save:=m2_save+3 else
+ begin m2_save:=m2_save+7-m2_size; if m1_save<m1_max then incr(m1_save)
+ else m1_save:=0;
+ end;
+mm_store[m1_save,m2_save]:=row_count div 256;
+if m2_save<m2_max then incr(m2_save) else
+ begin m2_save:=4; if m1_save<m1_max then incr(m1_save)
+ else m1_save:=0;
+ end;
+mm_store[m1_save,m2_save]:=row_count mod 256;
+
+@* Optional modes of output.
+As normally compiled, the |dialog| routine is not called and \.{DVIIMP}
+operated in the |errors_only| mode. One can remove the brackets ( {|...|} )
+that surround the |dialog| call in the main program module and
+\.{DVIIMP} will then print different quantities of information based on some
+options that the user must specify: The |out_mode| level is set to one of
+four values (|errors_only|, |terse|, |verbose|, |the_works|), giving
+different degrees of output; and the typeout can be confined to a
+restricted subset of the pages by specifying the desired starting page and
+the maximum number of pages. Furthermore there is an option to specify the
+resolution of an assumed discrete output device, so that pixel-oriented
+calculations will be shown; and there is an option to override the
+magnification factor that is stated in the \.{DVI} file.
+
+The starting page is specified by giving a sequence of 1 to 10 numbers or
+asterisks separated by dots. For example, the specification `\.{1.*.-5}'
+can be used to refer to a page output by \TeX\ when $\.{\\count0}=1$
+and $\.{\\count2}=-5$. (Recall that |bop| commands in a \.{DVI} file
+are followed by ten `count' values.) An asterisk matches any number,
+so the `\.*' in `\.{1.*.-5}' means that \.{\\count1} is ignored when
+specifying the first page. If several pages match the given specification,
+\.{DVIIMP} will begin with the earliest such page in the file. The
+default specification `\.*' (which matches all pages) therefore denotes
+the page at the beginning of the file.
+
+When the modified \.{DVIIMP} begins, it engages the user in a brief dialog
+so that the options will be specified. This part of \.{DVIIMP} requires
+nonstandard \PASCAL\ constructions to handle the online interaction; so it
+may not be easy to allow for this dialog,
+and if so, one should simply to stick to the
+default options (starting page `\.*' (but printed in
+reverse order),
+|max_pages=1000|, |resolution=300.0|, |new_mag=0|). On other hand, the
+system-dependent routines that are needed are not complicated, so it should
+not be terribly difficult to introduce them.
+@^system dependencies@>
+
+@<Glob...@>=
+@!max_pages:integer; {at most this many |bop..eop| pages will be printed}
+@!resolution:real; {pixels per inch}
+@!new_mag:integer; {if positive, overrides the postamble's magnification}
+
+@ The starting page specification is recorded in two global arrays called
+|start_count| and |start_there|. For example, `\.{1.*.-5}' is represented
+by |start_there[0]=true|, |start_count[0]=1|, |start_there[1]=false|,
+|start_there[2]=true|, |start_count[2]=-5|.
+We also set |start_vals=2|, to indicate that count 2 was the last one
+mentioned. The other values of |start_count| and |start_there| are not
+important, in this example.
+
+@<Glob...@>=
+@!start_count:array[0..9] of integer; {count values to select starting page}
+@!start_there:array[0..9] of boolean; {is the |start_count| value relevant?}
+@!start_vals:0..9; {the last count considered significant}
+@!count:array[0..9] of integer; {the count values on the current page}
+
+@ @<Set init...@>=
+max_pages:=1000; start_vals:=0; start_there[0]:=false; new_mag:=0;
+
+@ Here is a simple subroutine that tests if the current page might be the
+starting page.
+
+@p function start_match:boolean; {does |count| match the starting spec?}
+var k:0..9; {loop index}
+@!match:boolean; {does everything match so far?}
+begin match:=true;
+for k:=0 to start_vals do
+ if start_there[k]and(start_count[k]<>count[k]) then match:=false;
+start_match:=match;
+end;
+
+@ The |input_ln| routine waits for the user to type a line at his or her
+terminal; then it puts ASCII-code equivalents for the characters on that line
+into the |buffer| array. The |term_in| file is used for terminal input,
+and |term_out| for terminal output.
+@^system dependencies@>
+
+@<Glob...@>=
+@!buffer:array[0..terminal_line_length] of ASCII_code;
+@!term_in:text_file; {the terminal, considered as an input file}
+@!term_out:text_file; {the terminal, considered as an output file}
+
+@ Since the terminal is being used for both input and output, some systems
+need a special routine to make sure that the user can see a prompt message
+before waiting for input based on that message. (Otherwise the message
+may just be sitting in a hidden buffer somewhere, and the user will have
+no idea what the program is waiting for.) We shall invoke a system-dependent
+subroutine |update_terminal| in order to avoid this problem.
+@^system dependencies@>
+
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+
+@ During the dialog, \.{DVIIMP} will treat the first blank space in a
+line as the end of that line. Therefore |input_ln| makes sure that there
+is always at least one blank space in |buffer|.
+@^system dependencies@>
+
+@p procedure input_ln; {inputs a line from the terminal}
+var k:0..terminal_line_length;
+begin update_terminal; reset(term_in);
+if eoln(term_in) then read_ln(term_in);
+k:=0;
+while (k<terminal_line_length)and not eoln(term_in) do
+ begin buffer[k]:=xord[term_in^]; incr(k); get(term_in);
+ end;
+buffer[k]:=" ";
+end;
+
+@ The global variable |buf_ptr| is used while scanning each line of input;
+it points to the first unread character in |buffer|.
+
+@<Glob...@>=
+@!buf_ptr:0..terminal_line_length; {the number of characters read}
+
+@ Here is a routine that scans a (possibly signed) integer and computes
+the decimal value. If no decimal integer starts at |buf_ptr|, the
+value 0 is returned. The integer should be less than $2^{31}$ in
+absolute value.
+
+@p function get_integer:integer;
+var x:integer; {accumulates the value}
+@!negative:boolean; {should the value be negated?}
+begin if buffer[buf_ptr]="-" then
+ begin negative:=true; incr(buf_ptr);
+ end
+else negative:=false;
+x:=0;
+while (buffer[buf_ptr]>="0")and(buffer[buf_ptr]<="9") do
+ begin x:=10*x+buffer[buf_ptr]-"0"; incr(buf_ptr);
+ end;
+if negative then get_integer:=-x @+ else get_integer:=x;
+end;
+
+@ The selected options are put into global variables by the |dialog|
+procedure, which is called just as \.{DVIIMP} begins.
+@^system dependencies@>
+
+@p procedure dialog;
+label 2,3,4,5;
+var k:integer; {loop variable}
+begin rewrite(term_out); {prepare the terminal for output}
+write_ln(term_out,banner);
+@<Determine the desired |start_count| values@>;
+@<Determine the desired |max_pages|@>;
+@<Determine the desired |resolution|@>;
+@<Determine the desired |new_mag|@>;
+@<Print all the selected options@>;
+end;
+
+@ @<Determine the desired |start...@>=
+2: write(term_out,'Starting page (default=*): ');
+start_vals:=0; start_there[0]:=false;
+input_ln; buf_ptr:=0; k:=0;
+if buffer[0]<>" " then
+ repeat if buffer[buf_ptr]="*" then
+ begin start_there[k]:=false; incr(buf_ptr);
+ end
+ else begin start_there[k]:=true; start_count[k]:=get_integer;
+ end;
+ if (k<9)and(buffer[buf_ptr]=".") then
+ begin incr(k); incr(buf_ptr);
+ end
+ else if buffer[buf_ptr]=" " then start_vals:=k
+ else begin write(term_out,'Type, e.g., 1.*.-5 to specify the ');
+ write_ln(term_out,'first page with \count0=1, \count2=-5.');
+ goto 2;
+ end;
+ until start_vals=k
+
+@ @<Determine the desired |max_pages|@>=
+3: write(term_out,'Maximum number of pages (default=1000000): ');
+max_pages:=1000000; input_ln; buf_ptr:=0;
+if buffer[0]<>" " then
+ begin max_pages:=get_integer;
+ if max_pages<=0 then
+ begin write_ln(term_out,'Please type a positive number.');
+ goto 3;
+ end;
+ end
+
+@ @<Determine the desired |resolution|@>=
+4: write(term_out,'Assumed device resolution');
+write(term_out,' in pixels per inch (default=300/1): ');
+resolution:=300.0; input_ln; buf_ptr:=0;
+if buffer[0]<>" " then
+ begin k:=get_integer;
+ if (k>0)and(buffer[buf_ptr]="/")and
+ (buffer[buf_ptr+1]>"0")and(buffer[buf_ptr+1]<="9") then
+ begin incr(buf_ptr); resolution:=k/get_integer;
+ end
+ else begin write(term_out,'Type a ratio of positive integers;');
+ write_ln(term_out,' (1 pixel per mm would be 254/10).');
+ goto 4;
+ end;
+ end
+
+@ @<Determine the desired |new_mag|@>=
+5: write(term_out,'New magnification (default=0 to keep the old one): ');
+new_mag:=0; input_ln; buf_ptr:=0;
+if buffer[0]<>" " then
+ if (buffer[0]>="0")and(buffer[0]<="9") then new_mag:=get_integer
+ else begin write(term_out,'Type a positive integer to override ');
+ write_ln(term_out,'the magnification in the DVI file.');
+ goto 5;
+ end
+
+@ After the dialog is over, we print the options so that the user
+can see what \.{DVIIMP} thought was specified.
+
+@<Print all the selected options@>=
+print_ln('Options selected:');
+@.Options selected@>
+print(' Starting page = ');
+for k:=0 to start_vals do
+ begin if start_there[k] then print(start_count[k]:1)
+ else print('*');
+ if k<start_vals then print('.')
+ else print_ln(' ');
+ end;
+print_ln(' Maximum number of pages = ',max_pages:1);
+print_ln(' Resolution = ',resolution:12:8,' pixels per inch');
+if new_mag>0 then print_ln(' New magnification factor = ',new_mag/1000:8:3)
+
+@* Identifying and loading fonts.
+\.{DVIIMP} stores the raster information relating to the glyphs that it
+uses in a large |mm_store| array and stores the location of these rasters
+and information relating to their state in a |glyph_ptr| array. Additional
+|width| and |pixel_width| information is stored in still other arrays.
+
+It is usually not possible to provide a large enough |mm_store| space
+for all of the fonts that may be used in some documents. \.{DVIIMP}
+provides the facility for removing fonts from |mm_store| to make space for
+additional fonts and then for restoring the removed fonts if this becomes
+necessary.
+
+The general procedure is to
+read the \.{DVI} postamble first to get the desired |fnt_def1|
+information and to store this identifying information initially without
+storing the font rasters. An array |font_state[f]| is used to keep a
+record of the state of all fonts with the values set to 0 when the font
+identifying information is read. Later, when a |fnt_num| command is
+encountered in the body of the \.{DVI} file, the rasters for the entire
+font are read in and the |font_state| value for this font is changed to 1.
+However, glyphs are only downloaded as they are needed for the first time.
+
+The location and state for each individual glyph in all the fonts used is
+kept in the |glyph_ptr| array. This array is initially set to -1,
+indicating that the referenced glyphs either do not exist or that they
+have not yet been read into the |mm_store| memory. The individual glyph
+pointers are then set to positive values (actually, greater than 3) when
+the font rasters are read in, recording the position in the |mm_store|
+where the glyph is stored. These numbers are negated when each individual
+glyph is downloaded. Finally, if it becomes necessary to remove rasters
+to make space for other fonts, the positive |glyph_ptr| values for all
+glyphs of the removed fonts are set to zero without touching the negative
+pointer values (which still indicate the downloaded or non-existant states
+of the glyphs in question).
+
+Removing the rasters for the downloaded glyphs does not in any way prevent the
+continued use of these particular glyphs and no effort is made to reload any
+particular font until a request is encountered for a removed non-down-loaded
+glyph, as signalled by encountering a 0 value in the |glyph_ptr| array. At
+this time, only the non-down-loaded glyphs of the reloaded font are restored,
+with a possible substantial reduction in the space requirements as compared
+with the font's initial needs, since most of the more commonly used
+glyphs may have already been downloaded.
+
+A number of different utility procedures and functions will be needed.
+
+@<Glob...@>=
+@!font_state:array[0..max_fonts] of integer; {0 unloaded, 1 loaded}
+@!font_a_val:array[0..max_fonts] of integer; {length of directory name}
+@!font_l_val:array[0..max_fonts] of integer; {length of font name}
+@!scale_val:array [0..12] of integer; {table of preferred font scale values}
+
+@ @<Set init...@>=
+scale_val[0]:=round(1.0954*resolution);
+jj:=1.0;
+for i:=1 to 7 do
+ begin jj:=1.2*jj; scale_val[i]:=round(jj*resolution);
+@!debug
+ print_ln(' i=',i:1,' jj=',jj:1,' scale val=',scale_val[i]:1);
+gubed
+ end;
+scale_val[8]:=4*round(resolution);
+ {magnifications of 4000 and 5000 are sometines used}
+scale_val[9]:=5*round(resolution);
+scale_val[10]:=6*round(resolution);
+scale_val[11]:=7*round(resolution);
+scale_val[12]:=8*round(resolution);
+
+@ A minor problem in specifying the sizes of scaled fonts arises because
+of the fact that \.{\\magstep} definitions are in terms of the rounded
+values based on the magnification times 1000. For example, one will get
+different values for 1)~a magnification of 1200 as applied to a font
+scaled \.{\\magstep4}, and for 2)~a magnification of 1000 as applied to a
+font scaled \.{\\magstep5}. The following table and function provides the
+mechanism for resolving these differences by identifying the nearest match
+in terms of the overall actual magnification times the resolution. At
+\.{SAIL}, this figure is used as the file-name extension for standard
+\.{GF} files. @^system dependencies@>
+
+@p function reconcile_scale(m:integer):integer;
+label done;
+var i:0..12;
+begin
+reconcile_scale:=m;
+for i:=0 to 12 do
+ if abs(m-scale_val[i]) < abs(m-scale_val[i+1]) then
+ begin
+ if abs(m-scale_val[i])<4 then reconcile_scale:=scale_val[i];
+ goto done;
+ end;
+done: end;
+
+@ The following subroutine does the necessary things when a \\{fnt\_def}
+command is being processed in the postamble.
+
+@p procedure identify_font(@!e:integer); {|e| is an external font number}
+var f:0..max_fonts;
+@!p:integer; {length of the area/directory spec}
+@!n:integer; {length of the font name proper}
+@!c,@!q,@!d:integer; {check sum, scaled size, and design size}
+@!k:0..name_size; {indices into |names|}
+@!m: integer; {available for use in |mag| effect caculations}
+begin if nf=max_fonts then abort('DVIIMP capacity exceeded (max fonts=',
+ max_fonts:1,')!');
+@.DVIIMP capacity exceeded...@>
+font_num[nf]:=e; f:=0;
+while font_num[f]<>e do incr(f);
+@<Read the font parameters into position for font |nf|@>;
+@<Verify |font_scaled_size| and |font_design_size| for size@>;
+font_state[nf]:=0; {font identified but not read in}
+font_space[nf]:=q div 6; {this is a 3-unit ``thin space''}
+incr(nf); {signalling completion of identification}
+font_space[nf]:=0; {for |out_space| and |out_vmove|}
+end;
+
+@ @<Read the font parameters into position for font |nf|...@>=
+c:=signed_quad; font_check_sum[nf]:=c;@/
+q:=signed_quad; font_scaled_size[nf]:=q;@/
+d:=signed_quad; font_design_size[nf]:=d;@/
+p:=get_byte; font_a_val[nf]:=p;@/
+n:=get_byte; font_l_val[nf]:=n;@/
+if font_name[nf]+n+p>name_size then
+ abort('DVIIMP capacity exceeded (name size=',name_size:1,')!');
+@.DVIIMP capacity exceeded...@>
+font_name[nf+1]:=font_name[nf]+n+p;
+if n+p=0 then abort(' null n+p ')
+@.null n+p@>
+else for k:=font_name[nf] to font_name[nf+1]-1 do names[k]:=get_byte;
+m:=round((0.3*mag*q)/d);
+if (m>=round(1.05*resolution)) and (m<1500) then m:=reconcile_scale(m);
+font_m_val[nf]:=m;
+@!debug
+incr(nf);
+print_font(nf-1);
+print('.',m:1,' ');
+print_ln(' e=',e:1,' f=',nf:1,' c=',c:1,' q=',q:1,' d=',d:1,
+ ' p=',p:1,' n=',n:1);
+decr(nf);
+gubed
+
+@ @<Verify |font_scaled_size| and |font_design_size| for size@>=
+if (q<=0)or(q>=@'1000000000) then
+ print('---may not load, bad scale (',q:1,')!')
+@.bad scale@>
+ else if (d<=0)or(d>=@'1000000000) then
+ print('---may not load, bad design size (',d:1,')!');
+@.bad design size@>
+
+@ It will be desirable to skip over the |fnt_def1| commands that are found in
+the body of the \.{DVI} file as our method of reading the pages in reverse
+order makes it impractical for us to use them.
+
+@p procedure skip_it; {to bypass the |fnt_def1| commands in the body}
+var i,j,k: integer;
+begin
+for i:=1 to 13 do j:=get_byte;
+j:=j+get_byte;
+if j>0 then for i:=1 to j do k:=get_byte;
+end;
+
+@ We will have occasion to call the following from two different locations.
+
+@p procedure get_gf_file;
+var
+@!p:integer; {length of the area/directory spec}
+@!n:integer; {length of the font name proper}
+@!r:0..name_length; {index into |cur_name|}
+@!k:0..name_size; {indices into |names|}
+@!m: integer; {available for use in |mag| effect caculations}
+begin
+m:=font_m_val[cur_font];
+p:=font_a_val[cur_font];
+n:=font_l_val[cur_font];
+@<Move font name into the |cur_name| string@>;
+@!debug
+print_font(cur_font); print('.',m:1);
+print('(',cur_font:1,') ');
+gubed@/
+open_gf_file;
+
+if eof(gf_file) then
+ begin
+ print_nl;
+ print_font(cur_font); print_extension(m);
+@!debug
+ print('(',cur_font:1,') ');
+gubed@/
+ print(' not found');
+ @<Move font name into the |cur_tfm_name| string@>;
+ open_tfm_file;
+ if eof(tfm_file) then
+ begin
+ print(' and there is no |tfm| file ');
+ font_state[cur_font]:=-2;
+ end
+ else
+ begin
+ print(', characters will be left blank.');
+ font_state[cur_font]:=2;
+ end;
+ end;
+end;
+
+@ If |p=0|, i.e., if no font directory has been specified, \.{DVIIMP}
+is supposed to use the default font directory, which is a
+system-dependent place where the standard fonts are kept.
+The string variable |default_directory| contains the name of this area.
+@^system dependencies@>
+
+@d default_directory_name=='TeXGFs:' {change this to the correct name}
+@d default_directory_name_length=7 {change this to the correct length}
+@d dflt_tfm_directory_name=='TeXfonts:' {change this to the correct name}
+@d dflt_tfm_directory_name_length=9 {change this to the correct length}
+
+@<Glob...@>=
+@!default_directory:packed array[1..default_directory_name_length] of char;
+@!dflt_tfm_directory:packed array[1..dflt_tfm_directory_name_length] of char;
+
+@ @<Set init...@>=
+default_directory:=default_directory_name;
+dflt_tfm_directory:=dflt_tfm_directory_name;
+
+@ The string |cur_name| is supposed to be set to the external name of the
+\.{GF} file for the current font. This usually means that we need to
+prepend the name of the default directory, and
+to append the suffix `\.{.GF}'. Furthermore, we change lower case letters
+to upper case, since |cur_name| is a \PASCAL\ string.
+@^system dependencies@>
+
+@<Move font name into the |cur_name| string@>=
+for k:=1 to name_length do cur_name[k]:=' ';
+if p=0 then
+ begin for k:=1 to default_directory_name_length do
+ cur_name[k]:=default_directory[k];
+ r:=default_directory_name_length;
+ end
+else r:=0;
+for k:=font_name[cur_font] to font_name[cur_font+1]-1 do
+ begin incr(r);
+ if r+4>name_length then
+ abort('DVIIMP capacity exceeded (max font name length=',
+ name_length:1,')!');
+@.DVIIMP capacity exceeded...@>
+ if (names[k]>="a")and(names[k]<="z") then
+ cur_name[r]:=xchr[names[k]-@'40]
+ else cur_name[r]:=xchr[names[k]];
+ end;
+cur_name[r+1]:='.'; cur_name[r+2]:='G'; cur_name[r+3]:='F';
+{|cur_name[r+4]:='M';|}
+
+@ Normally, we only need to reference the \.{GF} files. On those
+occasions when no \.{GF} file is to be found we will want to obtain the
+glyph widths from a \.{TFM} file.
+The following module takes care of setting the external name of this
+\.{TFM} file.
+
+@<Move font name into the |cur_tfm_name| string@>=
+for k:=1 to name_length do cur_tfm_name[k]:=' ';
+if p=0 then
+ begin for k:=1 to dflt_tfm_directory_name_length do
+ cur_tfm_name[k]:=dflt_tfm_directory[k];
+ r:=dflt_tfm_directory_name_length;
+ end
+else r:=0;
+for k:=font_name[cur_font] to font_name[cur_font+1]-1 do
+ begin incr(r);
+ if r+4>name_length then
+ abort('DVIIMP capacity exceeded (max font name length=',
+ name_length:1,')!');
+@.DVIIMP capacity exceeded...@>
+ if (names[k]>="a")and(names[k]<="z") then
+ cur_tfm_name[r]:=xchr[names[k]-@'40]
+ else cur_tfm_name[r]:=xchr[names[k]];
+ end;
+cur_tfm_name[r+1]:='.'; cur_tfm_name[r+2]:='T';
+cur_tfm_name[r+3]:='F'; cur_tfm_name[r+4]:='M';
+
+@ We now come to the routines for reloading a font that has been removed.
+
+@p procedure reload_font;
+label done, restart;
+var k:integer; {index for loops}
+@!c: integer; { used it index character number}
+@!o:integer; {used to hold |gf| commands}
+@!p:integer; {used to hold |gf| parameter}
+@!a:integer; {used to hold |gf| parameter}
+@!del_m:integer; {used to hold |gf| parameter}
+@!del_n:integer; {used to hold |gf| parameter}
+@!mm_save,@!m1_save,@!m2_save:integer; {to allow corrections}
+begin
+get_gf_file;
+@<Skip over the preamble@>;
+@<Restow glyph rasters that have not been downloaded@>;
+font_state[cur_font]:=1; {signalling that font is loaded}
+end;
+
+@ @<Skip over the preamble@>=
+o:=gf_byte; {fetch the first byte}
+o:=gf_byte; {fetch the identification byte}
+o:=gf_byte; {fetch the length of the introductory comment}
+while o>0 do
+ begin decr(o); p:=gf_byte;
+ end;
+
+@ @<Restow glyph rasters that have not been downloaded@>=
+k:=0; while font_order[k]>=0 do incr(k);
+font_order[k]:=cur_font; {add this font to ordered list}
+repeat gf_prev_ptr:=cur_gf_loc;
+@<Pass |no_op|, |xxx| and |yyy| commands@>;
+if (o=boc) or (o=boc1) then begin
+ if o=boc then @<Read the |boc| information@>
+ else @<Read the |boc1| information@>;
+@!debug
+ print(' c=',c:1);
+gubed
+ if glyph_ptr[data_base[cur_font]+c]<0 then
+ @<Pass over the raster details@> {glyph has been downloaded}
+ else begin
+ mm_save:=mm; m1_save:=m1; m2_save:=m2;
+ {for possible width and height corrections}
+ glyph_ptr[data_base[cur_font]+c]:=m1*m2_size+m2;
+ {save glyph starting address}
+@!debug
+print(' (',cur_font:1,')',c:1,'[',m1:1,',',m2:1,']');
+gubed@/
+ @<Stow the |boc| or |boc1| information@>;
+ @<Stow the glyph details@>;
+ end;
+ end;
+until o=post;
+
+@ @<Read the |boc| information@>=
+begin
+char_code:=gf_signed_quad;
+p:=gf_signed_quad;
+c:=char_code mod 256;
+if c<0 then c:=c+256;
+@!debug
+print('[',c:1,']');
+if char_code<>c then
+ print(' in family ',(char_code-c) div 256 : 1);
+gubed@/
+min_m:=gf_signed_quad; max_m:=gf_signed_quad;
+min_n:=gf_signed_quad; max_n:=gf_signed_quad;
+del_m:=max_m-min_m;
+del_n:=max_n-min_n;
+end
+
+@ @<Read the |boc1| information@>=
+begin
+char_code:=gf_byte;
+p:=-1;
+c:=char_code;
+del_m:=gf_byte; max_m:=gf_byte;
+del_n:=gf_byte; max_n:=gf_byte;
+min_m:=max_m-del_m;
+end
+
+@ @<Stow the |boc| or |boc1| information@>=
+stow_signed_pair(del_m+1);
+stow_signed_pair(-min_m); {this is the initial |m| value}
+stow_signed_pair(del_n+1);
+stow_signed_pair(max_n);
+
+@ @<Pass over the raster details@>= {this glyph has been downloaded}
+begin
+o:=gf_byte;
+while o<>eoc do begin
+ a:=cur_gf_loc;
+ while (o<paint1) or (o=skip0) or ((o>=new_row_0) and (o<=new_row_164)) do
+ o:=gf_byte;
+ if (o=paint1) or (o=skip1) then begin
+ p:=gf_byte; o:=gf_byte;
+ end
+ else if (o=paint2) or (o=skip2) then begin
+ p:=gf_byte; p:=gf_byte; o:=gf_byte;
+ end
+ else if o=xxx1 then begin {\MF\ will not do this but it is allowed}
+ p:=gf_byte;
+ while p>0 do begin q:=gf_byte; decr(p); end;
+ o:=gf_byte;
+ end;
+ end;
+end
+
+@* Downloading glyph information.
+As mentioned earlier, the information for each used glyph (as stored in
+the |mm_store| array) will have to be translated and downloaded by means of
+an |im_bgly| command on the first occasion that the glyph is to be
+printed. The following definitions and tables will assist in this work:
+
+@d advance_q==begin if q2<m2_max then incr(q2)
+ else
+ begin
+ q2:=4; {|-4<m2<4| is left free for other uses}
+ if q1<m1_max then incr(q1) else q1:=0;
+ end;
+ end
+
+@<Glob...@>=
+@!atab:array[1..8] of integer; {used to locate asterisks if showing pattern}
+@!btab:array[0..8] of integer; {used to define bits to blacken}
+
+@ @<Set initial values@>=
+atab[1]:=128;
+btab[0]:=255;
+for i:=2 to 8 do atab[i]:=atab[i-1] div 2;
+for i:=1 to 8 do btab[i]:=btab[i-1] div 2;
+
+@ We will also have occasion to read halfwords from |mm_store|.
+
+@p function read_signed_pair(mm_tmp:integer):integer;
+ {returns the next two bytes, signed}
+var a,b:eight_bits;
+m1_tmp,m2_tmp:integer;
+begin
+m1_tmp:=mm_tmp div (m2_size); m2_tmp:=mm_tmp mod (m2_size);
+a:=mm_store[m1_tmp,m2_tmp];
+if m2_tmp<m2_max then incr(m2_tmp)
+else
+ begin m2_tmp:=4;
+ if m1_tmp<m1_max then incr(m1_tmp) else m1_tmp:=0; {wrap-around assumed}
+ end;
+b:=mm_store[m1_tmp,m2_tmp];
+if a<128 then read_signed_pair:=(a*256)+b
+else read_signed_pair:=(a-256)*256+b;
+end;
+
+@ For debugging purposes it may be desirable to display the actual glyph
+raster while it is being downloaded.
+
+@p procedure show_it(v:integer);
+var i: integer;
+begin
+for i:=1 to 8 do
+ if v>=atab[i] then
+ begin
+ print('*'); v:=v-atab[i];
+ end else print('.');
+end;
+
+@ And here is the procedure that does the actual downloading.
+
+@p procedure do_im_bgly(@!c:integer);
+var b,dis,n,i,q,val,w,real_w:integer;
+q1,q2: integer;
+bytes_required:integer; {bytes per row for current glyph}
+begin
+im_byte(im_bgly);
+if c<128 then im_halfword(cur_font*128+c) {normal family and member name}
+else im_halfword(im_extension[cur_font]*128+c-128);
+ {Imagen's family and member name}
+q:=pixel_width[data_base[cur_font]+c];
+im_halfword(q); {advance width}
+q:=glyph_ptr[data_base[cur_font]+c];
+ {get starting location in |mm_store|}
+q1:= q div (m2_size); q2:=q mod (m2_size);
+@!debug
+print(' im(',cur_font:1,')',c:1,'[',q1:1,',',q2:1,']');
+gubed@/
+bytes_required:=((read_signed_pair(q)+7)div 8);
+for i:=1 to 8 do
+ begin
+ im_byte(mm_store[q1,q2]);
+ advance_q;
+ end; {width, left offset, height,top offset}
+n:=0; dis:=0; val:=0; w:=0; real_w:=0;
+while real_w<>eoc do begin
+ @<Translate a sequence of paint commands@>;
+ w:=mm_store[q1,q2];
+ real_w:=w;
+ if (w>=new_row_0) and (w<=new_row_164) then
+ @<Translate a |new_row| command@>
+ else if (w>=skip0) and (w<new_row_0) then
+ @<Translate a |skip| command@>
+else if real_w<>eoc then
+print_ln('BAD D L COM ',w:1,' (',cur_font:1,')',c:1,'[',q1:1,',',q2:1,']');
+ end;
+{|print_ln('G EOC');|}
+glyph_ptr[data_base[cur_font]+c]:=-glyph_ptr[data_base[cur_font]+c];
+ {to show that the glyph has been downloaded}
+end;
+
+@ @<Translate a sequence of paint commands@>=
+while n<bytes_required do begin
+ if dis=0 then begin
+ @<Get two paint commands@>; dis:=w+b;
+ end;
+ while dis<8 do begin
+ val:=val+btab[w]-btab[dis];
+ @<Get two paint commands@>; w:=dis+w; dis:=w+b;
+ end;
+ if w>=8 then w:=w-8
+ else begin
+ val:=val+btab[w]; w:=0;
+ end;
+ im_byte(val); dis:=dis-8;
+ val:=0; incr(n);
+ end
+
+@ @<Translate a |new_row| command@>=
+begin
+w:=w-new_row_0;
+advance_q;
+b:=mm_store[q1,q2];
+if b<=paint2 then begin
+ advance_q;
+ if b=paint2 then
+ begin b:=mm_store[q1,q2]; advance_q;
+ b:=b*256+mm_store[q1,q2]; advance_q;
+ end
+ else if b=paint1 then begin
+ b:=mm_store[q1,q2]; advance_q;
+ end;
+ n:=0; dis:=w+b; val:=0;
+ end
+else begin b:=0; w:=8*bytes_required; {a safety measure}
+ end;
+n:=0; dis:=w+b; val:=0;
+end
+
+@ @<Translate a |skip| command@>=
+begin
+if w>skip0 then begin
+ advance_q;
+ w:=mm_store[q1,q2];
+ while w>0 do begin
+ for n:=1 to bytes_required do im_byte(0);
+ decr(w);
+ end;
+ end;
+advance_q;
+n:=0; dis:=0; val:=0; w:=0; b:=0;
+end
+
+@ @<Get two paint commands@>=
+begin w:=mm_store[q1,q2];
+if w<=paint2 then
+ begin
+ if w=paint2 then
+ begin advance_q; w:=mm_store[q1,q2]; advance_q;
+ w:=w*256+mm_store[q1,q2]; {can be as high as 65535}
+ end
+ else if w=paint1 then
+ begin advance_q; w:=mm_store[q1,q2]; {can be between 64 and 255}
+ end;
+ advance_q;
+ b:=mm_store[q1,q2];
+ if b<=paint2 then
+ begin
+ if b=paint2 then
+ begin advance_q; b:=mm_store[q1,q2]; advance_q;
+ b:=b*256+mm_store[q1,q2];
+ end
+ else if b=paint1 then
+ begin advance_q;
+ b:=mm_store[q1,q2];
+ end;
+ advance_q;
+ end
+ else
+ begin
+ b:=0; w:=8*bytes_required; {a safety measure}
+ end;
+ end
+else
+ begin b:=0; w:=8*bytes_required; {a safety measure}
+ end;
+end
+
+
+
+@* Translation to Impress form.
+The main work of \.{DVIIMP} is accomplished by the |do_page| procedure,
+which produces the output for an entire page, assuming that the |bop|
+command for that page has already been processed. This procedure is
+essentially an interpretive routine that reads and acts on the \.{DVI}
+commands.
+
+@ The definition of \.{DVI} files refers to six registers,
+$(h,v,w,x,y,z)$, which hold integer values in \.{DVI} units. In practice,
+we also need registers |hh| and |vv|, the pixel analogs of $h$ and $v$,
+since it is not always true that |hh=pixel_round(h)| or
+|vv=pixel_round(v)|. We will also find it useful to have two other
+registers, |hhi| and |vvi|
+to hold the values that \.{IMAGEN} would automatically
+assign for for the horizontal and vertical locations.
+
+The stack of $(h,v,w,x,y,z)$ values is represented by eight arrays
+called |hstack|, \dots, |zstack|, |hhstack|, and |vvstack|.
+
+@<Glob...@>=
+@!h,@!v,@!w,@!x,@!y,@!z,@!hh,@!hhi,@!vv,@!vvi:integer; {current state values}
+@!hstack,@!vstack,@!wstack,@!xstack,@!ystack,@!zstack:
+ array [0..stack_size] of integer; {pushed down values in \.{DVI} units}
+@!hhstack,@!vvstack:
+ array [0..stack_size] of integer; {pushed down values in pixels}
+@!h_org, @!v_org: integer; {page origin}
+
+@ Three characteristics of the pages (their |max_v|, |max_h|, and
+|max_s|) are specified in the postamble.
+Only |max_s| should not be exceeded.
+The postamble also specifies the total number of pages.
+
+@<Glob...@>=
+@!max_v:integer; {the value of |abs(v)| should probably not exceed this}
+@!max_h:integer; {the value of |abs(h)| should probably not exceed this}
+@!max_s:integer; {the stack depth should not exceed this}
+@!max_s_so_far:integer; {the record high levels}
+@!total_pages:integer; {the stated total number of pages}
+
+@ @<Set init...@>=
+max_s:=stack_size+1;
+max_s_so_far:=0;
+
+@ Before we get into the details of |do_page|, it is convenient to
+consider a simpler routine that computes the first parameter of each
+opcode. In doing this, we will use some multiple-case terms that were
+defined earlier.
+
+@p function first_par(o:eight_bits):integer;
+begin case o of
+sixty_four_cases(set_char_0),sixty_four_cases(set_char_0+64):
+ first_par:=o-set_char_0;
+set1,put1,fnt1,xxx1,fnt_def1: first_par:=get_byte;
+set1+1,put1+1,fnt1+1,xxx1+1,fnt_def1+1: first_par:=get_two_bytes;
+set1+2,put1+2,fnt1+2,xxx1+2,fnt_def1+2: first_par:=get_three_bytes;
+right1,w1,x1,down1,y1,z1: first_par:=signed_byte;
+right1+1,w1+1,x1+1,down1+1,y1+1,z1+1: first_par:=signed_pair;
+right1+2,w1+2,x1+2,down1+2,y1+2,z1+2: first_par:=signed_trio;
+set1+3,set_rule,put1+3,put_rule,right1+3,w1+3,x1+3,down1+3,y1+3,z1+3,
+ fnt1+3,xxx1+3,fnt_def1+3: first_par:=signed_quad;
+nop,bop,eop,push,pop,pre,post,post_post,undefined_commands: first_par:=0;
+w0: first_par:=w;
+x0: first_par:=x;
+y0: first_par:=y;
+z0: first_par:=z;
+sixty_four_cases(fnt_num_0): first_par:=o-fnt_num_0;
+end;
+end;
+
+@ Here is another subroutine that we need: It computes the number of
+pixels in the height or width of a rule. Characters and rules will line up
+properly if the sizes are computed precisely as specified here. (Since
+|conv| is computed with some floating-point roundoff error, in a
+machine-dependent way, format designers who are tailoring something for a
+particular resolution should not plan their measurements to come out to an
+exact integer number of pixels; they should compute things so that the
+rule dimensions are a little less than an integer number of pixels, e.g.,
+4.99 instead of 5.00.)
+
+@p function rule_pixels(x:integer):integer;
+ {computes $\lceil|conv|\cdot x\rceil$}
+var n:integer;
+begin n:=trunc(conv*x);
+if n<conv*x then rule_pixels:=n+1 @+ else rule_pixels:=n;
+end;
+
+@ The Imagen is capable of executing a limited repartee of graphic
+commands and it will be convenient to assign a set of six
+\.{\\special} commands to invoke them.
+We will need the following globals.
+
+@<Glob...@>=
+@!pen_size: integer; {must be between 0 and 20 finally}
+@!hh_point,@!vv_point:array[0..255] of integer; {point coordinates}
+@!p_index:integer; {used to index |hh_point| and |vv_point|}
+@!join_points:array[0..255] of eight_bits; {points used in a |join|}
+@!vertex_count:integer; {used to index |join_points|}
+@!xxx_point:array[1..6] of eight_bits;
+@!xxx_join:array[1..5] of eight_bits;
+@!xxx_rectangle:array[1..10] of eight_bits;
+@!xxx_circle:array[1..7] of eight_bits;
+@!xxx_arc:array[1..4] of eight_bits;
+@!xxx_segm:array[1..5] of eight_bits;
+@!xxx_ellipse:array[1..8] of eight_bits;
+@!xxx_o:eight_bits; {needed in special prcedures}
+@!xxx_k:integer; {needed in special prcedures}
+
+@ @<Set initial values@>=
+xxx_point[1]:="p"; xxx_point[2]:="o"; xxx_point[3]:="i"; xxx_point[4]:="n";
+xxx_point[5]:="t"; xxx_point[6]:=" ";
+xxx_join[1]:="j"; xxx_join[2]:="o"; xxx_join[3]:="i"; xxx_join[4]:="n";
+xxx_join[5]:=" ";
+xxx_rectangle[1]:="r"; xxx_rectangle[2]:="e"; xxx_rectangle[3]:="c";
+xxx_rectangle[4]:="t"; xxx_rectangle[5]:="a"; xxx_rectangle[6]:="n";
+xxx_rectangle[7]:="g"; xxx_rectangle[8]:="l"; xxx_rectangle[9]:="e";
+xxx_rectangle[10]:=" ";
+xxx_circle[1]:="c"; xxx_circle[2]:="i"; xxx_circle[3]:="r"; xxx_circle[4]:="c";
+xxx_circle[5]:="l"; xxx_circle[6]:="e"; xxx_circle[7]:=" ";
+xxx_arc[1]:="a"; xxx_arc[2]:="r"; xxx_arc[3]:="c"; xxx_arc[4]:=" ";
+xxx_segm[1]:="s"; xxx_segm[2]:="e"; xxx_segm[3]:="g"; xxx_segm[4]:="m";
+xxx_segm[5]:=" ";
+xxx_ellipse[1]:="e"; xxx_ellipse[2]:="l";
+xxx_ellipse[3]:="l"; xxx_ellipse[4]:="i";
+xxx_ellipse[5]:="p"; xxx_ellipse[6]:="s";
+xxx_ellipse[7]:="e"; xxx_ellipse[8]:=" ";
+
+@ The following procedures will be used for these \.{\\special} commands.
+
+@p function read_ascii(p:integer):real;
+var jj,kk:real;
+negative:boolean;
+begin
+jj:=0.0;
+negative:=false;
+while (xxx_o=" ") and (xxx_k<p) do begin incr(xxx_k); xxx_o:=get_byte; end;
+if (xxx_o="-") and (xxx_k<p) then
+ begin negative:=true;
+ incr(xxx_k); xxx_o:=get_byte;
+ end;
+while (xxx_o>="0") and (xxx_o<="9") and (xxx_k<=p) do
+ begin
+ jj:=jj*10+(xxx_o-"0"); incr(xxx_k);
+ if xxx_k<=p then xxx_o:=get_byte;
+ end;
+if (xxx_o=".") and (xxx_k<p) then
+ begin
+ incr(xxx_k); xxx_o:=get_byte;
+ kk:=1.0;
+ while (xxx_o>="0") and (xxx_o<="9") and (xxx_k<=p) do
+ begin
+ kk:=kk*0.1; jj:=jj+kk*(xxx_o-"0"); incr(xxx_k);
+ if xxx_k<=p then xxx_o:=get_byte;
+ end;
+ end;
+if negative then jj:=-jj;
+read_ascii:=jj;
+end;
+
+@ This procedure defines the points for use by the |do_join| procedure
+that follows.
+
+@p procedure do_point(p:integer);
+var k:integer; {loop variable}
+o:eight_bits;
+match:boolean; {does everything match}
+begin if p<7 then for k:=2 to p do o:=get_byte else
+ begin match:=true;
+ for k:=2 to 6 do
+ begin o:=get_byte;
+ if o<>xxx_point[k] then match:=false;
+@!debug
+ print(xchr[o]);
+gubed
+ end;
+ p_index:=0;
+ for k:=7 to p do
+ begin o:=get_byte;
+ if match then p_index:=p_index*10+o-"0";
+ end;
+ if match then
+ begin hh_point[p_index]:=pixel_round(h);
+ vv_point[p_index]:=pixel_round(v);
+@!debug
+print(p_index:1,' ',pixel_round(h):1,',',pixel_round(v):1);
+gubed
+ end;
+ end;
+end;
+
+@ The |do_join| procedure joins points by straight lines only.
+
+@p procedure do_join(p:integer);
+var k,q:integer;
+jj:real; {used in computing |pen_size|}
+match:boolean; {does everything match}
+begin if p<8 then for k:=2 to p do xxx_o:=get_byte else
+ begin match:=true;
+ for k:=2 to 5 do
+ begin xxx_o:=get_byte;
+ if xxx_o<>xxx_join[k] then match:=false;
+ end;
+ if not match then for k:=6 to p do xxx_o:=get_byte else
+ begin xxx_o:=get_byte;
+ xxx_k:=6;
+ jj:=read_ascii(p);
+ pen_size:=pixel_round(jj*65536.0);
+ if pen_size>20 then pen_size:=20 else if pen_size<0 then pen_size:=0;
+ im_byte(set_pen); im_byte(pen_size);
+ vertex_count:=1; q:=0; incr(xxx_k);
+ for k:=xxx_k to p do begin
+ xxx_o:=get_byte;
+ if (xxx_o>="0") and (xxx_o<="9") then q:=q*10+xxx_o-"0" else
+ if xxx_o=" " then begin
+ join_points[vertex_count]:=q; incr(vertex_count); q:=0;
+ end;
+ end;
+ join_points[vertex_count]:=q;
+ im_byte(create_path);
+ im_halfword(vertex_count);
+ for q:=1 to vertex_count do
+ begin im_halfword(hh_point[join_points[q]]);
+ im_halfword(vv_point[join_points[q]]);
+ end;
+ im_byte(draw_path); im_byte(15);
+ end;
+ end;
+end;
+
+@ And now we come the the |do_circle| procedure.
+
+@p procedure do_circle(p:integer);
+var k,q,r:integer; jj:real;
+match:boolean; {does everything match}
+begin if p<13 then for k:=2 to p do xxx_o:=get_byte else
+ begin match:=true;
+ for k:=2 to 7 do
+ begin xxx_o:=get_byte;
+ if xxx_o<>xxx_circle[k] then match:=false;
+@!debug
+ print(xchr[xxx_o]);
+gubed
+ end;
+ if not match then for k:=8 to p do xxx_o:=get_byte else
+ begin xxx_o:=get_byte;
+ xxx_k:=8;
+ jj:=read_ascii(p);
+ pen_size:=pixel_round(jj*65536.0);
+ if pen_size>20 then pen_size:=20 else if pen_size<0 then pen_size:=0;
+ im_byte(set_pen); im_byte(pen_size);
+ @<Resyncronize@>;
+ im_byte(circ_arc);
+@!debug
+ print('(',pen_size:1,')');
+gubed
+ jj:=read_ascii(p);
+ r:=pixel_round(jj*65536.0); im_halfword(r); {the radius}
+@!debug
+ print('(',r:1,')');
+gubed
+ jj:=read_ascii(p);
+ q:=-round(jj*16384/360); {to measure counterclockwise}
+ im_halfword(q); {first angle}
+@!debug
+ print('(',q:1,')');
+gubed
+ jj:=read_ascii(p);
+ r:=-round(jj*16384/360); {to measure counterclockwise}
+ im_halfword(r); {second angle}
+@!debug
+ print('(',r:1,')');
+gubed
+ im_byte(draw_path); im_byte(15);
+ end;
+ end;
+end;
+
+@ And finally the |do_ellipse| procedure.
+@p procedure do_ellipse(p:integer);
+var k,q,r:integer; jj:real;
+match:boolean; {does everything match}
+begin if p<18 then for k:=2 to p do xxx_o:=get_byte else
+ begin match:=true;
+ for k:=2 to 8 do
+ begin xxx_o:=get_byte;
+ if xxx_o<>xxx_ellipse[k] then match:=false;
+@!debug
+ print(xchr[xxx_o]);
+gubed
+ end;
+ if not match then for k:=9 to p do xxx_o:=get_byte else
+ begin xxx_o:=get_byte;
+ xxx_k:=9;
+ jj:=read_ascii(p);
+ pen_size:=pixel_round(jj*65536.0);
+ if pen_size>20 then pen_size:=20 else if pen_size<0 then pen_size:=0;
+ im_byte(set_pen); im_byte(pen_size);
+ @<Resyncronize@>;
+ im_byte(ellipse_arc);
+@!debug
+ print('(',pen_size:1,')');
+gubed
+ jj:=read_ascii(p);
+ r:=pixel_round(jj*65536.0); im_halfword(r); {radiusa}
+@!debug
+ print('(',r:1,')');
+gubed
+ jj:=read_ascii(p);
+ r:=pixel_round(jj*65536.0); im_halfword(r); {radiusb}
+@!debug
+ print('(',r:1,')');
+gubed
+ jj:=read_ascii(p);
+ q:=-round(jj*16384/360); {to measure counterclockwise}
+ im_halfword(q); {|alpha_offset|}
+@!debug
+ print('(',q:1,')');
+gubed
+ jj:=read_ascii(p);
+ q:=-round(jj*16384/360); {to measure counterclockwise}
+ im_halfword(q); {first angle}
+@!debug
+ print('(',q:1,')');
+gubed
+ jj:=read_ascii(p);
+ r:=-round(jj*16384/360); {to measure counterclockwise}
+ im_halfword(r); {second angle}
+@!debug
+ print('(',r:1,')');
+gubed
+ im_byte(draw_path); im_byte(15);
+ end;
+ end;
+end;
+
+@ The |do_page|
+subroutine is organized as a typical interpreter, with a multiway branch
+on the command code followed by |goto| statements leading to routines that
+finish up the activities common to different commands. We will use the
+following labels:
+
+@d fin_set=41 {label for commands that set or put a character}
+@d fin_rule=42 {label for commands that set or put a rule}
+@d move_right=43 {label for commands that change |h|}
+@d move_down=44 {label for commands that change |v|}
+@d change_font=45 {label for commands that change |cur_font|}
+
+@ Some \PASCAL\ compilers severely restrict the length of procedure bodies,
+so we shall split |do_page| into two parts, one of which is
+called |special_cases|. The different parts communicate with each other
+via the global variables mentioned above, together with the following ones:
+
+@<Glob...@>=
+@!s:integer; {current stack size}
+@!cur_font:integer; {current internal font number}
+
+@ Here is the overall setup.
+
+@d infinity==@'17777777777 {$\infty$ (approximately)}
+
+@p @t\4@>@<Declare the function called |special_cases|@>@;
+procedure do_page;
+label fin_set,fin_rule,move_right,done,9999;
+var o:eight_bits; {operation code of the current command}
+@!p,@!q:integer; {parameters of the current command}
+@!g:integer; {to hold |glyph_ptr| temporarily and force its computation}
+@!a:integer; {byte number of the current command}
+@!hhh:integer; {|h|, rounded to the nearest pixel}
+begin cur_font:=nf; {set current font undefined}
+ s:=0; w:=0; x:=0; y:=0; z:=0;
+ h:=round(h_org/conv); v:=round(v_org/conv);
+ hh:=pixel_round(h); vv:=pixel_round(v);
+ hhi:=infinity; vvi:=infinity;
+ {initialize the state variables}
+while true do @<Translate the next command in the \.{DVI} file;
+ |goto 9999| if it was |eop|@>;
+9999: im_byte(im_end_page);
+end;
+
+@ The following procedure will do the actual comparing of the specified
+|start_page| with values of |count[0]| and it will increment |f_count|.
+
+@p procedure back_count;
+var @!k:0..255; {command code}
+begin
+move_to_byte(new_backpointer);
+k:=get_byte; if k=bop then
+ begin
+ incr(f_count);
+ for k:=0 to 9 do count[k]:=signed_quad;
+ if count[0]=start_page then page_match:=true;
+ new_backpointer:=signed_quad;
+ end else new_backpointer:=-1;
+end;
+
+@ The following routine allows us to read the pages in reverse order.
+
+@p procedure next_page;
+var @!k:0..255; {command code}
+begin
+incr(counter);
+move_to_byte(new_backpointer);
+k:=get_byte; if k=bop then
+ begin
+ for k:=0 to 9 do count[k]:=signed_quad;
+ new_backpointer:=signed_quad;
+@!debug
+ print_ln(' In next_page first_backpointer=',first_backpointer:1);
+gubed
+ end;
+if (counter>=l_count) then
+ begin
+ do_page; print('[',count[0]:1,'] ');
+ end;
+end;
+
+@ The main command loop.
+
+@<Translate the next command...@>=
+begin a:=cur_loc;
+@!debug
+ print_nl; print(a:1,': ');
+gubed
+o:=get_byte; p:=first_par(o);
+if eof(dvi_file) then bad_dvi('the file ended prematurely');
+@.the file ended prematurely@>
+@<Start translation of command |o| and |goto| the appropriate label to
+ finish the job@>;
+fin_set: @<Finish a command that either sets or puts a character, then
+ |goto move_right| or |done|@>;
+fin_rule: @<Finish a command that either sets or puts a rule, then
+ |goto move_right| or |done|@>;
+move_right: @<Finish a command that sets |h:=h+q|, then |goto done|@>;
+done:
+end
+
+@ The multiway switch in |first_par|, above, was organized by the length
+of each command; the one in |do_page| is organized by the semantics.
+
+@<Start translation...@>=
+if o<set_char_0+128 then goto fin_set
+else case o of
+ four_cases(set1): goto fin_set;
+ four_cases(put1): goto fin_set;
+ set_rule: goto fin_rule;
+ put_rule: goto fin_rule;
+ @t\4@>@<Cases for commands |nop|, |bop|, \dots, |pop|@>@;
+ @t\4@>@<Cases for horizontal motion@>@;
+ othercases begin special_cases(o,p,a); goto done; end
+ endcases
+
+@ @<Declare the function called |special_cases|@>=
+procedure special_cases(@!o:eight_bits;@!p,@!a:integer);
+label change_font,move_down,done;
+var q:integer; {parameter of the current command}
+@!k:integer; {loop index}
+@!vvv:integer; {|v|, rounded to the nearest pixel}
+begin
+case o of
+@t\4@>@<Cases for vertical motion@>@;
+@t\4@>@<Cases for fonts@>@;
+four_cases(xxx1): @<Translate an |xxx| command and |goto done|@>;
+pre: bad_dvi('preamble command within a page!');
+@.preamble command within a page@>
+post,post_post: bad_dvi('postamble command within a page!');
+@.postamble command within a page@>
+othercases bad_dvi('undefined command ',o:1,'!')
+@.undefined command@>
+endcases;
+move_down: @<Finish a command that sets |v:=v+p|, then |goto done|@>;
+change_font: @<Finish a command that changes the current font,
+ then |goto done|@>;
+done:
+end;
+
+@ @<Cases for commands |nop|, |bop|, \dots, |pop|@>=
+nop: goto done;
+bop: bad_dvi('bop occurred before eop!');
+@.bop occurred before eop@>
+eop: begin
+ if s<>0 then bad_dvi('stack not empty at end of page (level ',
+ s:1,')!');
+@.stack not empty...@>
+ goto 9999;
+ end;
+push: begin
+ if s=max_s_so_far then
+ begin max_s_so_far:=s+1;
+ if s=max_s then bad_dvi('deeper than claimed in postamble!');
+@.deeper than claimed...@>
+@.push deeper than claimed...@>
+ if s=stack_size then
+ bad_dvi('DVIIMP capacity exceeded (stack size=',
+ stack_size:1,')');
+ end;
+ hstack[s]:=h; vstack[s]:=v; wstack[s]:=w;
+ xstack[s]:=x; ystack[s]:=y; zstack[s]:=z;
+ hhstack[s]:=hh; vvstack[s]:=vv; incr(s);
+@!debug
+print(' push(',s:1,')',hh:1,',',vv:1);
+gubed
+ goto done;
+ end;
+pop: begin
+ if s=0 then bad_dvi('POP illegal at level zero')
+ else begin decr(s); hh:=hhstack[s]; vv:=vvstack[s];
+ h:=hstack[s]; v:=vstack[s]; w:=wstack[s];
+ x:=xstack[s]; y:=ystack[s]; z:=zstack[s];
+@!debug
+print(' pop(',s:1,')',hh:1,',',vv:1);
+gubed
+ end;
+ goto done;
+ end;
+
+@ Rounding to the nearest pixel is best done in the manner shown here, so as
+to be inoffensive to the eye: When the horizontal motion is small, like a
+kern, |hh| changes by rounding the kern; but when the motion is large, |hh|
+changes by rounding the true position |h| so that accumulated rounding errors
+disappear. We allow a larger space in the negative direction than in
+the positive one, because \TeX\ makes comparatively
+large backspaces when it positions accents.
+
+@d out_space==if (p>=font_space[cur_font])or(p<=-4*font_space[cur_font]) then
+ hh:=pixel_round(h+p)
+ else hh:=hh+pixel_round(p);
+ q:=p; goto move_right
+
+@<Cases for horizontal motion@>=
+four_cases(right1): begin out_space; end;
+w0,four_cases(w1):begin w:=p; out_space; end;
+x0,four_cases(x1):begin x:=p; out_space; end;
+
+@ Vertical motion is done similarly, but with the threshold between
+``small'' and ``large'' increased by a factor of five. The idea is to make
+fractions like ``$1\over2$'' round consistently, but to absorb accumulated
+rounding errors in the baseline-skip moves.
+
+@d out_vmove==if abs(p)>=5*font_space[cur_font] then vv:=pixel_round(v+p)
+ else vv:=vv+pixel_round(p);
+ goto move_down
+
+@<Cases for vertical motion@>=
+four_cases(down1): begin out_vmove; end;
+y0,four_cases(y1): begin y:=p; out_vmove; end;
+z0,four_cases(z1): begin z:=p; out_vmove; end;
+
+@ @<Cases for fonts@>=
+sixty_four_cases(fnt_num_0): goto change_font;
+four_cases(fnt1): goto change_font;
+four_cases(fnt_def1): begin skip_it; goto done; end;
+
+@ @<Translate an |xxx| command and |goto done|@>=
+begin
+if p<0 then bad_dvi('string of negative length!');
+@.string of negative length@>
+if p<=0 then goto done;
+o:=get_byte;
+case o of
+"p":begin
+@!debug
+ print_nl; print(a:1,': ');
+ print(' p');
+gubed
+ do_point(p);
+ end;
+"j":begin
+@!debug
+ print_nl; print(a:1,': ');
+ print(' j');
+gubed
+ do_join(p);
+ end;
+"c":begin
+@!debug
+ print_nl; print(a:1,': ');
+ print(' c');
+gubed
+ do_circle(p);
+ end;
+"e":begin
+@!debug
+ print_nl; print(a:1,': ');
+ print(' e');
+gubed
+ do_ellipse(p);
+ end;
+othercases begin print(' othercases');
+ for k:=2 to p do o:=get_byte;
+ end
+endcases;
+goto done;
+end
+
+@ @<Resyncronize@>=
+if hhi<>hh then begin
+@!debug
+print(' ',hhi:1,',',hh:1);
+gubed
+ hhi:=hh; im_byte(set_abs_h); im_halfword(hh);
+ end;
+if vvi<>vv then begin
+ vvi:=vv; im_byte(set_abs_v); im_halfword(vv);
+ end;
+
+@ @<Finish a command that either sets or puts a character...@>=
+if p<0 then p:=255-((-1-p) mod 256)
+else if p>=256 then p:=p mod 256; {width computation for oriental fonts}
+@^oriental characters@>@^Chinese characters@>@^Japanese characters@>
+{|if (p<font_bc[cur_font])or(p>font_ec[cur_font]) then q:=invalid_width else|}
+ q:=char_width(cur_font)(p);
+@!debug
+print_ln(' p=',p:1);
+print_ln(' bc=',font_bc[cur_font]:1,' ec=',font_ec[cur_font]:1);
+print(' ch',char_width(cur_font)(p):1);
+print_ln(' q=',q:1);
+gubed
+if q=invalid_width then
+ begin print('character ',p:1,' invalid in font ');
+@.character $c$ invalid...@>
+ print_font(cur_font);
+ if cur_font<>nf then print('!'); {font |nf| has `\.!' in its name}
+ end
+else begin
+ g:=glyph_ptr[data_base[cur_font]+p];
+@!debug
+if g<-3 then print(' (',cur_font:1,')',p:1);
+gubed
+ if g=0 then begin
+@!debug
+ print_ln(' must reload (',cur_font:1,')',p:1);
+gubed
+ reload_font; {font must be reloaded}
+ g:=glyph_ptr[data_base[cur_font]+p];
+ end;
+@!debug
+if g=-1 then print(' -1(',cur_font:1,')',p:1);
+gubed
+ if g>3 then do_im_bgly(p);
+ @<Resyncronize@>;
+if (font_state[cur_font]=2) or (g=-1) then
+ begin
+ hhi:=hhi+pixel_width[data_base[cur_font]+p];
+ @<Resyncronize@>;
+ end
+else
+ begin
+ if p<128 then im_byte(p) {this sets or puts p of current family}
+ else begin
+ im_byte(set_family); im_byte(im_extension[cur_font]);
+ im_byte(p-128); {this sets or puts glyph under its imagen name}
+ im_byte(set_family); im_byte(cur_font);
+ end;
+ hhi:=hhi+pixel_width[data_base[cur_font]+p];
+ end;
+ end;
+if o>=put1 then goto done;
+if q=invalid_width then q:=0
+else hh:=hh+char_pixel_width(cur_font)(p);
+goto move_right
+
+@ @<Finish a command that either sets or puts a rule...@>=
+q:=signed_quad;
+@<Resyncronize@>;
+im_byte(im_brule); im_halfword(rule_pixels(q)); im_halfword(rule_pixels(p));
+im_halfword(rule_pixels(-p));
+if o=put_rule then goto done;
+hh:=hh+rule_pixels(q);
+goto move_right
+
+@ A sequence of consecutive rules, or consecutive characters in a fixed-width
+font whose width is not an integer number of pixels, can cause |hh| to drift
+far away from a correctly rounded value. \.{DVIIMP} ensures that the
+amount of drift will never exceed |max_drift| pixels.
+
+@d max_drift=2 {we insist that abs|(hh-pixel_round(h))<=max_drift|}
+
+@<Finish a command that sets |h:=h+q|, then |goto done|@>=
+if (h>0)and(q>0) then if h>infinity-q then
+ begin print('arithmetic overflow! parameter changed from ',
+@.arithmetic overflow...@>
+ q:1,' to ',infinity-h:1);
+ q:=infinity-h;
+ end;
+if (h<0)and(q<0) then if -h>q+infinity then
+ begin print('arithmetic overflow! parameter changed from ',
+ q:1, ' to ',(-h)-infinity:1);
+ q:=(-h)-infinity;
+ end;
+hhh:=pixel_round(h+q);
+if abs(hhh-hh)>max_drift then
+ begin
+ if hhh>hh then hh:=hhh-max_drift
+ else hh:=hhh+max_drift;
+ hhi:=hh; im_byte(set_abs_h); im_halfword(hhi);
+ end;
+h:=h+q;
+@!debug
+print(' r ',hh:1,' ');
+gubed
+goto done
+
+@ @<Finish a command that sets |v:=v+p|, then |goto done|@>=
+if (v>0)and(p>0) then if v>infinity-p then
+ begin print('arithmetic overflow! parameter changed from ',
+@.arithmetic overflow...@>
+ p:1,' to ',infinity-v:1);
+ p:=infinity-v;
+ end;
+if (v<0)and(p<0) then if -v>p+infinity then
+ begin print('arithmetic overflow! parameter changed from ',
+ p:1, ' to ',(-v)-infinity:1);
+ p:=(-v)-infinity;
+ end;
+vvv:=pixel_round(v+p);
+if abs(vvv-vv)>max_drift then
+ begin
+ if vvv>vv then vv:=vvv-max_drift
+ else vv:=vvv+max_drift;
+ vvi:=vv; im_byte(set_abs_v); im_halfword(vvi);
+ end;
+v:=v+p;
+@!debug
+print(' d ',vv:1,' ');
+gubed
+goto done
+
+@ @<Finish a command that changes the current font...@>=
+font_num[nf]:=p; cur_font:=0;
+while font_num[cur_font]<>p do incr(cur_font);
+if cur_font=nf then bad_dvi('bad font?');
+if font_state[cur_font]=0 then
+ begin get_gf_file;
+ if font_state[cur_font]=0 then
+ begin
+ if in_gf(font_scaled_size[cur_font]) then
+ font_state[cur_font]:=1 else font_state[cur_font]:=-1;
+ end;
+ if font_state[cur_font]=2 then
+ begin
+ if in_tfm(font_scaled_size[cur_font]) then
+ font_state[cur_font]:=2 else font_state[cur_font]:=-1;
+ end;
+ end;
+im_byte(set_family); im_byte(cur_font);
+goto done
+
+@* Using the backpointers.
+The routines in this section of the program are brought into play only
+if |random_reading| is |true|.
+First comes a routine that illustrates how to find the postamble quickly.
+
+@<Find the postamble, working back from the end@>=
+n:=dvi_length;
+if n<53 then bad_dvi('only ',n:1,' bytes long');
+@.only n bytes long@>
+m:=n-4;
+repeat if m=0 then bad_dvi('all 223s');
+@.all 223s@>
+move_to_byte(m); k:=get_byte; decr(m);
+until k<>223;
+if k<>id_byte then bad_dvi('ID byte is ',k:1);
+@.ID byte is wrong@>
+move_to_byte(m-3); q:=signed_quad;
+if (q<0)or(q>m-33) then bad_dvi('post pointer ',q:1,' at byte ',m-3:1);
+@.post pointer is wrong@>
+move_to_byte(q); k:=get_byte;
+if k<>post then bad_dvi('byte ',q:1,' is not post');
+@.byte n is not post@>
+post_loc:=q; first_backpointer:=signed_quad;
+
+@ Note that the last steps of the above code save the locations of the
+the |post| byte and the final |bop|. We had better declare these global
+variables, together with others that we will need shortly.
+
+@<Glob...@>=
+@!post_loc:integer; {byte location where the postamble begins}
+@!first_backpointer:integer; {the pointer following |post|}
+@!new_backpointer:integer; {the current |bop| command location}
+
+@ The following routine locates the postamble in order to read the value
+of the |first_backpointer| but then processes the pages starting with the
+last page so that the pages will be stacked properly by the \.{IMAGEN}.
+
+@<Find the postamble then process the pages in reverse order@>=
+q:=post_loc;
+move_to_byte(q); k:=get_byte;
+if k<>post then bad_dvi('byte ',q:1,' is not post');
+@.byte n is not post@>
+first_backpointer:=signed_quad;
+new_backpointer:=first_backpointer;
+while (new_backpointer<>-1) and (counter<f_count) do next_page;
+while im_byte_no mod 4 <> 3 do im_byte(im_no_op);
+im_byte(im_eof);
+
+@* Reading the postamble.
+Now imagine that we are reading the \.{DVI} file and positioned just
+four bytes after the |post| command. That, in fact, is the situation,
+when the following part of \.{DVIIMP} is called upon to read, translate,
+and check the rest of the postamble.
+
+@p procedure read_postamble;
+var k:integer; {loop index}
+@!p:integer; {general purpose registers}
+begin
+post_loc:=cur_loc-5;
+if signed_quad<>numerator then
+ print_ln('numerator doesn''t match the preamble!');
+@.numerator doesn't match@>
+if signed_quad<>denominator then
+ print_ln('denominator doesn''t match the preamble!');
+@.denominator doesn't match@>
+if signed_quad<>mag then if new_mag=0 then
+ print_ln('magnification doesn''t match the preamble!');
+@.magnification doesn't match@>
+max_v:=signed_quad; max_h:=signed_quad;@/
+max_s:=get_two_bytes; total_pages:=get_two_bytes;@/
+@<Process the font definitions of the postamble@>;
+end;
+
+@ @<Process the font definitions...@>=
+repeat k:=get_byte;
+if (k>=fnt_def1)and(k<fnt_def1+4) then
+ begin p:=first_par(k);
+ identify_font(p); k:=nop;
+ end;
+until k<>nop;
+if k<>post_post then
+ print_ln('byte ',cur_loc-1:1,' is not postpost!')
+@.byte n is not postpost@>
+
+@ @<Establish range of pages to be printed@>=
+if f_flag=false then f_count:=total_pages else
+ begin f_count:=0; q:=post_loc;
+ move_to_byte(q); p:=get_byte;
+ page_match:=false; f_count:=0;
+ first_backpointer:=signed_quad;
+ new_backpointer:=first_backpointer;
+ while (new_backpointer<>-1) and (page_match=false) do back_count;
+ end;
+if n_flag=false then l_count:=1 else l_count:=f_count-num_pages+1;
+
+@* The main program.
+Now we are ready to put it all together. This is where \.{DVIIMP} starts,
+and where it ends.
+
+@p begin initialize; {get all variables initialized}
+@<Process the preamble@>;
+open_im_file;
+@<Find the postamble, working back from the end@>;
+read_postamble;
+@<Establish range of pages to be printed@>;
+@<Find the postamble then process the pages in reverse order@>;
+final_end:end.
+
+@ The main program needs a few global variables in order to do its work.
+
+@<Glob...@>=
+@!k,@!m,@!n,@!p,@!q:integer; {general purpose registers}
+@!id_len: 0..255;
+@!id: packed array[0..255] of 0..255;
+
+
+@ A \.{DVI}-reading program that reads the postamble first need not look at the
+preamble; but \.{DVIIMP} looks at the preamble in order to do error
+checking, and to display the introductory comment.
+
+@<Process the preamble@>=
+open_dvi_file;
+p:=get_byte; {fetch the first byte}
+if p<>pre then bad_dvi('First byte isn''t start of preamble!');
+@.First byte isn't...@>
+p:=get_byte; {fetch the identification byte}
+if p<>id_byte then
+ bad_dvi('identification in byte 1 should be ',id_byte:1,'!');
+@.identification...should be n@>
+@<Compute the conversion factor@>;
+id_len:=get_byte; {fetch the length of the introductory comment}
+p:=0;
+while p<id_len do
+ begin incr(p); id[p]:=get_byte;
+ end;
+
+@ The conversion factor |conv| is figured as follows: There are exactly
+|n/d| \.{DVI} units per decimicron, and 254000 decimicrons per inch,
+and |resolution| pixels per inch. Then we have to adjust this
+by the stated amount of magnification.
+
+@<Compute the conversion factor@>=
+numerator:=signed_quad; denominator:=signed_quad;
+if numerator<=0 then bad_dvi('numerator is ',numerator:1);
+@.numerator is wrong@>
+if denominator<=0 then bad_dvi('denominator is ',denominator:1);
+@.denominator is wrong@>
+conv:=(numerator/254000.0)*(resolution/denominator);
+mag:=signed_quad;
+if new_mag>0 then mag:=new_mag
+else if mag<=0 then bad_dvi('magnification is ',mag:1);
+@.magnification is wrong@>
+true_conv:=conv; conv:=true_conv*(mag/1000.0);
+
+@* System-dependent changes.
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{DVIIMP} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@^system dependencies@>
+
+@* Index.
+Pointers to error messages appear here together with the section numbers
+where each ident\-i\-fier is used.
diff --git a/obsolete/systems/knuth/unsupported/texware/dvitype.cms-changes b/obsolete/systems/knuth/unsupported/texware/dvitype.cms-changes
new file mode 100644
index 0000000000..b318141ccb
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/texware/dvitype.cms-changes
@@ -0,0 +1,378 @@
+% This is DVITYPE.CHGCMS in text format, as of jun 25, 1986
+% (change file for IBM CMS PASCAL/VS, created by B.SCHULZE, SFB72)
+%
+%
+%line numbers correspond to version 2.8 of DVITYPE (of may 5, 1986)
+% (more or less)
+%
+%line 105
+%
+%module 2
+@x othercases, terminal I/O
+@d random_reading==true {should we skip around in the file?}
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@y
+@d random_reading==false {should we skip around in the file?}
+@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 126
+%
+%module 3
+@x open terminal
+ begin print_ln(banner);@/
+@y
+ begin
+ @= termin@>(term_in);
+ @= termout@>(term_out); {prepare the terminal for output}
+ print_ln(banner);@/
+@z
+%
+%line 149
+%
+%module 5
+@x font files
+@!name_length=50; {a file name shouldn't be longer than this}
+@y
+@!name_length=20; {a file name shouldn't be longer than this}
+@!dvi_max_size=4096; {should fit all installations}
+@!tfm_max_size=4096;
+@z
+%
+%line 215
+%
+%module 9
+@x text files
+@!text_file=packed file of text_char;
+@y
+@!text_file=text;
+@z
+%
+%line 838
+%
+%module 21
+@x packed
+@!eight_bits=0..255; {unsigned one-byte quantity}
+@!byte_file=packed file of eight_bits; {files that contain binary data}
+@y
+@!eight_bits=packed 0..255; {unsigned one-byte quantity}
+@z
+%
+%line 847
+%
+%module xx
+@x
+@!dvi_file:byte_file; {the stuff we are \.{DVI}typing}
+@!tfm_file:byte_file; {a font metric file}
+@y
+@!dvi_file:text;
+@!tfm_file:text;
+@!dvi_rec:string(dvi_max_size);
+@!tfm_rec:string(tfm_max_size);
+@!tfm_ptr,tfm_rec_size:integer; {current position (last read) and}
+@!dvi_ptr,dvi_rec_size:integer; {length of current record}
+@!eof_dvi_file:boolean;
+@!eof_tfm_file:boolean;
+@z
+%
+%line 867
+%
+%module 23
+@x open dvi file
+begin reset(dvi_file);
+@y
+begin reset(dvi_file);
+read_ln(dvi_file,dvi_rec);
+dvi_ptr:=0;
+dvi_rec_size:= @= LENGTH @> (dvi_rec);
+if dvi_rec_size=0 then eof_dvi_file:=true
+ else eof_dvi_file:=false;
+@z
+%
+%line 872
+%
+%module 23
+@x open tfm file
+begin reset(tfm_file,cur_name);
+@y
+begin reset(tfm_file,'NAME='||trim(str(cur_name)));
+read_ln(tfm_file,tfm_rec);
+tfm_ptr:=0;
+tfm_rec_size:= @= LENGTH @> (tfm_rec);
+if tfm_rec_size=0 then eof_tfm_file:=true
+ else eof_tfm_file:=false;
+@z
+%
+%line 891
+%
+%module xx
+@x
+begin read(tfm_file,b0); read(tfm_file,b1);
+read(tfm_file,b2); read(tfm_file,b3);
+end;
+@y
+begin
+{length of current record should be 0 mod 4}
+if tfm_ptr + 4 >= tfm_rec_size then
+ begin
+ read_ln(tfm_file,tfm_rec);
+ tfm_ptr:=0;
+ end;
+b0:=ord(tfm_rec(.tfm_ptr+1.));
+b1:=ord(tfm_rec(.tfm_ptr+2.));
+b2:=ord(tfm_rec(.tfm_ptr+3.));
+b3:=ord(tfm_rec(.tfm_ptr+4.));
+tfm_ptr:=tfm_ptr+4;
+eof_tfm_file:=eof(tfm_file) & (tfm_ptr >= tfm_rec_size);
+end;
+
+procedure read_dvi(var b:eight_bits);
+begin
+if dvi_ptr >= dvi_rec_size then
+ begin
+ read_ln(dvi_file,dvi_rec);
+ dvi_ptr:=0;
+ end;
+b:=ord(dvi_rec(.dvi_ptr+1.));
+incr(dvi_ptr);
+eof_dvi_file:=eof(dvi_file) & (dvi_ptr >= dvi_rec_size);
+end;
+@z
+%
+%line 904
+%
+%module 27
+@x
+begin if eof(dvi_file) then get_byte:=0
+else begin read(dvi_file,b); incr(cur_loc); get_byte:=b;
+@y
+begin if eof_dvi_file then get_byte:=0
+else begin read_dvi(b); incr(cur_loc); get_byte:=b;
+@z
+%
+%line 911
+%
+%module xx
+@x
+begin read(dvi_file,b); incr(cur_loc);
+@y
+begin read_dvi(b); incr(cur_loc);
+@z
+%
+%line 917
+%
+%module xx
+@x
+begin read(dvi_file,a); read(dvi_file,b);
+@y
+begin read_dvi(a); read_dvi(b);
+@z
+%
+%line 924
+%
+%module xx
+@x
+begin read(dvi_file,a); read(dvi_file,b);
+@y
+begin read_dvi(a); read_dvi(b);
+@z
+%
+%line 932
+%
+%module xx
+@x
+begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c);
+@y
+begin read_dvi(a); read_dvi(b); read_dvi(c);
+@z
+%
+%line 939
+%
+%module xx
+@x
+begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c);
+@y
+begin read_dvi(a); read_dvi(b); read_dvi(c);
+@z
+%
+%line 947
+%
+%module xx
+@x
+begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c); read(dvi_file,d);
+@y
+begin read_dvi(a); read_dvi(b); read_dvi(c); read_dvi(d);
+@z
+%
+%line 970
+%
+%module 28
+@x random
+begin set_pos(dvi_file,-1); dvi_length:=cur_pos(dvi_file);
+end;
+@#
+procedure move_to_byte(n:integer);
+begin set_pos(dvi_file,n); cur_loc:=n;
+end;
+@y
+begin
+dvi_length := 0
+end;
+@#
+procedure move_to_byte(n:integer);
+begin
+cur_loc := 0
+end;
+@z
+%
+%line 1107
+%
+%module 46
+@x
+ begin if eof(tfm_file) then goto 9997;
+@y
+ begin if eof_tfm_file then goto 9997;
+@z
+%
+%line 1304
+%
+%module 46
+@x break
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@y
+@d update_terminal ==write_ln(term_out) {empty the terminal output buffer}
+@z
+%
+%line 1311
+%
+%module 47
+@x read from terminal
+@p procedure input_ln; {inputs a line from the terminal}
+var k:0..terminal_line_length;
+begin update_terminal; reset(term_in);
+if eoln(term_in) then read_ln(term_in);
+k:=0;
+while (k<terminal_line_length)and not eoln(term_in) do
+ begin buffer[k]:=xord[term_in^]; incr(k); get(term_in);
+ end;
+buffer[k]:=" ";
+end;
+@y
+@p procedure input_ln; {inputs a line from the terminal}
+var k:0..terminal_line_length;
+ il: string(terminal_line_length);
+begin update_terminal;
+read_ln(term_in,il);
+k:=0;
+while (k<length(il)) do
+ begin
+ buffer(.k.):=xord(.il(.k+1.).); incr(k);
+ end;
+buffer[k]:=" ";
+end;
+@z
+%
+%line 1354
+%
+%module 50
+@x open terminal
+begin rewrite(term_out); {prepare the terminal for output}
+@y
+begin
+@z
+%
+%line 1547
+%
+%module xx
+@x
+if eof(tfm_file) then
+@y
+if eof_tfm_file then
+@z
+%
+%line 1602
+%
+%module 66
+@x font names
+@<Move font name into the |cur_name| string@>=
+for k:=1 to name_length do cur_name[k]:=' ';
+if p=0 then
+ begin for k:=1 to default_directory_name_length do
+ cur_name[k]:=default_directory[k];
+ r:=default_directory_name_length;
+ end
+else r:=0;
+for k:=font_name[nf] to font_name[nf+1]-1 do
+ begin incr(r);
+ if r+4>name_length then
+ abort('DVItype capacity exceeded (max font name length=',
+ name_length:1,')!');
+@.DVItype capacity exceeded...@>
+ if (names[k]>="a")and(names[k]<="z") then
+ cur_name[r]:=xchr[names[k]-@'40]
+ else cur_name[r]:=xchr[names[k]];
+ end;
+cur_name[r+1]:='.'; cur_name[r+2]:='T'; cur_name[r+3]:='F'; cur_name[r+4]:='M'
+@y
+@<Move font name into the |cur_name| string@>=
+for k:=1 to name_length do cur_name[k]:=' ';
+r:=0;
+for k:=font_name[nf] to font_name[nf+1]-1 do
+ begin incr(r);
+ if r+6>name_length then
+ abort('DVItype capacity exceeded (max font name length=',
+ name_length:1,')!');
+@.DVItype capacity exceeded...@>
+ if (names[k]>="a")and(names[k]<="z") then
+ cur_name[r]:=xchr[names[k]-@'40]
+ else cur_name[r]:=xchr[names[k]];
+ end;
+cur_name[r+1]:='.'; cur_name[r+2]:='T'; cur_name[r+3]:='F';
+cur_name[r+4]:='M'; cur_name[r+5]:='.'; cur_name[r+6]:='*';
+@z
+%
+%line 1642
+%
+%module 69
+@x we have no brackets
+ begin print('[');
+ for k:=1 to text_ptr do print(xchr[text_buf[k]]);
+ print_ln(']');
+@y
+ begin print('(');
+ for k:=1 to text_ptr do print(xchr[text_buf[k]]);
+ print_ln(')');
+@z
+%
+%line 1813
+%
+%module xx
+@x
+if eof(dvi_file) then bad_dvi('the file ended prematurely');
+@y
+if eof_dvi_file then bad_dvi('the file ended prematurely');
+@z
+%
+%line 2122
+%
+%module xx
+@x
+ begin if eof(dvi_file) then bad_dvi('the file ended prematurely');
+@y
+ begin if eof_dvi_file then bad_dvi('the file ended prematurely');
+@z
+%
+%line 2301
+%
+%module xx
+@x
+while (m=223)and not eof(dvi_file) do m:=get_byte;
+if not eof(dvi_file) then bad_dvi('signature in byte ',cur_loc-1:1,
+@y
+while (m=223)and not eof_dvi_file do m:=get_byte;
+if not eof_dvi_file then bad_dvi('signature in byte ',cur_loc-1:1,
+@z
diff --git a/obsolete/systems/knuth/unsupported/texware/dvitype.tops10-changes b/obsolete/systems/knuth/unsupported/texware/dvitype.tops10-changes
new file mode 100644
index 0000000000..a72f7a5df4
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/texware/dvitype.tops10-changes
@@ -0,0 +1,98 @@
+Warning: The font names and areas are handled inconsistently wrt TeX.
+@x
+@d random_reading==true {should we skip around in the file?}
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+@y
+@d random_reading==false {should we skip around in the file?}
+@d othercases == others: {default for cases not listed explicitly}
+@d endcases == @+end {follows the default case in an extended |case| statement}
+@f othercases == else
+@f endcases == end
+@<Compiler directives@>=
+@{@&$C-,A+,D-,Z-@} {no range checking, arithmetic overflow check,
+ no debug overhead, don't initialize to zero }
+@z
+
+@x
+@p program DVI_type(@!dvi_file,@!output);
+@y
+@p @<Compiler directives@>@/
+program DVI_type(@!dvi_file,@!output);
+@z
+
+@x
+begin reset(dvi_file);
+@y
+begin reset(dvi_file,'','/B:8');
+@z
+
+@x
+begin reset(tfm_file,cur_name);
+@y
+begin reset(tfm_file,cur_name,'/B:8');
+@z
+
+@x
+begin update_terminal; reset(term_in);
+@y
+begin update_terminal; reset(term_in,'TTY:FOO1.BAR');
+@z
+
+@x
+begin rewrite(term_out); {prepare the terminal for output}
+@y
+begin rewrite(term_out,'TTY:FOO2.BAR'); {prepare the terminal for output}
+@z
+
+@x
+@d default_directory_name=='TeXfonts:' {change this to the correct name}
+@d default_directory_name_length=9 {change this to the correct length}
+@y
+@d default_directory_name=='[120,44,tfm]' {change this to the correct name}
+@d default_directory_name_length=12 {change this to the correct length}
+@z
+
+@x
+@<Move font name into the |cur_name| string@>=
+for k:=1 to name_length do cur_name[k]:=' ';
+if p=0 then
+ begin for k:=1 to default_directory_name_length do
+ cur_name[k]:=default_directory[k];
+ r:=default_directory_name_length;
+ end
+else r:=0;
+for k:=font_name[nf] to font_name[nf+1]-1 do
+ begin incr(r);
+ if r+4>name_length then
+ abort('DVItype capacity exceeded (max font name length=',
+ name_length:1,')!');
+@.DVItype capacity exceeded...@>
+ if (names[k]>="a")and(names[k]<="z") then
+ cur_name[r]:=xchr[names[k]-@'40]
+ else cur_name[r]:=xchr[names[k]];
+ end;
+cur_name[r+1]:='.'; cur_name[r+2]:='T'; cur_name[r+3]:='F'; cur_name[r+4]:='M'
+@y
+@<Move font name into the |cur_name| string@>=
+for k:=1 to name_length do cur_name[k]:=' ';
+r:=0;
+for k:=font_name[nf] to font_name[nf+1]-1 do
+ begin incr(r);
+ if default_directory_name_length +10>name_length then
+ abort('DVItype capacity exceeded (max font name length=',
+ name_length:0,')!');
+@.DVItype capacity exceeded...@>
+ if (names[k]>="a")and(names[k]<="z") then
+ cur_name[r]:=xchr[names[k]-@'40]
+ else cur_name[r]:=xchr[names[k]];
+ end;
+cur_name[r+1]:='.'; cur_name[r+2]:='T'; cur_name[r+3]:='F';
+cur_name[r+4]:='M';
+if p=0 then
+ begin for k:=1 to default_directory_name_length do
+ cur_name[r+4+k]:=default_directory[k];
+ end;
+@z
diff --git a/obsolete/systems/knuth/unsupported/texware/dvitype.tops20-changes b/obsolete/systems/knuth/unsupported/texware/dvitype.tops20-changes
new file mode 100644
index 0000000000..9339707466
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/texware/dvitype.tops20-changes
@@ -0,0 +1,72 @@
+
+DVItype change file for Tops-20
+Copyright (C) 1983 by David Fuchs. All rights are reserved.
+
+@x Tell WEAVE to print only the changes:
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{DVI$\,$\lowercase{type} changes for Tops-20}
+@z
+
+@x TOPS-20's banner:
+@d banner=='This is DVItype, Version 2.9' {printed when the program starts}
+@y
+@d banner=='This is DVItype, Tops-20 Version 2.9'
+@z
+
+@x Identify input vs. output files so version numbers are properly handled:
+@p program DVI_type(@!dvi_file,@!output);
+@y
+@p program DVI_type(@!dvi_file:-,@!output:+,TTY:/);
+@z
+
+@x Open dvi_file in binary mode:
+begin reset(dvi_file);
+@y
+begin reset(dvi_file,'','/B:8');
+@z
+
+@x Open tfm_file in binary mode:
+begin reset(tfm_file,cur_name);
+@y
+begin reset(tfm_file,cur_name,'/B:8');
+@z
+
+@x Hardwire term_in and term_out to TTY:
+and |term_out| for terminal output.
+@^system dependencies@>
+
+@<Glob...@>=
+@!buffer:array[0..terminal_line_length] of ASCII_code;
+@!term_in:text_file; {the terminal, considered as an input file}
+@!term_out:text_file; {the terminal, considered as an output file}
+@y
+and |term_out| for terminal output.
+@^system dependencies@>
+
+@d term_in==TTY {the terminal, considered as an input file}
+@d term_out==TTY {the terminal, considered as an output file}
+
+@<Glob...@>=
+@!buffer:array[0..terminal_line_length] of ASCII_code;
+@z
+
+@x Update_terminal does nothing:
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@y
+@d update_terminal == do_nothing {empty the terminal output buffer}
+@z
+
+@x
+begin update_terminal; reset(term_in);
+@y
+begin update_terminal;
+@z
+
+@x
+begin rewrite(term_out); {prepare the terminal for output}
+@y
+begin {no need to prepare the terminal for output}
+@z
diff --git a/obsolete/systems/knuth/unsupported/texware/dvitype.vms-changes b/obsolete/systems/knuth/unsupported/texware/dvitype.vms-changes
new file mode 100644
index 0000000000..838588b5ac
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/texware/dvitype.vms-changes
@@ -0,0 +1,469 @@
+DVItype change file for Vax/VMS
+Copyright (C) 1983 by David Fuchs. All rights are reserved.
+
+@x
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{DVI$\,$\lowercase{type} changes for Vax/VMS}
+@z
+
+@x
+@d banner=='This is DVItype, Version 2.9' {printed when the program starts}
+@y
+@d banner=='This is DVItype, Vax/VMS Version 2.9'
+@z
+
+@x
+@d othercases == others: {default for cases not listed explicitly}
+@y
+@d othercases == otherwise {Vax/VMS default for cases not listed explicitly}
+@z
+
+@x
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+@y
+In fact, we do this under Vax/VMS. We also use double-precision for all
+real values.
+
+@d print(#)==write(type_file,#)
+@d print_ln(#)==write_ln(type_file,#)
+@d real==double
+@z
+
+@x
+@p program DVI_type(@!dvi_file,@!output);
+@y
+@p
+@\@=[inherit('sys$library:starlet')]@>@\
+ {allows us to use system symbols and routines}
+program DVI_type(@!dvi_file,@!tfm_file,@!type_file,@!input,@!output);
+@z
+
+@x
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ begin print_ln(banner);@/
+@y
+@<Procedures for initialization@>@/
+procedure initialize; {this procedure gets things started properly}
+ var i:integer; {loop index for initializations}
+ begin
+ @<Preset initial values@>@/
+ print_ln(banner);@/
+@z
+
+@x
+@!byte_file=packed file of eight_bits; {files that contain binary data}
+@y
+{later we'll define files that contain binary data}
+@z
+
+@x
+@!dvi_file:byte_file; {the stuff we are \.{DVI}typing}
+@!tfm_file:byte_file; {a font metric file}
+@y
+@!dvi_file:packed file of byte_block; {the stuff we are \.{DVI}typing}
+@!tfm_file:packed file of byte_block; {a font metric file}
+@!dvi_count:integer; {number of bytes read from current block of |dvi_file|}
+@!tfm_count:integer; {number of bytes read from current block of |tfm_file|}
+@!dvi_blocks:integer; {number of blocks in |dvi_file|}
+@z
+
+@x
+begin reset(dvi_file);
+@y
+begin reset(dvi_file);
+dvi_count:=0;
+@z
+
+@x
+begin reset(tfm_file,cur_name);
+@y
+begin close(tfm_file,@=error@>:=@=continue@>); {stupid Vax/VMS run-times}
+open(tfm_file,cur_name,@=readonly@>,@=error@>:=@=continue@>);
+reset(tfm_file,@=error@>:=@=continue@>);
+tfm_count:=0;
+@z
+
+@x
+@p procedure read_tfm_word;
+begin read(tfm_file,b0); read(tfm_file,b1);
+read(tfm_file,b2); read(tfm_file,b3);
+@y
+@d read_tfm_file(#)==begin
+ if tfm_count=VAX_block_length then begin
+ get(tfm_file,@=error:=continue@>); tfm_count:=0;
+ end;
+ #:=tfm_file^[tfm_count];
+ incr(tfm_count);
+ end
+
+@p procedure read_tfm_word;
+begin read_tfm_file(b0); read_tfm_file(b1);
+read_tfm_file(b2); read_tfm_file(b3);
+@z
+
+@x
+@p function get_byte:integer; {returns the next byte, unsigned}
+var b:eight_bits;
+begin if eof(dvi_file) then get_byte:=0
+else begin read(dvi_file,b); incr(cur_loc); get_byte:=b;
+ end;
+end;
+@#
+function signed_byte:integer; {returns the next byte, signed}
+var b:eight_bits;
+begin read(dvi_file,b); incr(cur_loc);
+if b<128 then signed_byte:=b @+ else signed_byte:=b-256;
+end;
+@#
+function get_two_bytes:integer; {returns the next two bytes, unsigned}
+var a,@!b:eight_bits;
+begin read(dvi_file,a); read(dvi_file,b);
+cur_loc:=cur_loc+2;
+get_two_bytes:=a*256+b;
+end;
+@#
+function signed_pair:integer; {returns the next two bytes, signed}
+var a,@!b:eight_bits;
+begin read(dvi_file,a); read(dvi_file,b);
+cur_loc:=cur_loc+2;
+if a<128 then signed_pair:=a*256+b
+else signed_pair:=(a-256)*256+b;
+end;
+@#
+function get_three_bytes:integer; {returns the next three bytes, unsigned}
+var a,@!b,@!c:eight_bits;
+begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c);
+cur_loc:=cur_loc+3;
+get_three_bytes:=(a*256+b)*256+c;
+end;
+@#
+function signed_trio:integer; {returns the next three bytes, signed}
+var a,@!b,@!c:eight_bits;
+begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c);
+cur_loc:=cur_loc+3;
+if a<128 then signed_trio:=(a*256+b)*256+c
+else signed_trio:=((a-256)*256+b)*256+c;
+end;
+@#
+function signed_quad:integer; {returns the next four bytes, signed}
+var a,@!b,@!c,@!d:eight_bits;
+begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c); read(dvi_file,d);
+cur_loc:=cur_loc+4;
+if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
+else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+end;
+@y
+@d read_dvi_file(#)==begin
+ if dvi_count=VAX_block_length then begin
+ get(dvi_file,@=error:=continue@>); dvi_count:=0;
+ end;
+ #:=dvi_file^[dvi_count];
+ incr(dvi_count);
+ end
+
+@p function get_byte:integer; {returns the next byte, unsigned}
+var b:eight_bits;
+begin if eof(dvi_file) then get_byte:=0
+else begin read_dvi_file(b); incr(cur_loc); get_byte:=b;
+ end;
+end;
+@#
+function signed_byte:integer; {returns the next byte, signed}
+var b:eight_bits;
+begin read_dvi_file(b); incr(cur_loc);
+if b<128 then signed_byte:=b @+ else signed_byte:=b-256;
+end;
+@#
+function get_two_bytes:integer; {returns the next two bytes, unsigned}
+var a,@!b:eight_bits;
+begin read_dvi_file(a); read_dvi_file(b);
+cur_loc:=cur_loc+2;
+get_two_bytes:=a*256+b;
+end;
+@#
+function signed_pair:integer; {returns the next two bytes, signed}
+var a,@!b:eight_bits;
+begin read_dvi_file(a); read_dvi_file(b);
+cur_loc:=cur_loc+2;
+if a<128 then signed_pair:=a*256+b
+else signed_pair:=(a-256)*256+b;
+end;
+@#
+function get_three_bytes:integer; {returns the next three bytes, unsigned}
+var a,@!b,@!c:eight_bits;
+begin read_dvi_file(a); read_dvi_file(b); read_dvi_file(c);
+cur_loc:=cur_loc+3;
+get_three_bytes:=(a*256+b)*256+c;
+end;
+@#
+function signed_trio:integer; {returns the next three bytes, signed}
+var a,@!b,@!c:eight_bits;
+begin read_dvi_file(a); read_dvi_file(b); read_dvi_file(c);
+cur_loc:=cur_loc+3;
+if a<128 then signed_trio:=(a*256+b)*256+c
+else signed_trio:=((a-256)*256+b)*256+c;
+end;
+@#
+function signed_quad:integer; {returns the next four bytes, signed}
+var a,@!b,@!c,@!d:eight_bits;
+begin read_dvi_file(a); read_dvi_file(b); read_dvi_file(c); read_dvi_file(d);
+cur_loc:=cur_loc+4;
+if a<128 then signed_quad:=((a*256+b)*256+c)*256+d
+else signed_quad:=(((a-256)*256+b)*256+c)*256+d;
+end;
+@z
+
+@x
+begin set_pos(dvi_file,-1); dvi_length:=cur_pos(dvi_file);
+@y
+begin dvi_length:=dvi_blocks*VAX_block_length-1;
+@z
+
+@x
+begin set_pos(dvi_file,n); cur_loc:=n;
+@y
+var @!blk,@!byt:integer; {block and byte number}
+begin cur_loc:=n;
+blk:=n div VAX_block_length;
+byt:=n-(blk*VAX_block_length);
+@=find@>(dvi_file,blk+1); {VMS starts counting block numbers at 1, not 0}
+dvi_count:=byt;
+@z
+
+@x
+and |term_out| for terminal output.
+@^system dependencies@>
+
+@<Glob...@>=
+@!buffer:array[0..terminal_line_length] of ASCII_code;
+@!term_in:text_file; {the terminal, considered as an input file}
+@!term_out:text_file; {the terminal, considered as an output file}
+@y
+and |term_out| for terminal output.
+@^system dependencies@>
+
+@d term_in==input {the terminal, considered as an input file}
+@d term_out==output {the terminal, considered as an output file}
+
+@<Glob...@>=
+@!buffer:array[0..terminal_line_length] of ASCII_code;
+@z
+
+@x
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@y
+On Vax/VMS, this is actually not necessary in this context, since
+|update_terminal| is always called just before a |read|.
+
+@d update_terminal == {the terminal output buffer is emptied by |read|}
+@z
+
+@x
+begin update_terminal; reset(term_in);
+if eoln(term_in) then read_ln(term_in);
+k:=0;
+while (k<terminal_line_length)and not eoln(term_in) do
+ begin buffer[k]:=xord[term_in^]; incr(k); get(term_in);
+ end;
+buffer[k]:=" ";
+@y
+begin update_terminal;
+k:=0;
+while (k<terminal_line_length)and not eoln(term_in) do
+ begin buffer[k]:=xord[term_in^]; incr(k); get(term_in);
+ end;
+buffer[k]:=" ";
+read_ln(term_in);
+@z
+
+@x
+ begin incr(buf_ptr); resolution:=k/get_integer;
+@y
+ begin incr(buf_ptr); resolution:=@=dble@>(k)/get_integer;
+@z
+
+@x
+if eof(tfm_file) then
+@y
+if status(tfm_file)<>0 then
+@z
+
+@x
+@d default_directory_name=='TeXfonts:' {change this to the correct name}
+@d default_directory_name_length=9 {change this to the correct length}
+@y
+@d default_directory_name=='TEX$FONTS:' {change this to the correct name}
+@d default_directory_name_length=10 {change this to the correct length}
+@z
+
+@x
+m:=n-4;
+@y
+m:=n;
+repeat if m=0 then bad_dvi('all 0s');
+@.all 0s@>
+move_to_byte(m); k:=get_byte; decr(m);
+until k<>0;
+if k<>223 then bad_dvi('223 byte is ',k:1);
+@.223 byte is wrong@>
+@z
+
+@x
+while (m=223)and not eof(dvi_file) do m:=get_byte;
+@y
+while ((m=223) or (m=0)) and not eof(dvi_file) do m:=get_byte;
+@z
+
+@x
+final_end:end.
+@y
+close(type_file,@=disposition:=save@>,@=error:=continue@>);
+final_end:end.
+@z
+
+@x
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{DVItype} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@y
+Here are the remaining changes to the program
+that are necessary to make \.{DVItype} work on Vax/VMS.
+
+@<Const...@>==
+@!VAX_block_length=512;
+
+@ @<Types...@>==
+@!byte_block=packed array [0..VAX_block_length-1] of 0..255;
+
+@ On Vax/VMS we need the following special definitions, types, variables
+and procedures to be able to get the file name from the command line,
+or to prompt for them.
+
+@d VAX_direct==@=direct@>
+@d VAX_fixed==@=fixed@>
+@d VAX_volatile==@=volatile@>
+@d VAX_immed==@=%immed @>
+@d VAX_external==@=external@>
+@d VAX_stdescr==@=%stdescr @>
+@d VAX_lib_get_foreign==@= lib$get_foreign@>
+@d VAX_length==@=length @>
+@d VAX_fab_type==@= FAB$TYPE @>
+@d VAX_rab_type==@= RAB$TYPE @>
+@d VAX_xab_type==@= XAB$TYPE @>
+@d VAX_fab_xab==@= FAB$L_XAB @>
+@d VAX_xab_nxt==@= XAB$L_NXT @>
+@d VAX_xab_cod==@= XAB$B_COD @>
+@d VAX_xab_fhc==@= XAB$C_FHC @>
+@d VAX_xab_ebk==@= XAB$L_EBK @>
+
+@ @<Types...@>=
+@!sixteen_bits= 0..65535;
+
+@ @<Glob...@>==
+@!type_file: text;
+@!command_line:packed array[1..300] of char;
+@!cmd_len:sixteen_bits;
+@!cmd_i:integer;
+@!file_name,@!def_file_name:varying [300] of char;
+@!ask,@!got_file_name: boolean;
+
+@ @<Preset init...@>=
+open(output,'SYS$OUTPUT',@=error:=continue@>); {FIX ME! JUNK FOR RUN-TIME BUG}
+
+cmd_i:=0;
+VAX_lib_get_foreign(command_line,,cmd_len,cmd_i);
+cmd_i:=1; while (cmd_i<=cmd_len) and (command_line[cmd_i]=' ') do incr(cmd_i);
+got_file_name:=cmd_i<=cmd_len;
+if got_file_name then
+ def_file_name:=substr(command_line,cmd_i,cmd_len-cmd_i+1);
+
+if got_file_name then begin
+ file_name:=def_file_name+'.DVI';
+ open(dvi_file,file_name,@=readonly@>,,VAX_direct,
+ VAX_fixed,@=user_action:=@>dvi_open,@=error:=continue@>);
+ ask:=status(dvi_file)<>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end
+else ask:=true;
+while ask do begin
+ got_file_name:=false;
+ write('DVI file: ');
+ if eof then goto 9999;
+ read_ln(file_name);
+ open(dvi_file,file_name,@=readonly@>,,VAX_direct,
+ VAX_fixed,@=user_action:=@>dvi_open,@=error:=continue@>);
+ ask:=status(dvi_file)<>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end;
+
+if got_file_name then begin
+ cmd_i:=1;
+ for cmd_len:=1 to def_file_name.VAX_length do
+ if (def_file_name[cmd_len]=']')
+ or (def_file_name[cmd_len]=':')
+ then cmd_i:=cmd_len+1;
+ if cmd_i<=def_file_name.VAX_length then
+ def_file_name:=substr(def_file_name,cmd_i,
+ def_file_name.VAX_length-cmd_i+1);
+ file_name:=def_file_name+'.TYP';
+ open(type_file,file_name,@=new,32767,disposition:=delete@>,
+ @=error:=continue@>);
+ ask:=status(type_file)>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end
+else ask:=true;
+while ask do begin
+ write('TYPE file: ');
+ if eof then goto 9999;
+ read_ln(file_name);
+ if file_name.VAX_length=0 then file_name:='SYS$OUTPUT';
+ open(type_file,file_name,@=new,32767,disposition:=delete@>,
+ @=error:=continue@>);
+ ask:=status(type_file)>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end;
+rewrite(type_file);
+
+@ Here is the library procedure that gets the user's command line.
+
+@<Procedures for ...@>=
+[VAX_external] function VAX_lib_get_foreign(
+ VAX_stdescr cmdlin:[VAX_volatile] packed array [$l1..$u1:integer] of char
+ := VAX_immed 0;
+ VAX_stdescr prompt:[VAX_volatile] packed array [$l2..$u2:integer] of char
+ := VAX_immed 0;
+ var len : [VAX_volatile] sixteen_bits := VAX_immed 0;
+ var flag : [VAX_volatile] integer := VAX_immed 0)
+ :integer; extern;
+
+@ Here is how we intervene to find out the length of the |dvi_file|.
+
+@<Procedures for ...@>=
+function dvi_open(var fab:VAX_fab_type; var rab:VAX_rab_type):integer;
+ type XAB_ptr = ^VAX_xab_type;
+ var user_status:integer;
+ xab,fhc:XAB_ptr;
+ begin
+ user_status:=@= $OPEN@>(fab);
+ if odd(user_status) then @= $CONNECT@>(rab);
+ xab:=fab.VAX_fab_xab::XAB_ptr;
+ fhc:=nil;
+ while (xab<>nil) and (fhc=nil) do
+ if xab^.VAX_xab_cod=VAX_xab_fhc then fhc:=xab
+ else xab:=xab^.VAX_xab_nxt::XAB_ptr;
+ if fhc<>nil then dvi_blocks:=int(fhc^.VAX_xab_ebk)
+ else dvi_blocks:=0;
+
+ dvi_open:=user_status;
+ end;
+
+@z
diff --git a/obsolete/systems/knuth/unsupported/texware/pltotf.cms-changes b/obsolete/systems/knuth/unsupported/texware/pltotf.cms-changes
new file mode 100644
index 0000000000..3247a19f26
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/texware/pltotf.cms-changes
@@ -0,0 +1,61 @@
+PLtoTF change file for VM/CMS and MVS.
+Copyright (C) 1984 by David Fuchs. All rights are reserved.
+
+@x
+@d banner=='This is PLtoTF, Version 2.3' {printed when the program starts}
+@y
+@d banner=='This is PLtoTF, VM/CMS Version 2.3' {printed when program starts}
+@z
+
+@x
+@!tfm_file:packed file of 0..255;
+@y
+@!tfm_file:packed file of block;
+@!tfm_count:0..CMS_block_length; {where the next byte goes}
+@z
+
+@x
+@d out(#)==write(tfm_file,#)
+@y
+@d out(#)==begin
+ if tfm_count=CMS_block_length then begin
+ put(tfm_file); tfm_count:=0; end;
+ tfm_file@@(.tfm_count.):=#;
+ incr(tfm_count);
+ end
+@d flush_tfm==begin
+ while tfm_count<CMS_block_length do begin
+ tfm_file@@(.tfm_count.):=0; incr(tfm_count); end;
+ put(tfm_file);
+ end
+@<Set init...@>==
+tfm_count:=0;
+@z
+
+@x
+end.
+@y
+flush_tfm;
+end.
+@z
+
+@x
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{PLtoTF} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@y
+Here are the remaining changes to the program
+that are necessary to make \.{PLtoTF} work on VM/CMS.
+
+@ Here's the extra stuff we need for buffering the |tfm_file|.
+@<Const...@>==
+@!CMS_block_length=1024;
+
+@ @<Types...@>==
+@!block=packed array (.0..CMS_block_length-1.) of packed 0..255;
+
+@z
diff --git a/obsolete/systems/knuth/unsupported/texware/pltotf.tops10-changes b/obsolete/systems/knuth/unsupported/texware/pltotf.tops10-changes
new file mode 100644
index 0000000000..aa18cb9d6c
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/texware/pltotf.tops10-changes
@@ -0,0 +1,5 @@
+@x
+rewrite(tfm_file);
+@y
+rewrite(tfm_file,'','/B:8');
+@z
diff --git a/obsolete/systems/knuth/unsupported/texware/pltotf.tops20-changes b/obsolete/systems/knuth/unsupported/texware/pltotf.tops20-changes
new file mode 100644
index 0000000000..3d390a29ba
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/texware/pltotf.tops20-changes
@@ -0,0 +1,34 @@
+PLtoTF change file for Tops-20
+Copyright (C) 1983 by David Fuchs. All rights are reserved.
+
+@x Tell WEAVE to print only the changes:
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{PL\lowercase{to}TF changes for Tops-20}
+@z
+
+@x TOPS-20's banner:
+@d banner=='This is PLtoTF, Version 2.3' {printed when the program starts}
+@y
+@d banner=='This is PLtoTF, Tops-20 Version 2.3'
+@z
+
+@x Route output to TTY, and handle default file version numbers:
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+
+@p program PLtoTF(@!pl_file,@!tfm_file,@!output);
+@y
+@d print(#)==write(tty,#)
+@d print_ln(#)==write_ln(tty,#)
+
+@p program PLtoTF(@!pl_file:-,@!tfm_file:+);
+@z
+
+@x Binary open of TFM file:
+rewrite(tfm_file);
+@y
+rewrite(tfm_file,'','/B:8');
+@z
diff --git a/obsolete/systems/knuth/unsupported/texware/pltotf.vms-changes b/obsolete/systems/knuth/unsupported/texware/pltotf.vms-changes
new file mode 100644
index 0000000000..fbd7234366
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/texware/pltotf.vms-changes
@@ -0,0 +1,186 @@
+PLtoTF change file for Vax/VMS
+Copyright (C) 1983 by David Fuchs. All rights are reserved.
+
+@x
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{PL\lowercase{to}TF changes for Vax/VMS}
+@z
+
+@x
+@d banner=='This is PLtoTF, Version 2.3' {printed when the program starts}
+@y
+@d banner=='This is PLtoTF, Vax/VMS version 2.3'
+@z
+
+@x
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+@y
+@d print(#)==write_ln(term_out,#)
+@d print_ln(#)==write_ln(term_out,#,chr(13),chr(10))
+@z
+
+@x
+@p program PLtoTF(@!pl_file,@!tfm_file,@!output);
+@y
+@p program PLtoTF(@!pl_file,@!tfm_file,@!output,@!input,@!term_out);
+label 223; {for abort}
+@z
+
+@x
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+ begin print_ln(banner);@/
+@y
+@<Procedures for initialization@>@/
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@/
+ begin
+ @<Preset initial values@>@/
+ print_ln(banner);@/
+@z
+
+@x
+@!tfm_file:packed file of 0..255;
+@y
+@!tfm_file:packed file of block;
+@!tfm_count:0..VAX_block_length; {where the next byte goes}
+@z
+
+@x
+@d out(#)==write(tfm_file,#)
+@y
+@d out(#)==begin
+ if tfm_count=VAX_block_length then begin
+ put(tfm_file); tfm_count:=0; end;
+ tfm_file^[tfm_count]:=#;
+ incr(tfm_count);
+ end
+@d flush_tfm==begin
+ while tfm_count<VAX_block_length do begin
+ tfm_file^[tfm_count]:=0; incr(tfm_count); end;
+ put(tfm_file);
+ end
+@<Set init...@>==
+tfm_count:=0;
+@z
+
+@x
+end.
+@y
+flush_tfm;
+close(tfm_file,@=disposition:=save@>);
+223:
+end.
+@z
+
+@x
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{PLtoTF} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@y
+Here are the remaining changes to the program
+that are necessary to make \.{PLtoTF} work on Vax/VMS.
+
+@ Here's the extra stuff we need for buffering the |tfm_file|.
+@<Const...@>==
+@!VAX_block_length=512;
+
+@ @<Types...@>==
+@!block=packed array [0..VAX_block_length-1] of 0..255;
+
+@ On Vax/VMS we need the following special definitions, types, variables
+and procedures to be able to get the file name from the command line,
+or to prompt for them.
+
+@d VAX_volatile==@=volatile@>
+@d VAX_immed==@=%immed @>
+@d VAX_external==@=external@>
+@d VAX_stdescr==@=%stdescr @>
+@d VAX_lib_get_foreign==@= lib$get_foreign@>
+@d VAX_length==@=length @>
+
+@ @<Types...@>=
+@!sixteen_bits= 0..65535;
+
+@ @<Glob...@>==
+@!term_out: text; {for progress report to user's terminal}
+@!command_line:packed array[1..300] of char;
+@!cmd_len:sixteen_bits;
+@!cmd_i:integer;
+@!file_name,@!default_file_name:varying [300] of char;
+@!ask,@!got_file_name: boolean;
+
+@ @<Preset init...@>=
+open(term_out,'SYS$OUTPUT',@=carriage_control:=none@>);
+rewrite(term_out);
+cmd_i:=0;
+VAX_lib_get_foreign(command_line,,cmd_len,cmd_i);
+cmd_i:=1; while (cmd_i<=cmd_len) and (command_line[cmd_i]=' ') do incr(cmd_i);
+got_file_name:=cmd_i<=cmd_len;
+if got_file_name then
+ default_file_name:=substr(command_line,cmd_i,cmd_len-cmd_i+1);
+
+if got_file_name then begin
+ file_name:=default_file_name+'.PL';
+ open(pl_file,file_name,@=readonly,error:=continue@>);
+ ask:=status(pl_file)<>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end
+else ask:=true;
+while ask do begin
+ got_file_name:=false;
+ write('PL file: ');
+ if eof then goto 223;
+ read_ln(file_name);
+ open(pl_file,file_name,@=readonly,error:=continue@>);
+ ask:=status(pl_file)<>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end;
+
+if got_file_name then begin
+ cmd_i:=1;
+ for cmd_len:=1 to default_file_name.VAX_length do
+ if (default_file_name[cmd_len]=']')
+ or (default_file_name[cmd_len]=':')
+ then cmd_i:=cmd_len+1;
+ if cmd_i<=default_file_name.VAX_length then
+ default_file_name:=substr(default_file_name,cmd_i,
+ default_file_name.VAX_length-cmd_i+1);
+ file_name:=default_file_name+'.TFM';
+ open(tfm_file,file_name,@=new,disposition:=delete@>,
+ @=error:=continue@>);
+ ask:=status(tfm_file)>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end
+else ask:=true;
+while ask do begin
+ write('TFM file: ');
+ if eof then goto 223;
+ read_ln(file_name);
+ open(tfm_file,file_name,@=new,disposition:=delete@>,
+ @=error:=continue@>);
+ ask:=status(tfm_file)>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end;
+
+@ Here is the library procedure that gets the user's command line.
+
+@<Procedures for ...@>=
+[VAX_external] function VAX_lib_get_foreign(
+ VAX_stdescr cmdlin:[VAX_volatile] packed array [$l1..$u1:integer] of char
+ := VAX_immed 0;
+ VAX_stdescr prompt:[VAX_volatile] packed array [$l2..$u2:integer] of char
+ := VAX_immed 0;
+ var len : [VAX_volatile] sixteen_bits := VAX_immed 0;
+ var flag : [VAX_volatile] integer := VAX_immed 0)
+ :integer; extern;
+
+@z
diff --git a/obsolete/systems/knuth/unsupported/texware/pooltype.cms-changes b/obsolete/systems/knuth/unsupported/texware/pooltype.cms-changes
new file mode 100644
index 0000000000..b1d8bd37ac
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/texware/pooltype.cms-changes
@@ -0,0 +1,20 @@
+POOLtype change file for VM/CMS and MVS.
+Copyright (C) 1984 by David Fuchs. All rights are reserved.
+
+@x
+@!ASCII_code=0..127; {seven-bit numbers}
+@y
+@!ASCII_code=packed 0..127; {seven-bit numbers}
+@z
+
+@x
+@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
+
+@x
+@!pool_file:packed file of text_char;
+@y
+@!pool_file:text;
+@z
diff --git a/obsolete/systems/knuth/unsupported/texware/pooltype.vms-changes b/obsolete/systems/knuth/unsupported/texware/pooltype.vms-changes
new file mode 100644
index 0000000000..b181be7fd3
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/texware/pooltype.vms-changes
@@ -0,0 +1,152 @@
+POOLTYPE change file for Vax/VMS
+Copyright (C) 1983 by David Fuchs. All rights are reserved.
+
+@x
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{POOL\lowercase{type} changes for Vax/VMS}
+@z
+
+@x
+@p program POOLtype(@!pool_file,@!output);
+@y
+@p program POOLtype(@!pool_file,@!output,@!input,@!term_out);
+@z
+
+@x
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@;
+ begin @<Set initial values of key variables@>@/
+@y
+@<Procedures for initialization@>@/
+procedure initialize; {this procedure gets things started properly}
+ var @<Local variables for initialization@>@;
+ begin @<Preset initial values@>@/
+ @<Set initial values of key variables@>@/
+@z
+
+@x
+@d abort(#)==begin write_ln(#); goto 9999;
+@y
+@d crlf==chr(13),chr(10)
+@d abort(#)==begin
+ write_ln(term_out,#,crlf); goto 9999;
+@z
+
+@x
+9999:end.
+@y
+close(output,@=disposition:=save@>,@=error:=continue@>);
+9999:end.
+@z
+
+@x
+@!pool_file:packed file of text_char;
+@y
+@!pool_file:text;
+@z
+
+@x
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{POOLtype} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@y
+Here are the remaining changes to the program
+that are necessary to make \.{POOLtype} work on Vax/VMS.
+
+@ On Vax/VMS we need the following special definitions, types, variables
+and procedures to be able to get the file name from the command line,
+or to prompt for them.
+
+@d VAX_volatile==@=volatile@>
+@d VAX_immed==@=%immed @>
+@d VAX_external==@=external@>
+@d VAX_stdescr==@=%stdescr @>
+@d VAX_lib_get_foreign==@= lib$get_foreign@>
+@d VAX_length==@=length @>
+
+@ @<Types...@>=
+@!sixteen_bits= 0..65535;
+
+@ @<Glob...@>==
+@!term_out: text; {for progress report to user's terminal}
+@!command_line:packed array[1..300] of char;
+@!cmd_len:sixteen_bits;
+@!cmd_i:integer;
+@!file_name,@!default_file_name:varying [300] of char;
+@!ask,@!got_file_name: boolean;
+
+@ @<Preset init...@>=
+open(term_out,'SYS$OUTPUT',@=carriage_control:=none@>);
+rewrite(term_out);
+cmd_i:=0;
+VAX_lib_get_foreign(command_line,,cmd_len,cmd_i);
+cmd_i:=1; while (cmd_i<=cmd_len) and (command_line[cmd_i]=' ') do incr(cmd_i);
+got_file_name:=cmd_i<=cmd_len;
+if got_file_name then
+ default_file_name:=substr(command_line,cmd_i,cmd_len-cmd_i+1);
+
+if got_file_name then begin
+ file_name:=default_file_name+'.POO';
+ open(pool_file,file_name,@=readonly,error:=continue@>);
+ ask:=status(pool_file)<>0;
+ if ask then write_ln(term_out,'Couldn''t open ',file_name,crlf);
+ end
+else ask:=true;
+while ask do begin
+ got_file_name:=false;
+ write_ln(term_out,'Pool file: ');
+ if eof then goto 9999;
+ read_ln(file_name);
+ open(pool_file,file_name,@=readonly,error:=continue@>);
+ ask:=status(pool_file)<>0;
+ if ask then write_ln(term_out,'Couldn''t open ',file_name,crlf);
+ end;
+
+if got_file_name then begin
+ cmd_i:=1;
+ for cmd_len:=1 to default_file_name.VAX_length do
+ if (default_file_name[cmd_len]=']')
+ or (default_file_name[cmd_len]=':')
+ then cmd_i:=cmd_len+1;
+ if cmd_i<=default_file_name.VAX_length then
+ default_file_name:=substr(default_file_name,cmd_i,
+ default_file_name.VAX_length-cmd_i+1);
+ file_name:=default_file_name+'.TYP';
+ close(output,@=error:=continue@>);
+ open(output,file_name,@=new,disposition:=delete,error:=continue@>);
+ ask:=status(output)>0;
+ if ask then write_ln(term_out,'Couldn''t open ',file_name,crlf);
+ end
+else ask:=true;
+while ask do begin
+ write_ln(term_out,'Type file: ');
+ if eof then goto 9999;
+ read_ln(file_name);
+ close(output,@=error:=continue@>);
+ open(output,file_name,@=new,32767,disposition:=delete@>,
+ @=error:=continue@>);
+ ask:=status(output)>0;
+ if ask then write_ln(term_out,'Couldn''t open ',file_name,crlf);
+ end;
+rewrite(output);
+
+@ Here is the library procedure that gets the user's command line.
+
+@<Procedures for ...@>=
+[VAX_external] function VAX_lib_get_foreign(
+ VAX_stdescr cmdlin:[VAX_volatile] packed array [$l1..$u1:integer] of char
+ := VAX_immed 0;
+ VAX_stdescr prompt:[VAX_volatile] packed array [$l2..$u2:integer] of char
+ := VAX_immed 0;
+ var len : [VAX_volatile] sixteen_bits := VAX_immed 0;
+ var flag : [VAX_volatile] integer := VAX_immed 0)
+ :integer; extern;
+
+@z
diff --git a/obsolete/systems/knuth/unsupported/texware/tftopl.cms-changes b/obsolete/systems/knuth/unsupported/texware/tftopl.cms-changes
new file mode 100644
index 0000000000..1d1031e84c
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/texware/tftopl.cms-changes
@@ -0,0 +1,86 @@
+TFtoPL change file for VM/CMS and MVS.
+Copyright (C) 1984 by David Fuchs. All rights are reserved.
+
+@x
+@d banner=='This is TFtoPL, Version 2.5' {printed when the program starts}
+@y
+@d banner=='This is TFtoPL, VM/CMS Version 2.5'
+@z
+
+@x
+@!tfm_file:packed file of 0..255;
+@y
+@!tfm_file:packed file of block;
+@!tfm_count:0..CMS_block_length; {where the next byte comes from}
+@z
+
+@x
+@<Read the whole input file@>=
+read(tfm_file,tfm[0]);
+@y
+@d read_tfm_file(#)==begin
+ if tfm_count=CMS_block_length then begin
+ get(tfm_file);
+ tfm_count:=0;
+ end;
+ #:=tfm_file@@(.tfm_count.);
+ incr(tfm_count);
+ end
+
+@<Read the whole input file@>=
+read_tfm_file(tfm(.0.));
+@z
+
+@x
+if eof(tfm_file) then abort('The input file is only one byte long!');
+@.The input...one byte long@>
+read(tfm_file,tfm[1]); lf:=tfm[0]*@'400+tfm[1];
+@y
+read_tfm_file(tfm(.1.)); lf:=tfm(.0.)*@'400+tfm(.1.);
+@z
+
+@x
+ read(tfm_file,tfm[tfm_ptr]);
+@y
+ read_tfm_file(tfm(.tfm_ptr.));
+@z
+
+@x
+if not eof(tfm_file) then
+@y
+get(tfm_file);
+if not eof(tfm_file) then
+@z
+
+@x
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{TFtoPL} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@y
+Here are the remaining changes to the program
+that are necessary to make \.{TFtoPL} work on VM/CMS.
+
+@ Here's the extra stuff we need for buffering the |tfm_file|.
+The |CMS_block_length| constant should be 1024 for consistency
+with the idea that CMS \TeX\ and \MF\ read and write non-text
+data files blocked \.{RECFM F LRECL 1024}, but I have set it at
+2048 to accomodate re-formatting \.{TFM} files for the \.{am}
+fonts of the old CMS \TeX\ versions which were \.{RECFM V} with
+some record lengths greater than 1024 but less than 2048. These
+files can be re-formatted for use with \TeX\ 2.0 by running
+\.{TFtoPL} on them and \.{PLtoTF} on the resulting \.{PL} files.
+
+@<Const...@>==
+@!CMS_block_length=2048;
+
+@ @<Types...@>==
+@!block=packed array (.0..CMS_block_length-1.) of packed 0..255;
+
+@ @<Set init...@>=
+tfm_count:=0;
+
+@z
diff --git a/obsolete/systems/knuth/unsupported/texware/tftopl.tops10-changes b/obsolete/systems/knuth/unsupported/texware/tftopl.tops10-changes
new file mode 100644
index 0000000000..4a76170edd
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/texware/tftopl.tops10-changes
@@ -0,0 +1,5 @@
+@x
+reset(tfm_file);
+@y
+reset(tfm_file,'','/B:8');
+@z
diff --git a/obsolete/systems/knuth/unsupported/texware/tftopl.tops20-changes b/obsolete/systems/knuth/unsupported/texware/tftopl.tops20-changes
new file mode 100644
index 0000000000..893bda6c1e
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/texware/tftopl.tops20-changes
@@ -0,0 +1,34 @@
+TFtoPL change file for Tops-20
+Copyright (C) 1983 by David Fuchs. All rights are reserved.
+
+@x Tell WEAVE to print only the changes:
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{TF\lowercase{to}PL changes for Tops-20}
+@z
+
+@x TOPS-20's banner:
+@d banner=='This is TFtoPL, Version 2.4' {printed when the program starts}
+@y
+@d banner=='This is TFtoPL, Tops-20 Version 2.4'
+@z
+
+@x Route output to TTY, and handle default file version numbers:
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+
+@p program TFtoPL(@!tfm_file,@!pl_file,@!output);
+@y
+@d print(#)==write(tty,#)
+@d print_ln(#)==write_ln(tty,#)
+
+@p program TFtoPL(@!tfm_file:-,@!pl_file:+);
+@z
+
+@x Binary open of TFM file:
+reset(tfm_file);
+@y
+reset(tfm_file,'','/B:8');
+@z
diff --git a/obsolete/systems/knuth/unsupported/texware/tftopl.vms-changes b/obsolete/systems/knuth/unsupported/texware/tftopl.vms-changes
new file mode 100644
index 0000000000..118e0d3f8e
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/texware/tftopl.vms-changes
@@ -0,0 +1,203 @@
+TFtoPL change file for Vax/VMS
+Copyright (C) 1983 by David Fuchs. All rights are reserved.
+
+@x
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{TF\lowercase{to}PL changes for Vax/VMS}
+@z
+
+@x
+@d banner=='This is TFtoPL, Version 2.5' {printed when the program starts}
+@y
+@d banner=='This is TFtoPL, Vax/VMS version 2.5'
+@z
+
+@x
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+@y
+@d print(#)==write_ln(term_out,#)
+@d print_ln(#)==write_ln(term_out,#,chr(13),chr(10))
+@z
+
+@x
+@p program TFtoPL(@!tfm_file,@!pl_file,@!output);
+@y
+@p program TFtoPL(@!tfm_file,@!pl_file,@!output,@!input,@!term_out);
+@z
+
+@x
+procedure initialize; {this procedure gets things started properly}
+ begin print_ln(banner);@/
+@y
+@<Procedures for initialization@>@/
+procedure initialize; {this procedure gets things started properly}
+ begin
+ @<Preset initial values@>@/
+ print_ln(banner);@/
+@z
+
+@x
+@!tfm_file:packed file of 0..255;
+@y
+@!tfm_file:packed file of block;
+@!tfm_count:0..VAX_block_length; {where the next byte comes from}
+@z
+
+@x
+@<Read the whole input file@>=
+read(tfm_file,tfm[0]);
+@y
+@d read_tfm_file(#)==begin
+ if tfm_count=VAX_block_length then begin
+ get(tfm_file,@=error:=continue@>);
+ tfm_count:=0;
+ end;
+ #:=tfm_file^[tfm_count];
+ incr(tfm_count);
+ end
+
+@<Read the whole input file@>=
+read_tfm_file(tfm[0]);
+@z
+
+@x
+if eof(tfm_file) then abort('The input file is only one byte long!');
+@.The input...one byte long@>
+read(tfm_file,tfm[1]); lf:=tfm[0]*@'400+tfm[1];
+@y
+read_tfm_file(tfm[1]); lf:=tfm[0]*@'400+tfm[1];
+@z
+
+@x
+ read(tfm_file,tfm[tfm_ptr]);
+@y
+ read_tfm_file(tfm[tfm_ptr]);
+@z
+
+@x
+if not eof(tfm_file) then
+@y
+get(tfm_file,@=error:=continue@>);
+if not eof(tfm_file) then
+@z
+
+@x
+final_end:end.
+@y
+close(pl_file,@=disposition:=save@>,@=error:=continue@>);
+final_end:end.
+@z
+
+@x
+This section should be replaced, if necessary, by changes to the program
+that are necessary to make \.{TFtoPL} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous sections preserve the section numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new sections, can be inserted here; then only the index
+itself will get a new section number.
+@y
+Here are the remaining changes to the program
+that are necessary to make \.{TFtoPL} work on Vax/VMS.
+
+@ Here's the extra stuff we need for buffering the |tfm_file|.
+@<Const...@>==
+@!VAX_block_length=512;
+
+@ @<Types...@>==
+@!block=packed array [0..VAX_block_length-1] of 0..255;
+
+@ @<Set init...@>=
+tfm_count:=0;
+
+@ On Vax/VMS we need the following special definitions, types, variables
+and procedures to be able to get the file name from the command line,
+or to prompt for them.
+
+@d VAX_volatile==@=volatile@>
+@d VAX_immed==@=%immed @>
+@d VAX_external==@=external@>
+@d VAX_stdescr==@=%stdescr @>
+@d VAX_lib_get_foreign==@= lib$get_foreign@>
+@d VAX_length==@=length @>
+
+@ @<Types...@>=
+@!sixteen_bits= 0..65535;
+
+@ @<Glob...@>==
+@!term_out: text; {for progress report to user's terminal}
+@!command_line:packed array[1..300] of char;
+@!cmd_len:sixteen_bits;
+@!cmd_i:integer;
+@!file_name,@!default_file_name:varying [300] of char;
+@!ask,@!got_file_name: boolean;
+
+@ @<Preset init...@>=
+open(term_out,'SYS$OUTPUT',@=carriage_control:=none@>); rewrite(term_out);
+cmd_i:=0;
+VAX_lib_get_foreign(command_line,,cmd_len,cmd_i);
+cmd_i:=1; while (cmd_i<=cmd_len) and (command_line[cmd_i]=' ') do incr(cmd_i);
+got_file_name:=cmd_i<=cmd_len;
+if got_file_name then
+ default_file_name:=substr(command_line,cmd_i,cmd_len-cmd_i+1);
+
+if got_file_name then begin
+ file_name:=default_file_name+'.TFM';
+ open(tfm_file,file_name,@=readonly,error:=continue@>);
+ ask:=status(tfm_file)<>0;
+ if ask then write_ln('Coudln''t open ',file_name);
+ end
+else ask:=true;
+while ask do begin
+ got_file_name:=false;
+ write('TFM file: ');
+ if eof then goto final_end;
+ read_ln(file_name);
+ open(tfm_file,file_name,@=readonly,error:=continue@>);
+ ask:=status(tfm_file)<>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end;
+
+if got_file_name then begin
+ cmd_i:=1;
+ for cmd_len:=1 to default_file_name.VAX_length do
+ if (default_file_name[cmd_len]=']')
+ or (default_file_name[cmd_len]=':')
+ then cmd_i:=cmd_len+1;
+ if cmd_i<=default_file_name.VAX_length then
+ default_file_name:=substr(default_file_name,cmd_i,
+ default_file_name.VAX_length-cmd_i+1);
+ file_name:=default_file_name+'.PL';
+ open(pl_file,file_name,@=new,32767,disposition:=delete@>,
+ @=error:=continue@>);
+ ask:=status(pl_file)>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end
+else ask:=true;
+while ask do begin
+ write('PL file: ');
+ if eof then goto final_end;
+ read_ln(file_name);
+ open(pl_file,file_name,@=new,32767,disposition:=delete@>,
+ @=error:=continue@>);
+ ask:=status(pl_file)>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end;
+
+@ Here is the library procedure that gets the user's command line.
+
+@<Procedures for ...@>=
+[VAX_external] function VAX_lib_get_foreign(
+ VAX_stdescr cmdlin:[VAX_volatile] packed array [$l1..$u1:integer] of char
+ := VAX_immed 0;
+ VAX_stdescr prompt:[VAX_volatile] packed array [$l2..$u2:integer] of char
+ := VAX_immed 0;
+ var len : [VAX_volatile] sixteen_bits := VAX_immed 0;
+ var flag : [VAX_volatile] integer := VAX_immed 0)
+ :integer; extern;
+
+@z
diff --git a/obsolete/systems/knuth/unsupported/web/tangle.changes b/obsolete/systems/knuth/unsupported/web/tangle.changes
new file mode 100644
index 0000000000..184e52c105
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/web/tangle.changes
@@ -0,0 +1,20 @@
+This is the change file for TANGLE.WEB. It turns on the DEBUG and STAT
+features, and helps you debug your installation of Tangle.
+
+@x Turn on debugging:
+@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
+@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
+@y
+@d debug==
+@d gubed==
+@z
+
+@x Turn on statistics gathering:
+@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==
+@d tats==
+@z
diff --git a/obsolete/systems/knuth/unsupported/web/tangle.cms-changes b/obsolete/systems/knuth/unsupported/web/tangle.cms-changes
new file mode 100644
index 0000000000..2122027d53
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/web/tangle.cms-changes
@@ -0,0 +1,162 @@
+TANGLE change file for VM/CMS and MVS.
+Copyright (C) 1984 by David Fuchs. All rights are reserved.
+
+@x banner line
+@d banner=='This is TANGLE, Version 2.8'
+@y
+@d banner=='This is TANGLE, VM/CMS Version 2.8'
+@d term_in==tty_in
+@d term_out==tty_out
+@z
+
+@x debug switch
+@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
+@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
+@y
+@d debug==@{
+@d gubed==@t@>@}
+@z
+
+@x statistics switch
+@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==
+@d tats==
+@z
+
+@x 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
+{It seems impossible to turn CHECK and DEBUG on and off easily given
+ how Tangle and VS/PASCAL work}
+@z
+
+@x otherwise clause
+@d othercases == others: {default for cases not listed explicitly}
+@y
+@d othercases == otherwise {default for cases not listed explicitly}
+@z
+
+@x packing
+@!ASCII_code=0..127; {seven-bit numbers, a subrange of the integers}
+@y
+@!ASCII_code=packed 0..127; {seven-bit numbers, a subrange of the integers}
+@z
+
+@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
+
+@x text files
+@!text_file=packed file of text_char;
+@y
+@!text_file=text;
+@z
+
+@x terminal output
+rewrite(term_out,'TTY:'); {send |term_out| output to the terminal}
+@y
+rewrite(term_out); {often redirected to the user's terminal}
+@z
+
+@x update terminal buffer
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@y
+@d update_terminal == do_nothing
+@z
+
+@x pack buffer
+@<Globals...@>=@!buffer: array[0..buf_size] of ASCII_code;
+@y
+@<Globals...@>=@!buffer: packed array[0..buf_size] of ASCII_code;
+@z
+
+@x input_ln optimization
+@p function input_ln(var f:text_file):boolean;
+ {inputs a line or returns |false|}
+var final_limit:0..buf_size; {|limit| without trailing blanks}
+begin limit:=0; final_limit:=0;
+if eof(f) then input_ln:=false
+else begin while not eoln(f) do
+ begin buffer[limit]:=xord[f^]; get(f);
+ incr(limit);
+ if buffer[limit-1]<>" " then final_limit:=limit;
+ if limit=buf_size then
+ begin while not eoln(f) do get(f);
+ decr(limit); {keep |buffer[buf_size]| empty}
+ print_nl('! Input line too long'); loc:=0; error;
+@.Input line too long@>
+ end;
+ end;
+ read_ln(f); limit:=final_limit; input_ln:=true;
+ end;
+end;
+@y
+@p function input_ln(var f:text_file):boolean;
+ {inputs a line or returns |false|}
+var i:0..buf_size;
+@!temp_buf:string(buf_size);
+begin
+limit:=0;
+if eof(f) then input_ln:=false
+else begin
+ read(f,temp_buf);
+ limit:=@=length@>(trim(temp_buf));
+ if not eoln(f) then begin
+ print_nl('! Input line too long'); loc:=0; error;
+@.Input line too long@>
+ end
+ else read_ln(f);
+ if limit>0 then for i:=0 to limit-1 do
+ buffer(.i.):=xord(.temp_buf(.i+1.).);
+ input_ln:=true;
+ end;
+end;
+@z
+
+@x packing
+@!eight_bits=0..255; {unsigned one-byte quantity}
+@!sixteen_bits=0..65535; {unsigned two-byte quantity}
+@y
+@!eight_bits=packed 0..255; {unsigned one-byte quantity}
+@!sixteen_bits=packed 0..65535; {unsigned two-byte quantity}
+@z
+
+@x EBCDIC
+double_dot: begin out_contrib[1]:="."; out_contrib[2]:="."; send_out(str,2);
+ end;
+@y
+double_dot: begin out_contrib[1]:="."; out_contrib[2]:="."; send_out(str,2);
+ end;
+"^": begin out_contrib[1]:="@@"; send_out(str,1);
+ end;
+"[": begin out_contrib[1]:="("; out_contrib[2]:="."; send_out(str,2);
+ end;
+"]": begin out_contrib[1]:="."; out_contrib[2]:=")"; send_out(str,2);
+ end;
+@z
+@x
+"@@","[","\","]","^","_","`","{","|"
+@y
+"@@","\","_","`","{","|"
+@z
+
+@x
+reset(term_in,'TTY:','/I'); {open |term_in| as the terminal, don't do a |get|}
+@y
+{reset(term_in,'INTERACTIVE'); {open |term_in|, don't do a |get|}}
+@=termin@>(term_in); {don't ask me why the above line didn't work!}
+@z
+
+@x set return code
+case history of
+@y
+retcode(4*history); {set return code}
+case history of
+@z
diff --git a/obsolete/systems/knuth/unsupported/web/tangle.cmspas b/obsolete/systems/knuth/unsupported/web/tangle.cmspas
new file mode 100644
index 0000000000..b57c0df28b
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/web/tangle.cmspas
@@ -0,0 +1,780 @@
+{2:}{4:}{:4}PROGRAM TANGLE(WEBFILE,CHANGEFILE,PASCALFILE,POOL);
+LABEL 9999;CONST{8:}BUFSIZE=100;MAXBYTES=45000;MAXTOKS=50000;
+MAXNAMES=4000;MAXTEXTS=2000;HASHSIZE=353;LONGESTNAME=400;LINELENGTH=72;
+OUTBUFSIZE=144;STACKSIZE=50;MAXIDLENGTH=12;UNAMBIGLENGT=7;{:8}TYPE{11:}
+ASCIICODE=PACKED 0..127;{:11}{12:}TEXTFILE=TEXT;{:12}{37:}
+EIGHTBITS=PACKED 0..255;SIXTEENBITS=PACKED 0..65535;{:37}{39:}
+NAMEPOINTER=0..MAXNAMES;{:39}{43:}TEXTPOINTER=0..MAXTEXTS;{:43}{78:}
+OUTPUTSTATE=RECORD ENDFIELD:SIXTEENBITS;BYTEFIELD:SIXTEENBITS;
+NAMEFIELD:NAMEPOINTER;REPLFIELD:TEXTPOINTER;MODFIELD:0..12287;END;{:78}
+VAR{9:}HISTORY:0..3;{:9}{13:}XORD:ARRAY[CHAR]OF ASCIICODE;
+XCHR:ARRAY[ASCIICODE]OF CHAR;{:13}{20:}TTYOUT:TEXTFILE;{:20}{23:}
+WEBFILE:TEXTFILE;CHANGEFILE:TEXTFILE;{:23}{25:}PASCALFILE:TEXTFILE;
+POOL:TEXTFILE;{:25}{27:}BUFFER:PACKED ARRAY[0..BUFSIZE]OF ASCIICODE;
+{:27}{29:}PHASEONE:BOOLEAN;{:29}{38:}
+BYTEMEM:PACKED ARRAY[0..1,0..MAXBYTES]OF ASCIICODE;
+TOKMEM:PACKED ARRAY[0..2,0..MAXTOKS]OF EIGHTBITS;
+BYTESTART:ARRAY[0..MAXNAMES]OF SIXTEENBITS;
+TOKSTART:ARRAY[0..MAXTEXTS]OF SIXTEENBITS;
+LINK:ARRAY[0..MAXNAMES]OF SIXTEENBITS;
+ILK:ARRAY[0..MAXNAMES]OF SIXTEENBITS;
+EQUIV:ARRAY[0..MAXNAMES]OF SIXTEENBITS;
+TEXTLINK:ARRAY[0..MAXTEXTS]OF SIXTEENBITS;{:38}{40:}NAMEPTR:NAMEPOINTER;
+STRINGPTR:NAMEPOINTER;BYTEPTR:ARRAY[0..1]OF 0..MAXBYTES;
+POOLCHECKSUM:INTEGER;{:40}{44:}TEXTPTR:TEXTPOINTER;
+TOKPTR:ARRAY[0..2]OF 0..MAXTOKS;Z:0..2;
+MAXTOKPTR:ARRAY[0..2]OF 0..MAXTOKS;{:44}{50:}IDFIRST:0..BUFSIZE;
+IDLOC:0..BUFSIZE;DOUBLECHARS:0..BUFSIZE;
+HASH,CHOPHASH:ARRAY[0..HASHSIZE]OF SIXTEENBITS;
+CHOPPEDID:ARRAY[0..UNAMBIGLENGT]OF ASCIICODE;{:50}{65:}
+MODTEXT:ARRAY[0..LONGESTNAME]OF ASCIICODE;{:65}{70:}
+LASTUNNAMED:TEXTPOINTER;{:70}{79:}CURSTATE:OUTPUTSTATE;
+STACK:ARRAY[1..STACKSIZE]OF OUTPUTSTATE;STACKPTR:0..STACKSIZE;{:79}{80:}
+ZO:0..2;{:80}{82:}BRACELEVEL:EIGHTBITS;{:82}{86:}CURVAL:INTEGER;{:86}
+{94:}OUTBUF:ARRAY[0..OUTBUFSIZE]OF ASCIICODE;OUTPTR:0..OUTBUFSIZE;
+BREAKPTR:0..OUTBUFSIZE;SEMIPTR:0..OUTBUFSIZE;{:94}{95:}
+OUTSTATE:EIGHTBITS;OUTVAL,OUTAPP:INTEGER;OUTSIGN:ASCIICODE;
+LASTSIGN:-1..+1;{:95}{100:}OUTCONTRIB:ARRAY[1..LINELENGTH]OF ASCIICODE;
+{:100}{124:}LINE:INTEGER;OTHERLINE:INTEGER;TEMPLINE:INTEGER;
+LIMIT:0..BUFSIZE;LOC:0..BUFSIZE;INPUTHASENDE:BOOLEAN;CHANGING:BOOLEAN;
+{:124}{126:}CHANGEBUFFER:ARRAY[0..BUFSIZE]OF ASCIICODE;
+CHANGELIMIT:0..BUFSIZE;{:126}{143:}CURMODULE:NAMEPOINTER;
+SCANNINGHEX:BOOLEAN;{:143}{156:}NEXTCONTROL:EIGHTBITS;{:156}{164:}
+CURREPLTEXT:TEXTPOINTER;{:164}{171:}MODULECOUNT:0..12287;{:171}{179:}
+{TROUBLESHOOT:BOOLEAN;DDT:SIXTEENBITS;DD:SIXTEENBITS;DEBUGCYCLE:INTEGER;
+DEBUGSKIPPED:INTEGER;TTYIN:TEXTFILE;}{:179}{185:}WO:0..1;{:185}{30:}
+{PROCEDURE DEBUGHELP;FORWARD;}{:30}{31:}PROCEDURE ERROR;
+VAR J:0..OUTBUFSIZE;K,L:0..BUFSIZE;BEGIN IF PHASEONE THEN{32:}
+BEGIN IF CHANGING THEN WRITE(TTYOUT,'. (change file ')ELSE WRITE(TTYOUT,
+'. (');WRITELN(TTYOUT,'l.',LINE:1,')');
+IF LOC>=LIMIT THEN L:=LIMIT ELSE L:=LOC;
+FOR K:=1 TO L DO IF BUFFER[K-1]=9 THEN WRITE(TTYOUT,' ')ELSE WRITE(
+TTYOUT,XCHR[BUFFER[K-1]]);WRITELN(TTYOUT);
+FOR K:=1 TO L DO WRITE(TTYOUT,' ');
+FOR K:=L+1 TO LIMIT DO WRITE(TTYOUT,XCHR[BUFFER[K-1]]);
+WRITE(TTYOUT,' ');END{:32}ELSE{33:}
+BEGIN WRITELN(TTYOUT,'. (l.',LINE:1,')');
+FOR J:=1 TO OUTPTR DO WRITE(TTYOUT,XCHR[OUTBUF[J-1]]);
+WRITE(TTYOUT,'... ');END{:33};;HISTORY:=2;{DEBUGHELP;}END;{:31}{34:}
+PROCEDURE JUMPOUT;BEGIN GOTO 9999;END;{:34}PROCEDURE INITIALIZE;VAR{16:}
+I:0..255;{:16}{41:}WI:0..1;{:41}{45:}ZI:0..2;{:45}{51:}H:0..HASHSIZE;
+{:51}BEGIN{10:}HISTORY:=0;{:10}{14:}XCHR[32]:=' ';XCHR[33]:='!';
+XCHR[34]:='"';XCHR[35]:='#';XCHR[36]:='$';XCHR[37]:='%';XCHR[38]:='&';
+XCHR[39]:='''';XCHR[40]:='(';XCHR[41]:=')';XCHR[42]:='*';XCHR[43]:='+';
+XCHR[44]:=',';XCHR[45]:='-';XCHR[46]:='.';XCHR[47]:='/';XCHR[48]:='0';
+XCHR[49]:='1';XCHR[50]:='2';XCHR[51]:='3';XCHR[52]:='4';XCHR[53]:='5';
+XCHR[54]:='6';XCHR[55]:='7';XCHR[56]:='8';XCHR[57]:='9';XCHR[58]:=':';
+XCHR[59]:=';';XCHR[60]:='<';XCHR[61]:='=';XCHR[62]:='>';XCHR[63]:='?';
+XCHR[64]:='@';XCHR[65]:='A';XCHR[66]:='B';XCHR[67]:='C';XCHR[68]:='D';
+XCHR[69]:='E';XCHR[70]:='F';XCHR[71]:='G';XCHR[72]:='H';XCHR[73]:='I';
+XCHR[74]:='J';XCHR[75]:='K';XCHR[76]:='L';XCHR[77]:='M';XCHR[78]:='N';
+XCHR[79]:='O';XCHR[80]:='P';XCHR[81]:='Q';XCHR[82]:='R';XCHR[83]:='S';
+XCHR[84]:='T';XCHR[85]:='U';XCHR[86]:='V';XCHR[87]:='W';XCHR[88]:='X';
+XCHR[89]:='Y';XCHR[90]:='Z';XCHR[91]:='[';XCHR[92]:='\';XCHR[93]:=']';
+XCHR[94]:='^';XCHR[95]:='_';XCHR[96]:='`';XCHR[97]:='a';XCHR[98]:='b';
+XCHR[99]:='c';XCHR[100]:='d';XCHR[101]:='e';XCHR[102]:='f';
+XCHR[103]:='g';XCHR[104]:='h';XCHR[105]:='i';XCHR[106]:='j';
+XCHR[107]:='k';XCHR[108]:='l';XCHR[109]:='m';XCHR[110]:='n';
+XCHR[111]:='o';XCHR[112]:='p';XCHR[113]:='q';XCHR[114]:='r';
+XCHR[115]:='s';XCHR[116]:='t';XCHR[117]:='u';XCHR[118]:='v';
+XCHR[119]:='w';XCHR[120]:='x';XCHR[121]:='y';XCHR[122]:='z';
+XCHR[123]:='{';XCHR[124]:='|';XCHR[125]:='}';XCHR[126]:='~';
+XCHR[0]:=' ';XCHR[127]:=' ';{:14}{17:}FOR I:=1 TO 31 DO XCHR[I]:=' ';
+{:17}{18:}FOR I:=0 TO 255 DO XORD[CHR(I)]:=32;
+FOR I:=1 TO 126 DO XORD[XCHR[I]]:=I;{:18}{21:}REWRITE(TTYOUT);{:21}{26:}
+REWRITE(PASCALFILE);REWRITE(POOL);{:26}{42:}
+FOR WI:=0 TO 1 DO BEGIN BYTESTART[WI]:=0;BYTEPTR[WI]:=0;END;
+BYTESTART[2]:=0;NAMEPTR:=1;STRINGPTR:=128;POOLCHECKSUM:=271828;{:42}
+{46:}FOR ZI:=0 TO 2 DO BEGIN TOKSTART[ZI]:=0;TOKPTR[ZI]:=0;END;
+TOKSTART[3]:=0;TEXTPTR:=1;Z:=1 MOD 3;{:46}{48:}ILK[0]:=0;EQUIV[0]:=0;
+{:48}{52:}FOR H:=0 TO HASHSIZE-1 DO BEGIN HASH[H]:=0;CHOPHASH[H]:=0;END;
+{:52}{71:}LASTUNNAMED:=0;TEXTLINK[0]:=0;{:71}{144:}SCANNINGHEX:=FALSE;
+{:144}{152:}MODTEXT[0]:=32;{:152}{180:}{TROUBLESHOOT:=TRUE;
+DEBUGCYCLE:=1;DEBUGSKIPPED:=0;TROUBLESHOOT:=FALSE;DEBUGCYCLE:=99999;
+termin(TTYIN);}{:180}END;{:2}{24:}PROCEDURE OPENINPUT;
+BEGIN RESET(WEBFILE);RESET(CHANGEFILE);END;{:24}{28:}
+FUNCTION INPUTLN(VAR F:TEXTFILE):BOOLEAN;VAR I:0..BUFSIZE;
+TEMPBUF:STRING(BUFSIZE);BEGIN LIMIT:=0;
+IF EOF(F)THEN INPUTLN:=FALSE ELSE BEGIN READ(F,TEMPBUF);
+LIMIT:=length(TRIM(TEMPBUF));
+IF NOT EOLN(F)THEN BEGIN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Input line too long');END;LOC:=0;ERROR;
+END ELSE READLN(F);
+IF LIMIT>0 THEN FOR I:=0 TO LIMIT-1 DO BUFFER[I]:=XORD[TEMPBUF[I+1]];
+INPUTLN:=TRUE;END;END;{:28}{49:}PROCEDURE PRINTID(P:NAMEPOINTER);
+VAR K:0..MAXBYTES;W:0..1;
+BEGIN IF P>=NAMEPTR THEN WRITE(TTYOUT,'IMPOSSIBLE')ELSE BEGIN W:=P MOD 2
+;
+FOR K:=BYTESTART[P]TO BYTESTART[P+2]-1 DO WRITE(TTYOUT,XCHR[BYTEMEM[W,K]
+]);END;END;{:49}{53:}FUNCTION IDLOOKUP(T:EIGHTBITS):NAMEPOINTER;
+LABEL 31,32;VAR C:EIGHTBITS;I:0..BUFSIZE;H:0..HASHSIZE;K:0..MAXBYTES;
+W:0..1;L:0..BUFSIZE;P,Q:NAMEPOINTER;S:0..UNAMBIGLENGT;
+BEGIN L:=IDLOC-IDFIRST;{54:}H:=BUFFER[IDFIRST];I:=IDFIRST+1;
+WHILE I<IDLOC DO BEGIN H:=(H+H+BUFFER[I])MOD HASHSIZE;I:=I+1;END{:54};
+{55:}P:=HASH[H];
+WHILE P<>0 DO BEGIN IF BYTESTART[P+2]-BYTESTART[P]=L THEN{56:}
+BEGIN I:=IDFIRST;K:=BYTESTART[P];W:=P MOD 2;
+WHILE(I<IDLOC)AND(BUFFER[I]=BYTEMEM[W,K])DO BEGIN I:=I+1;K:=K+1;END;
+IF I=IDLOC THEN GOTO 31;END{:56};P:=LINK[P];END;P:=NAMEPTR;
+LINK[P]:=HASH[H];HASH[H]:=P;31:{:55};IF(P=NAMEPTR)OR(T<>0)THEN{57:}
+BEGIN IF((P<>NAMEPTR)AND(T<>0)AND(ILK[P]=0))OR((P=NAMEPTR)AND(T=0)AND(
+BUFFER[IDFIRST]<>34))THEN{58:}BEGIN I:=IDFIRST;S:=0;H:=0;
+WHILE(I<IDLOC)AND(S<UNAMBIGLENGT)DO BEGIN IF BUFFER[I]<>95 THEN BEGIN IF
+BUFFER[I]>=97 THEN CHOPPEDID[S]:=BUFFER[I]-32 ELSE CHOPPEDID[S]:=BUFFER[
+I];H:=(H+H+CHOPPEDID[S])MOD HASHSIZE;S:=S+1;END;I:=I+1;END;
+CHOPPEDID[S]:=0;END{:58};IF P<>NAMEPTR THEN{59:}
+BEGIN IF ILK[P]=0 THEN BEGIN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! This identifier has already appeared');ERROR;END;{60:}
+Q:=CHOPHASH[H];
+IF Q=P THEN CHOPHASH[H]:=EQUIV[P]ELSE BEGIN WHILE EQUIV[Q]<>P DO Q:=
+EQUIV[Q];EQUIV[Q]:=EQUIV[P];END{:60};END ELSE BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! This identifier was defined before');ERROR;END;
+ILK[P]:=T;END{:59}ELSE{61:}
+BEGIN IF(T=0)AND(BUFFER[IDFIRST]<>34)THEN{62:}BEGIN Q:=CHOPHASH[H];
+WHILE Q<>0 DO BEGIN{63:}BEGIN K:=BYTESTART[Q];S:=0;W:=Q MOD 2;
+WHILE(K<BYTESTART[Q+2])AND(S<UNAMBIGLENGT)DO BEGIN C:=BYTEMEM[W,K];
+IF C<>95 THEN BEGIN IF C>=97 THEN C:=C-32;
+IF CHOPPEDID[S]<>C THEN GOTO 32;S:=S+1;END;K:=K+1;END;
+IF(K=BYTESTART[Q+2])AND(CHOPPEDID[S]<>0)THEN GOTO 32;
+BEGIN WRITELN(TTYOUT);WRITE(TTYOUT,'! Identifier conflict with ');END;
+FOR K:=BYTESTART[Q]TO BYTESTART[Q+2]-1 DO WRITE(TTYOUT,XCHR[BYTEMEM[W,K]
+]);ERROR;Q:=0;32:END{:63};Q:=EQUIV[Q];END;EQUIV[P]:=CHOPHASH[H];
+CHOPHASH[H]:=P;END{:62};W:=NAMEPTR MOD 2;K:=BYTEPTR[W];
+IF K+L>MAXBYTES THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Sorry, ','byte memory',' capacity exceeded');ERROR;
+HISTORY:=3;JUMPOUT;END;IF NAMEPTR>MAXNAMES-2 THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Sorry, ','name',' capacity exceeded');ERROR;HISTORY:=3;
+JUMPOUT;END;I:=IDFIRST;WHILE I<IDLOC DO BEGIN BYTEMEM[W,K]:=BUFFER[I];
+K:=K+1;I:=I+1;END;BYTEPTR[W]:=K;BYTESTART[NAMEPTR+2]:=K;
+NAMEPTR:=NAMEPTR+1;IF BUFFER[IDFIRST]<>34 THEN ILK[P]:=T ELSE{64:}
+BEGIN ILK[P]:=1;
+IF L-DOUBLECHARS=2 THEN EQUIV[P]:=BUFFER[IDFIRST+1]+32768 ELSE BEGIN
+EQUIV[P]:=STRINGPTR+32768;L:=L-DOUBLECHARS-1;
+IF L>99 THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Preprocessed string is too long');ERROR;END;
+STRINGPTR:=STRINGPTR+1;WRITE(POOL,XCHR[48+L DIV 10],XCHR[48+L MOD 10]);
+POOLCHECKSUM:=POOLCHECKSUM+POOLCHECKSUM+L;
+WHILE POOLCHECKSUM>536870841 DO POOLCHECKSUM:=POOLCHECKSUM-536870841;
+I:=IDFIRST+1;WHILE I<IDLOC DO BEGIN WRITE(POOL,XCHR[BUFFER[I]]);
+POOLCHECKSUM:=POOLCHECKSUM+POOLCHECKSUM+BUFFER[I];
+WHILE POOLCHECKSUM>536870841 DO POOLCHECKSUM:=POOLCHECKSUM-536870841;
+IF(BUFFER[I]=34)OR(BUFFER[I]=64)THEN I:=I+2 ELSE I:=I+1;END;
+WRITELN(POOL);END;END{:64};END{:61};END{:57};IDLOOKUP:=P;END;{:53}{66:}
+FUNCTION MODLOOKUP(L:SIXTEENBITS):NAMEPOINTER;LABEL 31;VAR C:0..4;
+J:0..LONGESTNAME;K:0..MAXBYTES;W:0..1;P:NAMEPOINTER;Q:NAMEPOINTER;
+BEGIN C:=2;Q:=0;P:=ILK[0];WHILE P<>0 DO BEGIN{68:}BEGIN K:=BYTESTART[P];
+W:=P MOD 2;C:=1;J:=1;
+WHILE(K<BYTESTART[P+2])AND(J<=L)AND(MODTEXT[J]=BYTEMEM[W,K])DO BEGIN K:=
+K+1;J:=J+1;END;
+IF K=BYTESTART[P+2]THEN IF J>L THEN C:=1 ELSE C:=4 ELSE IF J>L THEN C:=3
+ELSE IF MODTEXT[J]<BYTEMEM[W,K]THEN C:=0 ELSE C:=2;END{:68};Q:=P;
+IF C=0 THEN P:=LINK[Q]ELSE IF C=2 THEN P:=ILK[Q]ELSE GOTO 31;END;{67:}
+W:=NAMEPTR MOD 2;K:=BYTEPTR[W];
+IF K+L>MAXBYTES THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Sorry, ','byte memory',' capacity exceeded');ERROR;
+HISTORY:=3;JUMPOUT;END;IF NAMEPTR>MAXNAMES-2 THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Sorry, ','name',' capacity exceeded');ERROR;HISTORY:=3;
+JUMPOUT;END;P:=NAMEPTR;IF C=0 THEN LINK[Q]:=P ELSE ILK[Q]:=P;LINK[P]:=0;
+ILK[P]:=0;C:=1;EQUIV[P]:=0;
+FOR J:=1 TO L DO BYTEMEM[W,K+J-1]:=MODTEXT[J];BYTEPTR[W]:=K+L;
+BYTESTART[NAMEPTR+2]:=K+L;NAMEPTR:=NAMEPTR+1;{:67};
+31:IF C<>1 THEN BEGIN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Incompatible section names');ERROR;END;P:=0;END;
+MODLOOKUP:=P;END;{:66}{69:}
+FUNCTION PREFIXLOOKUP(L:SIXTEENBITS):NAMEPOINTER;VAR C:0..4;
+COUNT:0..MAXNAMES;J:0..LONGESTNAME;K:0..MAXBYTES;W:0..1;P:NAMEPOINTER;
+Q:NAMEPOINTER;R:NAMEPOINTER;BEGIN Q:=0;P:=ILK[0];COUNT:=0;R:=0;
+WHILE P<>0 DO BEGIN{68:}BEGIN K:=BYTESTART[P];W:=P MOD 2;C:=1;J:=1;
+WHILE(K<BYTESTART[P+2])AND(J<=L)AND(MODTEXT[J]=BYTEMEM[W,K])DO BEGIN K:=
+K+1;J:=J+1;END;
+IF K=BYTESTART[P+2]THEN IF J>L THEN C:=1 ELSE C:=4 ELSE IF J>L THEN C:=3
+ELSE IF MODTEXT[J]<BYTEMEM[W,K]THEN C:=0 ELSE C:=2;END{:68};
+IF C=0 THEN P:=LINK[P]ELSE IF C=2 THEN P:=ILK[P]ELSE BEGIN R:=P;
+COUNT:=COUNT+1;Q:=ILK[P];P:=LINK[P];END;IF P=0 THEN BEGIN P:=Q;Q:=0;END;
+END;IF COUNT<>1 THEN IF COUNT=0 THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Name does not match');ERROR;
+END ELSE BEGIN WRITELN(TTYOUT);WRITE(TTYOUT,'! Ambiguous prefix');ERROR;
+END;PREFIXLOOKUP:=R;END;{:69}{73:}PROCEDURE STORETWOBYTE(X:SIXTEENBITS);
+BEGIN IF TOKPTR[Z]+2>MAXTOKS THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Sorry, ','token',' capacity exceeded');ERROR;HISTORY:=3;
+JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=X DIV 256;
+TOKMEM[Z,TOKPTR[Z]+1]:=X MOD 256;TOKPTR[Z]:=TOKPTR[Z]+2;END;{:73}{74:}
+{PROCEDURE PRINTREPL(P:TEXTPOINTER);VAR K:0..MAXTOKS;A:SIXTEENBITS;
+ZP:0..2;
+BEGIN IF P>=TEXTPTR THEN WRITE(TTYOUT,'BAD')ELSE BEGIN K:=TOKSTART[P];
+ZP:=P MOD 3;WHILE K<TOKSTART[P+3]DO BEGIN A:=TOKMEM[ZP,K];
+IF A>=128 THEN[75:]BEGIN K:=K+1;
+IF A<168 THEN BEGIN A:=(A-128)*256+TOKMEM[ZP,K];PRINTID(A);
+IF BYTEMEM[A MOD 2,BYTESTART[A]]=34 THEN WRITE(TTYOUT,'"')ELSE WRITE(
+TTYOUT,' ');END ELSE IF A<208 THEN BEGIN WRITE(TTYOUT,'@<');
+PRINTID((A-168)*256+TOKMEM[ZP,K]);WRITE(TTYOUT,'@>');
+END ELSE BEGIN A:=(A-208)*256+TOKMEM[ZP,K];
+WRITE(TTYOUT,'@',XCHR[123],A:1,'@',XCHR[125]);END;
+END[:75]ELSE[76:]CASE A OF 9:WRITE(TTYOUT,'@',XCHR[123]);
+10:WRITE(TTYOUT,'@',XCHR[125]);12:WRITE(TTYOUT,'@''');
+13:WRITE(TTYOUT,'@"');125:WRITE(TTYOUT,'@$');0:WRITE(TTYOUT,'#');
+64:WRITE(TTYOUT,'@@');2:WRITE(TTYOUT,'@=');3:WRITE(TTYOUT,'@\');
+OTHERWISE WRITE(TTYOUT,XCHR[A])END[:76];K:=K+1;END;END;END;}{:74}{84:}
+PROCEDURE PUSHLEVEL(P:NAMEPOINTER);
+BEGIN IF STACKPTR=STACKSIZE THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Sorry, ','stack',' capacity exceeded');ERROR;HISTORY:=3;
+JUMPOUT;END ELSE BEGIN STACK[STACKPTR]:=CURSTATE;STACKPTR:=STACKPTR+1;
+CURSTATE.NAMEFIELD:=P;CURSTATE.REPLFIELD:=EQUIV[P];
+ZO:=CURSTATE.REPLFIELD MOD 3;
+CURSTATE.BYTEFIELD:=TOKSTART[CURSTATE.REPLFIELD];
+CURSTATE.ENDFIELD:=TOKSTART[CURSTATE.REPLFIELD+3];CURSTATE.MODFIELD:=0;
+END;END;{:84}{85:}PROCEDURE POPLEVEL;LABEL 10;
+BEGIN IF TEXTLINK[CURSTATE.REPLFIELD]=0 THEN BEGIN IF ILK[CURSTATE.
+NAMEFIELD]=3 THEN{91:}BEGIN NAMEPTR:=NAMEPTR-1;TEXTPTR:=TEXTPTR-1;
+Z:=TEXTPTR MOD 3;IF TOKPTR[Z]>MAXTOKPTR[Z]THEN MAXTOKPTR[Z]:=TOKPTR[Z];
+TOKPTR[Z]:=TOKSTART[TEXTPTR];
+{BYTEPTR[NAMEPTR MOD 2]:=BYTEPTR[NAMEPTR MOD 2]-1;}END{:91};
+END ELSE IF TEXTLINK[CURSTATE.REPLFIELD]<MAXTEXTS THEN BEGIN CURSTATE.
+REPLFIELD:=TEXTLINK[CURSTATE.REPLFIELD];ZO:=CURSTATE.REPLFIELD MOD 3;
+CURSTATE.BYTEFIELD:=TOKSTART[CURSTATE.REPLFIELD];
+CURSTATE.ENDFIELD:=TOKSTART[CURSTATE.REPLFIELD+3];GOTO 10;END;
+STACKPTR:=STACKPTR-1;IF STACKPTR>0 THEN BEGIN CURSTATE:=STACK[STACKPTR];
+ZO:=CURSTATE.REPLFIELD MOD 3;END;10:END;{:85}{87:}
+FUNCTION GETOUTPUT:SIXTEENBITS;LABEL 20,30,31;VAR A:SIXTEENBITS;
+B:EIGHTBITS;BAL:SIXTEENBITS;K:0..MAXBYTES;W:0..1;
+BEGIN 20:IF STACKPTR=0 THEN BEGIN A:=0;GOTO 31;END;
+IF CURSTATE.BYTEFIELD=CURSTATE.ENDFIELD THEN BEGIN CURVAL:=-CURSTATE.
+MODFIELD;POPLEVEL;IF CURVAL=0 THEN GOTO 20;A:=129;GOTO 31;END;
+A:=TOKMEM[ZO,CURSTATE.BYTEFIELD];
+CURSTATE.BYTEFIELD:=CURSTATE.BYTEFIELD+1;IF A<128 THEN IF A=0 THEN{92:}
+BEGIN PUSHLEVEL(NAMEPTR-1);GOTO 20;END{:92}ELSE GOTO 31;
+A:=(A-128)*256+TOKMEM[ZO,CURSTATE.BYTEFIELD];
+CURSTATE.BYTEFIELD:=CURSTATE.BYTEFIELD+1;IF A<10240 THEN{89:}
+BEGIN CASE ILK[A]OF 0:BEGIN CURVAL:=A;A:=130;END;
+1:BEGIN CURVAL:=EQUIV[A]-32768;A:=128;END;2:BEGIN PUSHLEVEL(A);GOTO 20;
+END;3:BEGIN{90:}
+WHILE(CURSTATE.BYTEFIELD=CURSTATE.ENDFIELD)AND(STACKPTR>0)DO POPLEVEL;
+IF(STACKPTR=0)OR(TOKMEM[ZO,CURSTATE.BYTEFIELD]<>40)THEN BEGIN BEGIN
+WRITELN(TTYOUT);WRITE(TTYOUT,'! No parameter given for ');END;
+PRINTID(A);ERROR;GOTO 20;END;{93:}BAL:=1;
+CURSTATE.BYTEFIELD:=CURSTATE.BYTEFIELD+1;
+WHILE TRUE DO BEGIN B:=TOKMEM[ZO,CURSTATE.BYTEFIELD];
+CURSTATE.BYTEFIELD:=CURSTATE.BYTEFIELD+1;
+IF B=0 THEN STORETWOBYTE(NAMEPTR+32767)ELSE BEGIN IF B>=128 THEN BEGIN
+BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Sorry, ','token',' capacity exceeded');ERROR;HISTORY:=3;
+JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=B;TOKPTR[Z]:=TOKPTR[Z]+1;END;
+B:=TOKMEM[ZO,CURSTATE.BYTEFIELD];
+CURSTATE.BYTEFIELD:=CURSTATE.BYTEFIELD+1;
+END ELSE CASE B OF 40:BAL:=BAL+1;41:BEGIN BAL:=BAL-1;
+IF BAL=0 THEN GOTO 30;END;
+39:REPEAT BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Sorry, ','token',' capacity exceeded');ERROR;HISTORY:=3;
+JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=B;TOKPTR[Z]:=TOKPTR[Z]+1;END;
+B:=TOKMEM[ZO,CURSTATE.BYTEFIELD];
+CURSTATE.BYTEFIELD:=CURSTATE.BYTEFIELD+1;UNTIL B=39;OTHERWISE END;
+BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Sorry, ','token',' capacity exceeded');ERROR;HISTORY:=3;
+JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=B;TOKPTR[Z]:=TOKPTR[Z]+1;END;END;END;
+30:{:93};EQUIV[NAMEPTR]:=TEXTPTR;ILK[NAMEPTR]:=2;W:=NAMEPTR MOD 2;
+K:=BYTEPTR[W];{IF K=MAXBYTES THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Sorry, ','byte memory',' capacity exceeded');ERROR;
+HISTORY:=3;JUMPOUT;END;BYTEMEM[W,K]:=35;K:=K+1;BYTEPTR[W]:=K;}
+IF NAMEPTR>MAXNAMES-2 THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Sorry, ','name',' capacity exceeded');ERROR;HISTORY:=3;
+JUMPOUT;END;BYTESTART[NAMEPTR+2]:=K;NAMEPTR:=NAMEPTR+1;
+IF TEXTPTR>MAXTEXTS-3 THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Sorry, ','text',' capacity exceeded');ERROR;HISTORY:=3;
+JUMPOUT;END;TEXTLINK[TEXTPTR]:=0;TOKSTART[TEXTPTR+3]:=TOKPTR[Z];
+TEXTPTR:=TEXTPTR+1;Z:=TEXTPTR MOD 3{:90};PUSHLEVEL(A);GOTO 20;END;
+OTHERWISE BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! This can''t happen (','output',')');ERROR;HISTORY:=3;
+JUMPOUT;END END;GOTO 31;END{:89};IF A<20480 THEN{88:}BEGIN A:=A-10240;
+IF EQUIV[A]<>0 THEN PUSHLEVEL(A)ELSE IF A<>0 THEN BEGIN BEGIN WRITELN(
+TTYOUT);WRITE(TTYOUT,'! Not present: <');END;PRINTID(A);
+WRITE(TTYOUT,'>');ERROR;END;GOTO 20;END{:88};CURVAL:=A-20480;A:=129;
+CURSTATE.MODFIELD:=CURVAL;31:{IF TROUBLESHOOT THEN DEBUGHELP;}
+GETOUTPUT:=A;END;{:87}{97:}PROCEDURE FLUSHBUFFER;VAR K:0..OUTBUFSIZE;
+B:0..OUTBUFSIZE;BEGIN B:=BREAKPTR;
+IF(SEMIPTR<>0)AND(OUTPTR-SEMIPTR<=LINELENGTH)THEN BREAKPTR:=SEMIPTR;
+FOR K:=1 TO BREAKPTR DO WRITE(PASCALFILE,XCHR[OUTBUF[K-1]]);
+WRITELN(PASCALFILE);LINE:=LINE+1;
+IF LINE MOD 100=0 THEN BEGIN WRITE(TTYOUT,'.');
+IF LINE MOD 500=0 THEN WRITE(TTYOUT,LINE:1);;END;
+IF BREAKPTR<OUTPTR THEN BEGIN IF OUTBUF[BREAKPTR]=32 THEN BEGIN BREAKPTR
+:=BREAKPTR+1;IF BREAKPTR>B THEN B:=BREAKPTR;END;
+FOR K:=BREAKPTR TO OUTPTR-1 DO OUTBUF[K-BREAKPTR]:=OUTBUF[K];END;
+OUTPTR:=OUTPTR-BREAKPTR;BREAKPTR:=B-BREAKPTR;SEMIPTR:=0;
+IF OUTPTR>LINELENGTH THEN BEGIN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Long line must be truncated');ERROR;END;
+OUTPTR:=LINELENGTH;END;END;{:97}{99:}PROCEDURE APPVAL(V:INTEGER);
+VAR K:0..OUTBUFSIZE;BEGIN K:=OUTBUFSIZE;REPEAT OUTBUF[K]:=V MOD 10;
+V:=V DIV 10;K:=K-1;UNTIL V=0;REPEAT K:=K+1;
+BEGIN OUTBUF[OUTPTR]:=OUTBUF[K]+48;OUTPTR:=OUTPTR+1;END;
+UNTIL K=OUTBUFSIZE;END;{:99}{101:}PROCEDURE SENDOUT(T:EIGHTBITS;
+V:SIXTEENBITS);LABEL 20;VAR K:0..LINELENGTH;BEGIN{102:}
+20:CASE OUTSTATE OF 1:IF T<>3 THEN BEGIN BREAKPTR:=OUTPTR;
+IF T=2 THEN BEGIN OUTBUF[OUTPTR]:=32;OUTPTR:=OUTPTR+1;END;END;
+2:BEGIN BEGIN OUTBUF[OUTPTR]:=44-OUTAPP;OUTPTR:=OUTPTR+1;END;
+IF OUTPTR>LINELENGTH THEN FLUSHBUFFER;BREAKPTR:=OUTPTR;END;
+3,4:BEGIN{103:}
+IF(OUTVAL<0)OR((OUTVAL=0)AND(LASTSIGN<0))THEN BEGIN OUTBUF[OUTPTR]:=45;
+OUTPTR:=OUTPTR+1;
+END ELSE IF OUTSIGN>0 THEN BEGIN OUTBUF[OUTPTR]:=OUTSIGN;
+OUTPTR:=OUTPTR+1;END;APPVAL(ABS(OUTVAL));
+IF OUTPTR>LINELENGTH THEN FLUSHBUFFER;{:103};OUTSTATE:=OUTSTATE-2;
+GOTO 20;END;5:{104:}BEGIN IF(T=3)OR({105:}
+((T=2)AND(V=3)AND(((OUTCONTRIB[1]=68)AND(OUTCONTRIB[2]=73)AND(OUTCONTRIB
+[3]=86))OR((OUTCONTRIB[1]=77)AND(OUTCONTRIB[2]=79)AND(OUTCONTRIB[3]=68))
+))OR((T=0)AND((V=42)OR(V=47))){:105})THEN BEGIN{103:}
+IF(OUTVAL<0)OR((OUTVAL=0)AND(LASTSIGN<0))THEN BEGIN OUTBUF[OUTPTR]:=45;
+OUTPTR:=OUTPTR+1;
+END ELSE IF OUTSIGN>0 THEN BEGIN OUTBUF[OUTPTR]:=OUTSIGN;
+OUTPTR:=OUTPTR+1;END;APPVAL(ABS(OUTVAL));
+IF OUTPTR>LINELENGTH THEN FLUSHBUFFER;{:103};OUTSIGN:=43;OUTVAL:=OUTAPP;
+END ELSE OUTVAL:=OUTVAL+OUTAPP;OUTSTATE:=3;GOTO 20;END{:104};
+0:IF T<>3 THEN BREAKPTR:=OUTPTR;OTHERWISE END{:102};
+IF T<>0 THEN FOR K:=1 TO V DO BEGIN OUTBUF[OUTPTR]:=OUTCONTRIB[K];
+OUTPTR:=OUTPTR+1;END ELSE BEGIN OUTBUF[OUTPTR]:=V;OUTPTR:=OUTPTR+1;END;
+IF OUTPTR>LINELENGTH THEN FLUSHBUFFER;
+IF(T=0)AND((V=59)OR(V=125))THEN BEGIN SEMIPTR:=OUTPTR;BREAKPTR:=OUTPTR;
+END;IF T>=2 THEN OUTSTATE:=1 ELSE OUTSTATE:=0 END;{:101}{106:}
+PROCEDURE SENDSIGN(V:INTEGER);
+BEGIN CASE OUTSTATE OF 2,4:OUTAPP:=OUTAPP*V;3:BEGIN OUTAPP:=V;
+OUTSTATE:=4;END;5:BEGIN OUTVAL:=OUTVAL+OUTAPP;OUTAPP:=V;OUTSTATE:=4;END;
+OTHERWISE BEGIN BREAKPTR:=OUTPTR;OUTAPP:=V;OUTSTATE:=2;END END;
+LASTSIGN:=OUTAPP;END;{:106}{107:}PROCEDURE SENDVAL(V:INTEGER);
+LABEL 666,10;BEGIN CASE OUTSTATE OF 1:BEGIN{110:}
+IF(OUTPTR=BREAKPTR+3)OR((OUTPTR=BREAKPTR+4)AND(OUTBUF[BREAKPTR]=32))THEN
+IF((OUTBUF[OUTPTR-3]=68)AND(OUTBUF[OUTPTR-2]=73)AND(OUTBUF[OUTPTR-1]=86)
+)OR((OUTBUF[OUTPTR-3]=77)AND(OUTBUF[OUTPTR-2]=79)AND(OUTBUF[OUTPTR-1]=68
+))THEN GOTO 666{:110};OUTSIGN:=32;OUTSTATE:=3;OUTVAL:=V;
+BREAKPTR:=OUTPTR;LASTSIGN:=+1;END;0:BEGIN{109:}
+IF(OUTPTR=BREAKPTR+1)AND((OUTBUF[BREAKPTR]=42)OR(OUTBUF[BREAKPTR]=47))
+THEN GOTO 666{:109};OUTSIGN:=0;OUTSTATE:=3;OUTVAL:=V;BREAKPTR:=OUTPTR;
+LASTSIGN:=+1;END;{108:}2:BEGIN OUTSIGN:=43;OUTSTATE:=3;OUTVAL:=OUTAPP*V;
+END;3:BEGIN OUTSTATE:=5;OUTAPP:=V;BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Two numbers occurred without a sign between them');
+ERROR;END;END;4:BEGIN OUTSTATE:=5;OUTAPP:=OUTAPP*V;END;
+5:BEGIN OUTVAL:=OUTVAL+OUTAPP;OUTAPP:=V;BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Two numbers occurred without a sign between them');
+ERROR;END;END;{:108}OTHERWISE GOTO 666 END;GOTO 10;666:{111:}
+IF V>=0 THEN BEGIN IF OUTSTATE=1 THEN BEGIN BREAKPTR:=OUTPTR;
+BEGIN OUTBUF[OUTPTR]:=32;OUTPTR:=OUTPTR+1;END;END;APPVAL(V);
+IF OUTPTR>LINELENGTH THEN FLUSHBUFFER;OUTSTATE:=1;
+END ELSE BEGIN BEGIN OUTBUF[OUTPTR]:=40;OUTPTR:=OUTPTR+1;END;
+BEGIN OUTBUF[OUTPTR]:=45;OUTPTR:=OUTPTR+1;END;APPVAL(-V);
+BEGIN OUTBUF[OUTPTR]:=41;OUTPTR:=OUTPTR+1;END;
+IF OUTPTR>LINELENGTH THEN FLUSHBUFFER;OUTSTATE:=0;END{:111};10:END;
+{:107}{113:}PROCEDURE SENDTHEOUTPU;LABEL 2,21,22;VAR CURCHAR:EIGHTBITS;
+K:0..LINELENGTH;J:0..MAXBYTES;W:0..1;N:INTEGER;
+BEGIN WHILE STACKPTR>0 DO BEGIN CURCHAR:=GETOUTPUT;
+21:CASE CURCHAR OF 0:;{116:}
+65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,
+89,90:BEGIN OUTCONTRIB[1]:=CURCHAR;SENDOUT(2,1);END;
+97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115
+,116,117,118,119,120,121,122:BEGIN OUTCONTRIB[1]:=CURCHAR-32;
+SENDOUT(2,1);END;130:BEGIN K:=0;J:=BYTESTART[CURVAL];W:=CURVAL MOD 2;
+WHILE(K<MAXIDLENGTH)AND(J<BYTESTART[CURVAL+2])DO BEGIN K:=K+1;
+OUTCONTRIB[K]:=BYTEMEM[W,J];J:=J+1;
+IF OUTCONTRIB[K]>=97 THEN OUTCONTRIB[K]:=OUTCONTRIB[K]-32 ELSE IF
+OUTCONTRIB[K]=95 THEN K:=K-1;END;SENDOUT(2,K);END;{:116}{119:}
+48,49,50,51,52,53,54,55,56,57:BEGIN N:=0;REPEAT CURCHAR:=CURCHAR-48;
+IF N>=214748364 THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Constant too big');ERROR;END ELSE N:=10*N+CURCHAR;
+CURCHAR:=GETOUTPUT;UNTIL(CURCHAR>57)OR(CURCHAR<48);SENDVAL(N);K:=0;
+IF CURCHAR=101 THEN CURCHAR:=69;IF CURCHAR=69 THEN GOTO 2 ELSE GOTO 21;
+END;125:SENDVAL(POOLCHECKSUM);12:BEGIN N:=0;CURCHAR:=48;
+REPEAT CURCHAR:=CURCHAR-48;IF N>=268435456 THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Constant too big');ERROR;END ELSE N:=8*N+CURCHAR;
+CURCHAR:=GETOUTPUT;UNTIL(CURCHAR>55)OR(CURCHAR<48);SENDVAL(N);GOTO 21;
+END;13:BEGIN N:=0;CURCHAR:=48;
+REPEAT IF CURCHAR>=65 THEN CURCHAR:=CURCHAR-55 ELSE CURCHAR:=CURCHAR-48;
+IF N>=134217728 THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Constant too big');ERROR;END ELSE N:=16*N+CURCHAR;
+CURCHAR:=GETOUTPUT;
+UNTIL(CURCHAR>70)OR(CURCHAR<48)OR((CURCHAR>57)AND(CURCHAR<65));
+SENDVAL(N);GOTO 21;END;128:SENDVAL(CURVAL);46:BEGIN K:=1;
+OUTCONTRIB[1]:=46;CURCHAR:=GETOUTPUT;
+IF CURCHAR=46 THEN BEGIN OUTCONTRIB[2]:=46;SENDOUT(1,2);
+END ELSE IF(CURCHAR>=48)AND(CURCHAR<=57)THEN GOTO 2 ELSE BEGIN SENDOUT(0
+,46);GOTO 21;END;END;{:119}43,45:SENDSIGN(44-CURCHAR);{114:}
+4:BEGIN OUTCONTRIB[1]:=65;OUTCONTRIB[2]:=78;OUTCONTRIB[3]:=68;
+SENDOUT(2,3);END;5:BEGIN OUTCONTRIB[1]:=78;OUTCONTRIB[2]:=79;
+OUTCONTRIB[3]:=84;SENDOUT(2,3);END;6:BEGIN OUTCONTRIB[1]:=73;
+OUTCONTRIB[2]:=78;SENDOUT(2,2);END;31:BEGIN OUTCONTRIB[1]:=79;
+OUTCONTRIB[2]:=82;SENDOUT(2,2);END;24:BEGIN OUTCONTRIB[1]:=58;
+OUTCONTRIB[2]:=61;SENDOUT(1,2);END;26:BEGIN OUTCONTRIB[1]:=60;
+OUTCONTRIB[2]:=62;SENDOUT(1,2);END;28:BEGIN OUTCONTRIB[1]:=60;
+OUTCONTRIB[2]:=61;SENDOUT(1,2);END;29:BEGIN OUTCONTRIB[1]:=62;
+OUTCONTRIB[2]:=61;SENDOUT(1,2);END;30:BEGIN OUTCONTRIB[1]:=61;
+OUTCONTRIB[2]:=61;SENDOUT(1,2);END;32:BEGIN OUTCONTRIB[1]:=46;
+OUTCONTRIB[2]:=46;SENDOUT(1,2);END;94:BEGIN OUTCONTRIB[1]:=64;
+SENDOUT(1,1);END;91:BEGIN OUTCONTRIB[1]:=40;OUTCONTRIB[2]:=46;
+SENDOUT(1,2);END;93:BEGIN OUTCONTRIB[1]:=46;OUTCONTRIB[2]:=41;
+SENDOUT(1,2);END;{:114}39:{117:}BEGIN K:=1;OUTCONTRIB[1]:=39;
+REPEAT IF K<LINELENGTH THEN K:=K+1;OUTCONTRIB[K]:=GETOUTPUT;
+UNTIL(OUTCONTRIB[K]=39)OR(STACKPTR=0);
+IF K=LINELENGTH THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! String too long');ERROR;END;SENDOUT(1,K);
+CURCHAR:=GETOUTPUT;IF CURCHAR=39 THEN OUTSTATE:=6;GOTO 21;END{:117};
+{115:}
+33,34,35,36,37,38,40,41,42,44,47,58,59,60,61,62,63,64,92,95,96,123,124{:
+115}:SENDOUT(0,CURCHAR);{121:}
+9:BEGIN IF BRACELEVEL=0 THEN SENDOUT(0,123)ELSE SENDOUT(0,91);
+BRACELEVEL:=BRACELEVEL+1;END;
+10:IF BRACELEVEL>0 THEN BEGIN BRACELEVEL:=BRACELEVEL-1;
+IF BRACELEVEL=0 THEN SENDOUT(0,125)ELSE SENDOUT(0,93);
+END ELSE BEGIN WRITELN(TTYOUT);WRITE(TTYOUT,'! Extra @}');ERROR;END;
+129:BEGIN IF BRACELEVEL=0 THEN SENDOUT(0,123)ELSE SENDOUT(0,91);
+IF CURVAL<0 THEN BEGIN SENDOUT(0,58);SENDVAL(-CURVAL);
+END ELSE BEGIN SENDVAL(CURVAL);SENDOUT(0,58);END;
+IF BRACELEVEL=0 THEN SENDOUT(0,125)ELSE SENDOUT(0,93);END;{:121}
+127:BEGIN SENDOUT(3,0);OUTSTATE:=6;END;2:{118:}BEGIN K:=0;
+REPEAT IF K<LINELENGTH THEN K:=K+1;OUTCONTRIB[K]:=GETOUTPUT;
+UNTIL(OUTCONTRIB[K]=2)OR(STACKPTR=0);
+IF K=LINELENGTH THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Verbatim string too long');ERROR;END;SENDOUT(1,K-1);
+END{:118};3:{122:}BEGIN SENDOUT(1,0);
+WHILE OUTPTR>0 DO BEGIN IF OUTPTR<=LINELENGTH THEN BREAKPTR:=OUTPTR;
+FLUSHBUFFER;END;OUTSTATE:=0;END{:122};OTHERWISE BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Can''t output ASCII code ',CURCHAR:1);ERROR;END END;
+GOTO 22;2:{120:}REPEAT IF K<LINELENGTH THEN K:=K+1;
+OUTCONTRIB[K]:=CURCHAR;CURCHAR:=GETOUTPUT;
+IF(OUTCONTRIB[K]=69)AND((CURCHAR=43)OR(CURCHAR=45))THEN BEGIN IF K<
+LINELENGTH THEN K:=K+1;OUTCONTRIB[K]:=CURCHAR;CURCHAR:=GETOUTPUT;
+END ELSE IF CURCHAR=101 THEN CURCHAR:=69;
+UNTIL(CURCHAR<>69)AND((CURCHAR<48)OR(CURCHAR>57));
+IF K=LINELENGTH THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Fraction too long');ERROR;END;SENDOUT(3,K);GOTO 21{:120}
+;22:END;END;{:113}{127:}FUNCTION LINESDONTMAT:BOOLEAN;LABEL 10;
+VAR K:0..BUFSIZE;BEGIN LINESDONTMAT:=TRUE;
+IF CHANGELIMIT<>LIMIT THEN GOTO 10;
+IF LIMIT>0 THEN FOR K:=0 TO LIMIT-1 DO IF CHANGEBUFFER[K]<>BUFFER[K]THEN
+GOTO 10;LINESDONTMAT:=FALSE;10:END;{:127}{128:}PROCEDURE PRIMETHECHAN;
+LABEL 22,30,10;VAR K:0..BUFSIZE;BEGIN CHANGELIMIT:=0;{129:}
+WHILE TRUE DO BEGIN LINE:=LINE+1;IF NOT INPUTLN(CHANGEFILE)THEN GOTO 10;
+IF LIMIT<2 THEN GOTO 22;IF BUFFER[0]<>64 THEN GOTO 22;
+IF(BUFFER[1]>=88)AND(BUFFER[1]<=90)THEN BUFFER[1]:=BUFFER[1]+32;
+IF BUFFER[1]=120 THEN GOTO 30;
+IF(BUFFER[1]=121)OR(BUFFER[1]=122)THEN BEGIN LOC:=2;
+BEGIN WRITELN(TTYOUT);WRITE(TTYOUT,'! Where is the matching @x?');ERROR;
+END;END;22:END;30:{:129};{130:}REPEAT LINE:=LINE+1;
+IF NOT INPUTLN(CHANGEFILE)THEN BEGIN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Change file ended after @x');ERROR;END;GOTO 10;END;
+UNTIL LIMIT>0;{:130};{131:}BEGIN CHANGELIMIT:=LIMIT;
+FOR K:=0 TO LIMIT DO CHANGEBUFFER[K]:=BUFFER[K];END{:131};10:END;{:128}
+{132:}PROCEDURE CHECKCHANGE;LABEL 10;VAR N:INTEGER;K:0..BUFSIZE;
+BEGIN IF LINESDONTMAT THEN GOTO 10;N:=0;
+WHILE TRUE DO BEGIN CHANGING:=NOT CHANGING;TEMPLINE:=OTHERLINE;
+OTHERLINE:=LINE;LINE:=TEMPLINE;LINE:=LINE+1;
+IF NOT INPUTLN(CHANGEFILE)THEN BEGIN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Change file ended before @y');ERROR;END;CHANGELIMIT:=0;
+CHANGING:=NOT CHANGING;TEMPLINE:=OTHERLINE;OTHERLINE:=LINE;
+LINE:=TEMPLINE;GOTO 10;END;{133:}
+IF LIMIT>1 THEN IF BUFFER[0]=64 THEN BEGIN IF(BUFFER[1]>=88)AND(BUFFER[1
+]<=90)THEN BUFFER[1]:=BUFFER[1]+32;
+IF(BUFFER[1]=120)OR(BUFFER[1]=122)THEN BEGIN LOC:=2;
+BEGIN WRITELN(TTYOUT);WRITE(TTYOUT,'! Where is the matching @y?');ERROR;
+END;END ELSE IF BUFFER[1]=121 THEN BEGIN IF N>0 THEN BEGIN LOC:=2;
+BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Hmm... ',N:1,' of the preceding lines failed to match');
+ERROR;END;END;GOTO 10;END;END{:133};{131:}BEGIN CHANGELIMIT:=LIMIT;
+FOR K:=0 TO LIMIT DO CHANGEBUFFER[K]:=BUFFER[K];END{:131};
+CHANGING:=NOT CHANGING;TEMPLINE:=OTHERLINE;OTHERLINE:=LINE;
+LINE:=TEMPLINE;LINE:=LINE+1;
+IF NOT INPUTLN(WEBFILE)THEN BEGIN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! WEB file ended during a change');ERROR;END;
+INPUTHASENDE:=TRUE;GOTO 10;END;IF LINESDONTMAT THEN N:=N+1;END;10:END;
+{:132}{135:}PROCEDURE GETLINE;LABEL 20;BEGIN 20:IF CHANGING THEN{137:}
+BEGIN LINE:=LINE+1;
+IF NOT INPUTLN(CHANGEFILE)THEN BEGIN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Change file ended without @z');ERROR;END;BUFFER[0]:=64;
+BUFFER[1]:=122;LIMIT:=2;END;
+IF LIMIT>1 THEN IF BUFFER[0]=64 THEN BEGIN IF(BUFFER[1]>=88)AND(BUFFER[1
+]<=90)THEN BUFFER[1]:=BUFFER[1]+32;
+IF(BUFFER[1]=120)OR(BUFFER[1]=121)THEN BEGIN LOC:=2;
+BEGIN WRITELN(TTYOUT);WRITE(TTYOUT,'! Where is the matching @z?');ERROR;
+END;END ELSE IF BUFFER[1]=122 THEN BEGIN PRIMETHECHAN;
+CHANGING:=NOT CHANGING;TEMPLINE:=OTHERLINE;OTHERLINE:=LINE;
+LINE:=TEMPLINE;END;END;END{:137};IF NOT CHANGING THEN BEGIN{136:}
+BEGIN LINE:=LINE+1;
+IF NOT INPUTLN(WEBFILE)THEN INPUTHASENDE:=TRUE ELSE IF LIMIT=CHANGELIMIT
+THEN IF BUFFER[0]=CHANGEBUFFER[0]THEN IF CHANGELIMIT>0 THEN CHECKCHANGE;
+END{:136};IF CHANGING THEN GOTO 20;END;LOC:=0;BUFFER[LIMIT]:=32;END;
+{:135}{139:}FUNCTION CONTROLCODE(C:ASCIICODE):EIGHTBITS;
+BEGIN CASE C OF 64:CONTROLCODE:=64;39:CONTROLCODE:=12;
+34:CONTROLCODE:=13;36:CONTROLCODE:=125;32,9:CONTROLCODE:=136;
+42:BEGIN WRITE(TTYOUT,'*',MODULECOUNT+1:1);;CONTROLCODE:=136;END;
+68,100:CONTROLCODE:=133;70,102:CONTROLCODE:=132;123:CONTROLCODE:=9;
+125:CONTROLCODE:=10;80,112:CONTROLCODE:=134;
+84,116,94,46,58:CONTROLCODE:=131;38:CONTROLCODE:=127;
+60:CONTROLCODE:=135;61:CONTROLCODE:=2;92:CONTROLCODE:=3;
+OTHERWISE CONTROLCODE:=0 END;END;{:139}{140:}
+FUNCTION SKIPAHEAD:EIGHTBITS;LABEL 30;VAR C:EIGHTBITS;
+BEGIN WHILE TRUE DO BEGIN IF LOC>LIMIT THEN BEGIN GETLINE;
+IF INPUTHASENDE THEN BEGIN C:=136;GOTO 30;END;END;BUFFER[LIMIT+1]:=64;
+WHILE BUFFER[LOC]<>64 DO LOC:=LOC+1;IF LOC<=LIMIT THEN BEGIN LOC:=LOC+2;
+C:=CONTROLCODE(BUFFER[LOC-1]);IF(C<>0)OR(BUFFER[LOC-1]=62)THEN GOTO 30;
+END;END;30:SKIPAHEAD:=C;END;{:140}{141:}PROCEDURE SKIPCOMMENT;LABEL 10;
+VAR BAL:EIGHTBITS;C:ASCIICODE;BEGIN BAL:=0;
+WHILE TRUE DO BEGIN IF LOC>LIMIT THEN BEGIN GETLINE;
+IF INPUTHASENDE THEN BEGIN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Input ended in mid-comment');ERROR;END;GOTO 10;END;END;
+C:=BUFFER[LOC];LOC:=LOC+1;{142:}IF C=64 THEN BEGIN C:=BUFFER[LOC];
+IF(C<>32)AND(C<>9)AND(C<>42)AND(C<>122)AND(C<>90)THEN LOC:=LOC+1 ELSE
+BEGIN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Section ended in mid-comment');ERROR;END;LOC:=LOC-1;
+GOTO 10;
+END END ELSE IF(C=92)AND(BUFFER[LOC]<>64)THEN LOC:=LOC+1 ELSE IF C=123
+THEN BAL:=BAL+1 ELSE IF C=125 THEN BEGIN IF BAL=0 THEN GOTO 10;
+BAL:=BAL-1;END{:142};END;10:END;{:141}{145:}FUNCTION GETNEXT:EIGHTBITS;
+LABEL 20,30,31;VAR C:EIGHTBITS;D:EIGHTBITS;J,K:0..LONGESTNAME;
+BEGIN 20:IF LOC>LIMIT THEN BEGIN GETLINE;
+IF INPUTHASENDE THEN BEGIN C:=136;GOTO 31;END;END;C:=BUFFER[LOC];
+LOC:=LOC+1;IF SCANNINGHEX THEN{146:}
+IF((C>=48)AND(C<=57))OR((C>=65)AND(C<=70))THEN GOTO 31 ELSE SCANNINGHEX
+:=FALSE{:146};
+CASE C OF 65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85
+,86,87,88,89,90,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111
+,112,113,114,115,116,117,118,119,120,121,122:{148:}
+BEGIN IF((C=101)OR(C=69))AND(LOC>1)THEN IF(BUFFER[LOC-2]<=57)AND(BUFFER[
+LOC-2]>=48)THEN C:=0;IF C<>0 THEN BEGIN LOC:=LOC-1;IDFIRST:=LOC;
+REPEAT LOC:=LOC+1;D:=BUFFER[LOC];
+UNTIL((D<48)OR((D>57)AND(D<65))OR((D>90)AND(D<97))OR(D>122))AND(D<>95);
+IF LOC>IDFIRST+1 THEN BEGIN C:=130;IDLOC:=LOC;END;END ELSE C:=69;
+END{:148};34:{149:}BEGIN DOUBLECHARS:=0;IDFIRST:=LOC-1;
+REPEAT D:=BUFFER[LOC];LOC:=LOC+1;
+IF(D=34)OR(D=64)THEN IF BUFFER[LOC]=D THEN BEGIN LOC:=LOC+1;D:=0;
+DOUBLECHARS:=DOUBLECHARS+1;
+END ELSE BEGIN IF D=64 THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Double @ sign missing');ERROR;
+END END ELSE IF LOC>LIMIT THEN BEGIN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! String constant didn''t end');ERROR;END;D:=34;END;
+UNTIL D=34;IDLOC:=LOC-1;C:=130;END{:149};64:{150:}
+BEGIN C:=CONTROLCODE(BUFFER[LOC]);LOC:=LOC+1;
+IF C=0 THEN GOTO 20 ELSE IF C=13 THEN SCANNINGHEX:=TRUE ELSE IF C=135
+THEN{151:}BEGIN{153:}K:=0;
+WHILE TRUE DO BEGIN IF LOC>LIMIT THEN BEGIN GETLINE;
+IF INPUTHASENDE THEN BEGIN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Input ended in section name');ERROR;END;GOTO 30;END;END;
+D:=BUFFER[LOC];{154:}IF D=64 THEN BEGIN D:=BUFFER[LOC+1];
+IF D=62 THEN BEGIN LOC:=LOC+2;GOTO 30;END;
+IF(D=32)OR(D=9)OR(D=42)THEN BEGIN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Section name didn''t end');ERROR;END;GOTO 30;END;K:=K+1;
+MODTEXT[K]:=64;LOC:=LOC+1;END{:154};LOC:=LOC+1;
+IF K<LONGESTNAME-1 THEN K:=K+1;IF(D=32)OR(D=9)THEN BEGIN D:=32;
+IF MODTEXT[K-1]=32 THEN K:=K-1;END;MODTEXT[K]:=D;END;30:{155:}
+IF K>=LONGESTNAME-2 THEN BEGIN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Section name too long: ');END;
+FOR J:=1 TO 25 DO WRITE(TTYOUT,XCHR[MODTEXT[J]]);WRITE(TTYOUT,'...');
+IF HISTORY=0 THEN HISTORY:=1;END{:155};
+IF(MODTEXT[K]=32)AND(K>0)THEN K:=K-1;{:153};
+IF K>3 THEN BEGIN IF(MODTEXT[K]=46)AND(MODTEXT[K-1]=46)AND(MODTEXT[K-2]=
+46)THEN CURMODULE:=PREFIXLOOKUP(K-3)ELSE CURMODULE:=MODLOOKUP(K);
+END ELSE CURMODULE:=MODLOOKUP(K);END{:151}
+ELSE IF C=131 THEN BEGIN REPEAT C:=SKIPAHEAD;UNTIL C<>64;
+IF BUFFER[LOC-1]<>62 THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Improper @ within control text');ERROR;END;GOTO 20;END;
+END{:150};{147:}
+46:IF BUFFER[LOC]=46 THEN BEGIN IF LOC<=LIMIT THEN BEGIN C:=32;
+LOC:=LOC+1;END;
+END ELSE IF BUFFER[LOC]=41 THEN BEGIN IF LOC<=LIMIT THEN BEGIN C:=93;
+LOC:=LOC+1;END;END;
+58:IF BUFFER[LOC]=61 THEN BEGIN IF LOC<=LIMIT THEN BEGIN C:=24;
+LOC:=LOC+1;END;END;
+61:IF BUFFER[LOC]=61 THEN BEGIN IF LOC<=LIMIT THEN BEGIN C:=30;
+LOC:=LOC+1;END;END;
+62:IF BUFFER[LOC]=61 THEN BEGIN IF LOC<=LIMIT THEN BEGIN C:=29;
+LOC:=LOC+1;END;END;
+60:IF BUFFER[LOC]=61 THEN BEGIN IF LOC<=LIMIT THEN BEGIN C:=28;
+LOC:=LOC+1;END;
+END ELSE IF BUFFER[LOC]=62 THEN BEGIN IF LOC<=LIMIT THEN BEGIN C:=26;
+LOC:=LOC+1;END;END;
+40:IF BUFFER[LOC]=42 THEN BEGIN IF LOC<=LIMIT THEN BEGIN C:=9;
+LOC:=LOC+1;END;
+END ELSE IF BUFFER[LOC]=46 THEN BEGIN IF LOC<=LIMIT THEN BEGIN C:=91;
+LOC:=LOC+1;END;END;
+42:IF BUFFER[LOC]=41 THEN BEGIN IF LOC<=LIMIT THEN BEGIN C:=10;
+LOC:=LOC+1;END;END;{:147}32,9:GOTO 20;123:BEGIN SKIPCOMMENT;GOTO 20;END;
+OTHERWISE END;31:{IF TROUBLESHOOT THEN DEBUGHELP;}GETNEXT:=C;END;{:145}
+{157:}PROCEDURE SCANNUMERIC(P:NAMEPOINTER);LABEL 21,30;
+VAR ACCUMULATOR:INTEGER;NEXTSIGN:-1..+1;Q:NAMEPOINTER;VAL:INTEGER;
+BEGIN{158:}ACCUMULATOR:=0;NEXTSIGN:=+1;
+WHILE TRUE DO BEGIN NEXTCONTROL:=GETNEXT;
+21:CASE NEXTCONTROL OF 48,49,50,51,52,53,54,55,56,57:BEGIN{160:}VAL:=0;
+REPEAT VAL:=10*VAL+NEXTCONTROL-48;NEXTCONTROL:=GETNEXT;
+UNTIL(NEXTCONTROL>57)OR(NEXTCONTROL<48){:160};
+BEGIN ACCUMULATOR:=ACCUMULATOR+NEXTSIGN*(VAL);NEXTSIGN:=+1;END;GOTO 21;
+END;12:BEGIN{161:}VAL:=0;NEXTCONTROL:=48;
+REPEAT VAL:=8*VAL+NEXTCONTROL-48;NEXTCONTROL:=GETNEXT;
+UNTIL(NEXTCONTROL>55)OR(NEXTCONTROL<48){:161};
+BEGIN ACCUMULATOR:=ACCUMULATOR+NEXTSIGN*(VAL);NEXTSIGN:=+1;END;GOTO 21;
+END;13:BEGIN{162:}VAL:=0;NEXTCONTROL:=48;
+REPEAT IF NEXTCONTROL>=65 THEN NEXTCONTROL:=NEXTCONTROL-7;
+VAL:=16*VAL+NEXTCONTROL-48;NEXTCONTROL:=GETNEXT;
+UNTIL(NEXTCONTROL>70)OR(NEXTCONTROL<48)OR((NEXTCONTROL>57)AND(
+NEXTCONTROL<65)){:162};BEGIN ACCUMULATOR:=ACCUMULATOR+NEXTSIGN*(VAL);
+NEXTSIGN:=+1;END;GOTO 21;END;130:BEGIN Q:=IDLOOKUP(0);
+IF ILK[Q]<>1 THEN BEGIN NEXTCONTROL:=42;GOTO 21;END;
+BEGIN ACCUMULATOR:=ACCUMULATOR+NEXTSIGN*(EQUIV[Q]-32768);NEXTSIGN:=+1;
+END;END;43:;45:NEXTSIGN:=-NEXTSIGN;132,133,135,134,136:GOTO 30;
+59:BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Omit semicolon in numeric definition');ERROR;END;
+OTHERWISE{159:}BEGIN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Improper numeric definition will be flushed');ERROR;END;
+REPEAT NEXTCONTROL:=SKIPAHEAD UNTIL(NEXTCONTROL>=132);
+IF NEXTCONTROL=135 THEN BEGIN LOC:=LOC-2;NEXTCONTROL:=GETNEXT;END;
+ACCUMULATOR:=0;GOTO 30;END{:159}END;END;30:{:158};
+IF ABS(ACCUMULATOR)>=32768 THEN BEGIN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Value too big: ',ACCUMULATOR:1);ERROR;END;
+ACCUMULATOR:=0;END;EQUIV[P]:=ACCUMULATOR+32768;END;{:157}{165:}
+PROCEDURE SCANREPL(T:EIGHTBITS);LABEL 22,30,31;VAR A:SIXTEENBITS;
+B:ASCIICODE;BAL:EIGHTBITS;BEGIN BAL:=0;
+WHILE TRUE DO BEGIN 22:A:=GETNEXT;CASE A OF 40:BAL:=BAL+1;
+41:IF BAL=0 THEN BEGIN WRITELN(TTYOUT);WRITE(TTYOUT,'! Extra )');ERROR;
+END ELSE BAL:=BAL-1;39:{168:}BEGIN B:=39;
+WHILE TRUE DO BEGIN BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(TTYOUT
+);WRITE(TTYOUT,'! Sorry, ','token',' capacity exceeded');ERROR;
+HISTORY:=3;JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=B;TOKPTR[Z]:=TOKPTR[Z]+1;
+END;
+IF B=64 THEN IF BUFFER[LOC]=64 THEN LOC:=LOC+1 ELSE BEGIN WRITELN(TTYOUT
+);WRITE(TTYOUT,'! You should double @ signs in strings');ERROR;END;
+IF LOC=LIMIT THEN BEGIN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! String didn''t end');ERROR;END;BUFFER[LOC]:=39;
+BUFFER[LOC+1]:=0;END;B:=BUFFER[LOC];LOC:=LOC+1;
+IF B=39 THEN BEGIN IF BUFFER[LOC]<>39 THEN GOTO 31 ELSE BEGIN LOC:=LOC+1
+;BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Sorry, ','token',' capacity exceeded');ERROR;HISTORY:=3;
+JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=39;TOKPTR[Z]:=TOKPTR[Z]+1;END;END;END;
+END;31:END{:168};35:IF T=3 THEN A:=0;{167:}130:BEGIN A:=IDLOOKUP(0);
+BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Sorry, ','token',' capacity exceeded');ERROR;HISTORY:=3;
+JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=(A DIV 256)+128;TOKPTR[Z]:=TOKPTR[Z]+1;
+END;A:=A MOD 256;END;
+135:IF T<>135 THEN GOTO 30 ELSE BEGIN BEGIN IF TOKPTR[Z]=MAXTOKS THEN
+BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Sorry, ','token',' capacity exceeded');ERROR;HISTORY:=3;
+JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=(CURMODULE DIV 256)+168;
+TOKPTR[Z]:=TOKPTR[Z]+1;END;A:=CURMODULE MOD 256;END;2:{169:}
+BEGIN BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Sorry, ','token',' capacity exceeded');ERROR;HISTORY:=3;
+JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=2;TOKPTR[Z]:=TOKPTR[Z]+1;END;
+BUFFER[LIMIT+1]:=64;
+WHILE BUFFER[LOC]<>64 DO BEGIN BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN
+WRITELN(TTYOUT);WRITE(TTYOUT,'! Sorry, ','token',' capacity exceeded');
+ERROR;HISTORY:=3;JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=BUFFER[LOC];
+TOKPTR[Z]:=TOKPTR[Z]+1;END;LOC:=LOC+1;
+IF LOC<LIMIT THEN IF(BUFFER[LOC]=64)AND(BUFFER[LOC+1]=64)THEN BEGIN
+BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Sorry, ','token',' capacity exceeded');ERROR;HISTORY:=3;
+JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=64;TOKPTR[Z]:=TOKPTR[Z]+1;END;
+LOC:=LOC+2;END;END;IF LOC>=LIMIT THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Verbatim string didn''t end');ERROR;
+END ELSE IF BUFFER[LOC+1]<>62 THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! You should double @ signs in verbatim strings');ERROR;
+END;LOC:=LOC+2;END{:169};
+133,132,134:IF T<>135 THEN GOTO 30 ELSE BEGIN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! @',XCHR[BUFFER[LOC-1]],' is ignored in Pascal text');
+ERROR;END;GOTO 22;END;136:GOTO 30;{:167}OTHERWISE END;
+BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Sorry, ','token',' capacity exceeded');ERROR;HISTORY:=3;
+JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=A;TOKPTR[Z]:=TOKPTR[Z]+1;END;END;
+30:NEXTCONTROL:=A;{166:}
+IF BAL>0 THEN BEGIN IF BAL=1 THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Missing )');ERROR;END ELSE BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Missing ',BAL:1,' )''s');ERROR;END;
+WHILE BAL>0 DO BEGIN BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(
+TTYOUT);WRITE(TTYOUT,'! Sorry, ','token',' capacity exceeded');ERROR;
+HISTORY:=3;JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=41;TOKPTR[Z]:=TOKPTR[Z]+1;
+END;BAL:=BAL-1;END;END{:166};
+IF TEXTPTR>MAXTEXTS-3 THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Sorry, ','text',' capacity exceeded');ERROR;HISTORY:=3;
+JUMPOUT;END;CURREPLTEXT:=TEXTPTR;TOKSTART[TEXTPTR+3]:=TOKPTR[Z];
+TEXTPTR:=TEXTPTR+1;IF Z=2 THEN Z:=0 ELSE Z:=Z+1;END;{:165}{170:}
+PROCEDURE DEFINEMACRO(T:EIGHTBITS);VAR P:NAMEPOINTER;
+BEGIN P:=IDLOOKUP(T);SCANREPL(T);EQUIV[P]:=CURREPLTEXT;
+TEXTLINK[CURREPLTEXT]:=0;END;{:170}{172:}PROCEDURE SCANMODULE;
+LABEL 22,30,10;VAR P:NAMEPOINTER;BEGIN MODULECOUNT:=MODULECOUNT+1;{173:}
+NEXTCONTROL:=0;
+WHILE TRUE DO BEGIN 22:WHILE NEXTCONTROL<=132 DO BEGIN NEXTCONTROL:=
+SKIPAHEAD;IF NEXTCONTROL=135 THEN BEGIN LOC:=LOC-2;NEXTCONTROL:=GETNEXT;
+END;END;IF NEXTCONTROL<>133 THEN GOTO 30;NEXTCONTROL:=GETNEXT;
+IF NEXTCONTROL<>130 THEN BEGIN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Definition flushed, must start with ',
+'identifier of length > 1');ERROR;END;GOTO 22;END;NEXTCONTROL:=GETNEXT;
+IF NEXTCONTROL=61 THEN BEGIN SCANNUMERIC(IDLOOKUP(1));GOTO 22;
+END ELSE IF NEXTCONTROL=30 THEN BEGIN DEFINEMACRO(2);GOTO 22;
+END ELSE{174:}IF NEXTCONTROL=40 THEN BEGIN NEXTCONTROL:=GETNEXT;
+IF NEXTCONTROL=35 THEN BEGIN NEXTCONTROL:=GETNEXT;
+IF NEXTCONTROL=41 THEN BEGIN NEXTCONTROL:=GETNEXT;
+IF NEXTCONTROL=61 THEN BEGIN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Use == for macros');ERROR;END;NEXTCONTROL:=30;END;
+IF NEXTCONTROL=30 THEN BEGIN DEFINEMACRO(3);GOTO 22;END;END;END;END;
+{:174};BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Definition flushed since it starts badly');ERROR;END;
+END;30:{:173};{175:}CASE NEXTCONTROL OF 134:P:=0;135:BEGIN P:=CURMODULE;
+{176:}REPEAT NEXTCONTROL:=GETNEXT;UNTIL NEXTCONTROL<>43;
+IF(NEXTCONTROL<>61)AND(NEXTCONTROL<>30)THEN BEGIN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Pascal text flushed, = sign is missing');ERROR;END;
+REPEAT NEXTCONTROL:=SKIPAHEAD;UNTIL NEXTCONTROL=136;GOTO 10;END{:176};
+END;OTHERWISE GOTO 10 END;{177:}STORETWOBYTE(53248+MODULECOUNT);{:177};
+SCANREPL(135);{178:}
+IF P=0 THEN BEGIN TEXTLINK[LASTUNNAMED]:=CURREPLTEXT;
+LASTUNNAMED:=CURREPLTEXT;
+END ELSE IF EQUIV[P]=0 THEN EQUIV[P]:=CURREPLTEXT ELSE BEGIN P:=EQUIV[P]
+;WHILE TEXTLINK[P]<MAXTEXTS DO P:=TEXTLINK[P];TEXTLINK[P]:=CURREPLTEXT;
+END;TEXTLINK[CURREPLTEXT]:=MAXTEXTS;{:178};{:175};10:END;{:172}{181:}
+{PROCEDURE DEBUGHELP;LABEL 888,10;VAR K:SIXTEENBITS;
+BEGIN DEBUGSKIPPED:=DEBUGSKIPPED+1;
+IF DEBUGSKIPPED<DEBUGCYCLE THEN GOTO 10;DEBUGSKIPPED:=0;
+WHILE TRUE DO BEGIN WRITE(TTYOUT,'#');;READ(TTYIN,DDT);
+IF DDT<0 THEN GOTO 10 ELSE IF DDT=0 THEN BEGIN GOTO 888;
+888:DDT:=0;
+END ELSE BEGIN READ(TTYIN,DD);CASE DDT OF 1:PRINTID(DD);2:PRINTREPL(DD);
+3:FOR K:=1 TO DD DO WRITE(TTYOUT,XCHR[BUFFER[K]]);
+4:FOR K:=1 TO DD DO WRITE(TTYOUT,XCHR[MODTEXT[K]]);
+5:FOR K:=1 TO OUTPTR DO WRITE(TTYOUT,XCHR[OUTBUF[K]]);
+6:FOR K:=1 TO DD DO WRITE(TTYOUT,XCHR[OUTCONTRIB[K]]);
+OTHERWISE WRITE(TTYOUT,'?')END;END;END;10:END;}{:181}{182:}
+BEGIN INITIALIZE;{134:}OPENINPUT;LINE:=0;OTHERLINE:=0;CHANGING:=TRUE;
+PRIMETHECHAN;CHANGING:=NOT CHANGING;TEMPLINE:=OTHERLINE;OTHERLINE:=LINE;
+LINE:=TEMPLINE;LIMIT:=0;LOC:=1;BUFFER[0]:=32;INPUTHASENDE:=FALSE;{:134};
+WRITELN(TTYOUT,'This is TANGLE, VM/CMS Version 2.6');{183:}
+PHASEONE:=TRUE;MODULECOUNT:=0;REPEAT NEXTCONTROL:=SKIPAHEAD;
+UNTIL NEXTCONTROL=136;WHILE NOT INPUTHASENDE DO SCANMODULE;{138:}
+IF CHANGELIMIT<>0 THEN BEGIN FOR LOC:=0 TO CHANGELIMIT DO BUFFER[LOC]:=
+CHANGEBUFFER[LOC];LIMIT:=CHANGELIMIT;CHANGING:=TRUE;LINE:=OTHERLINE;
+LOC:=CHANGELIMIT;BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Change file entry did not match');ERROR;END;END{:138};
+PHASEONE:=FALSE;{:183};FOR ZO:=0 TO 2 DO MAXTOKPTR[ZO]:=TOKPTR[ZO];
+{112:}IF TEXTLINK[0]=0 THEN BEGIN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! No output was specified.');END;
+IF HISTORY=0 THEN HISTORY:=1;END ELSE BEGIN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'Writing the output file');END;;{83:}STACKPTR:=1;
+BRACELEVEL:=0;CURSTATE.NAMEFIELD:=0;CURSTATE.REPLFIELD:=TEXTLINK[0];
+ZO:=CURSTATE.REPLFIELD MOD 3;
+CURSTATE.BYTEFIELD:=TOKSTART[CURSTATE.REPLFIELD];
+CURSTATE.ENDFIELD:=TOKSTART[CURSTATE.REPLFIELD+3];CURSTATE.MODFIELD:=0;
+{:83};{96:}OUTSTATE:=0;OUTPTR:=0;BREAKPTR:=0;SEMIPTR:=0;OUTBUF[0]:=0;
+LINE:=1;{:96};SENDTHEOUTPU;{98:}BREAKPTR:=OUTPTR;SEMIPTR:=0;FLUSHBUFFER;
+IF BRACELEVEL<>0 THEN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'! Program ended at brace level ',BRACELEVEL:1);ERROR;END;
+{:98};BEGIN WRITELN(TTYOUT);WRITE(TTYOUT,'Done.');END;END{:112};
+9999:IF STRINGPTR>128 THEN{184:}BEGIN BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,STRINGPTR-128:1,' strings written to string pool file.');
+END;WRITE(POOL,'*');
+FOR STRINGPTR:=1 TO 9 DO BEGIN OUTBUF[STRINGPTR]:=POOLCHECKSUM MOD 10;
+POOLCHECKSUM:=POOLCHECKSUM DIV 10;END;
+FOR STRINGPTR:=9 DOWNTO 1 DO WRITE(POOL,XCHR[48+OUTBUF[STRINGPTR]]);
+WRITELN(POOL);END{:184};{186:}BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'Memory usage statistics:');END;BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,NAMEPTR:1,' names, ',TEXTPTR:1,' replacement texts;');END;
+BEGIN WRITELN(TTYOUT);WRITE(TTYOUT,BYTEPTR[0]:1);END;
+FOR WO:=1 TO 1 DO WRITE(TTYOUT,'+',BYTEPTR[WO]:1);
+WRITE(TTYOUT,' bytes, ',MAXTOKPTR[0]:1);
+FOR ZO:=1 TO 2 DO WRITE(TTYOUT,'+',MAXTOKPTR[ZO]:1);
+WRITE(TTYOUT,' tokens.');{:186};{187:}RETCODE(4*HISTORY);
+CASE HISTORY OF 0:BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'(No errors were found.)');END;1:BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'(Did you see the warning message above?)');END;
+2:BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'(Pardon me, but I think I spotted something wrong.)');END;
+3:BEGIN WRITELN(TTYOUT);
+WRITE(TTYOUT,'(That was a fatal error, my friend.)');END;END{:187};
+END.{:182}
diff --git a/obsolete/systems/knuth/unsupported/web/tangle.pas b/obsolete/systems/knuth/unsupported/web/tangle.pas
new file mode 100644
index 0000000000..1738c363dc
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/web/tangle.pas
@@ -0,0 +1,783 @@
+{2:}{4:}{$C-,A+,D-}{$C+,D+}{:4}
+PROGRAM TANGLE(WEBFILE,CHANGEFILE,PASCALFILE,POOL);LABEL 9999;CONST{8:}
+BUFSIZE=100;MAXBYTES=45000;MAXTOKS=50000;MAXNAMES=4000;MAXTEXTS=2000;
+HASHSIZE=353;LONGESTNAME=400;LINELENGTH=72;OUTBUFSIZE=144;STACKSIZE=50;
+MAXIDLENGTH=12;UNAMBIGLENGT=7;{:8}TYPE{11:}ASCIICODE=0..127;{:11}{12:}
+TEXTFILE=PACKED FILE OF CHAR;{:12}{37:}EIGHTBITS=0..255;
+SIXTEENBITS=0..65535;{:37}{39:}NAMEPOINTER=0..MAXNAMES;{:39}{43:}
+TEXTPOINTER=0..MAXTEXTS;{:43}{78:}
+OUTPUTSTATE=RECORD ENDFIELD:SIXTEENBITS;BYTEFIELD:SIXTEENBITS;
+NAMEFIELD:NAMEPOINTER;REPLFIELD:TEXTPOINTER;MODFIELD:0..12287;END;{:78}
+VAR{9:}HISTORY:0..3;{:9}{13:}XORD:ARRAY[CHAR]OF ASCIICODE;
+XCHR:ARRAY[ASCIICODE]OF CHAR;{:13}{20:}TERMOUT:TEXTFILE;{:20}{23:}
+WEBFILE:TEXTFILE;CHANGEFILE:TEXTFILE;{:23}{25:}PASCALFILE:TEXTFILE;
+POOL:TEXTFILE;{:25}{27:}BUFFER:ARRAY[0..BUFSIZE]OF ASCIICODE;{:27}{29:}
+PHASEONE:BOOLEAN;{:29}{38:}
+BYTEMEM:PACKED ARRAY[0..1,0..MAXBYTES]OF ASCIICODE;
+TOKMEM:PACKED ARRAY[0..2,0..MAXTOKS]OF EIGHTBITS;
+BYTESTART:ARRAY[0..MAXNAMES]OF SIXTEENBITS;
+TOKSTART:ARRAY[0..MAXTEXTS]OF SIXTEENBITS;
+LINK:ARRAY[0..MAXNAMES]OF SIXTEENBITS;
+ILK:ARRAY[0..MAXNAMES]OF SIXTEENBITS;
+EQUIV:ARRAY[0..MAXNAMES]OF SIXTEENBITS;
+TEXTLINK:ARRAY[0..MAXTEXTS]OF SIXTEENBITS;{:38}{40:}NAMEPTR:NAMEPOINTER;
+STRINGPTR:NAMEPOINTER;BYTEPTR:ARRAY[0..1]OF 0..MAXBYTES;
+POOLCHECKSUM:INTEGER;{:40}{44:}TEXTPTR:TEXTPOINTER;
+TOKPTR:ARRAY[0..2]OF 0..MAXTOKS;Z:0..2;
+MAXTOKPTR:ARRAY[0..2]OF 0..MAXTOKS;{:44}{50:}IDFIRST:0..BUFSIZE;
+IDLOC:0..BUFSIZE;DOUBLECHARS:0..BUFSIZE;
+HASH,CHOPHASH:ARRAY[0..HASHSIZE]OF SIXTEENBITS;
+CHOPPEDID:ARRAY[0..UNAMBIGLENGT]OF ASCIICODE;{:50}{65:}
+MODTEXT:ARRAY[0..LONGESTNAME]OF ASCIICODE;{:65}{70:}
+LASTUNNAMED:TEXTPOINTER;{:70}{79:}CURSTATE:OUTPUTSTATE;
+STACK:ARRAY[1..STACKSIZE]OF OUTPUTSTATE;STACKPTR:0..STACKSIZE;{:79}{80:}
+ZO:0..2;{:80}{82:}BRACELEVEL:EIGHTBITS;{:82}{86:}CURVAL:INTEGER;{:86}
+{94:}OUTBUF:ARRAY[0..OUTBUFSIZE]OF ASCIICODE;OUTPTR:0..OUTBUFSIZE;
+BREAKPTR:0..OUTBUFSIZE;SEMIPTR:0..OUTBUFSIZE;{:94}{95:}
+OUTSTATE:EIGHTBITS;OUTVAL,OUTAPP:INTEGER;OUTSIGN:ASCIICODE;
+LASTSIGN:-1..+1;{:95}{100:}OUTCONTRIB:ARRAY[1..LINELENGTH]OF ASCIICODE;
+{:100}{124:}LINE:INTEGER;OTHERLINE:INTEGER;TEMPLINE:INTEGER;
+LIMIT:0..BUFSIZE;LOC:0..BUFSIZE;INPUTHASENDE:BOOLEAN;CHANGING:BOOLEAN;
+{:124}{126:}CHANGEBUFFER:ARRAY[0..BUFSIZE]OF ASCIICODE;
+CHANGELIMIT:0..BUFSIZE;{:126}{143:}CURMODULE:NAMEPOINTER;
+SCANNINGHEX:BOOLEAN;{:143}{156:}NEXTCONTROL:EIGHTBITS;{:156}{164:}
+CURREPLTEXT:TEXTPOINTER;{:164}{171:}MODULECOUNT:0..12287;{:171}{179:}
+TROUBLESHOOT:BOOLEAN;DDT:INTEGER;DD:INTEGER;DEBUGCYCLE:INTEGER;
+DEBUGSKIPPED:INTEGER;TERMIN:TEXTFILE;{:179}{185:}WO:0..1;{:185}{30:}
+PROCEDURE DEBUGHELP;FORWARD;{:30}{31:}PROCEDURE ERROR;
+VAR J:0..OUTBUFSIZE;K,L:0..BUFSIZE;BEGIN IF PHASEONE THEN{32:}
+BEGIN IF CHANGING THEN WRITE(TERMOUT,'. (change file ')ELSE WRITE(
+TERMOUT,'. (');WRITELN(TERMOUT,'l.',LINE:1,')');
+IF LOC>=LIMIT THEN L:=LIMIT ELSE L:=LOC;
+FOR K:=1 TO L DO IF BUFFER[K-1]=9 THEN WRITE(TERMOUT,' ')ELSE WRITE(
+TERMOUT,XCHR[BUFFER[K-1]]);WRITELN(TERMOUT);
+FOR K:=1 TO L DO WRITE(TERMOUT,' ');
+FOR K:=L+1 TO LIMIT DO WRITE(TERMOUT,XCHR[BUFFER[K-1]]);
+WRITE(TERMOUT,' ');END{:32}ELSE{33:}
+BEGIN WRITELN(TERMOUT,'. (l.',LINE:1,')');
+FOR J:=1 TO OUTPTR DO WRITE(TERMOUT,XCHR[OUTBUF[J-1]]);
+WRITE(TERMOUT,'... ');END{:33};BREAK(TERMOUT);HISTORY:=2;DEBUGHELP;END;
+{:31}{34:}PROCEDURE JUMPOUT;BEGIN GOTO 9999;END;{:34}
+PROCEDURE INITIALIZE;VAR{16:}I:0..127;{:16}{41:}WI:0..1;{:41}{45:}
+ZI:0..2;{:45}{51:}H:0..HASHSIZE;{:51}BEGIN{10:}HISTORY:=0;{:10}{14:}
+XCHR[32]:=' ';XCHR[33]:='!';XCHR[34]:='"';XCHR[35]:='#';XCHR[36]:='$';
+XCHR[37]:='%';XCHR[38]:='&';XCHR[39]:='''';XCHR[40]:='(';XCHR[41]:=')';
+XCHR[42]:='*';XCHR[43]:='+';XCHR[44]:=',';XCHR[45]:='-';XCHR[46]:='.';
+XCHR[47]:='/';XCHR[48]:='0';XCHR[49]:='1';XCHR[50]:='2';XCHR[51]:='3';
+XCHR[52]:='4';XCHR[53]:='5';XCHR[54]:='6';XCHR[55]:='7';XCHR[56]:='8';
+XCHR[57]:='9';XCHR[58]:=':';XCHR[59]:=';';XCHR[60]:='<';XCHR[61]:='=';
+XCHR[62]:='>';XCHR[63]:='?';XCHR[64]:='@';XCHR[65]:='A';XCHR[66]:='B';
+XCHR[67]:='C';XCHR[68]:='D';XCHR[69]:='E';XCHR[70]:='F';XCHR[71]:='G';
+XCHR[72]:='H';XCHR[73]:='I';XCHR[74]:='J';XCHR[75]:='K';XCHR[76]:='L';
+XCHR[77]:='M';XCHR[78]:='N';XCHR[79]:='O';XCHR[80]:='P';XCHR[81]:='Q';
+XCHR[82]:='R';XCHR[83]:='S';XCHR[84]:='T';XCHR[85]:='U';XCHR[86]:='V';
+XCHR[87]:='W';XCHR[88]:='X';XCHR[89]:='Y';XCHR[90]:='Z';XCHR[91]:='[';
+XCHR[92]:='\';XCHR[93]:=']';XCHR[94]:='^';XCHR[95]:='_';XCHR[96]:='`';
+XCHR[97]:='a';XCHR[98]:='b';XCHR[99]:='c';XCHR[100]:='d';XCHR[101]:='e';
+XCHR[102]:='f';XCHR[103]:='g';XCHR[104]:='h';XCHR[105]:='i';
+XCHR[106]:='j';XCHR[107]:='k';XCHR[108]:='l';XCHR[109]:='m';
+XCHR[110]:='n';XCHR[111]:='o';XCHR[112]:='p';XCHR[113]:='q';
+XCHR[114]:='r';XCHR[115]:='s';XCHR[116]:='t';XCHR[117]:='u';
+XCHR[118]:='v';XCHR[119]:='w';XCHR[120]:='x';XCHR[121]:='y';
+XCHR[122]:='z';XCHR[123]:='{';XCHR[124]:='|';XCHR[125]:='}';
+XCHR[126]:='~';XCHR[0]:=' ';XCHR[127]:=' ';{:14}{17:}
+FOR I:=1 TO 31 DO XCHR[I]:=' ';{:17}{18:}
+FOR I:=0 TO 127 DO XORD[CHR(I)]:=32;FOR I:=1 TO 126 DO XORD[XCHR[I]]:=I;
+{:18}{21:}REWRITE(TERMOUT,'TTY:');{:21}{26:}REWRITE(PASCALFILE);
+REWRITE(POOL);{:26}{42:}FOR WI:=0 TO 1 DO BEGIN BYTESTART[WI]:=0;
+BYTEPTR[WI]:=0;END;BYTESTART[2]:=0;NAMEPTR:=1;STRINGPTR:=128;
+POOLCHECKSUM:=271828;{:42}{46:}FOR ZI:=0 TO 2 DO BEGIN TOKSTART[ZI]:=0;
+TOKPTR[ZI]:=0;END;TOKSTART[3]:=0;TEXTPTR:=1;Z:=1 MOD 3;{:46}{48:}
+ILK[0]:=0;EQUIV[0]:=0;{:48}{52:}
+FOR H:=0 TO HASHSIZE-1 DO BEGIN HASH[H]:=0;CHOPHASH[H]:=0;END;{:52}{71:}
+LASTUNNAMED:=0;TEXTLINK[0]:=0;{:71}{144:}SCANNINGHEX:=FALSE;{:144}{152:}
+MODTEXT[0]:=32;{:152}{180:}TROUBLESHOOT:=TRUE;DEBUGCYCLE:=1;
+DEBUGSKIPPED:=0;TROUBLESHOOT:=FALSE;DEBUGCYCLE:=99999;
+RESET(TERMIN,'TTY:','/I');{:180}END;{:2}{24:}PROCEDURE OPENINPUT;
+BEGIN RESET(WEBFILE);RESET(CHANGEFILE);END;{:24}{28:}
+FUNCTION INPUTLN(VAR F:TEXTFILE):BOOLEAN;VAR FINALLIMIT:0..BUFSIZE;
+BEGIN LIMIT:=0;FINALLIMIT:=0;
+IF EOF(F)THEN INPUTLN:=FALSE ELSE BEGIN WHILE NOT EOLN(F)DO BEGIN BUFFER
+[LIMIT]:=XORD[F^];GET(F);LIMIT:=LIMIT+1;
+IF BUFFER[LIMIT-1]<>32 THEN FINALLIMIT:=LIMIT;
+IF LIMIT=BUFSIZE THEN BEGIN WHILE NOT EOLN(F)DO GET(F);LIMIT:=LIMIT-1;
+BEGIN WRITELN(TERMOUT);WRITE(TERMOUT,'! Input line too long');END;
+LOC:=0;ERROR;END;END;READLN(F);LIMIT:=FINALLIMIT;INPUTLN:=TRUE;END;END;
+{:28}{49:}PROCEDURE PRINTID(P:NAMEPOINTER);VAR K:0..MAXBYTES;W:0..1;
+BEGIN IF P>=NAMEPTR THEN WRITE(TERMOUT,'IMPOSSIBLE')ELSE BEGIN W:=P MOD
+2;
+FOR K:=BYTESTART[P]TO BYTESTART[P+2]-1 DO WRITE(TERMOUT,XCHR[BYTEMEM[W,K
+]]);END;END;{:49}{53:}FUNCTION IDLOOKUP(T:EIGHTBITS):NAMEPOINTER;
+LABEL 31,32;VAR C:EIGHTBITS;I:0..BUFSIZE;H:0..HASHSIZE;K:0..MAXBYTES;
+W:0..1;L:0..BUFSIZE;P,Q:NAMEPOINTER;S:0..UNAMBIGLENGT;
+BEGIN L:=IDLOC-IDFIRST;{54:}H:=BUFFER[IDFIRST];I:=IDFIRST+1;
+WHILE I<IDLOC DO BEGIN H:=(H+H+BUFFER[I])MOD HASHSIZE;I:=I+1;END{:54};
+{55:}P:=HASH[H];
+WHILE P<>0 DO BEGIN IF BYTESTART[P+2]-BYTESTART[P]=L THEN{56:}
+BEGIN I:=IDFIRST;K:=BYTESTART[P];W:=P MOD 2;
+WHILE(I<IDLOC)AND(BUFFER[I]=BYTEMEM[W,K])DO BEGIN I:=I+1;K:=K+1;END;
+IF I=IDLOC THEN GOTO 31;END{:56};P:=LINK[P];END;P:=NAMEPTR;
+LINK[P]:=HASH[H];HASH[H]:=P;31:{:55};IF(P=NAMEPTR)OR(T<>0)THEN{57:}
+BEGIN IF((P<>NAMEPTR)AND(T<>0)AND(ILK[P]=0))OR((P=NAMEPTR)AND(T=0)AND(
+BUFFER[IDFIRST]<>34))THEN{58:}BEGIN I:=IDFIRST;S:=0;H:=0;
+WHILE(I<IDLOC)AND(S<UNAMBIGLENGT)DO BEGIN IF BUFFER[I]<>95 THEN BEGIN IF
+BUFFER[I]>=97 THEN CHOPPEDID[S]:=BUFFER[I]-32 ELSE CHOPPEDID[S]:=BUFFER[
+I];H:=(H+H+CHOPPEDID[S])MOD HASHSIZE;S:=S+1;END;I:=I+1;END;
+CHOPPEDID[S]:=0;END{:58};IF P<>NAMEPTR THEN{59:}
+BEGIN IF ILK[P]=0 THEN BEGIN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! This identifier has already appeared');ERROR;END;{60:}
+Q:=CHOPHASH[H];
+IF Q=P THEN CHOPHASH[H]:=EQUIV[P]ELSE BEGIN WHILE EQUIV[Q]<>P DO Q:=
+EQUIV[Q];EQUIV[Q]:=EQUIV[P];END{:60};END ELSE BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! This identifier was defined before');ERROR;END;
+ILK[P]:=T;END{:59}ELSE{61:}
+BEGIN IF(T=0)AND(BUFFER[IDFIRST]<>34)THEN{62:}BEGIN Q:=CHOPHASH[H];
+WHILE Q<>0 DO BEGIN{63:}BEGIN K:=BYTESTART[Q];S:=0;W:=Q MOD 2;
+WHILE(K<BYTESTART[Q+2])AND(S<UNAMBIGLENGT)DO BEGIN C:=BYTEMEM[W,K];
+IF C<>95 THEN BEGIN IF C>=97 THEN C:=C-32;
+IF CHOPPEDID[S]<>C THEN GOTO 32;S:=S+1;END;K:=K+1;END;
+IF(K=BYTESTART[Q+2])AND(CHOPPEDID[S]<>0)THEN GOTO 32;
+BEGIN WRITELN(TERMOUT);WRITE(TERMOUT,'! Identifier conflict with ');END;
+FOR K:=BYTESTART[Q]TO BYTESTART[Q+2]-1 DO WRITE(TERMOUT,XCHR[BYTEMEM[W,K
+]]);ERROR;Q:=0;32:END{:63};Q:=EQUIV[Q];END;EQUIV[P]:=CHOPHASH[H];
+CHOPHASH[H]:=P;END{:62};W:=NAMEPTR MOD 2;K:=BYTEPTR[W];
+IF K+L>MAXBYTES THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Sorry, ','byte memory',' capacity exceeded');ERROR;
+HISTORY:=3;JUMPOUT;END;
+IF NAMEPTR>MAXNAMES-2 THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Sorry, ','name',' capacity exceeded');ERROR;HISTORY:=3;
+JUMPOUT;END;I:=IDFIRST;WHILE I<IDLOC DO BEGIN BYTEMEM[W,K]:=BUFFER[I];
+K:=K+1;I:=I+1;END;BYTEPTR[W]:=K;BYTESTART[NAMEPTR+2]:=K;
+NAMEPTR:=NAMEPTR+1;IF BUFFER[IDFIRST]<>34 THEN ILK[P]:=T ELSE{64:}
+BEGIN ILK[P]:=1;
+IF L-DOUBLECHARS=2 THEN EQUIV[P]:=BUFFER[IDFIRST+1]+32768 ELSE BEGIN
+EQUIV[P]:=STRINGPTR+32768;L:=L-DOUBLECHARS-1;
+IF L>99 THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Preprocessed string is too long');ERROR;END;
+STRINGPTR:=STRINGPTR+1;WRITE(POOL,XCHR[48+L DIV 10],XCHR[48+L MOD 10]);
+POOLCHECKSUM:=POOLCHECKSUM+POOLCHECKSUM+L;
+WHILE POOLCHECKSUM>536870839 DO POOLCHECKSUM:=POOLCHECKSUM-536870839;
+I:=IDFIRST+1;WHILE I<IDLOC DO BEGIN WRITE(POOL,XCHR[BUFFER[I]]);
+POOLCHECKSUM:=POOLCHECKSUM+POOLCHECKSUM+BUFFER[I];
+WHILE POOLCHECKSUM>536870839 DO POOLCHECKSUM:=POOLCHECKSUM-536870839;
+IF(BUFFER[I]=34)OR(BUFFER[I]=64)THEN I:=I+2 ELSE I:=I+1;END;
+WRITELN(POOL);END;END{:64};END{:61};END{:57};IDLOOKUP:=P;END;{:53}{66:}
+FUNCTION MODLOOKUP(L:SIXTEENBITS):NAMEPOINTER;LABEL 31;VAR C:0..4;
+J:0..LONGESTNAME;K:0..MAXBYTES;W:0..1;P:NAMEPOINTER;Q:NAMEPOINTER;
+BEGIN C:=2;Q:=0;P:=ILK[0];WHILE P<>0 DO BEGIN{68:}BEGIN K:=BYTESTART[P];
+W:=P MOD 2;C:=1;J:=1;
+WHILE(K<BYTESTART[P+2])AND(J<=L)AND(MODTEXT[J]=BYTEMEM[W,K])DO BEGIN K:=
+K+1;J:=J+1;END;
+IF K=BYTESTART[P+2]THEN IF J>L THEN C:=1 ELSE C:=4 ELSE IF J>L THEN C:=3
+ELSE IF MODTEXT[J]<BYTEMEM[W,K]THEN C:=0 ELSE C:=2;END{:68};Q:=P;
+IF C=0 THEN P:=LINK[Q]ELSE IF C=2 THEN P:=ILK[Q]ELSE GOTO 31;END;{67:}
+W:=NAMEPTR MOD 2;K:=BYTEPTR[W];
+IF K+L>MAXBYTES THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Sorry, ','byte memory',' capacity exceeded');ERROR;
+HISTORY:=3;JUMPOUT;END;
+IF NAMEPTR>MAXNAMES-2 THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Sorry, ','name',' capacity exceeded');ERROR;HISTORY:=3;
+JUMPOUT;END;P:=NAMEPTR;IF C=0 THEN LINK[Q]:=P ELSE ILK[Q]:=P;LINK[P]:=0;
+ILK[P]:=0;C:=1;EQUIV[P]:=0;
+FOR J:=1 TO L DO BYTEMEM[W,K+J-1]:=MODTEXT[J];BYTEPTR[W]:=K+L;
+BYTESTART[NAMEPTR+2]:=K+L;NAMEPTR:=NAMEPTR+1;{:67};
+31:IF C<>1 THEN BEGIN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Incompatible section names');ERROR;END;P:=0;END;
+MODLOOKUP:=P;END;{:66}{69:}
+FUNCTION PREFIXLOOKUP(L:SIXTEENBITS):NAMEPOINTER;VAR C:0..4;
+COUNT:0..MAXNAMES;J:0..LONGESTNAME;K:0..MAXBYTES;W:0..1;P:NAMEPOINTER;
+Q:NAMEPOINTER;R:NAMEPOINTER;BEGIN Q:=0;P:=ILK[0];COUNT:=0;R:=0;
+WHILE P<>0 DO BEGIN{68:}BEGIN K:=BYTESTART[P];W:=P MOD 2;C:=1;J:=1;
+WHILE(K<BYTESTART[P+2])AND(J<=L)AND(MODTEXT[J]=BYTEMEM[W,K])DO BEGIN K:=
+K+1;J:=J+1;END;
+IF K=BYTESTART[P+2]THEN IF J>L THEN C:=1 ELSE C:=4 ELSE IF J>L THEN C:=3
+ELSE IF MODTEXT[J]<BYTEMEM[W,K]THEN C:=0 ELSE C:=2;END{:68};
+IF C=0 THEN P:=LINK[P]ELSE IF C=2 THEN P:=ILK[P]ELSE BEGIN R:=P;
+COUNT:=COUNT+1;Q:=ILK[P];P:=LINK[P];END;IF P=0 THEN BEGIN P:=Q;Q:=0;END;
+END;IF COUNT<>1 THEN IF COUNT=0 THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Name does not match');ERROR;
+END ELSE BEGIN WRITELN(TERMOUT);WRITE(TERMOUT,'! Ambiguous prefix');
+ERROR;END;PREFIXLOOKUP:=R;END;{:69}{73:}
+PROCEDURE STORETWOBYTE(X:SIXTEENBITS);
+BEGIN IF TOKPTR[Z]+2>MAXTOKS THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Sorry, ','token',' capacity exceeded');ERROR;
+HISTORY:=3;JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=X DIV 256;
+TOKMEM[Z,TOKPTR[Z]+1]:=X MOD 256;TOKPTR[Z]:=TOKPTR[Z]+2;END;{:73}{74:}
+PROCEDURE PRINTREPL(P:TEXTPOINTER);VAR K:0..MAXTOKS;A:SIXTEENBITS;
+ZP:0..2;
+BEGIN IF P>=TEXTPTR THEN WRITE(TERMOUT,'BAD')ELSE BEGIN K:=TOKSTART[P];
+ZP:=P MOD 3;WHILE K<TOKSTART[P+3]DO BEGIN A:=TOKMEM[ZP,K];
+IF A>=128 THEN{75:}BEGIN K:=K+1;
+IF A<168 THEN BEGIN A:=(A-128)*256+TOKMEM[ZP,K];PRINTID(A);
+IF BYTEMEM[A MOD 2,BYTESTART[A]]=34 THEN WRITE(TERMOUT,'"')ELSE WRITE(
+TERMOUT,' ');END ELSE IF A<208 THEN BEGIN WRITE(TERMOUT,'@<');
+PRINTID((A-168)*256+TOKMEM[ZP,K]);WRITE(TERMOUT,'@>');
+END ELSE BEGIN A:=(A-208)*256+TOKMEM[ZP,K];
+WRITE(TERMOUT,'@',XCHR[123],A:1,'@',XCHR[125]);END;END{:75}ELSE{76:}
+CASE A OF 9:WRITE(TERMOUT,'@',XCHR[123]);
+10:WRITE(TERMOUT,'@',XCHR[125]);12:WRITE(TERMOUT,'@''');
+13:WRITE(TERMOUT,'@"');125:WRITE(TERMOUT,'@$');0:WRITE(TERMOUT,'#');
+64:WRITE(TERMOUT,'@@');2:WRITE(TERMOUT,'@=');3:WRITE(TERMOUT,'@\');
+OTHERS:WRITE(TERMOUT,XCHR[A])END{:76};K:=K+1;END;END;END;{:74}{84:}
+PROCEDURE PUSHLEVEL(P:NAMEPOINTER);
+BEGIN IF STACKPTR=STACKSIZE THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Sorry, ','stack',' capacity exceeded');ERROR;
+HISTORY:=3;JUMPOUT;END ELSE BEGIN STACK[STACKPTR]:=CURSTATE;
+STACKPTR:=STACKPTR+1;CURSTATE.NAMEFIELD:=P;CURSTATE.REPLFIELD:=EQUIV[P];
+ZO:=CURSTATE.REPLFIELD MOD 3;
+CURSTATE.BYTEFIELD:=TOKSTART[CURSTATE.REPLFIELD];
+CURSTATE.ENDFIELD:=TOKSTART[CURSTATE.REPLFIELD+3];CURSTATE.MODFIELD:=0;
+END;END;{:84}{85:}PROCEDURE POPLEVEL;LABEL 10;
+BEGIN IF TEXTLINK[CURSTATE.REPLFIELD]=0 THEN BEGIN IF ILK[CURSTATE.
+NAMEFIELD]=3 THEN{91:}BEGIN NAMEPTR:=NAMEPTR-1;TEXTPTR:=TEXTPTR-1;
+Z:=TEXTPTR MOD 3;IF TOKPTR[Z]>MAXTOKPTR[Z]THEN MAXTOKPTR[Z]:=TOKPTR[Z];
+TOKPTR[Z]:=TOKSTART[TEXTPTR];
+BYTEPTR[NAMEPTR MOD 2]:=BYTEPTR[NAMEPTR MOD 2]-1;END{:91};
+END ELSE IF TEXTLINK[CURSTATE.REPLFIELD]<MAXTEXTS THEN BEGIN CURSTATE.
+REPLFIELD:=TEXTLINK[CURSTATE.REPLFIELD];ZO:=CURSTATE.REPLFIELD MOD 3;
+CURSTATE.BYTEFIELD:=TOKSTART[CURSTATE.REPLFIELD];
+CURSTATE.ENDFIELD:=TOKSTART[CURSTATE.REPLFIELD+3];GOTO 10;END;
+STACKPTR:=STACKPTR-1;IF STACKPTR>0 THEN BEGIN CURSTATE:=STACK[STACKPTR];
+ZO:=CURSTATE.REPLFIELD MOD 3;END;10:END;{:85}{87:}
+FUNCTION GETOUTPUT:SIXTEENBITS;LABEL 20,30,31;VAR A:SIXTEENBITS;
+B:EIGHTBITS;BAL:SIXTEENBITS;K:0..MAXBYTES;W:0..1;
+BEGIN 20:IF STACKPTR=0 THEN BEGIN A:=0;GOTO 31;END;
+IF CURSTATE.BYTEFIELD=CURSTATE.ENDFIELD THEN BEGIN CURVAL:=-CURSTATE.
+MODFIELD;POPLEVEL;IF CURVAL=0 THEN GOTO 20;A:=129;GOTO 31;END;
+A:=TOKMEM[ZO,CURSTATE.BYTEFIELD];
+CURSTATE.BYTEFIELD:=CURSTATE.BYTEFIELD+1;IF A<128 THEN IF A=0 THEN{92:}
+BEGIN PUSHLEVEL(NAMEPTR-1);GOTO 20;END{:92}ELSE GOTO 31;
+A:=(A-128)*256+TOKMEM[ZO,CURSTATE.BYTEFIELD];
+CURSTATE.BYTEFIELD:=CURSTATE.BYTEFIELD+1;IF A<10240 THEN{89:}
+BEGIN CASE ILK[A]OF 0:BEGIN CURVAL:=A;A:=130;END;
+1:BEGIN CURVAL:=EQUIV[A]-32768;A:=128;END;2:BEGIN PUSHLEVEL(A);GOTO 20;
+END;3:BEGIN{90:}
+WHILE(CURSTATE.BYTEFIELD=CURSTATE.ENDFIELD)AND(STACKPTR>0)DO POPLEVEL;
+IF(STACKPTR=0)OR(TOKMEM[ZO,CURSTATE.BYTEFIELD]<>40)THEN BEGIN BEGIN
+WRITELN(TERMOUT);WRITE(TERMOUT,'! No parameter given for ');END;
+PRINTID(A);ERROR;GOTO 20;END;{93:}BAL:=1;
+CURSTATE.BYTEFIELD:=CURSTATE.BYTEFIELD+1;
+WHILE TRUE DO BEGIN B:=TOKMEM[ZO,CURSTATE.BYTEFIELD];
+CURSTATE.BYTEFIELD:=CURSTATE.BYTEFIELD+1;
+IF B=0 THEN STORETWOBYTE(NAMEPTR+32767)ELSE BEGIN IF B>=128 THEN BEGIN
+BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Sorry, ','token',' capacity exceeded');ERROR;
+HISTORY:=3;JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=B;TOKPTR[Z]:=TOKPTR[Z]+1;
+END;B:=TOKMEM[ZO,CURSTATE.BYTEFIELD];
+CURSTATE.BYTEFIELD:=CURSTATE.BYTEFIELD+1;
+END ELSE CASE B OF 40:BAL:=BAL+1;41:BEGIN BAL:=BAL-1;
+IF BAL=0 THEN GOTO 30;END;
+39:REPEAT BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Sorry, ','token',' capacity exceeded');ERROR;
+HISTORY:=3;JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=B;TOKPTR[Z]:=TOKPTR[Z]+1;
+END;B:=TOKMEM[ZO,CURSTATE.BYTEFIELD];
+CURSTATE.BYTEFIELD:=CURSTATE.BYTEFIELD+1;UNTIL B=39;OTHERS:END;
+BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Sorry, ','token',' capacity exceeded');ERROR;
+HISTORY:=3;JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=B;TOKPTR[Z]:=TOKPTR[Z]+1;
+END;END;END;30:{:93};EQUIV[NAMEPTR]:=TEXTPTR;ILK[NAMEPTR]:=2;
+W:=NAMEPTR MOD 2;K:=BYTEPTR[W];
+IF K=MAXBYTES THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Sorry, ','byte memory',' capacity exceeded');ERROR;
+HISTORY:=3;JUMPOUT;END;BYTEMEM[W,K]:=35;K:=K+1;BYTEPTR[W]:=K;
+IF NAMEPTR>MAXNAMES-2 THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Sorry, ','name',' capacity exceeded');ERROR;HISTORY:=3;
+JUMPOUT;END;BYTESTART[NAMEPTR+2]:=K;NAMEPTR:=NAMEPTR+1;
+IF TEXTPTR>MAXTEXTS-3 THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Sorry, ','text',' capacity exceeded');ERROR;HISTORY:=3;
+JUMPOUT;END;TEXTLINK[TEXTPTR]:=0;TOKSTART[TEXTPTR+3]:=TOKPTR[Z];
+TEXTPTR:=TEXTPTR+1;Z:=TEXTPTR MOD 3{:90};PUSHLEVEL(A);GOTO 20;END;
+OTHERS:BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! This can''t happen (','output',')');ERROR;HISTORY:=3;
+JUMPOUT;END END;GOTO 31;END{:89};IF A<20480 THEN{88:}BEGIN A:=A-10240;
+IF EQUIV[A]<>0 THEN PUSHLEVEL(A)ELSE IF A<>0 THEN BEGIN BEGIN WRITELN(
+TERMOUT);WRITE(TERMOUT,'! Not present: <');END;PRINTID(A);
+WRITE(TERMOUT,'>');ERROR;END;GOTO 20;END{:88};CURVAL:=A-20480;A:=129;
+CURSTATE.MODFIELD:=CURVAL;31:IF TROUBLESHOOT THEN DEBUGHELP;
+GETOUTPUT:=A;END;{:87}{97:}PROCEDURE FLUSHBUFFER;VAR K:0..OUTBUFSIZE;
+B:0..OUTBUFSIZE;BEGIN B:=BREAKPTR;
+IF(SEMIPTR<>0)AND(OUTPTR-SEMIPTR<=LINELENGTH)THEN BREAKPTR:=SEMIPTR;
+FOR K:=1 TO BREAKPTR DO WRITE(PASCALFILE,XCHR[OUTBUF[K-1]]);
+WRITELN(PASCALFILE);LINE:=LINE+1;
+IF LINE MOD 100=0 THEN BEGIN WRITE(TERMOUT,'.');
+IF LINE MOD 500=0 THEN WRITE(TERMOUT,LINE:1);BREAK(TERMOUT);END;
+IF BREAKPTR<OUTPTR THEN BEGIN IF OUTBUF[BREAKPTR]=32 THEN BEGIN BREAKPTR
+:=BREAKPTR+1;IF BREAKPTR>B THEN B:=BREAKPTR;END;
+FOR K:=BREAKPTR TO OUTPTR-1 DO OUTBUF[K-BREAKPTR]:=OUTBUF[K];END;
+OUTPTR:=OUTPTR-BREAKPTR;BREAKPTR:=B-BREAKPTR;SEMIPTR:=0;
+IF OUTPTR>LINELENGTH THEN BEGIN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Long line must be truncated');ERROR;END;
+OUTPTR:=LINELENGTH;END;END;{:97}{99:}PROCEDURE APPVAL(V:INTEGER);
+VAR K:0..OUTBUFSIZE;BEGIN K:=OUTBUFSIZE;REPEAT OUTBUF[K]:=V MOD 10;
+V:=V DIV 10;K:=K-1;UNTIL V=0;REPEAT K:=K+1;
+BEGIN OUTBUF[OUTPTR]:=OUTBUF[K]+48;OUTPTR:=OUTPTR+1;END;
+UNTIL K=OUTBUFSIZE;END;{:99}{101:}PROCEDURE SENDOUT(T:EIGHTBITS;
+V:SIXTEENBITS);LABEL 20;VAR K:0..LINELENGTH;BEGIN{102:}
+20:CASE OUTSTATE OF 1:IF T<>3 THEN BEGIN BREAKPTR:=OUTPTR;
+IF T=2 THEN BEGIN OUTBUF[OUTPTR]:=32;OUTPTR:=OUTPTR+1;END;END;
+2:BEGIN BEGIN OUTBUF[OUTPTR]:=44-OUTAPP;OUTPTR:=OUTPTR+1;END;
+IF OUTPTR>LINELENGTH THEN FLUSHBUFFER;BREAKPTR:=OUTPTR;END;
+3,4:BEGIN{103:}
+IF(OUTVAL<0)OR((OUTVAL=0)AND(LASTSIGN<0))THEN BEGIN OUTBUF[OUTPTR]:=45;
+OUTPTR:=OUTPTR+1;
+END ELSE IF OUTSIGN>0 THEN BEGIN OUTBUF[OUTPTR]:=OUTSIGN;
+OUTPTR:=OUTPTR+1;END;APPVAL(ABS(OUTVAL));
+IF OUTPTR>LINELENGTH THEN FLUSHBUFFER;{:103};OUTSTATE:=OUTSTATE-2;
+GOTO 20;END;5:{104:}BEGIN IF(T=3)OR({105:}
+((T=2)AND(V=3)AND(((OUTCONTRIB[1]=68)AND(OUTCONTRIB[2]=73)AND(OUTCONTRIB
+[3]=86))OR((OUTCONTRIB[1]=77)AND(OUTCONTRIB[2]=79)AND(OUTCONTRIB[3]=68))
+))OR((T=0)AND((V=42)OR(V=47))){:105})THEN BEGIN{103:}
+IF(OUTVAL<0)OR((OUTVAL=0)AND(LASTSIGN<0))THEN BEGIN OUTBUF[OUTPTR]:=45;
+OUTPTR:=OUTPTR+1;
+END ELSE IF OUTSIGN>0 THEN BEGIN OUTBUF[OUTPTR]:=OUTSIGN;
+OUTPTR:=OUTPTR+1;END;APPVAL(ABS(OUTVAL));
+IF OUTPTR>LINELENGTH THEN FLUSHBUFFER;{:103};OUTSIGN:=43;OUTVAL:=OUTAPP;
+END ELSE OUTVAL:=OUTVAL+OUTAPP;OUTSTATE:=3;GOTO 20;END{:104};
+0:IF T<>3 THEN BREAKPTR:=OUTPTR;OTHERS:END{:102};
+IF T<>0 THEN FOR K:=1 TO V DO BEGIN OUTBUF[OUTPTR]:=OUTCONTRIB[K];
+OUTPTR:=OUTPTR+1;END ELSE BEGIN OUTBUF[OUTPTR]:=V;OUTPTR:=OUTPTR+1;END;
+IF OUTPTR>LINELENGTH THEN FLUSHBUFFER;
+IF(T=0)AND((V=59)OR(V=125))THEN BEGIN SEMIPTR:=OUTPTR;BREAKPTR:=OUTPTR;
+END;IF T>=2 THEN OUTSTATE:=1 ELSE OUTSTATE:=0 END;{:101}{106:}
+PROCEDURE SENDSIGN(V:INTEGER);
+BEGIN CASE OUTSTATE OF 2,4:OUTAPP:=OUTAPP*V;3:BEGIN OUTAPP:=V;
+OUTSTATE:=4;END;5:BEGIN OUTVAL:=OUTVAL+OUTAPP;OUTAPP:=V;OUTSTATE:=4;END;
+OTHERS:BEGIN BREAKPTR:=OUTPTR;OUTAPP:=V;OUTSTATE:=2;END END;
+LASTSIGN:=OUTAPP;END;{:106}{107:}PROCEDURE SENDVAL(V:INTEGER);
+LABEL 666,10;BEGIN CASE OUTSTATE OF 1:BEGIN{110:}
+IF(OUTPTR=BREAKPTR+3)OR((OUTPTR=BREAKPTR+4)AND(OUTBUF[BREAKPTR]=32))THEN
+IF((OUTBUF[OUTPTR-3]=68)AND(OUTBUF[OUTPTR-2]=73)AND(OUTBUF[OUTPTR-1]=86)
+)OR((OUTBUF[OUTPTR-3]=77)AND(OUTBUF[OUTPTR-2]=79)AND(OUTBUF[OUTPTR-1]=68
+))THEN GOTO 666{:110};OUTSIGN:=32;OUTSTATE:=3;OUTVAL:=V;
+BREAKPTR:=OUTPTR;LASTSIGN:=+1;END;0:BEGIN{109:}
+IF(OUTPTR=BREAKPTR+1)AND((OUTBUF[BREAKPTR]=42)OR(OUTBUF[BREAKPTR]=47))
+THEN GOTO 666{:109};OUTSIGN:=0;OUTSTATE:=3;OUTVAL:=V;BREAKPTR:=OUTPTR;
+LASTSIGN:=+1;END;{108:}2:BEGIN OUTSIGN:=43;OUTSTATE:=3;OUTVAL:=OUTAPP*V;
+END;3:BEGIN OUTSTATE:=5;OUTAPP:=V;BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Two numbers occurred without a sign between them');
+ERROR;END;END;4:BEGIN OUTSTATE:=5;OUTAPP:=OUTAPP*V;END;
+5:BEGIN OUTVAL:=OUTVAL+OUTAPP;OUTAPP:=V;BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Two numbers occurred without a sign between them');
+ERROR;END;END;{:108}OTHERS:GOTO 666 END;GOTO 10;666:{111:}
+IF V>=0 THEN BEGIN IF OUTSTATE=1 THEN BEGIN BREAKPTR:=OUTPTR;
+BEGIN OUTBUF[OUTPTR]:=32;OUTPTR:=OUTPTR+1;END;END;APPVAL(V);
+IF OUTPTR>LINELENGTH THEN FLUSHBUFFER;OUTSTATE:=1;
+END ELSE BEGIN BEGIN OUTBUF[OUTPTR]:=40;OUTPTR:=OUTPTR+1;END;
+BEGIN OUTBUF[OUTPTR]:=45;OUTPTR:=OUTPTR+1;END;APPVAL(-V);
+BEGIN OUTBUF[OUTPTR]:=41;OUTPTR:=OUTPTR+1;END;
+IF OUTPTR>LINELENGTH THEN FLUSHBUFFER;OUTSTATE:=0;END{:111};10:END;
+{:107}{113:}PROCEDURE SENDTHEOUTPU;LABEL 2,21,22;VAR CURCHAR:EIGHTBITS;
+K:0..LINELENGTH;J:0..MAXBYTES;W:0..1;N:INTEGER;
+BEGIN WHILE STACKPTR>0 DO BEGIN CURCHAR:=GETOUTPUT;
+21:CASE CURCHAR OF 0:;{116:}
+65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,
+89,90:BEGIN OUTCONTRIB[1]:=CURCHAR;SENDOUT(2,1);END;
+97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113,114,115
+,116,117,118,119,120,121,122:BEGIN OUTCONTRIB[1]:=CURCHAR-32;
+SENDOUT(2,1);END;130:BEGIN K:=0;J:=BYTESTART[CURVAL];W:=CURVAL MOD 2;
+WHILE(K<MAXIDLENGTH)AND(J<BYTESTART[CURVAL+2])DO BEGIN K:=K+1;
+OUTCONTRIB[K]:=BYTEMEM[W,J];J:=J+1;
+IF OUTCONTRIB[K]>=97 THEN OUTCONTRIB[K]:=OUTCONTRIB[K]-32 ELSE IF
+OUTCONTRIB[K]=95 THEN K:=K-1;END;SENDOUT(2,K);END;{:116}{119:}
+48,49,50,51,52,53,54,55,56,57:BEGIN N:=0;REPEAT CURCHAR:=CURCHAR-48;
+IF N>=214748364 THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Constant too big');ERROR;END ELSE N:=10*N+CURCHAR;
+CURCHAR:=GETOUTPUT;UNTIL(CURCHAR>57)OR(CURCHAR<48);SENDVAL(N);K:=0;
+IF CURCHAR=101 THEN CURCHAR:=69;IF CURCHAR=69 THEN GOTO 2 ELSE GOTO 21;
+END;125:SENDVAL(POOLCHECKSUM);12:BEGIN N:=0;CURCHAR:=48;
+REPEAT CURCHAR:=CURCHAR-48;IF N>=268435456 THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Constant too big');ERROR;END ELSE N:=8*N+CURCHAR;
+CURCHAR:=GETOUTPUT;UNTIL(CURCHAR>55)OR(CURCHAR<48);SENDVAL(N);GOTO 21;
+END;13:BEGIN N:=0;CURCHAR:=48;
+REPEAT IF CURCHAR>=65 THEN CURCHAR:=CURCHAR-55 ELSE CURCHAR:=CURCHAR-48;
+IF N>=134217728 THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Constant too big');ERROR;END ELSE N:=16*N+CURCHAR;
+CURCHAR:=GETOUTPUT;
+UNTIL(CURCHAR>70)OR(CURCHAR<48)OR((CURCHAR>57)AND(CURCHAR<65));
+SENDVAL(N);GOTO 21;END;128:SENDVAL(CURVAL);46:BEGIN K:=1;
+OUTCONTRIB[1]:=46;CURCHAR:=GETOUTPUT;
+IF CURCHAR=46 THEN BEGIN OUTCONTRIB[2]:=46;SENDOUT(1,2);
+END ELSE IF(CURCHAR>=48)AND(CURCHAR<=57)THEN GOTO 2 ELSE BEGIN SENDOUT(0
+,46);GOTO 21;END;END;{:119}43,45:SENDSIGN(44-CURCHAR);{114:}
+4:BEGIN OUTCONTRIB[1]:=65;OUTCONTRIB[2]:=78;OUTCONTRIB[3]:=68;
+SENDOUT(2,3);END;5:BEGIN OUTCONTRIB[1]:=78;OUTCONTRIB[2]:=79;
+OUTCONTRIB[3]:=84;SENDOUT(2,3);END;6:BEGIN OUTCONTRIB[1]:=73;
+OUTCONTRIB[2]:=78;SENDOUT(2,2);END;31:BEGIN OUTCONTRIB[1]:=79;
+OUTCONTRIB[2]:=82;SENDOUT(2,2);END;24:BEGIN OUTCONTRIB[1]:=58;
+OUTCONTRIB[2]:=61;SENDOUT(1,2);END;26:BEGIN OUTCONTRIB[1]:=60;
+OUTCONTRIB[2]:=62;SENDOUT(1,2);END;28:BEGIN OUTCONTRIB[1]:=60;
+OUTCONTRIB[2]:=61;SENDOUT(1,2);END;29:BEGIN OUTCONTRIB[1]:=62;
+OUTCONTRIB[2]:=61;SENDOUT(1,2);END;30:BEGIN OUTCONTRIB[1]:=61;
+OUTCONTRIB[2]:=61;SENDOUT(1,2);END;32:BEGIN OUTCONTRIB[1]:=46;
+OUTCONTRIB[2]:=46;SENDOUT(1,2);END;{:114}39:{117:}BEGIN K:=1;
+OUTCONTRIB[1]:=39;REPEAT IF K<LINELENGTH THEN K:=K+1;
+OUTCONTRIB[K]:=GETOUTPUT;UNTIL(OUTCONTRIB[K]=39)OR(STACKPTR=0);
+IF K=LINELENGTH THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! String too long');ERROR;END;SENDOUT(1,K);
+CURCHAR:=GETOUTPUT;IF CURCHAR=39 THEN OUTSTATE:=6;GOTO 21;END{:117};
+{115:}
+33,34,35,36,37,38,40,41,42,44,47,58,59,60,61,62,63,64,91,92,93,94,95,96,
+123,124{:115}:SENDOUT(0,CURCHAR);{121:}
+9:BEGIN IF BRACELEVEL=0 THEN SENDOUT(0,123)ELSE SENDOUT(0,91);
+BRACELEVEL:=BRACELEVEL+1;END;
+10:IF BRACELEVEL>0 THEN BEGIN BRACELEVEL:=BRACELEVEL-1;
+IF BRACELEVEL=0 THEN SENDOUT(0,125)ELSE SENDOUT(0,93);
+END ELSE BEGIN WRITELN(TERMOUT);WRITE(TERMOUT,'! Extra @}');ERROR;END;
+129:BEGIN IF BRACELEVEL=0 THEN SENDOUT(0,123)ELSE SENDOUT(0,91);
+IF CURVAL<0 THEN BEGIN SENDOUT(0,58);SENDVAL(-CURVAL);
+END ELSE BEGIN SENDVAL(CURVAL);SENDOUT(0,58);END;
+IF BRACELEVEL=0 THEN SENDOUT(0,125)ELSE SENDOUT(0,93);END;{:121}
+127:BEGIN SENDOUT(3,0);OUTSTATE:=6;END;2:{118:}BEGIN K:=0;
+REPEAT IF K<LINELENGTH THEN K:=K+1;OUTCONTRIB[K]:=GETOUTPUT;
+UNTIL(OUTCONTRIB[K]=2)OR(STACKPTR=0);
+IF K=LINELENGTH THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Verbatim string too long');ERROR;END;SENDOUT(1,K-1);
+END{:118};3:{122:}BEGIN SENDOUT(1,0);
+WHILE OUTPTR>0 DO BEGIN IF OUTPTR<=LINELENGTH THEN BREAKPTR:=OUTPTR;
+FLUSHBUFFER;END;OUTSTATE:=0;END{:122};OTHERS:BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Can''t output ASCII code ',CURCHAR:1);ERROR;END END;
+GOTO 22;2:{120:}REPEAT IF K<LINELENGTH THEN K:=K+1;
+OUTCONTRIB[K]:=CURCHAR;CURCHAR:=GETOUTPUT;
+IF(OUTCONTRIB[K]=69)AND((CURCHAR=43)OR(CURCHAR=45))THEN BEGIN IF K<
+LINELENGTH THEN K:=K+1;OUTCONTRIB[K]:=CURCHAR;CURCHAR:=GETOUTPUT;
+END ELSE IF CURCHAR=101 THEN CURCHAR:=69;
+UNTIL(CURCHAR<>69)AND((CURCHAR<48)OR(CURCHAR>57));
+IF K=LINELENGTH THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Fraction too long');ERROR;END;SENDOUT(3,K);
+GOTO 21{:120};22:END;END;{:113}{127:}FUNCTION LINESDONTMAT:BOOLEAN;
+LABEL 10;VAR K:0..BUFSIZE;BEGIN LINESDONTMAT:=TRUE;
+IF CHANGELIMIT<>LIMIT THEN GOTO 10;
+IF LIMIT>0 THEN FOR K:=0 TO LIMIT-1 DO IF CHANGEBUFFER[K]<>BUFFER[K]THEN
+GOTO 10;LINESDONTMAT:=FALSE;10:END;{:127}{128:}PROCEDURE PRIMETHECHAN;
+LABEL 22,30,10;VAR K:0..BUFSIZE;BEGIN CHANGELIMIT:=0;{129:}
+WHILE TRUE DO BEGIN LINE:=LINE+1;IF NOT INPUTLN(CHANGEFILE)THEN GOTO 10;
+IF LIMIT<2 THEN GOTO 22;IF BUFFER[0]<>64 THEN GOTO 22;
+IF(BUFFER[1]>=88)AND(BUFFER[1]<=90)THEN BUFFER[1]:=BUFFER[1]+32;
+IF BUFFER[1]=120 THEN GOTO 30;
+IF(BUFFER[1]=121)OR(BUFFER[1]=122)THEN BEGIN LOC:=2;
+BEGIN WRITELN(TERMOUT);WRITE(TERMOUT,'! Where is the matching @x?');
+ERROR;END;END;22:END;30:{:129};{130:}REPEAT LINE:=LINE+1;
+IF NOT INPUTLN(CHANGEFILE)THEN BEGIN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Change file ended after @x');ERROR;END;GOTO 10;END;
+UNTIL LIMIT>0;{:130};{131:}BEGIN CHANGELIMIT:=LIMIT;
+IF LIMIT>0 THEN FOR K:=0 TO LIMIT-1 DO CHANGEBUFFER[K]:=BUFFER[K];
+END{:131};10:END;{:128}{132:}PROCEDURE CHECKCHANGE;LABEL 10;
+VAR N:INTEGER;K:0..BUFSIZE;BEGIN IF LINESDONTMAT THEN GOTO 10;N:=0;
+WHILE TRUE DO BEGIN CHANGING:=NOT CHANGING;TEMPLINE:=OTHERLINE;
+OTHERLINE:=LINE;LINE:=TEMPLINE;LINE:=LINE+1;
+IF NOT INPUTLN(CHANGEFILE)THEN BEGIN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Change file ended before @y');ERROR;END;CHANGELIMIT:=0;
+CHANGING:=NOT CHANGING;TEMPLINE:=OTHERLINE;OTHERLINE:=LINE;
+LINE:=TEMPLINE;GOTO 10;END;{133:}
+IF LIMIT>1 THEN IF BUFFER[0]=64 THEN BEGIN IF(BUFFER[1]>=88)AND(BUFFER[1
+]<=90)THEN BUFFER[1]:=BUFFER[1]+32;
+IF(BUFFER[1]=120)OR(BUFFER[1]=122)THEN BEGIN LOC:=2;
+BEGIN WRITELN(TERMOUT);WRITE(TERMOUT,'! Where is the matching @y?');
+ERROR;END;END ELSE IF BUFFER[1]=121 THEN BEGIN IF N>0 THEN BEGIN LOC:=2;
+BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Hmm... ',N:1,' of the preceding lines failed to match')
+;ERROR;END;END;GOTO 10;END;END{:133};{131:}BEGIN CHANGELIMIT:=LIMIT;
+IF LIMIT>0 THEN FOR K:=0 TO LIMIT-1 DO CHANGEBUFFER[K]:=BUFFER[K];
+END{:131};CHANGING:=NOT CHANGING;TEMPLINE:=OTHERLINE;OTHERLINE:=LINE;
+LINE:=TEMPLINE;LINE:=LINE+1;
+IF NOT INPUTLN(WEBFILE)THEN BEGIN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! WEB file ended during a change');ERROR;END;
+INPUTHASENDE:=TRUE;GOTO 10;END;IF LINESDONTMAT THEN N:=N+1;END;10:END;
+{:132}{135:}PROCEDURE GETLINE;LABEL 20;BEGIN 20:IF CHANGING THEN{137:}
+BEGIN LINE:=LINE+1;
+IF NOT INPUTLN(CHANGEFILE)THEN BEGIN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Change file ended without @z');ERROR;END;BUFFER[0]:=64;
+BUFFER[1]:=122;LIMIT:=2;END;
+IF LIMIT>1 THEN IF BUFFER[0]=64 THEN BEGIN IF(BUFFER[1]>=88)AND(BUFFER[1
+]<=90)THEN BUFFER[1]:=BUFFER[1]+32;
+IF(BUFFER[1]=120)OR(BUFFER[1]=121)THEN BEGIN LOC:=2;
+BEGIN WRITELN(TERMOUT);WRITE(TERMOUT,'! Where is the matching @z?');
+ERROR;END;END ELSE IF BUFFER[1]=122 THEN BEGIN PRIMETHECHAN;
+CHANGING:=NOT CHANGING;TEMPLINE:=OTHERLINE;OTHERLINE:=LINE;
+LINE:=TEMPLINE;END;END;END{:137};IF NOT CHANGING THEN BEGIN{136:}
+BEGIN LINE:=LINE+1;
+IF NOT INPUTLN(WEBFILE)THEN INPUTHASENDE:=TRUE ELSE IF LIMIT=CHANGELIMIT
+THEN IF BUFFER[0]=CHANGEBUFFER[0]THEN IF CHANGELIMIT>0 THEN CHECKCHANGE;
+END{:136};IF CHANGING THEN GOTO 20;END;LOC:=0;BUFFER[LIMIT]:=32;END;
+{:135}{139:}FUNCTION CONTROLCODE(C:ASCIICODE):EIGHTBITS;
+BEGIN CASE C OF 64:CONTROLCODE:=64;39:CONTROLCODE:=12;
+34:CONTROLCODE:=13;36:CONTROLCODE:=125;32,9:CONTROLCODE:=136;
+42:BEGIN WRITE(TERMOUT,'*',MODULECOUNT+1:1);BREAK(TERMOUT);
+CONTROLCODE:=136;END;68,100:CONTROLCODE:=133;70,102:CONTROLCODE:=132;
+123:CONTROLCODE:=9;125:CONTROLCODE:=10;80,112:CONTROLCODE:=134;
+84,116,94,46,58:CONTROLCODE:=131;38:CONTROLCODE:=127;
+60:CONTROLCODE:=135;61:CONTROLCODE:=2;92:CONTROLCODE:=3;
+OTHERS:CONTROLCODE:=0 END;END;{:139}{140:}FUNCTION SKIPAHEAD:EIGHTBITS;
+LABEL 30;VAR C:EIGHTBITS;
+BEGIN WHILE TRUE DO BEGIN IF LOC>LIMIT THEN BEGIN GETLINE;
+IF INPUTHASENDE THEN BEGIN C:=136;GOTO 30;END;END;BUFFER[LIMIT+1]:=64;
+WHILE BUFFER[LOC]<>64 DO LOC:=LOC+1;IF LOC<=LIMIT THEN BEGIN LOC:=LOC+2;
+C:=CONTROLCODE(BUFFER[LOC-1]);IF(C<>0)OR(BUFFER[LOC-1]=62)THEN GOTO 30;
+END;END;30:SKIPAHEAD:=C;END;{:140}{141:}PROCEDURE SKIPCOMMENT;LABEL 10;
+VAR BAL:EIGHTBITS;C:ASCIICODE;BEGIN BAL:=0;
+WHILE TRUE DO BEGIN IF LOC>LIMIT THEN BEGIN GETLINE;
+IF INPUTHASENDE THEN BEGIN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Input ended in mid-comment');ERROR;END;GOTO 10;END;END;
+C:=BUFFER[LOC];LOC:=LOC+1;{142:}IF C=64 THEN BEGIN C:=BUFFER[LOC];
+IF(C<>32)AND(C<>9)AND(C<>42)AND(C<>122)AND(C<>90)THEN LOC:=LOC+1 ELSE
+BEGIN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Section ended in mid-comment');ERROR;END;LOC:=LOC-1;
+GOTO 10;
+END END ELSE IF(C=92)AND(BUFFER[LOC]<>64)THEN LOC:=LOC+1 ELSE IF C=123
+THEN BAL:=BAL+1 ELSE IF C=125 THEN BEGIN IF BAL=0 THEN GOTO 10;
+BAL:=BAL-1;END{:142};END;10:END;{:141}{145:}FUNCTION GETNEXT:EIGHTBITS;
+LABEL 20,30,31;VAR C:EIGHTBITS;D:EIGHTBITS;J,K:0..LONGESTNAME;
+BEGIN 20:IF LOC>LIMIT THEN BEGIN GETLINE;
+IF INPUTHASENDE THEN BEGIN C:=136;GOTO 31;END;END;C:=BUFFER[LOC];
+LOC:=LOC+1;IF SCANNINGHEX THEN{146:}
+IF((C>=48)AND(C<=57))OR((C>=65)AND(C<=70))THEN GOTO 31 ELSE SCANNINGHEX
+:=FALSE{:146};
+CASE C OF 65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85
+,86,87,88,89,90,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111
+,112,113,114,115,116,117,118,119,120,121,122:{148:}
+BEGIN IF((C=101)OR(C=69))AND(LOC>1)THEN IF(BUFFER[LOC-2]<=57)AND(BUFFER[
+LOC-2]>=48)THEN C:=0;IF C<>0 THEN BEGIN LOC:=LOC-1;IDFIRST:=LOC;
+REPEAT LOC:=LOC+1;D:=BUFFER[LOC];
+UNTIL((D<48)OR((D>57)AND(D<65))OR((D>90)AND(D<97))OR(D>122))AND(D<>95);
+IF LOC>IDFIRST+1 THEN BEGIN C:=130;IDLOC:=LOC;END;END ELSE C:=69;
+END{:148};34:{149:}BEGIN DOUBLECHARS:=0;IDFIRST:=LOC-1;
+REPEAT D:=BUFFER[LOC];LOC:=LOC+1;
+IF(D=34)OR(D=64)THEN IF BUFFER[LOC]=D THEN BEGIN LOC:=LOC+1;D:=0;
+DOUBLECHARS:=DOUBLECHARS+1;
+END ELSE BEGIN IF D=64 THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Double @ sign missing');ERROR;
+END END ELSE IF LOC>LIMIT THEN BEGIN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! String constant didn''t end');ERROR;END;D:=34;END;
+UNTIL D=34;IDLOC:=LOC-1;C:=130;END{:149};64:{150:}
+BEGIN C:=CONTROLCODE(BUFFER[LOC]);LOC:=LOC+1;
+IF C=0 THEN GOTO 20 ELSE IF C=13 THEN SCANNINGHEX:=TRUE ELSE IF C=135
+THEN{151:}BEGIN{153:}K:=0;
+WHILE TRUE DO BEGIN IF LOC>LIMIT THEN BEGIN GETLINE;
+IF INPUTHASENDE THEN BEGIN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Input ended in section name');ERROR;END;GOTO 30;END;
+END;D:=BUFFER[LOC];{154:}IF D=64 THEN BEGIN D:=BUFFER[LOC+1];
+IF D=62 THEN BEGIN LOC:=LOC+2;GOTO 30;END;
+IF(D=32)OR(D=9)OR(D=42)THEN BEGIN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Section name didn''t end');ERROR;END;GOTO 30;END;
+K:=K+1;MODTEXT[K]:=64;LOC:=LOC+1;END{:154};LOC:=LOC+1;
+IF K<LONGESTNAME-1 THEN K:=K+1;IF(D=32)OR(D=9)THEN BEGIN D:=32;
+IF MODTEXT[K-1]=32 THEN K:=K-1;END;MODTEXT[K]:=D;END;30:{155:}
+IF K>=LONGESTNAME-2 THEN BEGIN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Section name too long: ');END;
+FOR J:=1 TO 25 DO WRITE(TERMOUT,XCHR[MODTEXT[J]]);WRITE(TERMOUT,'...');
+IF HISTORY=0 THEN HISTORY:=1;END{:155};
+IF(MODTEXT[K]=32)AND(K>0)THEN K:=K-1;{:153};
+IF K>3 THEN BEGIN IF(MODTEXT[K]=46)AND(MODTEXT[K-1]=46)AND(MODTEXT[K-2]=
+46)THEN CURMODULE:=PREFIXLOOKUP(K-3)ELSE CURMODULE:=MODLOOKUP(K);
+END ELSE CURMODULE:=MODLOOKUP(K);END{:151}
+ELSE IF C=131 THEN BEGIN REPEAT C:=SKIPAHEAD;UNTIL C<>64;
+IF BUFFER[LOC-1]<>62 THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Improper @ within control text');ERROR;END;GOTO 20;END;
+END{:150};{147:}
+46:IF BUFFER[LOC]=46 THEN BEGIN IF LOC<=LIMIT THEN BEGIN C:=32;
+LOC:=LOC+1;END;
+END ELSE IF BUFFER[LOC]=41 THEN BEGIN IF LOC<=LIMIT THEN BEGIN C:=93;
+LOC:=LOC+1;END;END;
+58:IF BUFFER[LOC]=61 THEN BEGIN IF LOC<=LIMIT THEN BEGIN C:=24;
+LOC:=LOC+1;END;END;
+61:IF BUFFER[LOC]=61 THEN BEGIN IF LOC<=LIMIT THEN BEGIN C:=30;
+LOC:=LOC+1;END;END;
+62:IF BUFFER[LOC]=61 THEN BEGIN IF LOC<=LIMIT THEN BEGIN C:=29;
+LOC:=LOC+1;END;END;
+60:IF BUFFER[LOC]=61 THEN BEGIN IF LOC<=LIMIT THEN BEGIN C:=28;
+LOC:=LOC+1;END;
+END ELSE IF BUFFER[LOC]=62 THEN BEGIN IF LOC<=LIMIT THEN BEGIN C:=26;
+LOC:=LOC+1;END;END;
+40:IF BUFFER[LOC]=42 THEN BEGIN IF LOC<=LIMIT THEN BEGIN C:=9;
+LOC:=LOC+1;END;
+END ELSE IF BUFFER[LOC]=46 THEN BEGIN IF LOC<=LIMIT THEN BEGIN C:=91;
+LOC:=LOC+1;END;END;
+42:IF BUFFER[LOC]=41 THEN BEGIN IF LOC<=LIMIT THEN BEGIN C:=10;
+LOC:=LOC+1;END;END;{:147}32,9:GOTO 20;123:BEGIN SKIPCOMMENT;GOTO 20;END;
+OTHERS:END;31:IF TROUBLESHOOT THEN DEBUGHELP;GETNEXT:=C;END;{:145}{157:}
+PROCEDURE SCANNUMERIC(P:NAMEPOINTER);LABEL 21,30;
+VAR ACCUMULATOR:INTEGER;NEXTSIGN:-1..+1;Q:NAMEPOINTER;VAL:INTEGER;
+BEGIN{158:}ACCUMULATOR:=0;NEXTSIGN:=+1;
+WHILE TRUE DO BEGIN NEXTCONTROL:=GETNEXT;
+21:CASE NEXTCONTROL OF 48,49,50,51,52,53,54,55,56,57:BEGIN{160:}VAL:=0;
+REPEAT VAL:=10*VAL+NEXTCONTROL-48;NEXTCONTROL:=GETNEXT;
+UNTIL(NEXTCONTROL>57)OR(NEXTCONTROL<48){:160};
+BEGIN ACCUMULATOR:=ACCUMULATOR+NEXTSIGN*(VAL);NEXTSIGN:=+1;END;GOTO 21;
+END;12:BEGIN{161:}VAL:=0;NEXTCONTROL:=48;
+REPEAT VAL:=8*VAL+NEXTCONTROL-48;NEXTCONTROL:=GETNEXT;
+UNTIL(NEXTCONTROL>55)OR(NEXTCONTROL<48){:161};
+BEGIN ACCUMULATOR:=ACCUMULATOR+NEXTSIGN*(VAL);NEXTSIGN:=+1;END;GOTO 21;
+END;13:BEGIN{162:}VAL:=0;NEXTCONTROL:=48;
+REPEAT IF NEXTCONTROL>=65 THEN NEXTCONTROL:=NEXTCONTROL-7;
+VAL:=16*VAL+NEXTCONTROL-48;NEXTCONTROL:=GETNEXT;
+UNTIL(NEXTCONTROL>70)OR(NEXTCONTROL<48)OR((NEXTCONTROL>57)AND(
+NEXTCONTROL<65)){:162};BEGIN ACCUMULATOR:=ACCUMULATOR+NEXTSIGN*(VAL);
+NEXTSIGN:=+1;END;GOTO 21;END;130:BEGIN Q:=IDLOOKUP(0);
+IF ILK[Q]<>1 THEN BEGIN NEXTCONTROL:=42;GOTO 21;END;
+BEGIN ACCUMULATOR:=ACCUMULATOR+NEXTSIGN*(EQUIV[Q]-32768);NEXTSIGN:=+1;
+END;END;43:;45:NEXTSIGN:=-NEXTSIGN;132,133,135,134,136:GOTO 30;
+59:BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Omit semicolon in numeric definition');ERROR;END;
+OTHERS:{159:}BEGIN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Improper numeric definition will be flushed');ERROR;
+END;REPEAT NEXTCONTROL:=SKIPAHEAD UNTIL(NEXTCONTROL>=132);
+IF NEXTCONTROL=135 THEN BEGIN LOC:=LOC-2;NEXTCONTROL:=GETNEXT;END;
+ACCUMULATOR:=0;GOTO 30;END{:159}END;END;30:{:158};
+IF ABS(ACCUMULATOR)>=32768 THEN BEGIN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Value too big: ',ACCUMULATOR:1);ERROR;END;
+ACCUMULATOR:=0;END;EQUIV[P]:=ACCUMULATOR+32768;END;{:157}{165:}
+PROCEDURE SCANREPL(T:EIGHTBITS);LABEL 22,30,31;VAR A:SIXTEENBITS;
+B:ASCIICODE;BAL:EIGHTBITS;BEGIN BAL:=0;
+WHILE TRUE DO BEGIN 22:A:=GETNEXT;CASE A OF 40:BAL:=BAL+1;
+41:IF BAL=0 THEN BEGIN WRITELN(TERMOUT);WRITE(TERMOUT,'! Extra )');
+ERROR;END ELSE BAL:=BAL-1;39:{168:}BEGIN B:=39;
+WHILE TRUE DO BEGIN BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(
+TERMOUT);WRITE(TERMOUT,'! Sorry, ','token',' capacity exceeded');ERROR;
+HISTORY:=3;JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=B;TOKPTR[Z]:=TOKPTR[Z]+1;
+END;IF B=64 THEN IF BUFFER[LOC]=64 THEN LOC:=LOC+1 ELSE BEGIN WRITELN(
+TERMOUT);WRITE(TERMOUT,'! You should double @ signs in strings');ERROR;
+END;IF LOC=LIMIT THEN BEGIN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! String didn''t end');ERROR;END;BUFFER[LOC]:=39;
+BUFFER[LOC+1]:=0;END;B:=BUFFER[LOC];LOC:=LOC+1;
+IF B=39 THEN BEGIN IF BUFFER[LOC]<>39 THEN GOTO 31 ELSE BEGIN LOC:=LOC+1
+;BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Sorry, ','token',' capacity exceeded');ERROR;
+HISTORY:=3;JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=39;TOKPTR[Z]:=TOKPTR[Z]+1;
+END;END;END;END;31:END{:168};35:IF T=3 THEN A:=0;{167:}
+130:BEGIN A:=IDLOOKUP(0);
+BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Sorry, ','token',' capacity exceeded');ERROR;
+HISTORY:=3;JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=(A DIV 256)+128;
+TOKPTR[Z]:=TOKPTR[Z]+1;END;A:=A MOD 256;END;
+135:IF T<>135 THEN GOTO 30 ELSE BEGIN BEGIN IF TOKPTR[Z]=MAXTOKS THEN
+BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Sorry, ','token',' capacity exceeded');ERROR;
+HISTORY:=3;JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=(CURMODULE DIV 256)+168;
+TOKPTR[Z]:=TOKPTR[Z]+1;END;A:=CURMODULE MOD 256;END;2:{169:}
+BEGIN BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Sorry, ','token',' capacity exceeded');ERROR;
+HISTORY:=3;JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=2;TOKPTR[Z]:=TOKPTR[Z]+1;
+END;BUFFER[LIMIT+1]:=64;
+WHILE BUFFER[LOC]<>64 DO BEGIN BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN
+WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Sorry, ','token',' capacity exceeded');ERROR;
+HISTORY:=3;JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=BUFFER[LOC];
+TOKPTR[Z]:=TOKPTR[Z]+1;END;LOC:=LOC+1;
+IF LOC<LIMIT THEN IF(BUFFER[LOC]=64)AND(BUFFER[LOC+1]=64)THEN BEGIN
+BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Sorry, ','token',' capacity exceeded');ERROR;
+HISTORY:=3;JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=64;TOKPTR[Z]:=TOKPTR[Z]+1;
+END;LOC:=LOC+2;END;END;IF LOC>=LIMIT THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Verbatim string didn''t end');ERROR;
+END ELSE IF BUFFER[LOC+1]<>62 THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! You should double @ signs in verbatim strings');ERROR;
+END;LOC:=LOC+2;END{:169};
+133,132,134:IF T<>135 THEN GOTO 30 ELSE BEGIN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! @',XCHR[BUFFER[LOC-1]],' is ignored in Pascal text');
+ERROR;END;GOTO 22;END;136:GOTO 30;{:167}OTHERS:END;
+BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Sorry, ','token',' capacity exceeded');ERROR;
+HISTORY:=3;JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=A;TOKPTR[Z]:=TOKPTR[Z]+1;
+END;END;30:NEXTCONTROL:=A;{166:}
+IF BAL>0 THEN BEGIN IF BAL=1 THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Missing )');ERROR;END ELSE BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Missing ',BAL:1,' )''s');ERROR;END;
+WHILE BAL>0 DO BEGIN BEGIN IF TOKPTR[Z]=MAXTOKS THEN BEGIN WRITELN(
+TERMOUT);WRITE(TERMOUT,'! Sorry, ','token',' capacity exceeded');ERROR;
+HISTORY:=3;JUMPOUT;END;TOKMEM[Z,TOKPTR[Z]]:=41;TOKPTR[Z]:=TOKPTR[Z]+1;
+END;BAL:=BAL-1;END;END{:166};
+IF TEXTPTR>MAXTEXTS-3 THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Sorry, ','text',' capacity exceeded');ERROR;HISTORY:=3;
+JUMPOUT;END;CURREPLTEXT:=TEXTPTR;TOKSTART[TEXTPTR+3]:=TOKPTR[Z];
+TEXTPTR:=TEXTPTR+1;IF Z=2 THEN Z:=0 ELSE Z:=Z+1;END;{:165}{170:}
+PROCEDURE DEFINEMACRO(T:EIGHTBITS);VAR P:NAMEPOINTER;
+BEGIN P:=IDLOOKUP(T);SCANREPL(T);EQUIV[P]:=CURREPLTEXT;
+TEXTLINK[CURREPLTEXT]:=0;END;{:170}{172:}PROCEDURE SCANMODULE;
+LABEL 22,30,10;VAR P:NAMEPOINTER;BEGIN MODULECOUNT:=MODULECOUNT+1;{173:}
+NEXTCONTROL:=0;
+WHILE TRUE DO BEGIN 22:WHILE NEXTCONTROL<=132 DO BEGIN NEXTCONTROL:=
+SKIPAHEAD;IF NEXTCONTROL=135 THEN BEGIN LOC:=LOC-2;NEXTCONTROL:=GETNEXT;
+END;END;IF NEXTCONTROL<>133 THEN GOTO 30;NEXTCONTROL:=GETNEXT;
+IF NEXTCONTROL<>130 THEN BEGIN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Definition flushed, must start with ',
+'identifier of length > 1');ERROR;END;GOTO 22;END;NEXTCONTROL:=GETNEXT;
+IF NEXTCONTROL=61 THEN BEGIN SCANNUMERIC(IDLOOKUP(1));GOTO 22;
+END ELSE IF NEXTCONTROL=30 THEN BEGIN DEFINEMACRO(2);GOTO 22;
+END ELSE{174:}IF NEXTCONTROL=40 THEN BEGIN NEXTCONTROL:=GETNEXT;
+IF NEXTCONTROL=35 THEN BEGIN NEXTCONTROL:=GETNEXT;
+IF NEXTCONTROL=41 THEN BEGIN NEXTCONTROL:=GETNEXT;
+IF NEXTCONTROL=61 THEN BEGIN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Use == for macros');ERROR;END;NEXTCONTROL:=30;END;
+IF NEXTCONTROL=30 THEN BEGIN DEFINEMACRO(3);GOTO 22;END;END;END;END;
+{:174};BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Definition flushed since it starts badly');ERROR;END;
+END;30:{:173};{175:}CASE NEXTCONTROL OF 134:P:=0;135:BEGIN P:=CURMODULE;
+{176:}REPEAT NEXTCONTROL:=GETNEXT;UNTIL NEXTCONTROL<>43;
+IF(NEXTCONTROL<>61)AND(NEXTCONTROL<>30)THEN BEGIN BEGIN WRITELN(TERMOUT)
+;WRITE(TERMOUT,'! Pascal text flushed, = sign is missing');ERROR;END;
+REPEAT NEXTCONTROL:=SKIPAHEAD;UNTIL NEXTCONTROL=136;GOTO 10;END{:176};
+END;OTHERS:GOTO 10 END;{177:}STORETWOBYTE(53248+MODULECOUNT);{:177};
+SCANREPL(135);{178:}
+IF P=0 THEN BEGIN TEXTLINK[LASTUNNAMED]:=CURREPLTEXT;
+LASTUNNAMED:=CURREPLTEXT;
+END ELSE IF EQUIV[P]=0 THEN EQUIV[P]:=CURREPLTEXT ELSE BEGIN P:=EQUIV[P]
+;WHILE TEXTLINK[P]<MAXTEXTS DO P:=TEXTLINK[P];TEXTLINK[P]:=CURREPLTEXT;
+END;TEXTLINK[CURREPLTEXT]:=MAXTEXTS;{:178};{:175};10:END;{:172}{181:}
+PROCEDURE DEBUGHELP;LABEL 888,10;VAR K:INTEGER;
+BEGIN DEBUGSKIPPED:=DEBUGSKIPPED+1;
+IF DEBUGSKIPPED<DEBUGCYCLE THEN GOTO 10;DEBUGSKIPPED:=0;
+WHILE TRUE DO BEGIN WRITE(TERMOUT,'#');BREAK(TERMOUT);READ(TERMIN,DDT);
+IF DDT<0 THEN GOTO 10 ELSE IF DDT=0 THEN BEGIN GOTO 888;
+888:DDT:=0;
+END ELSE BEGIN READ(TERMIN,DD);CASE DDT OF 1:PRINTID(DD);
+2:PRINTREPL(DD);3:FOR K:=1 TO DD DO WRITE(TERMOUT,XCHR[BUFFER[K]]);
+4:FOR K:=1 TO DD DO WRITE(TERMOUT,XCHR[MODTEXT[K]]);
+5:FOR K:=1 TO OUTPTR DO WRITE(TERMOUT,XCHR[OUTBUF[K]]);
+6:FOR K:=1 TO DD DO WRITE(TERMOUT,XCHR[OUTCONTRIB[K]]);
+OTHERS:WRITE(TERMOUT,'?')END;END;END;10:END;{:181}{182:}
+BEGIN INITIALIZE;{134:}OPENINPUT;LINE:=0;OTHERLINE:=0;CHANGING:=TRUE;
+PRIMETHECHAN;CHANGING:=NOT CHANGING;TEMPLINE:=OTHERLINE;OTHERLINE:=LINE;
+LINE:=TEMPLINE;LIMIT:=0;LOC:=1;BUFFER[0]:=32;INPUTHASENDE:=FALSE;{:134};
+WRITELN(TERMOUT,'This is TANGLE, Version 2.8');{183:}PHASEONE:=TRUE;
+MODULECOUNT:=0;REPEAT NEXTCONTROL:=SKIPAHEAD;UNTIL NEXTCONTROL=136;
+WHILE NOT INPUTHASENDE DO SCANMODULE;{138:}
+IF CHANGELIMIT<>0 THEN BEGIN FOR LOC:=0 TO CHANGELIMIT DO BUFFER[LOC]:=
+CHANGEBUFFER[LOC];LIMIT:=CHANGELIMIT;CHANGING:=TRUE;LINE:=OTHERLINE;
+LOC:=CHANGELIMIT;BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Change file entry did not match');ERROR;END;END{:138};
+PHASEONE:=FALSE;{:183};FOR ZO:=0 TO 2 DO MAXTOKPTR[ZO]:=TOKPTR[ZO];
+{112:}IF TEXTLINK[0]=0 THEN BEGIN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! No output was specified.');END;
+IF HISTORY=0 THEN HISTORY:=1;END ELSE BEGIN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'Writing the output file');END;BREAK(TERMOUT);{83:}
+STACKPTR:=1;BRACELEVEL:=0;CURSTATE.NAMEFIELD:=0;
+CURSTATE.REPLFIELD:=TEXTLINK[0];ZO:=CURSTATE.REPLFIELD MOD 3;
+CURSTATE.BYTEFIELD:=TOKSTART[CURSTATE.REPLFIELD];
+CURSTATE.ENDFIELD:=TOKSTART[CURSTATE.REPLFIELD+3];CURSTATE.MODFIELD:=0;
+{:83};{96:}OUTSTATE:=0;OUTPTR:=0;BREAKPTR:=0;SEMIPTR:=0;OUTBUF[0]:=0;
+LINE:=1;{:96};SENDTHEOUTPU;{98:}BREAKPTR:=OUTPTR;SEMIPTR:=0;FLUSHBUFFER;
+IF BRACELEVEL<>0 THEN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'! Program ended at brace level ',BRACELEVEL:1);ERROR;END;
+{:98};BEGIN WRITELN(TERMOUT);WRITE(TERMOUT,'Done.');END;END{:112};
+9999:IF STRINGPTR>128 THEN{184:}BEGIN BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,STRINGPTR-128:1,' strings written to string pool file.');
+END;WRITE(POOL,'*');
+FOR STRINGPTR:=1 TO 9 DO BEGIN OUTBUF[STRINGPTR]:=POOLCHECKSUM MOD 10;
+POOLCHECKSUM:=POOLCHECKSUM DIV 10;END;
+FOR STRINGPTR:=9 DOWNTO 1 DO WRITE(POOL,XCHR[48+OUTBUF[STRINGPTR]]);
+WRITELN(POOL);END{:184};{186:}BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'Memory usage statistics:');END;BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,NAMEPTR:1,' names, ',TEXTPTR:1,' replacement texts;');END;
+BEGIN WRITELN(TERMOUT);WRITE(TERMOUT,BYTEPTR[0]:1);END;
+FOR WO:=1 TO 1 DO WRITE(TERMOUT,'+',BYTEPTR[WO]:1);
+WRITE(TERMOUT,' bytes, ',MAXTOKPTR[0]:1);
+FOR ZO:=1 TO 2 DO WRITE(TERMOUT,'+',MAXTOKPTR[ZO]:1);
+WRITE(TERMOUT,' tokens.');{:186};{187:}
+CASE HISTORY OF 0:BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'(No errors were found.)');END;1:BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'(Did you see the warning message above?)');END;
+2:BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'(Pardon me, but I think I spotted something wrong.)');
+END;3:BEGIN WRITELN(TERMOUT);
+WRITE(TERMOUT,'(That was a fatal error, my friend.)');END;END{:187};
+END.{:182}
diff --git a/obsolete/systems/knuth/unsupported/web/tangle.tops20-changes b/obsolete/systems/knuth/unsupported/web/tangle.tops20-changes
new file mode 100644
index 0000000000..6a73cc27e7
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/web/tangle.tops20-changes
@@ -0,0 +1,30 @@
+TANGLE change file for Tops-20
+Copyright (C) 1983 by David Fuchs. All rights are reserved.
+
+@x Tell WEAVE to print only the changes:
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{TANGLE changes for Tops-20}
+@z
+
+@x TOPS-20's banner:
+@d banner=='This is TANGLE, Version 2.8'
+@y
+@d banner=='This is TANGLE, Tops-20 Version 2.8'
+@z
+
+@x Identify input vs. output files for correct version number handling:
+program TANGLE(@!web_file,@!change_file,@!Pascal_file,@!pool);
+@y
+program TANGLE(@!web_file:-,@!change_file:-,@!Pascal_file:+,@!pool:+);
+@z
+
+@x Extra capacity:
+@d ww=2 {we multiply the byte capacity by approximately this amount}
+@d zz=3 {we multiply the token capacity by approximately this amount}
+@y
+@d ww=3 {we multiply the byte capacity by approximately this amount}
+@d zz=4 {we multiply the token capacity by approximately this amount}
+@z
diff --git a/obsolete/systems/knuth/unsupported/web/tangle.vms-changes b/obsolete/systems/knuth/unsupported/web/tangle.vms-changes
new file mode 100644
index 0000000000..55d27ded39
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/web/tangle.vms-changes
@@ -0,0 +1,346 @@
+TANGLE change file for Vax/VMS
+Copyright (C) 1983 by David Fuchs. All rights are reserved.
+21Oct85 JLC .Increased max_toks to tangle inimf 0.9999.
+
+@x
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{TANGLE changes for Vax/VMS}
+@z
+
+@x
+@d banner=='This is TANGLE, Version 2.8'
+@y
+@d banner=='This is TANGLE, Vax/VMS Version 2.8'
+@z
+
+@x
+and the string pool output goes to file |pool|.
+@y
+and the string pool output goes to file |pool|.
+VMS requires us to mention |input| and |output| in the program header, too.
+They are used for terminal input and output.
+@z
+
+@x
+program TANGLE(@!web_file,@!change_file,@!Pascal_file,@!pool);
+@y
+program TANGLE(@!input,@!output,@!web_file,@!change_file,@!Pascal_file,
+ @!pool);
+@z
+
+@x
+@<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
+On Vax/VMS, things are a bit different.
+
+@<Compiler directives@>=
+@=[check(none)]@> {no debug overhead, but...}
+debug @=[check(all)]@> gubed {turn everything on when debugging}
+@z
+
+@x
+@d othercases == others: {default for cases not listed explicitly}
+@y
+@d othercases == otherwise {Vax/VMS default for cases not listed
+ explicitly}
+@z
+
+@x
+@!max_toks=50000; {|1/zz| times the number of bytes in compressed \PASCAL\ code;
+ must be less than 65536}
+@y
+@!max_toks=51000; {|1/zz| times the number of bytes in compressed \PASCAL\ code;
+ must be less than 65536}
+@z
+
+@x
+@!text_file=packed file of text_char;
+@y
+@!text_file=text;
+@z
+
+@x
+@d print_ln(#)==write_ln(term_out,#) {`|print|' and then start new line}
+@d new_line==write_ln(term_out) {start new line}
+@y
+@d print_ln(#)==write_ln(term_out,#,chr(13),chr(10))
+ {`|print|' and then start new line}
+@d new_line==write_ln(term_out,chr(13),chr(10)) {start new line}
+@z
+
+@x
+rewrite(term_out,'TTY:'); {send |term_out| output to the terminal}
+@y
+open(term_out,'SYS$OUTPUT',@=carriage_control:=none@>);
+rewrite(term_out);
+@z
+
+@x
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@y
+@d update_terminal == write_ln(term_out) {empty the terminal output buffer}
+@z
+
+@x
+@ The following code opens |Pascal_file| and |pool|.
+Since these files were listed in the program header, we assume that the
+\PASCAL\ runtime system has checked that suitable external file names have
+been given.
+@^system dependencies@>
+
+@<Set init...@>=
+rewrite(Pascal_file); rewrite(pool);
+@y
+@ The following code opens |Pascal_file| and |pool|.
+Acutally, on Vax/VMS this task is put off until later.
+@^system dependencies@>
+@z
+
+@x
+@ Input goes into an array called |buffer|.
+
+@<Globals...@>=@!buffer: array[0..buf_size] of ASCII_code;
+@y
+@ Input goes into an array called |buffer|.
+Actually, it is first read into |temp_buffer|.
+@<Glob...@>=
+@!buffer: array[0..buf_size] of ASCII_code;
+@!temp_buffer: varying [buf_size] of char;
+@z
+
+@x
+@p function input_ln(var f:text_file):boolean;
+ {inputs a line or returns |false|}
+var final_limit:0..buf_size; {|limit| without trailing blanks}
+begin limit:=0; final_limit:=0;
+if eof(f) then input_ln:=false
+else begin while not eoln(f) do
+ begin buffer[limit]:=xord[f^]; get(f);
+ incr(limit);
+ if buffer[limit-1]<>" " then final_limit:=limit;
+ if limit=buf_size then
+ begin while not eoln(f) do get(f);
+ decr(limit); {keep |buffer[buf_size]| empty}
+ print_nl('! Input line too long'); loc:=0; error;
+@.Input line too long@>
+ end;
+ end;
+ read_ln(f); limit:=final_limit; input_ln:=true;
+ end;
+end;
+@y
+On Vax/VMS we first read a line into |temp_buffer|, since that's faster.
+
+@p function input_ln(var f:text_file):boolean;
+ {inputs a line or returns |false|}
+var i,@!l:0..buf_size;
+begin limit:=0;
+if eof(f) then input_ln:=false
+else begin
+ read(f,temp_buffer);
+ l:=temp_buffer.@=length@>;
+ for i:=1 to l do begin
+ buffer[i-1]:=xord[temp_buffer[i]];
+ if buffer[i-1]<>" " then limit:=i;
+ end;
+ if not eoln(f) then begin
+ print_nl('! Input line too long'); error;
+@.Input line too long@>
+ end
+ else read_ln(f);
+ input_ln:=true;
+ end;
+end;
+@z
+
+@x
+@d ww=2 {we multiply the byte capacity by approximately this amount}
+@y
+@d ww=3 {we multiply the byte capacity by approximately this amount}
+@z
+
+@x
+for k:=1 to break_ptr do write(Pascal_file,xchr[out_buf[k-1]]);
+write_ln(Pascal_file); incr(line);
+@y
+for k:=1 to break_ptr do out_temp_buffer[k]:=xchr[out_buf[k-1]];
+write_ln(Pascal_file,substr(out_temp_buffer,1,break_ptr)); incr(line);
+@z
+
+@x
+@!term_in:text_file; {the user's terminal as an input file}
+@y
+@z
+
+@x
+@<Set init...@>=
+@y
+@d term_in==input
+
+@<Set init...@>=
+@z
+
+@x
+reset(term_in,'TTY:','/I'); {open |term_in| as the terminal, don't do a |get|}
+@y
+@z
+
+@x save pool and Pascal files only if they were written to.
+if string_ptr>128 then @<Finish off the string pool file@>;
+stat @<Print statistics about memory usage@>;@+tats@;@/
+@t\4\4@>{here files should be closed if the operating system requires it}
+@y
+if history<fatal_message then begin
+ if string_ptr>128 then begin @<Finish off the string pool file@>;
+ close(pool,@=disposition:=save@>,@=error:=continue@>);
+ end;
+ close(Pascal_file,@=disposition:=save@>,@=error:=continue@>);
+ end;
+stat @<Print statistics about memory usage@>;@+tats@;@/
+@z
+
+@x
+This module should be replaced, if necessary, by changes to the program
+that are necessary to make \.{TANGLE} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous modules preserve the module numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new modules, can be inserted here; then only the index
+itself will get a new module number.
+@y
+Here are the remaining changes to the program
+that are necessary to make \.{TANGLE} work on Vax/VMS.
+
+
+@ This variable is for speeding up the output routine.
+
+@<Glob...@>=
+@!out_temp_buffer:packed array [1..out_buf_size] of char;
+
+@ On Vax/VMS we need the following special definitions, types, variables
+and procedures to be able to get the file name from the command line,
+or to prompt for them.
+
+@d VAX_volatile==@=volatile@>
+@d VAX_immed==@=%immed @>
+@d VAX_external==@=external@>
+@d VAX_stdescr==@=%stdescr @>
+@d VAX_lib_get_foreign==@= lib$get_foreign@>
+@d VAX_length==@=length @>
+
+@ @<Local...@>=
+@!command_line:packed array[1..300] of char;
+@!cmd_len:sixteen_bits;
+@!cmd_i:integer;
+@!file_name,@!default_file_name:varying [300] of char;
+@!ask,@!got_file_name: boolean;
+
+@ Here is the library procedure that gets the user's command line.
+
+@<Error...@>=
+[VAX_external] function VAX_lib_get_foreign(
+ VAX_stdescr cmdlin:[VAX_volatile] packed array [$l1..$u1:integer] of char
+ := VAX_immed 0;
+ VAX_stdescr prompt:[VAX_volatile] packed array [$l2..$u2:integer] of char
+ := VAX_immed 0;
+ var len : [VAX_volatile] sixteen_bits := VAX_immed 0;
+ var flag : [VAX_volatile] integer := VAX_immed 0)
+ :integer; extern;
+
+@ We get the external file names, and then call |open|
+to associate an external file with each file variable.
+
+@<Set init...@>=
+cmd_i:=0;
+VAX_lib_get_foreign(command_line,,cmd_len,cmd_i);
+cmd_i:=1; while (cmd_i<=cmd_len) and (command_line[cmd_i]=' ') do incr(cmd_i);
+got_file_name:=cmd_i<=cmd_len;
+if got_file_name then
+ default_file_name:=substr(command_line,cmd_i,cmd_len-cmd_i+1);
+
+if got_file_name then begin
+ file_name:=default_file_name+'.WEB';
+ open(web_file,file_name,@=readonly@>,@=error:=continue@>);
+ ask:=status(web_file)<>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end
+else ask:=true;
+while ask do begin
+ got_file_name:=false;
+ write('Web file: ');
+ if eof then begin mark_fatal; jump_out; end;
+ read_ln(file_name);
+ open(web_file,file_name,@=readonly@>,@=error:=continue@>);
+ ask:=status(web_file)<>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end;
+
+if got_file_name then begin
+ file_name:=default_file_name+'.CH';
+ open(change_file,file_name,@=readonly@>,@=error:=continue@>);
+ ask:=status(change_file)>0; {can be empty}
+ if ask then write_ln('Couldn''t open ',file_name);
+ end
+else ask:=true;
+while ask do begin
+ write('Change file: ');
+ if eof then begin mark_fatal; jump_out; end;
+ read_ln(file_name);
+ if file_name.VAX_length=0 then file_name:='NL:';
+ open(change_file,file_name,@=readonly@>,@=error:=continue@>);
+ ask:=status(change_file)>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end;
+
+if got_file_name then begin
+ cmd_i:=1;
+ for cmd_len:=1 to default_file_name.VAX_length do
+ if (default_file_name[cmd_len]=']')
+ or (default_file_name[cmd_len]=':')
+ then cmd_i:=cmd_len+1;
+ if cmd_i<=default_file_name.VAX_length then
+ default_file_name:=substr(default_file_name,cmd_i,
+ default_file_name.VAX_length-cmd_i+1);
+ end;
+
+if got_file_name then begin
+ file_name:=default_file_name+'.PAS';
+ open(Pascal_file,file_name,@=new,disposition:=delete@>,
+ @=error:=continue@>);
+ ask:=status(Pascal_file)>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end
+else ask:=true;
+while ask do begin
+ write('Pascal file: ');
+ if eof then begin mark_fatal; jump_out; end;
+ read_ln(file_name);
+ open(Pascal_file,file_name,@=new,disposition:=delete@>,
+ @=error:=continue@>);
+ ask:=status(Pascal_file)>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end;
+
+if got_file_name then begin
+ file_name:=default_file_name+'.POO';
+ open(pool,file_name,@=new,disposition:=delete@>,@=error:=continue@>);
+ ask:=status(pool)>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end
+else ask:=true;
+while ask do begin
+ write('Pool file: ');
+ if eof then begin mark_fatal; jump_out; end;
+ read_ln(file_name);
+ open(pool,file_name,@=new,disposition:=delete@>,@=error:=continue@>);
+ ask:=status(pool)>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end;
+
+rewrite(Pascal_file); rewrite(pool);
+@z
diff --git a/obsolete/systems/knuth/unsupported/web/weave.cms-changes b/obsolete/systems/knuth/unsupported/web/weave.cms-changes
new file mode 100644
index 0000000000..2f2857763c
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/web/weave.cms-changes
@@ -0,0 +1,187 @@
+WEAVE change file for VM/CMS and MVS.
+Copyright (C) 1984 by David Fuchs. All rights are reserved.
+
+@x banner line
+@d banner=='This is WEAVE, Version 2.8'
+@y
+@d banner=='This is WEAVE, VM/CMS Version 2.8'
+@d term_in==tty_in
+@d term_out==tty_out
+@z
+
+@x debug switch
+@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}
+@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}
+@y
+@d debug==@{
+@d gubed==@t@>@}
+@z
+
+@x statistics switch
+@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==
+@d tats==
+@z
+
+@x 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
+{It seems impossible to turn CHECK and DEBUG on and off easily given
+ how Tangle and VS/PASCAL work}
+@z
+
+@x otherwise clause
+@d othercases == others: {default for cases not listed explicitly}
+@y
+@d othercases == otherwise {default for cases not listed explicitly}
+@z
+
+@x enlarge |max_refs| so we can WEAVE TeX with CMS changes
+@!max_refs=20000; {number of cross references; must be less than 65536}
+@y
+@!max_refs=25000; {number of cross references; must be less than 65536}
+@z
+
+@x packing
+@!ASCII_code=0..127; {seven-bit numbers, a subrange of the integers}
+@y
+@!ASCII_code=packed 0..127; {seven-bit numbers, a subrange of the integers}
+@z
+
+@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
+
+@x text files
+@!text_file=packed file of text_char;
+@y
+@!text_file=text;
+@z
+
+@x terminal output
+rewrite(term_out,'TTY:'); {send |term_out| output to the terminal}
+@y
+rewrite(term_out); {often redirected to the user's terminal}
+@z
+
+@x update terminal buffer
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@y
+@d update_terminal == do_nothing
+@z
+
+@x pack buffer
+@<Globals...@>=@!buffer: array[0..long_buf_size] of ASCII_code;
+@y
+@<Globals...@>=@!buffer: packed array[0..long_buf_size] of ASCII_code;
+@z
+
+@x input_ln optimization
+@p function input_ln(var f:text_file):boolean;
+ {inputs a line or returns |false|}
+var final_limit:0..buf_size; {|limit| without trailing blanks}
+begin limit:=0; final_limit:=0;
+if eof(f) then input_ln:=false
+else begin while not eoln(f) do
+ begin buffer[limit]:=xord[f^]; get(f);
+ incr(limit);
+ if buffer[limit-1]<>" " then final_limit:=limit;
+ if limit=buf_size then
+ begin while not eoln(f) do get(f);
+ decr(limit); {keep |buffer[buf_size]| empty}
+ print_nl('! Input line too long'); loc:=0; error;
+@.Input line too long@>
+ end;
+ end;
+ read_ln(f); limit:=final_limit; input_ln:=true;
+ end;
+end;
+@y
+@p function input_ln(var f:text_file):boolean;
+ {inputs a line or returns |false|}
+var i:0..buf_size;
+@!temp_buf:@=string@>(buf_size);
+begin
+limit:=0;
+if eof(f) then input_ln:=false
+else begin
+ read(f,temp_buf);
+ limit:=@=length@>(trim(temp_buf));
+ if not eoln(f) then begin
+ print_nl('! Input line too long'); loc:=0; error;
+@.Input line too long@>
+ end
+ else read_ln(f);
+ if limit>0 then for i:=0 to limit-1 do
+ buffer(.i.):=xord(.temp_buf(.i+1.).);
+ input_ln:=true;
+ end;
+end;
+@z
+
+@x packing
+@!eight_bits=0..255; {unsigned one-byte quantity}
+@!sixteen_bits=0..65535; {unsigned two-byte quantity}
+@y
+@!eight_bits=packed 0..255; {unsigned one-byte quantity}
+@!sixteen_bits=packed 0..65535; {unsigned two-byte quantity}
+@z
+
+@x
+reset(term_in,'TTY:','/I'); {open |term_in| as the terminal, don't do a |get|}
+@y
+{reset(term_in,'INTERACTIVE'); {open |term_in|, don't do a |get|}}
+@=termin@>(term_in); {don't ask me why the above line didn't work!}
+@z
+
+@x
+The main procedure has been split into three sub-procedures in order to
+keep certain \PASCAL\ compilers from overflowing their capacity.
+@^split procedures@>
+
+@p procedure Phase_I;
+begin @<Phase I:...@>;
+end;
+@#
+procedure Phase_II;
+begin @<Phase II:...@>;
+end;
+@#
+@y
+The main procedure has been split into three sub-procedures in order to
+keep certain \PASCAL\ compilers from overflowing their capacity.
+@^split procedures@>
+
+@p procedure Phase_I;
+begin @<Phase I:...@>;
+end;
+@#
+procedure Phase_II;
+begin @<Phase II:...@>;
+end;
+@#
+procedure Store_reserved_words;
+begin @<Store all the reserved words@>;
+end;
+@#
+@z
+
+@x
+@<Store all the reserved words@>;
+@y
+Store_reserved_words;
+@z
+
+@x set return code
+case history of
+@y
+retcode(4*history); {set return code}
+case history of
+@z
diff --git a/obsolete/systems/knuth/unsupported/web/weave.tops20-changes b/obsolete/systems/knuth/unsupported/web/weave.tops20-changes
new file mode 100644
index 0000000000..822415b7e1
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/web/weave.tops20-changes
@@ -0,0 +1,22 @@
+WEAVE change file for Tops-20
+Copyright (C) 1983 by David Fuchs. All rights are reserved.
+
+@x Tell WEAVE to print only the changes:
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{WEAVE changes for Tops-20}
+@z
+
+@x TOPS-20's banner:
+@d banner=='This is WEAVE, Version 2.9'
+@y
+@d banner=='This is WEAVE, Tops-20 Version 2.9'
+@z
+
+@x
+program WEAVE(@!web_file,@!change_file,@!tex_file);
+@y
+program WEAVE(@!web_file:-,@!change_file:-,@!tex_file:+);
+@z
diff --git a/obsolete/systems/knuth/unsupported/web/weave.vms-changes b/obsolete/systems/knuth/unsupported/web/weave.vms-changes
new file mode 100644
index 0000000000..e96aeb63bf
--- /dev/null
+++ b/obsolete/systems/knuth/unsupported/web/weave.vms-changes
@@ -0,0 +1,315 @@
+WEAVE change file for Vax/VMS
+Copyright (C) 1983 by David Fuchs. All rights are reserved.
+
+@x
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{WEAVE changes for Vax/VMS}
+@z
+
+@x
+@d banner=='This is WEAVE, Version 2.9'
+@y
+@d banner=='This is WEAVE, Vax/VMS Version 2.9'
+@z
+
+@x
+and |change_file|, and the \TeX\ output goes to file |tex_file|.
+@y
+and |change_file|, and the \TeX\ output goes to file |tex_file|.
+VMS requires us to mention |input| and |output| in the program header, too.
+They are used for terminal input and output.
+@z
+
+@x
+program WEAVE(@!web_file,@!change_file,@!tex_file);
+@y
+program WEAVE(@!input,@!output,@!web_file,@!change_file,@!tex_file);
+@z
+
+@x
+ begin @<Set initial values@>@/
+@y
+ begin @<Preset initial values@>@/
+ @<Set initial values@>@/
+@z
+
+@x
+@<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
+On Vax/VMS, things are a bit different.
+
+@<Compiler directives@>=
+@=[check(none)]@> {no debug overhead, but...}
+debug @=[check(all)]@> gubed {turn everything on when debugging}
+@z
+
+@x
+@d othercases == others: {default for cases not listed explicitly}
+@y
+@d othercases == otherwise {Vax/VMS default for cases not listed
+ explicitly}
+@z
+
+@x
+@!text_file=packed file of text_char;
+@y
+@!text_file=text;
+@z
+
+@x
+@d print_ln(#)==write_ln(term_out,#) {`|print|' and then start new line}
+@d new_line==write_ln(term_out) {start new line}
+@y
+@d print_ln(#)==write_ln(term_out,#,chr(13),chr(10))
+ {`|print|' and then start new line}
+@d new_line==write_ln(term_out,chr(13),chr(10)) {start new line}
+@z
+
+@x
+rewrite(term_out,'TTY:'); {send |term_out| output to the terminal}
+@y
+@= open@>(term_out,'SYS$OUTPUT',@=carriage_control:=none@>);
+rewrite(term_out);
+@z
+
+@x
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@y
+@d update_terminal == write_ln(term_out) {empty the terminal output buffer}
+@z
+
+@x
+@ The following code opens |tex_file|.
+Since this file was listed in the program header, we assume that the
+\PASCAL\ runtime system has checked that a suitable external file name has
+been given.
+@^system dependencies@>
+
+@<Set init...@>=
+rewrite(tex_file);
+@y
+@ The following code opens |tex_file|.
+Actually, on Vax/VMS this task is put off until later.
+@^system dependencies@>
+@z
+
+@x
+@ Input goes into an array called |buffer|.
+
+@<Globals...@>=@!buffer: array[0..long_buf_size] of ASCII_code;
+@y
+@ Input goes into an array called |buffer|.
+Actually, it is first read into |temp_buffer|.
+
+@<Globals...@>=@!buffer: array[0..long_buf_size] of ASCII_code;
+@!temp_buffer: varying [buf_size] of char;
+@z
+
+@x
+@p function input_ln(var f:text_file):boolean;
+ {inputs a line or returns |false|}
+var final_limit:0..buf_size; {|limit| without trailing blanks}
+begin limit:=0; final_limit:=0;
+if eof(f) then input_ln:=false
+else begin while not eoln(f) do
+ begin buffer[limit]:=xord[f^]; get(f);
+ incr(limit);
+ if buffer[limit-1]<>" " then final_limit:=limit;
+ if limit=buf_size then
+ begin while not eoln(f) do get(f);
+ decr(limit); {keep |buffer[buf_size]| empty}
+ print_nl('! Input line too long'); loc:=0; error;
+@.Input line too long@>
+ end;
+ end;
+ read_ln(f); limit:=final_limit; input_ln:=true;
+ end;
+end;
+@y
+On Vax/VMS we first read a line into |temp_buffer|, since that's faster.
+
+@p function input_ln(var f:text_file):boolean;
+ {inputs a line or returns |false|}
+var i,@!l:0..buf_size;
+begin limit:=0;
+if eof(f) then input_ln:=false
+else begin
+ read(f,temp_buffer);
+ l:=temp_buffer.@=length@>;
+ for i:=1 to l do begin
+ buffer[i-1]:=xord[temp_buffer[i]];
+ if buffer[i-1]<>" " then limit:=i;
+ end;
+ if not eoln(f) then begin
+ print_nl('! Input line too long'); error;
+@.Input line too long@>
+ end
+ else read_ln(f);
+ input_ln:=true;
+ end;
+end;
+@z
+
+@x
+done: for k:=1 to j do write(tex_file,xchr[out_buf[k]]);
+if per_cent then write(tex_file,xchr["%"]);
+write_ln(tex_file); incr(out_line);
+@y
+done: for k:=1 to j do out_temp_buffer[k]:=xchr[out_buf[k]];
+k:=j;
+if per_cent then begin incr(k); out_temp_buffer[k]:=xchr["%"]; end;
+write_ln(tex_file,substr(out_temp_buffer,1,k)); incr(out_line);
+@z
+
+@x
+@!term_in:text_file; {the user's terminal as an input file}
+@y
+@z
+
+@x
+@<Set init...@>=
+@y
+@d term_in==input
+
+@<Set init...@>=
+@z
+
+@x
+reset(term_in,'TTY:','/I'); {open |term_in| as the terminal, don't do a |get|}
+@y
+@z
+
+@x
+@t\4\4@>{here files should be closed if the operating system requires it}
+@y
+if history<fatal_message then
+ @= close@>(tex_file,@=disposition:=save@>,@=error:=continue@>);
+@z
+
+@x
+This module should be replaced, if necessary, by changes to the program
+that are necessary to make \.{WEAVE} work at a particular installation.
+It is usually best to design your change file so that all changes to
+previous modules preserve the module numbering; then everybody's version
+will be consistent with the printed program. More extensive changes,
+which introduce new modules, can be inserted here; then only the index
+itself will get a new module number.
+@y
+Here are the remaining changes to the program
+that are necessary to make \.{WEAVE} work on Vax/VMS.
+
+@ This variable is for speeding up the output routine.
+
+@<Glob...@>=
+@!out_temp_buffer: packed array [1..line_length+1] of char;
+
+@ On Vax/VMS we need the following special definitions, types, variables
+and procedures to be able to get the file name from the command line,
+or to prompt for them.
+
+@d VAX_volatile==@=volatile@>
+@d VAX_immed==@=%immed @>
+@d VAX_external==@=external@>
+@d VAX_stdescr==@=%stdescr @>
+@d VAX_lib_get_foreign==@= lib$get_foreign@>
+@d VAX_length==@=length @>
+
+@ @<Local...@>=
+@!command_line:packed array[1..300] of char;
+@!cmd_len:sixteen_bits;
+@!cmd_i:integer;
+@!file_name,@!default_file_name:varying [300] of char;
+@!ask,@!got_file_name: boolean;
+
+@ Here is the library procedure that gets the user's command line.
+
+@<Error...@>=
+[VAX_external] function VAX_lib_get_foreign(
+ VAX_stdescr cmdlin:[VAX_volatile] packed array [$l1..$u1:integer] of char
+ := VAX_immed 0;
+ VAX_stdescr prompt:[VAX_volatile] packed array [$l2..$u2:integer] of char
+ := VAX_immed 0;
+ var len : [VAX_volatile] sixteen_bits := VAX_immed 0;
+ var flag : [VAX_volatile] integer := VAX_immed 0)
+ :integer; extern;
+
+@ We get the external file names, and then call |open|
+to associate an external file with each file variable.
+
+@d VAX_open == @= open@>
+
+@<Preset init...@>=
+cmd_i:=0;
+VAX_lib_get_foreign(command_line,,cmd_len,cmd_i);
+cmd_i:=1; while (cmd_i<=cmd_len) and (command_line[cmd_i]=' ') do incr(cmd_i);
+got_file_name:=cmd_i<=cmd_len;
+if got_file_name then
+ default_file_name:=substr(command_line,cmd_i,cmd_len-cmd_i+1);
+
+if got_file_name then begin
+ file_name:=default_file_name+'.WEB';
+ VAX_open(web_file,file_name,@=readonly@>,@=error:=continue@>);
+ ask:=status(web_file)<>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end
+else ask:=true;
+while ask do begin
+ got_file_name:=false;
+ write('Web file: ');
+ if eof then begin mark_fatal; jump_out; end;
+ read_ln(file_name);
+ VAX_open(web_file,file_name,@=readonly@>,@=error:=continue@>);
+ ask:=status(web_file)<>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end;
+
+if got_file_name then begin
+ file_name:=default_file_name+'.CH';
+ VAX_open(change_file,file_name,@=readonly@>,@=error:=continue@>);
+ ask:=status(change_file)>0; {can be empty}
+ if ask then write_ln('Couldn''t open ',file_name);
+ end
+else ask:=true;
+while ask do begin
+ write('Change file: ');
+ if eof then begin mark_fatal; jump_out; end;
+ read_ln(file_name);
+ if file_name.VAX_length=0 then file_name:='NL:';
+ VAX_open(change_file,file_name,@=readonly@>,@=error:=continue@>);
+ ask:=status(change_file)>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end;
+
+if got_file_name then begin
+ cmd_i:=1;
+ for cmd_len:=1 to default_file_name.VAX_length do
+ if (default_file_name[cmd_len]=']')
+ or (default_file_name[cmd_len]=':')
+ then cmd_i:=cmd_len+1;
+ if cmd_i<=default_file_name.VAX_length then
+ default_file_name:=substr(default_file_name,cmd_i,
+ default_file_name.VAX_length-cmd_i+1);
+ file_name:=default_file_name+'.TEX';
+ VAX_open(tex_file,file_name,@=new,disposition:=delete@>,
+ @=error:=continue@>);
+ ask:=status(tex_file)>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end
+else ask:=true;
+while ask do begin
+ write('TeX file: ');
+ if eof then begin mark_fatal; jump_out; end;
+ read_ln(file_name);
+ VAX_open(tex_file,file_name,@=new,disposition:=delete@>,
+ @=error:=continue@>);
+ ask:=status(tex_file)>0;
+ if ask then write_ln('Couldn''t open ',file_name);
+ end;
+
+rewrite(tex_file);
+@z