diff options
Diffstat (limited to 'obsolete/systems/knuth/unsupported')
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 |