summaryrefslogtreecommitdiff
path: root/systems/knuth/local/texware
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /systems/knuth/local/texware
Initial commit
Diffstat (limited to 'systems/knuth/local/texware')
-rw-r--r--systems/knuth/local/texware/Makefile40
-rw-r--r--systems/knuth/local/texware/access.c17
-rw-r--r--systems/knuth/local/texware/dvityext.c176
-rw-r--r--systems/knuth/local/texware/dvityext.h17
-rw-r--r--systems/knuth/local/texware/dvitype.ch468
-rw-r--r--systems/knuth/local/texware/dvitype.p604
-rw-r--r--systems/knuth/local/texware/pltotf.ch118
-rw-r--r--systems/knuth/local/texware/pltotf.p830
-rw-r--r--systems/knuth/local/texware/pooltype.ch92
-rw-r--r--systems/knuth/local/texware/pooltype.p57
-rw-r--r--systems/knuth/local/texware/texwarext.h5
-rw-r--r--systems/knuth/local/texware/tftopl.ch128
-rw-r--r--systems/knuth/local/texware/tftopl.p504
-rw-r--r--systems/knuth/local/texware/tftopl.pool2
14 files changed, 3058 insertions, 0 deletions
diff --git a/systems/knuth/local/texware/Makefile b/systems/knuth/local/texware/Makefile
new file mode 100644
index 0000000000..db7ad06a2c
--- /dev/null
+++ b/systems/knuth/local/texware/Makefile
@@ -0,0 +1,40 @@
+# Make executable files for this workstation, using the master TeX sources
+
+PFLAGS= -g -I..
+CFLAGS= -g -I..
+PC= gpc
+
+all: pooltype tftopl pltotf dvitype
+
+%.p: %.ch
+ tangle ../../dist/texware/$*.web $*.ch
+# the next line formerly necessary; but not with Linux's (Web2C) tangle
+# mv ../../dist/texware/$*.p .
+
+%.ch: ../../dist/texware/%.web
+ touch $*.ch
+
+%.o: %.p
+ ${PC} ${PFLAGS} -c $*.p
+
+pooltype: pooltype.o dvityext.o dvityext.h
+ pc ${PFLAGS} -o pooltype pooltype.o dvityext.o
+
+tftopl: tftopl.o dvityext.o dvityext.h
+ pc ${PFLAGS} -o tftopl tftopl.o dvityext.o
+
+pltotf: pltotf.o dvityext.o dvityext.h
+ ${PC} ${PFLAGS} -o pltotf pltotf.o dvityext.o
+
+dvitype: dvitype.o dvityext.o dvityext.h
+ ${PC} ${PFLAGS} -o dvitype dvitype.o dvityext.o
+
+dvityext.o: dvityext.c ../GPCtypes.h ../texpaths.h
+
+install: # doit make install "PROG=dvitype"
+ mv $(PROG) /usr/local/bin/$(PROG)
+
+clean:
+# rm -f *.p *.o *~ ../../dist/texware/*.pool
+ rm -f *.p *.o *~ *.pool core
+
diff --git a/systems/knuth/local/texware/access.c b/systems/knuth/local/texware/access.c
new file mode 100644
index 0000000000..6fde385791
--- /dev/null
+++ b/systems/knuth/local/texware/access.c
@@ -0,0 +1,17 @@
+#define namelength 100 /* must agree with tftopl.ch and pltotf.ch */
+
+bool testreadaccess(fn)
+ char *fn;
+{
+ register char *p;
+
+ fn[namelength-1] = ' ';
+ p = fn;
+ while (*p++ != ' ');
+ p--;
+ *p = '\0';
+ if (access(fn,4)==0) {
+ *p = ' '; return(TRUE);}
+ else {*p = ' '; return(FALSE);}
+}
+
diff --git a/systems/knuth/local/texware/dvityext.c b/systems/knuth/local/texware/dvityext.c
new file mode 100644
index 0000000000..61f20538a5
--- /dev/null
+++ b/systems/knuth/local/texware/dvityext.c
@@ -0,0 +1,176 @@
+/* External procedures for texware */
+/* Written by Don Knuth, 2000.04.29, based on Trickey's vintage 1983 code */
+
+#include "../texpaths.h" /* defines default TEXFONTS path */
+#include "../GPCtypes.h" /* defines Pascal I/O structure */
+#include <string.h>
+#include <unistd.h>
+#include <sys/stat.h>
+
+#define namelength 100 /* should agree with .ch files */
+
+void Argv(int n, char* str)
+{
+ register char *s,*t;
+ if (n<0 || n>=_p_argc) return;
+ s=_p_argv[n];
+ if (strlen(s) >= namelength-5) {
+ str[0]='\0'; return; /* we don't want it too long */
+ }
+ for (t=str; *s; s++,t++) *t=*s;
+ *t='\0';
+}
+
+bool Testreadaccess(char *fn)
+{
+ return access(fn,R_OK)? FALSE: TRUE;
+}
+
+char *fontpath;
+
+char *getenv();
+
+/*
+ * setpaths is called to set up the pointer fontpath
+ * as follows: if the user's environment has a value for TEXFONTS
+ * then use it; otherwise, use defaultfontpath.
+ */
+Setpaths()
+{
+ register char *envpath;
+
+ if ((envpath = getenv("TEXFONTS")) != NULL)
+ fontpath = envpath;
+ else
+ fontpath = defaultfontpath;
+}
+
+#define namelength 100 /* should agree with dvitype.ch */
+char Curname[namelength],Realnameoffile[namelength];
+#define curname Curname
+#define realnameoffile Realnameoffile
+
+/*
+ * testaccess(amode,filepath)
+ *
+ * Test whether or not the file whose name is in the global curname
+ * can be opened for reading (if mode=READACCESS)
+ * or writing (if mode=WRITEACCESS).
+ *
+ * The filepath argument is one of the ...FILEPATH constants defined below.
+ * If the filename given in curname does not begin with '/', we try
+ * prepending all the ':'-separated areanames in the appropriate path to the
+ * filename until access can be made, if it ever can.
+ *
+ * The realnameoffile global array will contain the name that yielded an
+ * access success.
+ */
+
+#define READACCESS 4
+#define WRITEACCESS 2
+
+#define NOFILEPATH 0
+#define FONTFILEPATH 3
+
+bool
+Testaccess(int amode,int filepath)
+{
+ register bool ok;
+ register char *p;
+ char *curpathplace;
+ int f;
+
+ switch(filepath) {
+ case NOFILEPATH: curpathplace = NULL; break;
+ case FONTFILEPATH: curpathplace = fontpath; break;
+ }
+ if (curname[0]=='/') /* file name has absolute path */
+ curpathplace = NULL;
+ do {
+ packrealnameoffile(&curpathplace);
+ if (amode==READACCESS)
+ /* use system call "access" to see if we could read it */
+ if (access(realnameoffile,R_OK)==0) ok = TRUE;
+ else ok = FALSE;
+ else {
+ /* WRITEACCESS: use creat to see if we could create it, but close
+ the file again if we're OK, to let pc open it for real */
+ f = creat(realnameoffile,0666);
+ if (f>=0) { ok = TRUE; close(f);}
+ else ok = FALSE;
+ }
+ } while (!ok && curpathplace != NULL);
+ return (ok);
+}
+
+/*
+ * packrealnameoffile(cpp) makes realnameoffile contain the directory at *cpp,
+ * followed by '/', followed by the characters in curname up until the
+ * first blank there, and finally a '\0'. The cpp pointer is left pointing
+ * at the next directory in the path.
+ * But: if *cpp == NULL, then we are supposed to use curname as is.
+ */
+packrealnameoffile(cpp)
+ char **cpp;
+{
+ register char *p,*realname;
+
+ realname = realnameoffile;
+ if ((p = *cpp)!=NULL) {
+ while ((*p != ':') && (*p != '\0')) {
+ *realname++ = *p++;
+ if (realname == &(realnameoffile[namelength-1]))
+ break;
+ }
+ if (*p == '\0') *cpp = NULL; /* at end of path now */
+ else *cpp = p+1; /* else get past ':' */
+ *realname++ = '/'; /* separate the area from the name to follow */
+ }
+ /* now append curname to realname... */
+ p = curname;
+ while (*p) {
+ if (realname >= &(realnameoffile[namelength-1])) {
+ fprintf(stderr,"! Full file name is too long\n");
+ break;
+ }
+ *realname++ = *p++;
+ }
+ *realname = '\0';
+}
+
+int Flength(FDR filep)
+{
+ register FILE *iop; /* stdio-style FILE pointer */
+ register long pos; /* current file position */
+ register int len; /* the file length */
+
+ iop = filep->FilJfn;
+ pos = ftell(iop);
+ fseek(iop,0L,SEEK_END);
+ len = ftell(iop);
+ fseek(iop,pos,0);
+ return len;
+}
+
+void Bseek(FDR filep,int cnt)
+{
+ register FILE *iop; /* stdio-style FILE pointer */
+
+ iop = filep->FilJfn;
+ fseek(iop,(long)cnt,SEEK_SET);
+}
+
+void Flushstdout()
+{
+ fflush(stdout);
+}
+
+void Readbyte(FDR filep, unsigned char *x)
+{
+ /* reads a character WITHOUT using the Pascal runtime buffers etc */
+ register int c;
+ c=getc(filep->FilJfn);
+ if (c==EOF) c=0;
+ *x=c;
+}
+
diff --git a/systems/knuth/local/texware/dvityext.h b/systems/knuth/local/texware/dvityext.h
new file mode 100644
index 0000000000..ab9a63da75
--- /dev/null
+++ b/systems/knuth/local/texware/dvityext.h
@@ -0,0 +1,17 @@
+argc:asmname '_p_argc' Integer;
+
+procedure argv(no:Integer;var str:UNIXfilename); external;
+
+function testreadaccess(var a:UNIXfilename):boolean; external;
+
+procedure setpaths; external;
+
+function testaccess(accessmode:integer; filepath:integer): boolean; external;
+
+function flength(var f: bytefile):integer; external;
+
+procedure bseek(var f: bytefile; loc: integer); external;
+
+procedure flushstdout; external;
+
+procedure readbyte(var f: bytefile; var v: ByteCard); external;
diff --git a/systems/knuth/local/texware/dvitype.ch b/systems/knuth/local/texware/dvitype.ch
new file mode 100644
index 0000000000..4857a60d62
--- /dev/null
+++ b/systems/knuth/local/texware/dvitype.ch
@@ -0,0 +1,468 @@
+% Change file for the DVItype processor, for use with GNU Pascal.
+% (by Don Knuth, based on prior work by Trickey and Curtis)
+% (see ../texware-sparc for complete details of their changes)
+
+% History:
+% 2000.04.29 Original version.
+
+% The section numbers used in this file refer to those in the standard
+% TeXware report (CS1097).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [0] WEAVE: print changes only
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{DVI$\,$\lowercase{type} changes for GNU Pascal}
+@z
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [1] Change banner string
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@d banner=='This is DVItype, Version 3.6' {printed when the program starts}
+@y
+@d banner=='This is DVItype, Version 3.6 for Linux'
+ {printed when the program starts}
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [2] Use default case statement feature of ISO extended Pascal
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@d othercases == others: {default for cases not listed explicitly}
+@y
+@d othercases == otherwise {default for cases not listed explicitly}
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [3] Change filenames in program statement; add #include statement
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@d print(#)==write(#)
+@d print_ln(#)==write_ln(#)
+
+@p program DVI_type(@!dvi_file,@!output);
+@y
+For {\mc UNIX}, we need the name |output| for the dialog, so make
+the output come out on a file called |'dvitype.out'|.
+
+@d print(#)==write(dvityout,#)
+@d print_ln(#)==write_ln(dvityout,#)
+
+@p program DVI_type(@!input,@!output);
+@z
+
+@x
+var @<Globals in the outer block@>@/
+@y
+var @<Globals in the outer block@>@/
+@\@=#include "dvityext.h"@>@\ {declarations for external C procedures}
+@z
+
+@x
+ begin print_ln(banner);@/
+@y
+ begin
+ setpaths; {read environment, to find TEXFONTS, if there}
+ rewrite(dvityout,'dvitype.out'); {prepare typescript for output}
+ print_ln(banner);@/
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [5] Increase name_length
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@!name_length=50; {a file name shouldn't be longer than this}
+@y
+@!name_length=100; {a file name shouldn't be longer than this}
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [9] make the compiler recognize a text file as text
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@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;
+@y
+@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=255 {ordinal number of the largest element of |text_char|}
+@d text_file==text
+
+@<Types...@>=
+@!UNIX_filename=packed array[1..name_length] of char;
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [21] Change definition of 'eight_bits'
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@!eight_bits=0..255; {unsigned one-byte quantity}
+@y
+@!eight_bits=ByteCard; {unsigned one-byte quantity}
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [23] Fix up opening the binary files
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@p procedure open_dvi_file; {prepares to read packed bytes in |dvi_file|}
+begin reset(dvi_file);
+cur_loc:=0;
+end;
+@#
+procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|}
+begin reset(tfm_file,cur_name);
+end;
+@y
+We use the external |test_access| procedure, which also does path searching
+based on the user's environment or the default path.
+
+@d read_access_mode=4 {``read'' mode for |test_access|}
+@d write_access_mode=2 {``write'' mode for |test_access|}
+
+@d no_file_path=0 {no path searching should be done}
+@d font_file_path=3 {path specifier for \.{TFM} files}
+
+@p procedure open_dvi_file; {prepares to read packed bytes in |dvi_file|}
+begin argv(1, cur_name);
+ if test_access(read_access_mode,no_file_path) then
+ begin dvi_name:=real_name_of_file; reset(dvi_file,dvi_name)
+ end
+ else begin
+ write_ln('DVI file not found');
+ jump_out;
+ end;
+ cur_loc:=0;
+end;
+@#
+procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|}
+begin
+if test_access(read_access_mode,font_file_path) then
+ reset(tfm_file,real_name_of_file)
+else begin
+ write_ln('TFM file not found: ',cur_name);
+ jump_out
+end;
+end;
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [24] Declare real_name_of_file
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+|dvi_file|, and |cur_name| is a string variable that will be set to the
+current font metric file name before |open_tfm_file| is called.
+
+@<Glob...@>=
+@!cur_loc:integer; {where we are about to look, in |dvi_file|}
+@!cur_name:packed array[1..name_length] of char; {external name,
+ with no lower case letters}
+@y
+|dvi_file|, and |cur_name| is a string variable that will be set to the
+current font metric file name before |open_tfm_file| is called.
+Under UNIX, we also have a |real_name_of_file| string, that gets
+set by the external |test_access| procedure after path searching.
+
+@<Glob...@>=
+@!cur_loc:integer; {where we are about to look, in |dvi_file|}
+@!cur_name,@!real_name_of_file:external UNIX_filename; {external names}
+@!dvi_name:UNIX_filename;
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [27] Use C library to read bytes
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@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
+The GNU Pascal runtime programs for |read| keeps its own
+buffers, and this conflicts with the |move_to_byte| routine.
+So we substitute our own function, |read_byte|. (Actually
+the Pascal runtimes work fine if |random_reading| is false.)
+
+@p function get_byte:integer; {returns the next byte, unsigned}
+var b:eight_bits;
+begin read_byte(dvi_file,b);
+incr(cur_loc); get_byte:=b;
+end;
+@#
+function signed_byte:integer; {returns the next byte, signed}
+var b:eight_bits;
+begin read_byte(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_byte(dvi_file,a); read_byte(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_byte(dvi_file,a); read_byte(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_byte(dvi_file,a); read_byte(dvi_file,b); read_byte(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_byte(dvi_file,a); read_byte(dvi_file,b); read_byte(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_byte(dvi_file,a); read_byte(dvi_file,b); read_byte(dvi_file,c); read_byte(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
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [28] Redefine dvi_length() and move_to_byte().
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@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;
+@y
+@p function dvi_length:integer;
+begin dvi_length:=flength(dvi_file);
+end;
+@#
+procedure move_to_byte(n:integer);
+begin bseek(dvi_file,n); cur_loc:=n;
+end;
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [45] Define term_in and term_out and declare dvityout, first_input
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@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
+@d term_out==output
+
+@<Glob...@>=
+@!buffer:array[0..terminal_line_length] of ASCII_code;
+@!dvityout:text;
+@!first_input:boolean; {true until |input_ln| has been invoked}
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [46] Define update_terminal
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@d update_terminal == break(term_out) {empty the terminal output buffer}
+@y
+@d update_terminal == flush_stdout {empty the terminal output buffer}
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [47] Remove call to reset(term_in) and initial eoln test
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+begin update_terminal; reset(term_in);
+if eoln(term_in) then read_ln(term_in);
+@y
+begin update_terminal;
+if first_input then first_input:=false
+else if eoln(term_in) then read_ln(term_in);
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [50] Remove call to rewrite(term_out)
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+begin rewrite(term_out); {prepare the terminal for output}
+@y
+begin
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [64] Set default_directory_name
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@d default_directory_name=='TeXfonts:' {change this to the correct name}
+@d default_directory_name_length=9 {change this to the correct length}
+
+@<Glob...@>=
+@!default_directory:packed array[1..default_directory_name_length] of char;
+@y
+Actually, under UNIX the standard area is defined in an external
+``texpaths.h'' file. And the users have a path searched for fonts,
+by setting the TEXFONTS environment variable.
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [65] Remove initialization of now-defunct array
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@ @<Set init...@>=
+default_directory:=default_directory_name;
+@y
+@ (No initialization to be done. Keep this module to preserve numbering.)
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [66] Fix addition of ".tfm" suffix for portability and keep lowercase
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@ The string |cur_name| is supposed to be set to the external name of the
+\.{TFM} file for the current font. This usually means that we need to
+prepend the name of the default directory, and
+to append the suffix `\.{.TFM}'. Furthermore, we change lower case letters
+to upper case, since |cur_name| is a \PASCAL\ string.
+@y
+@ The string |cur_name| is supposed to be set to the external name of the
+\.{TFM} file for the current font. This usually means that we need to,
+at most sites, append the
+suffix ``.tfm''.
+@z
+
+@x
+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;
+@y
+r:=0;
+@z
+
+@x
+ 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
+ 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]:=chr(0)
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [105] Reopen DVI file after postamble has been checked
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+if not eof(dvi_file) then bad_dvi('signature in byte ',cur_loc-1:1,
+@.signature...should be...@>
+ ' should be 223')
+else if cur_loc<k+4 then
+ print_ln('not enough signature bytes at end of file (',
+@.not enough signature bytes...@>
+ cur_loc-k:1,')');
+@y
+if not eof(dvi_file) then bad_dvi('signature in byte ',cur_loc-1:1,
+@.signature...should be...@>
+ ' should be 223');
+if cur_loc<k+4 then
+ print_ln('not enough signature bytes at end of file (',
+@.not enough signature bytes...@>
+ cur_loc-k:1,')');
+reset(dvi_file,dvi_name) {the UNIX routines may have closed the file}
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [107] Check usage; also print newline at end of program
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+dialog; {set up all the options}
+@y
+if argc <> 2 then
+ begin write_ln('Usage: dvitype <dvi-file>'); goto final_end;
+ end;
+first_input:=true; dialog; {set up all the options}
+@z
+@x
+final_end:end.
+@y
+final_end: print_ln(' '); end.
+@z
diff --git a/systems/knuth/local/texware/dvitype.p b/systems/knuth/local/texware/dvitype.p
new file mode 100644
index 0000000000..71262aa3d8
--- /dev/null
+++ b/systems/knuth/local/texware/dvitype.p
@@ -0,0 +1,604 @@
+{3:}program DVItype(input,output);label{4:}9999,30;{:4}const{5:}
+maxfonts=100;maxwidths=10000;linelength=79;terminallinelength=150;
+stacksize=100;namesize=1000;namelength=100;{:5}type{8:}
+ASCIIcode=32..126;{:8}{9:}
+UNIXfilename=packed array[1..namelength]of char;{:9}{21:}
+eightbits=ByteCard;bytefile=packed file of eightbits;{:21}var{10:}
+xord:array[char]of ASCIIcode;xchr:array[0..255]of char;{:10}{22:}
+dvifile:bytefile;tfmfile:bytefile;{:22}{24:}curloc:integer;
+curname,realnameoffile:external UNIXfilename;dviname:UNIXfilename;{:24}
+{25:}b0,b1,b2,b3:eightbits;{:25}{30:}
+fontnum:array[0..maxfonts]of integer;
+fontname:array[0..maxfonts]of 1..namesize;
+names:array[1..namesize]of ASCIIcode;
+fontchecksum:array[0..maxfonts]of integer;
+fontscaledsize:array[0..maxfonts]of integer;
+fontdesignsize:array[0..maxfonts]of integer;
+fontspace:array[0..maxfonts]of integer;
+fontbc:array[0..maxfonts]of integer;fontec:array[0..maxfonts]of integer;
+widthbase:array[0..maxfonts]of integer;
+width:array[0..maxwidths]of integer;nf:0..maxfonts;
+widthptr:0..maxwidths;{:30}{33:}inwidth:array[0..255]of integer;
+tfmchecksum:integer;tfmdesignsize:integer;tfmconv:real;{:33}{39:}
+pixelwidth:array[0..maxwidths]of integer;conv:real;trueconv:real;
+numerator,denominator:integer;mag:integer;{:39}{41:}outmode:0..4;
+maxpages:integer;resolution:real;newmag:integer;{:41}{42:}
+startcount:array[0..9]of integer;startthere:array[0..9]of boolean;
+startvals:0..9;count:array[0..9]of integer;{:42}{45:}
+buffer:array[0..terminallinelength]of ASCIIcode;dvityout:text;
+firstinput:boolean;{:45}{48:}bufptr:0..terminallinelength;{:48}{57:}
+inpostamble:boolean;{:57}{67:}textptr:0..linelength;
+textbuf:array[1..linelength]of ASCIIcode;{:67}{72:}
+h,v,w,x,y,z,hh,vv:integer;
+hstack,vstack,wstack,xstack,ystack,zstack:array[0..stacksize]of integer;
+hhstack,vvstack:array[0..stacksize]of integer;{:72}{73:}maxv:integer;
+maxh:integer;maxs:integer;maxvsofar,maxhsofar,maxssofar:integer;
+totalpages:integer;pagecount:integer;{:73}{78:}s:integer;ss:integer;
+curfont:integer;showing:boolean;{:78}{97:}oldbackpointer:integer;
+newbackpointer:integer;started:boolean;{:97}{101:}postloc:integer;
+firstbackpointer:integer;startloc:integer;afterpre:integer;{:101}{108:}
+k,m,n,p,q:integer;{:108}
+#include "dvityext.h"
+procedure initialize;var i:integer;begin setpaths;
+rewrite(dvityout,'dvitype.out');
+writeln(dvityout,'This is DVItype, Version 3.6 for Linux');{11:}
+for i:=0 to 31 do xchr[i]:='?';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]:='~';
+for i:=127 to 255 do xchr[i]:='?';{:11}{12:}
+for i:=0 to 255 do xord[chr(i)]:=32;
+for i:=32 to 126 do xord[xchr[i]]:=i;{:12}{31:}nf:=0;widthptr:=0;
+fontname[0]:=1;fontspace[maxfonts]:=0;fontbc[maxfonts]:=1;
+fontec[maxfonts]:=0;{:31}{43:}outmode:=4;maxpages:=1000000;startvals:=0;
+startthere[0]:=false;{:43}{58:}inpostamble:=false;{:58}{68:}textptr:=0;
+{:68}{74:}maxv:=2147483548;maxh:=2147483548;maxs:=stacksize+1;
+maxvsofar:=0;maxhsofar:=0;maxssofar:=0;pagecount:=0;{:74}{98:}
+oldbackpointer:=-1;started:=false;{:98}end;{:3}{7:}procedure jumpout;
+begin goto 9999;end;{:7}{23:}procedure opendvifile;
+begin argv(1,curname);
+if testaccess(4,0)then begin dviname:=realnameoffile;
+reset(dvifile,dviname)end else begin writeln('DVI file not found');
+jumpout;end;curloc:=0;end;procedure opentfmfile;
+begin if testaccess(4,3)then reset(tfmfile,realnameoffile)else begin
+writeln('TFM file not found: ',curname);jumpout end;end;{:23}{26:}
+procedure readtfmword;begin read(tfmfile,b0);read(tfmfile,b1);
+read(tfmfile,b2);read(tfmfile,b3);end;{:26}{27:}
+function getbyte:integer;var b:eightbits;begin readbyte(dvifile,b);
+curloc:=curloc+1;getbyte:=b;end;function signedbyte:integer;
+var b:eightbits;begin readbyte(dvifile,b);curloc:=curloc+1;
+if b<128 then signedbyte:=b else signedbyte:=b-256;end;
+function gettwobytes:integer;var a,b:eightbits;
+begin readbyte(dvifile,a);readbyte(dvifile,b);curloc:=curloc+2;
+gettwobytes:=a*256+b;end;function signedpair:integer;var a,b:eightbits;
+begin readbyte(dvifile,a);readbyte(dvifile,b);curloc:=curloc+2;
+if a<128 then signedpair:=a*256+b else signedpair:=(a-256)*256+b;end;
+function getthreebytes:integer;var a,b,c:eightbits;
+begin readbyte(dvifile,a);readbyte(dvifile,b);readbyte(dvifile,c);
+curloc:=curloc+3;getthreebytes:=(a*256+b)*256+c;end;
+function signedtrio:integer;var a,b,c:eightbits;
+begin readbyte(dvifile,a);readbyte(dvifile,b);readbyte(dvifile,c);
+curloc:=curloc+3;
+if a<128 then signedtrio:=(a*256+b)*256+c else signedtrio:=((a-256)*256+
+b)*256+c;end;function signedquad:integer;var a,b,c,d:eightbits;
+begin readbyte(dvifile,a);readbyte(dvifile,b);readbyte(dvifile,c);
+readbyte(dvifile,d);curloc:=curloc+4;
+if a<128 then signedquad:=((a*256+b)*256+c)*256+d else signedquad:=(((a
+-256)*256+b)*256+c)*256+d;end;{:27}{28:}function dvilength:integer;
+begin dvilength:=flength(dvifile);end;procedure movetobyte(n:integer);
+begin bseek(dvifile,n);curloc:=n;end;{:28}{32:}
+procedure printfont(f:integer);var k:0..namesize;
+begin if f=maxfonts then write(dvityout,'UNDEFINED!')else begin for k:=
+fontname[f]to fontname[f+1]-1 do write(dvityout,xchr[names[k]]);end;end;
+{:32}{34:}function inTFM(z:integer):boolean;label 9997,9998,9999;
+var k:integer;lh:integer;nw:integer;wp:0..maxwidths;alpha,beta:integer;
+begin{35:}readtfmword;lh:=b2*256+b3;readtfmword;fontbc[nf]:=b0*256+b1;
+fontec[nf]:=b2*256+b3;
+if fontec[nf]<fontbc[nf]then fontbc[nf]:=fontec[nf]+1;
+if widthptr+fontec[nf]-fontbc[nf]+1>maxwidths then begin writeln(
+dvityout,'---not loaded, DVItype needs larger width table');goto 9998;
+end;wp:=widthptr+fontec[nf]-fontbc[nf]+1;readtfmword;nw:=b0*256+b1;
+if(nw=0)or(nw>256)then goto 9997;
+for k:=1 to 3+lh do begin if eof(tfmfile)then goto 9997;readtfmword;
+if k=4 then if b0<128 then tfmchecksum:=((b0*256+b1)*256+b2)*256+b3 else
+tfmchecksum:=(((b0-256)*256+b1)*256+b2)*256+b3 else if k=5 then if b0<
+128 then tfmdesignsize:=round(tfmconv*(((b0*256+b1)*256+b2)*256+b3))else
+goto 9997;end;{:35};{36:}
+if wp>0 then for k:=widthptr to wp-1 do begin readtfmword;
+if b0>nw then goto 9997;width[k]:=b0;end;{:36};{37:}{38:}
+begin alpha:=16;while z>=8388608 do begin z:=z div 2;alpha:=alpha+alpha;
+end;beta:=256 div alpha;alpha:=alpha*z;end{:38};
+for k:=0 to nw-1 do begin readtfmword;
+inwidth[k]:=(((((b3*z)div 256)+(b2*z))div 256)+(b1*z))div beta;
+if b0>0 then if b0<255 then goto 9997 else inwidth[k]:=inwidth[k]-alpha;
+end{:37};{40:}if inwidth[0]<>0 then goto 9997;
+widthbase[nf]:=widthptr-fontbc[nf];
+if wp>0 then for k:=widthptr to wp-1 do if width[k]=0 then begin width[k
+]:=2147483647;pixelwidth[k]:=0;
+end else begin width[k]:=inwidth[width[k]];
+pixelwidth[k]:=round(conv*(width[k]));end{:40};widthptr:=wp;inTFM:=true;
+goto 9999;9997:writeln(dvityout,'---not loaded, TFM file is bad');
+9998:inTFM:=false;9999:end;{:34}{44:}function startmatch:boolean;
+var k:0..9;match:boolean;begin match:=true;
+for k:=0 to startvals do if startthere[k]and(startcount[k]<>count[k])
+then match:=false;startmatch:=match;end;{:44}{47:}procedure inputln;
+var k:0..terminallinelength;begin flushstdout;
+if firstinput then firstinput:=false else if eoln(input)then readln(
+input);k:=0;
+while(k<terminallinelength)and not eoln(input)do begin buffer[k]:=xord[
+input^];k:=k+1;get(input);end;buffer[k]:=32;end;{:47}{49:}
+function getinteger:integer;var x:integer;negative:boolean;
+begin if buffer[bufptr]=45 then begin negative:=true;bufptr:=bufptr+1;
+end else negative:=false;x:=0;
+while(buffer[bufptr]>=48)and(buffer[bufptr]<=57)do begin x:=10*x+buffer[
+bufptr]-48;bufptr:=bufptr+1;end;
+if negative then getinteger:=-x else getinteger:=x;end;{:49}{50:}
+procedure dialog;label 1,2,3,4,5;var k:integer;
+begin writeln(output,'This is DVItype, Version 3.6 for Linux');{51:}
+1:write(output,'Output level (default=4, ? for help): ');outmode:=4;
+inputln;
+if buffer[0]<>32 then if(buffer[0]>=48)and(buffer[0]<=52)then outmode:=
+buffer[0]-48 else begin write(output,'Type 4 for complete listing,');
+write(output,' 0 for errors and fonts only,');
+writeln(output,' 1 or 2 or 3 for something in between.');goto 1;end{:51}
+;{52:}2:write(output,'Starting page (default=*): ');startvals:=0;
+startthere[0]:=false;inputln;bufptr:=0;k:=0;
+if buffer[0]<>32 then repeat if buffer[bufptr]=42 then begin startthere[
+k]:=false;bufptr:=bufptr+1;end else begin startthere[k]:=true;
+startcount[k]:=getinteger;end;
+if(k<9)and(buffer[bufptr]=46)then begin k:=k+1;bufptr:=bufptr+1;
+end else if buffer[bufptr]=32 then startvals:=k else begin write(output,
+'Type, e.g., 1.*.-5 to specify the ');
+writeln(output,'first page with \count0=1, \count2=-5.');goto 2;end;
+until startvals=k{:52};{53:}
+3:write(output,'Maximum number of pages (default=1000000): ');
+maxpages:=1000000;inputln;bufptr:=0;
+if buffer[0]<>32 then begin maxpages:=getinteger;
+if maxpages<=0 then begin writeln(output,
+'Please type a positive number.');goto 3;end;end{:53};{54:}
+4:write(output,'Assumed device resolution');
+write(output,' in pixels per inch (default=300/1): ');resolution:=300.0;
+inputln;bufptr:=0;if buffer[0]<>32 then begin k:=getinteger;
+if(k>0)and(buffer[bufptr]=47)and(buffer[bufptr+1]>48)and(buffer[bufptr+1
+]<=57)then begin bufptr:=bufptr+1;resolution:=k/getinteger;
+end else begin write(output,'Type a ratio of positive integers;');
+writeln(output,' (1 pixel per mm would be 254/10).');goto 4;end;end{:54}
+;{55:}
+5:write(output,'New magnification (default=0 to keep the old one): ');
+newmag:=0;inputln;bufptr:=0;
+if buffer[0]<>32 then if(buffer[0]>=48)and(buffer[0]<=57)then newmag:=
+getinteger else begin write(output,
+'Type a positive integer to override ');
+writeln(output,'the magnification in the DVI file.');goto 5;end{:55};
+{56:}writeln(dvityout,'Options selected:');
+write(dvityout,' Starting page = ');
+for k:=0 to startvals do begin if startthere[k]then write(dvityout,
+startcount[k]:1)else write(dvityout,'*');
+if k<startvals then write(dvityout,'.')else writeln(dvityout,' ');end;
+writeln(dvityout,' Maximum number of pages = ',maxpages:1);
+write(dvityout,' Output level = ',outmode:1);
+case outmode of 0:writeln(dvityout,
+' (showing bops, fonts, and error messages only)');
+1:writeln(dvityout,' (terse)');2:writeln(dvityout,' (mnemonics)');
+3:writeln(dvityout,' (verbose)');
+4:if true then writeln(dvityout,' (the works)')else begin outmode:=3;
+writeln(dvityout,' (the works: same as level 3 in this DVItype)');end;
+end;
+writeln(dvityout,' Resolution = ',resolution:12:8,' pixels per inch');
+if newmag>0 then writeln(dvityout,' New magnification factor = ',newmag
+/1000:8:3){:56};end;{:50}{59:}procedure definefont(e:integer);
+var f:0..maxfonts;p:integer;n:integer;c,q,d,m:integer;r:0..namelength;
+j,k:0..namesize;mismatch:boolean;
+begin if nf=maxfonts then begin write(dvityout,' ',
+'DVItype capacity exceeded (max fonts=',maxfonts:1,')!');jumpout;end;
+fontnum[nf]:=e;f:=0;while fontnum[f]<>e do f:=f+1;{61:}c:=signedquad;
+fontchecksum[nf]:=c;q:=signedquad;fontscaledsize[nf]:=q;d:=signedquad;
+fontdesignsize[nf]:=d;
+if(q<=0)or(d<=0)then m:=1000 else m:=round((1000.0*conv*q)/(trueconv*d))
+;p:=getbyte;n:=getbyte;
+if fontname[nf]+n+p>namesize then begin write(dvityout,' ',
+'DVItype capacity exceeded (name size=',namesize:1,')!');jumpout;end;
+fontname[nf+1]:=fontname[nf]+n+p;
+if showing then write(dvityout,': ')else write(dvityout,'Font ',e:1,': '
+);
+if n+p=0 then write(dvityout,'null font name!')else for k:=fontname[nf]
+to fontname[nf+1]-1 do names[k]:=getbyte;printfont(nf);
+if not showing then if m<>1000 then write(dvityout,' scaled ',m:1){:61};
+if((outmode=4)and inpostamble)or((outmode<4)and not inpostamble)then
+begin if f<nf then writeln(dvityout,'---this font was already defined!')
+;end else begin if f=nf then writeln(dvityout,
+'---this font wasn''t loaded before!');end;if f=nf then{62:}begin{66:}
+for k:=1 to namelength do curname[k]:=' ';r:=0;
+for k:=fontname[nf]to fontname[nf+1]-1 do begin r:=r+1;
+if r+4>namelength then begin write(dvityout,' ',
+'DVItype capacity exceeded (max font name length=',namelength:1,')!');
+jumpout;end;curname[r]:=xchr[names[k]];end;curname[r+1]:='.';
+curname[r+2]:='t';curname[r+3]:='f';curname[r+4]:='m';
+curname[r+5]:=chr(0){:66};opentfmfile;
+if eof(tfmfile)then write(dvityout,
+'---not loaded, TFM file can''t be opened!')else begin if(q<=0)or(q>=
+134217728)then write(dvityout,'---not loaded, bad scale (',q:1,')!')else
+if(d<=0)or(d>=134217728)then write(dvityout,
+'---not loaded, bad design size (',d:1,')!')else if inTFM(q)then{63:}
+begin fontspace[nf]:=q div 6;
+if(c<>0)and(tfmchecksum<>0)and(c<>tfmchecksum)then begin writeln(
+dvityout,'---beware: check sums do not agree!');
+writeln(dvityout,' (',c:1,' vs. ',tfmchecksum:1,')');
+write(dvityout,' ');end;
+if abs(tfmdesignsize-d)>2 then begin writeln(dvityout,
+'---beware: design sizes do not agree!');
+writeln(dvityout,' (',d:1,' vs. ',tfmdesignsize:1,')');
+write(dvityout,' ');end;
+write(dvityout,'---loaded at size ',q:1,' DVI units');
+d:=round((100.0*conv*q)/(trueconv*d));
+if d<>100 then begin writeln(dvityout,' ');
+write(dvityout,' (this font is magnified ',d:1,'%)');end;nf:=nf+1;
+end{:63};end;if outmode=0 then writeln(dvityout,' ');end{:62}else{60:}
+begin if fontchecksum[f]<>c then writeln(dvityout,
+'---check sum doesn''t match previous definition!');
+if fontscaledsize[f]<>q then writeln(dvityout,
+'---scaled size doesn''t match previous definition!');
+if fontdesignsize[f]<>d then writeln(dvityout,
+'---design size doesn''t match previous definition!');j:=fontname[f];
+k:=fontname[nf];
+if fontname[f+1]-j<>fontname[nf+1]-k then mismatch:=true else begin
+mismatch:=false;
+while j<fontname[f+1]do begin if names[j]<>names[k]then mismatch:=true;
+j:=j+1;k:=k+1;end;end;
+if mismatch then writeln(dvityout,
+'---font name doesn''t match previous definition!');end{:60};end;{:59}
+{69:}procedure flushtext;var k:0..linelength;
+begin if textptr>0 then begin if outmode>0 then begin write(dvityout,'['
+);for k:=1 to textptr do write(dvityout,xchr[textbuf[k]]);
+writeln(dvityout,']');end;textptr:=0;end;end;{:69}{70:}
+procedure outtext(c:ASCIIcode);
+begin if textptr=linelength-2 then flushtext;textptr:=textptr+1;
+textbuf[textptr]:=c;end;{:70}{75:}
+function firstpar(o:eightbits):integer;
+begin case o of 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,
+22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,
+46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,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,91,92,93,
+94,95,96,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,123,124,125,126,127:firstpar:=o
+-0;128,133,235,239,243:firstpar:=getbyte;
+129,134,236,240,244:firstpar:=gettwobytes;
+130,135,237,241,245:firstpar:=getthreebytes;
+143,148,153,157,162,167:firstpar:=signedbyte;
+144,149,154,158,163,168:firstpar:=signedpair;
+145,150,155,159,164,169:firstpar:=signedtrio;
+131,132,136,137,146,151,156,160,165,170,238,242,246:firstpar:=signedquad
+;138,139,140,141,142,247,248,249,250,251,252,253,254,255:firstpar:=0;
+147:firstpar:=w;152:firstpar:=x;161:firstpar:=y;166:firstpar:=z;
+171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,
+189,190,191,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,
+207,208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,224,
+225,226,227,228,229,230,231,232,233,234:firstpar:=o-171;end;end;{:75}
+{76:}function rulepixels(x:integer):integer;var n:integer;
+begin n:=trunc(conv*x);
+if n<conv*x then rulepixels:=n+1 else rulepixels:=n;end;{:76}{79:}{82:}
+function specialcases(o:eightbits;p,a:integer):boolean;
+label 46,44,30,9998;var q:integer;k:integer;badchar:boolean;
+pure:boolean;vvv:integer;begin pure:=true;case o of{85:}
+157,158,159,160:begin if abs(p)>=5*fontspace[curfont]then vv:=round(conv
+*(v+p))else vv:=vv+round(conv*(p));if outmode>0 then begin flushtext;
+showing:=true;write(dvityout,a:1,': ','down',o-156:1,' ',p:1);end;
+goto 44;end;161,162,163,164,165:begin y:=p;
+if abs(p)>=5*fontspace[curfont]then vv:=round(conv*(v+p))else vv:=vv+
+round(conv*(p));if outmode>0 then begin flushtext;showing:=true;
+write(dvityout,a:1,': ','y',o-161:1,' ',p:1);end;goto 44;end;
+166,167,168,169,170:begin z:=p;
+if abs(p)>=5*fontspace[curfont]then vv:=round(conv*(v+p))else vv:=vv+
+round(conv*(p));if outmode>0 then begin flushtext;showing:=true;
+write(dvityout,a:1,': ','z',o-166:1,' ',p:1);end;goto 44;end;{:85}{86:}
+171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188,
+189,190,191,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206,
+207,208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,224,
+225,226,227,228,229,230,231,232,233,234:begin if outmode>0 then begin
+flushtext;showing:=true;write(dvityout,a:1,': ','fntnum',p:1);end;
+goto 46;end;235,236,237,238:begin if outmode>0 then begin flushtext;
+showing:=true;write(dvityout,a:1,': ','fnt',o-234:1,' ',p:1);end;
+goto 46;end;243,244,245,246:begin if outmode>0 then begin flushtext;
+showing:=true;write(dvityout,a:1,': ','fntdef',o-242:1,' ',p:1);end;
+definefont(p);goto 30;end;{:86}239,240,241,242:{87:}
+begin if outmode>0 then begin flushtext;showing:=true;
+write(dvityout,a:1,': ','xxx ''');end;badchar:=false;
+if p<0 then if not showing then begin flushtext;showing:=true;
+write(dvityout,a:1,': ','string of negative length!');
+end else write(dvityout,' ','string of negative length!');
+for k:=1 to p do begin q:=getbyte;if(q<32)or(q>126)then badchar:=true;
+if showing then write(dvityout,xchr[q]);end;
+if showing then write(dvityout,'''');
+if badchar then if not showing then begin flushtext;showing:=true;
+write(dvityout,a:1,': ','non-ASCII character in xxx command!');
+end else write(dvityout,' ','non-ASCII character in xxx command!');
+goto 30;end{:87};247:begin if not showing then begin flushtext;
+showing:=true;
+write(dvityout,a:1,': ','preamble command within a page!');
+end else write(dvityout,' ','preamble command within a page!');
+goto 9998;end;248,249:begin if not showing then begin flushtext;
+showing:=true;
+write(dvityout,a:1,': ','postamble command within a page!');
+end else write(dvityout,' ','postamble command within a page!');
+goto 9998;end;otherwise begin if not showing then begin flushtext;
+showing:=true;write(dvityout,a:1,': ','undefined command ',o:1,'!');
+end else write(dvityout,' ','undefined command ',o:1,'!');goto 30;
+end end;44:{92:}
+if(v>0)and(p>0)then if v>2147483647-p then begin if not showing then
+begin flushtext;showing:=true;
+write(dvityout,a:1,': ','arithmetic overflow! parameter changed from ',p
+:1,' to ',2147483647-v:1);end else write(dvityout,' ',
+'arithmetic overflow! parameter changed from ',p:1,' to ',2147483647-v:1
+);p:=2147483647-v;end;
+if(v<0)and(p<0)then if-v>p+2147483647 then begin if not showing then
+begin flushtext;showing:=true;
+write(dvityout,a:1,': ','arithmetic overflow! parameter changed from ',p
+:1,' to ',(-v)-2147483647:1);end else write(dvityout,' ',
+'arithmetic overflow! parameter changed from ',p:1,' to ',(-v)
+-2147483647:1);p:=(-v)-2147483647;end;vvv:=round(conv*(v+p));
+if abs(vvv-vv)>2 then if vvv>vv then vv:=vvv-2 else vv:=vvv+2;
+if showing then if outmode>2 then begin write(dvityout,' v:=',v:1);
+if p>=0 then write(dvityout,'+');
+write(dvityout,p:1,'=',v+p:1,', vv:=',vv:1);end;v:=v+p;
+if abs(v)>maxvsofar then begin if abs(v)>maxv+99 then begin if not
+showing then begin flushtext;showing:=true;
+write(dvityout,a:1,': ','warning: |v|>',maxv:1,'!');
+end else write(dvityout,' ','warning: |v|>',maxv:1,'!');maxv:=abs(v);
+end;maxvsofar:=abs(v);end;goto 30{:92};46:{94:}fontnum[nf]:=p;
+curfont:=0;while fontnum[curfont]<>p do curfont:=curfont+1;
+if curfont=nf then begin curfont:=maxfonts;
+if not showing then begin flushtext;showing:=true;
+write(dvityout,a:1,': ','invalid font selection: font ',p:1,
+' was never defined!');
+end else write(dvityout,' ','invalid font selection: font ',p:1,
+' was never defined!');end;
+if showing then if outmode>2 then begin write(dvityout,
+' current font is ');printfont(curfont);end;goto 30{:94};
+9998:pure:=false;30:specialcases:=pure;end;{:82}function dopage:boolean;
+label 41,42,43,45,30,9998,9999;var o:eightbits;p,q:integer;a:integer;
+hhh:integer;begin curfont:=maxfonts;s:=0;h:=0;v:=0;w:=0;x:=0;y:=0;z:=0;
+hh:=0;vv:=0;while true do{80:}begin a:=curloc;showing:=false;o:=getbyte;
+p:=firstpar(o);
+if eof(dvifile)then begin write(dvityout,' ','Bad DVI file: ',
+'the file ended prematurely','!');jumpout;end;{81:}if o<128 then{88:}
+begin if(o>32)and(o<=126)then begin outtext(p);
+if outmode>1 then begin showing:=true;
+write(dvityout,a:1,': ','setchar',p:1);end;
+end else if outmode>0 then begin flushtext;showing:=true;
+write(dvityout,a:1,': ','setchar',p:1);end;goto 41;end{:88}
+else case o of 128,129,130,131:begin if outmode>0 then begin flushtext;
+showing:=true;write(dvityout,a:1,': ','set',o-127:1,' ',p:1);end;
+goto 41;end;133,134,135,136:begin if outmode>0 then begin flushtext;
+showing:=true;write(dvityout,a:1,': ','put',o-132:1,' ',p:1);end;
+goto 41;end;132:begin if outmode>0 then begin flushtext;showing:=true;
+write(dvityout,a:1,': ','setrule');end;goto 42;end;
+137:begin if outmode>0 then begin flushtext;showing:=true;
+write(dvityout,a:1,': ','putrule');end;goto 42;end;{83:}
+138:begin if outmode>1 then begin showing:=true;
+write(dvityout,a:1,': ','nop');end;goto 30;end;
+139:begin if not showing then begin flushtext;showing:=true;
+write(dvityout,a:1,': ','bop occurred before eop!');
+end else write(dvityout,' ','bop occurred before eop!');goto 9998;end;
+140:begin if outmode>0 then begin flushtext;showing:=true;
+write(dvityout,a:1,': ','eop');end;
+if s<>0 then if not showing then begin flushtext;showing:=true;
+write(dvityout,a:1,': ','stack not empty at end of page (level ',s:1,
+')!');
+end else write(dvityout,' ','stack not empty at end of page (level ',s:1
+,')!');dopage:=true;writeln(dvityout,' ');goto 9999;end;
+141:begin if outmode>0 then begin flushtext;showing:=true;
+write(dvityout,a:1,': ','push');end;
+if s=maxssofar then begin maxssofar:=s+1;
+if s=maxs then if not showing then begin flushtext;showing:=true;
+write(dvityout,a:1,': ','deeper than claimed in postamble!');
+end else write(dvityout,' ','deeper than claimed in postamble!');
+if s=stacksize then begin if not showing then begin flushtext;
+showing:=true;
+write(dvityout,a:1,': ','DVItype capacity exceeded (stack size=',
+stacksize:1,')');
+end else write(dvityout,' ','DVItype capacity exceeded (stack size=',
+stacksize:1,')');goto 9998;end;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;s:=s+1;ss:=s-1;goto 45;end;
+142:begin if outmode>0 then begin flushtext;showing:=true;
+write(dvityout,a:1,': ','pop');end;
+if s=0 then if not showing then begin flushtext;showing:=true;
+write(dvityout,a:1,': ','(illegal at level zero)!');
+end else write(dvityout,' ','(illegal at level zero)!')else begin s:=s-1
+;hh:=hhstack[s];vv:=vvstack[s];h:=hstack[s];v:=vstack[s];w:=wstack[s];
+x:=xstack[s];y:=ystack[s];z:=zstack[s];end;ss:=s;goto 45;end;{:83}{84:}
+143,144,145,146:begin if(p>=fontspace[curfont])or(p<=-4*fontspace[
+curfont])then begin outtext(32);hh:=round(conv*(h+p));
+end else hh:=hh+round(conv*(p));if outmode>1 then begin showing:=true;
+write(dvityout,a:1,': ','right',o-142:1,' ',p:1);end;q:=p;goto 43;end;
+147,148,149,150,151:begin w:=p;
+if(p>=fontspace[curfont])or(p<=-4*fontspace[curfont])then begin outtext(
+32);hh:=round(conv*(h+p));end else hh:=hh+round(conv*(p));
+if outmode>1 then begin showing:=true;
+write(dvityout,a:1,': ','w',o-147:1,' ',p:1);end;q:=p;goto 43;end;
+152,153,154,155,156:begin x:=p;
+if(p>=fontspace[curfont])or(p<=-4*fontspace[curfont])then begin outtext(
+32);hh:=round(conv*(h+p));end else hh:=hh+round(conv*(p));
+if outmode>1 then begin showing:=true;
+write(dvityout,a:1,': ','x',o-152:1,' ',p:1);end;q:=p;goto 43;end;{:84}
+otherwise if specialcases(o,p,a)then goto 30 else goto 9998 end{:81};
+41:{89:}
+if p<0 then p:=255-((-1-p)mod 256)else if p>=256 then p:=p mod 256;
+if(p<fontbc[curfont])or(p>fontec[curfont])then q:=2147483647 else q:=
+width[widthbase[curfont]+p];
+if q=2147483647 then begin if not showing then begin flushtext;
+showing:=true;
+write(dvityout,a:1,': ','character ',p:1,' invalid in font ');
+end else write(dvityout,' ','character ',p:1,' invalid in font ');
+printfont(curfont);if curfont<>maxfonts then write(dvityout,'!');end;
+if o>=133 then goto 30;
+if q=2147483647 then q:=0 else hh:=hh+pixelwidth[widthbase[curfont]+p];
+goto 43{:89};42:{90:}q:=signedquad;
+if showing then begin write(dvityout,' height ',p:1,', width ',q:1);
+if outmode>2 then if(p<=0)or(q<=0)then write(dvityout,' (invisible)')
+else write(dvityout,' (',rulepixels(p):1,'x',rulepixels(q):1,' pixels)')
+;end;if o=137 then goto 30;
+if showing then if outmode>2 then writeln(dvityout,' ');
+hh:=hh+rulepixels(q);goto 43{:90};43:{91:}
+if(h>0)and(q>0)then if h>2147483647-q then begin if not showing then
+begin flushtext;showing:=true;
+write(dvityout,a:1,': ','arithmetic overflow! parameter changed from ',q
+:1,' to ',2147483647-h:1);end else write(dvityout,' ',
+'arithmetic overflow! parameter changed from ',q:1,' to ',2147483647-h:1
+);q:=2147483647-h;end;
+if(h<0)and(q<0)then if-h>q+2147483647 then begin if not showing then
+begin flushtext;showing:=true;
+write(dvityout,a:1,': ','arithmetic overflow! parameter changed from ',q
+:1,' to ',(-h)-2147483647:1);end else write(dvityout,' ',
+'arithmetic overflow! parameter changed from ',q:1,' to ',(-h)
+-2147483647:1);q:=(-h)-2147483647;end;hhh:=round(conv*(h+q));
+if abs(hhh-hh)>2 then if hhh>hh then hh:=hhh-2 else hh:=hhh+2;
+if showing then if outmode>2 then begin write(dvityout,' h:=',h:1);
+if q>=0 then write(dvityout,'+');
+write(dvityout,q:1,'=',h+q:1,', hh:=',hh:1);end;h:=h+q;
+if abs(h)>maxhsofar then begin if abs(h)>maxh+99 then begin if not
+showing then begin flushtext;showing:=true;
+write(dvityout,a:1,': ','warning: |h|>',maxh:1,'!');
+end else write(dvityout,' ','warning: |h|>',maxh:1,'!');maxh:=abs(h);
+end;maxhsofar:=abs(h);end;goto 30{:91};45:{93:}
+if showing then if outmode>2 then begin writeln(dvityout,' ');
+write(dvityout,'level ',ss:1,':(h=',h:1,',v=',v:1,',w=',w:1,',x=',x:1,
+',y=',y:1,',z=',z:1,',hh=',hh:1,',vv=',vv:1,')');end;goto 30{:93};
+30:if showing then writeln(dvityout,' ');end{:80};
+9998:writeln(dvityout,'!');dopage:=false;9999:end;{:79}{95:}{99:}
+procedure scanbop;var k:0..255;
+begin repeat if eof(dvifile)then begin write(dvityout,' ',
+'Bad DVI file: ','the file ended prematurely','!');jumpout;end;
+k:=getbyte;if(k>=243)and(k<247)then begin definefont(firstpar(k));
+k:=138;end;until k<>138;
+if k=248 then inpostamble:=true else begin if k<>139 then begin write(
+dvityout,' ','Bad DVI file: ','byte ',curloc-1:1,' is not bop','!');
+jumpout;end;newbackpointer:=curloc-1;pagecount:=pagecount+1;
+for k:=0 to 9 do count[k]:=signedquad;
+if signedquad<>oldbackpointer then writeln(dvityout,
+'backpointer in byte ',curloc-4:1,' should be ',oldbackpointer:1,'!');
+oldbackpointer:=newbackpointer;end;end;{:99}
+procedure skippages(bopseen:boolean);label 9999;var p:integer;k:0..255;
+downthedrain:integer;begin showing:=false;
+while true do begin if not bopseen then begin scanbop;
+if inpostamble then goto 9999;
+if not started then if startmatch then begin started:=true;goto 9999;
+end;end;{96:}
+repeat if eof(dvifile)then begin write(dvityout,' ','Bad DVI file: ',
+'the file ended prematurely','!');jumpout;end;k:=getbyte;p:=firstpar(k);
+case k of 132,137:downthedrain:=signedquad;
+243,244,245,246:begin definefont(p);writeln(dvityout,' ');end;
+239,240,241,242:while p>0 do begin downthedrain:=getbyte;p:=p-1;end;
+139,247,248,249,250,251,252,253,254,255:begin write(dvityout,' ',
+'Bad DVI file: ','illegal command at byte ',curloc-1:1,'!');jumpout;end;
+otherwise end;until k=140;{:96};bopseen:=false;end;9999:end;{:95}{103:}
+procedure readpostamble;var k:integer;p,q,m:integer;
+begin showing:=false;postloc:=curloc-5;
+writeln(dvityout,'Postamble starts at byte ',postloc:1,'.');
+if signedquad<>numerator then writeln(dvityout,
+'numerator doesn''t match the preamble!');
+if signedquad<>denominator then writeln(dvityout,
+'denominator doesn''t match the preamble!');
+if signedquad<>mag then if newmag=0 then writeln(dvityout,
+'magnification doesn''t match the preamble!');maxv:=signedquad;
+maxh:=signedquad;write(dvityout,'maxv=',maxv:1,', maxh=',maxh:1);
+maxs:=gettwobytes;totalpages:=gettwobytes;
+writeln(dvityout,', maxstackdepth=',maxs:1,', totalpages=',totalpages:1)
+;if outmode<4 then{104:}
+begin if maxv+99<maxvsofar then writeln(dvityout,
+'warning: observed maxv was ',maxvsofar:1);
+if maxh+99<maxhsofar then writeln(dvityout,'warning: observed maxh was '
+,maxhsofar:1);if maxs<maxssofar then writeln(dvityout,
+'warning: observed maxstackdepth was ',maxssofar:1);
+if pagecount<>totalpages then writeln(dvityout,'there are really ',
+pagecount:1,' pages, not ',totalpages:1,'!');end{:104};{106:}
+repeat k:=getbyte;if(k>=243)and(k<247)then begin p:=firstpar(k);
+definefont(p);writeln(dvityout,' ');k:=138;end;until k<>138;
+if k<>249 then writeln(dvityout,'byte ',curloc-1:1,' is not postpost!'){
+:106};{105:}q:=signedquad;
+if q<>postloc then writeln(dvityout,'bad postamble pointer in byte ',
+curloc-4:1,'!');m:=getbyte;
+if m<>2 then writeln(dvityout,'identification in byte ',curloc-1:1,
+' should be ',2:1,'!');k:=curloc;m:=223;
+while(m=223)and not eof(dvifile)do m:=getbyte;
+if not eof(dvifile)then begin write(dvityout,' ','Bad DVI file: ',
+'signature in byte ',curloc-1:1,' should be 223','!');jumpout;end;
+if curloc<k+4 then writeln(dvityout,
+'not enough signature bytes at end of file (',curloc-k:1,')');
+reset(dvifile,dviname){:105};end;{:103}{107:}begin initialize;
+if argc<>2 then begin writeln('Usage: dvitype <dvi-file>');goto 9999;
+end;firstinput:=true;dialog;{109:}opendvifile;p:=getbyte;
+if p<>247 then begin write(dvityout,' ','Bad DVI file: ',
+'First byte isn''t start of preamble!','!');jumpout;end;p:=getbyte;
+if p<>2 then writeln(dvityout,'identification in byte 1 should be ',2:1,
+'!');{110:}numerator:=signedquad;denominator:=signedquad;
+if numerator<=0 then begin write(dvityout,' ','Bad DVI file: ',
+'numerator is ',numerator:1,'!');jumpout;end;
+if denominator<=0 then begin write(dvityout,' ','Bad DVI file: ',
+'denominator is ',denominator:1,'!');jumpout;end;
+writeln(dvityout,'numerator/denominator=',numerator:1,'/',denominator:1)
+;tfmconv:=(25400000.0/numerator)*(denominator/473628672)/16.0;
+conv:=(numerator/254000.0)*(resolution/denominator);mag:=signedquad;
+if newmag>0 then mag:=newmag else if mag<=0 then begin write(dvityout,
+' ','Bad DVI file: ','magnification is ',mag:1,'!');jumpout;end;
+trueconv:=conv;conv:=trueconv*(mag/1000.0);
+writeln(dvityout,'magnification=',mag:1,'; ',conv:16:8,
+' pixels per DVI unit'){:110};p:=getbyte;write(dvityout,'''');
+while p>0 do begin p:=p-1;write(dvityout,xchr[getbyte]);end;
+writeln(dvityout,'''');afterpre:=curloc{:109};
+if outmode=4 then begin{100:}n:=dvilength;
+if n<53 then begin write(dvityout,' ','Bad DVI file: ','only ',n:1,
+' bytes long','!');jumpout;end;m:=n-4;
+repeat if m=0 then begin write(dvityout,' ','Bad DVI file: ','all 223s',
+'!');jumpout;end;movetobyte(m);k:=getbyte;m:=m-1;until k<>223;
+if k<>2 then begin write(dvityout,' ','Bad DVI file: ','ID byte is ',k:1
+,'!');jumpout;end;movetobyte(m-3);q:=signedquad;
+if(q<0)or(q>m-33)then begin write(dvityout,' ','Bad DVI file: ',
+'post pointer ',q:1,' at byte ',m-3:1,'!');jumpout;end;movetobyte(q);
+k:=getbyte;
+if k<>248 then begin write(dvityout,' ','Bad DVI file: ','byte ',q:1,
+' is not post','!');jumpout;end;postloc:=q;
+firstbackpointer:=signedquad{:100};inpostamble:=true;readpostamble;
+inpostamble:=false;{102:}q:=postloc;p:=firstbackpointer;startloc:=-1;
+if p<0 then inpostamble:=true else begin repeat if p>q-46 then begin
+write(dvityout,' ','Bad DVI file: ','page link ',p:1,' after byte ',q:1,
+'!');jumpout;end;q:=p;movetobyte(q);k:=getbyte;
+if k=139 then pagecount:=pagecount+1 else begin write(dvityout,' ',
+'Bad DVI file: ','byte ',q:1,' is not bop','!');jumpout;end;
+for k:=0 to 9 do count[k]:=signedquad;p:=signedquad;
+if startmatch then begin startloc:=q;oldbackpointer:=p;end;until p<0;
+if startloc<0 then begin write(dvityout,' ',
+'starting page number could not be found!');jumpout;end;
+if oldbackpointer<0 then startloc:=afterpre;movetobyte(startloc);end;
+if pagecount<>totalpages then writeln(dvityout,'there are really ',
+pagecount:1,' pages, not ',totalpages:1,'!'){:102};end;skippages(false);
+if not inpostamble then{111:}
+begin while maxpages>0 do begin maxpages:=maxpages-1;
+writeln(dvityout,' ');
+write(dvityout,curloc-45:1,': beginning of page ');
+for k:=0 to startvals do begin write(dvityout,count[k]:1);
+if k<startvals then write(dvityout,'.')else writeln(dvityout,' ');end;
+if not dopage then begin write(dvityout,' ','Bad DVI file: ',
+'page ended unexpectedly','!');jumpout;end;scanbop;
+if inpostamble then goto 30;end;30:end{:111};
+if outmode<4 then begin if not inpostamble then skippages(true);
+if signedquad<>oldbackpointer then writeln(dvityout,
+'backpointer in byte ',curloc-4:1,' should be ',oldbackpointer:1,'!');
+readpostamble;end;9999:writeln(dvityout,' ');end.{:107}
diff --git a/systems/knuth/local/texware/pltotf.ch b/systems/knuth/local/texware/pltotf.ch
new file mode 100644
index 0000000000..72afbe0f3a
--- /dev/null
+++ b/systems/knuth/local/texware/pltotf.ch
@@ -0,0 +1,118 @@
+% Change file for the PLtoTF processor, for use with GNU Pascal.
+% (by Don Knuth, based on the work of Pavel Curtis in ../texware-sparc)
+
+% History:
+% 2000.04.30 Original version
+
+% The section numbers used in this file refer to the current nunmbers,
+% and, where different, also to those in the standard TeXware report (CS1097).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [0] WEAVE: print changes only
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@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 GNU Pascal}
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [1] Change banner string
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@d banner=='This is PLtoTF, Version 3.5' {printed when the program starts}
+@y
+@d banner=='This is PLtoTF, Version 3.5 for Linux'
+ {printed when the program starts}
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [2] Fix filenames in program statement; add `final_end' label; add access
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@p program PLtoTF(@!pl_file,@!tfm_file,@!output);
+const @<Constants in the outer block@>@/
+type @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+@y
+@d final_end==9999
+
+@p program PLtoTF(@!output);
+label final_end;
+const @<Constants in the outer block@>@/
+type UNIX_file_name=packed array[1..100] of char;
+ @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+@\
+@=#include "texwarext.h"@>
+@\@/
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [6] Open PL file
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+reset(pl_file);
+@y
+if argc < 3 then begin
+ print_ln('Usage: pltotf <pl-file> <tfm-file>');
+ goto final_end;
+end;
+argv(1, pl_name);
+if testreadaccess(pl_name) then reset(pl_file, pl_name)
+else begin print_ln('I can''t read the PL file!'); goto final_end;
+ end;
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [15] Change type of tfm_file and declare extra TFM-file variables
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@!tfm_file:packed file of 0..255;
+@y
+@!tfm_file : packed file of ByteCard;
+@!tfm_name,
+@!pl_name : UNIX_file_name;
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [16] Open TFM file
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@ On some systems you may have to do something special to write a
+packed file of bytes. For example, the following code didn't work
+when it was first tried at Stanford, because packed files have to be
+opened with a special switch setting on the \PASCAL\ that was used.
+@^system dependencies@>
+
+@<Set init...@>=
+rewrite(tfm_file);
+@y
+@ On some systems you may have to do something special to write a
+packed file of bytes.
+@^system dependencies@>
+
+@<Set init...@>=
+argv(2, tfm_name);
+rewrite(tfm_file, tfm_name);
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [17] Make byte a byte
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@!byte=0..255; {unsigned eight-bit quantity}
+@y
+@!byte=ByteCard; {unsigned eight-bit quantity}
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [147, was 135] Define label `final_end'; print newline at end of program
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+end.
+@y
+final_end: print_ln(' '); end.
+@z
diff --git a/systems/knuth/local/texware/pltotf.p b/systems/knuth/local/texware/pltotf.p
new file mode 100644
index 0000000000..6001876228
--- /dev/null
+++ b/systems/knuth/local/texware/pltotf.p
@@ -0,0 +1,830 @@
+{2:}program PLtoTF(output);label 9999;const{3:}bufsize=60;
+maxheaderbytes=100;maxparamwords=30;maxligsteps=5000;maxkerns=500;
+hashsize=5003;{:3}type UNIXfilename=packed array[1..100]of char;{17:}
+byte=ByteCard;ASCIIcode=32..127;{:17}{57:}fourbytes=record b0:byte;
+b1:byte;b2:byte;b3:byte;end;{:57}{61:}fixword=integer;{:61}{68:}
+headerindex=0..maxheaderbytes;indx=0..32767;{:68}{71:}pointer=0..1032;
+{:71}var{5:}plfile:text;{:5}{15:}tfmfile:packed file of ByteCard;
+tfmname,plname:UNIXfilename;{:15}{18:}xord:array[char]of ASCIIcode;{:18}
+{21:}line:integer;goodindent:integer;indent:integer;level:integer;{:21}
+{23:}leftln,rightln:boolean;limit:0..bufsize;loc:0..bufsize;
+buffer:array[1..bufsize]of char;inputhasended:boolean;{:23}{25:}
+charsonline:0..8;{:25}{30:}curchar:ASCIIcode;{:30}{36:}
+start:array[1..88]of 0..600;dictionary:array[0..600]of ASCIIcode;
+startptr:0..88;dictptr:0..600;{:36}{38:}
+curname:array[1..20]of ASCIIcode;namelength:0..20;nameptr:0..88;{:38}
+{39:}nhash:array[0..100]of 0..88;curhash:0..100;{:39}{44:}
+equiv:array[0..88]of byte;curcode:byte;{:44}{58:}curbytes:fourbytes;
+{:58}{65:}fractiondigits:array[1..7]of integer;{:65}{67:}
+headerbytes:array[headerindex]of byte;headerptr:headerindex;
+designsize:fixword;designunits:fixword;sevenbitsafeflag:boolean;
+ligkern:array[0..maxligsteps]of fourbytes;nl:0..32767;minnl:0..32767;
+kern:array[0..maxkerns]of fixword;nk:0..maxkerns;
+exten:array[0..255]of fourbytes;ne:0..256;
+param:array[1..maxparamwords]of fixword;np:0..maxparamwords;
+checksumspecified:boolean;bchar:0..256;{:67}{72:}
+memory:array[pointer]of fixword;memptr:pointer;
+link:array[pointer]of pointer;charwd:array[byte]of pointer;
+charht:array[byte]of pointer;chardp:array[byte]of pointer;
+charic:array[byte]of pointer;chartag:array[byte]of 0..3;
+charremainder:array[0..256]of 0..65535;{:72}{76:}nextd:fixword;{:76}
+{79:}index:array[pointer]of byte;excess:byte;{:79}{81:}c:byte;{:81}{98:}
+lkstepended:boolean;krnptr:0..maxkerns;{:98}{109:}sevenunsafe:boolean;
+{:109}{114:}delta:fixword;{:114}{118:}ligptr:0..maxligsteps;
+hash:array[0..hashsize]of 0..66048;class:array[0..hashsize]of 0..4;
+ligz:array[0..hashsize]of 0..257;hashptr:0..hashsize;
+hashlist:array[0..hashsize]of 0..hashsize;h,hh:0..hashsize;tt:indx;
+xligcycle,yligcycle:0..256;{:118}{129:}bc:byte;ec:byte;lh:byte;
+lf:0..32767;notfound:boolean;tempwidth:fixword;{:129}{132:}
+j:0..maxheaderbytes;p:pointer;q:1..4;parptr:0..maxparamwords;{:132}
+{138:}labeltable:array[0..256]of record rr:-1..32767;cc:byte;end;
+labelptr:0..256;sortptr:0..256;lkoffset:0..256;t:0..32767;
+extralocneeded:boolean;{:138}
+#include "texwarext.h"
+procedure initialize;var{19:}k:integer;{:19}{40:}h:0..100;{:40}{69:}
+d:headerindex;{:69}{73:}c:byte;{:73}
+begin writeln('This is PLtoTF, Version 3.5 for Linux');{6:}
+if argc<3 then begin writeln('Usage: pltotf <pl-file> <tfm-file>');
+goto 9999;end;argv(1,plname);
+if testreadaccess(plname)then reset(plfile,plname)else begin writeln(
+'I can''t read the PL file!');goto 9999;end;{:6}{16:}argv(2,tfmname);
+rewrite(tfmfile,tfmname);{:16}{20:}for k:=0 to 127 do xord[chr(k)]:=127;
+xord[' ']:=32;xord['!']:=33;xord['"']:=34;xord['#']:=35;xord['$']:=36;
+xord['%']:=37;xord['&']:=38;xord['''']:=39;xord['(']:=40;xord[')']:=41;
+xord['*']:=42;xord['+']:=43;xord[',']:=44;xord['-']:=45;xord['.']:=46;
+xord['/']:=47;xord['0']:=48;xord['1']:=49;xord['2']:=50;xord['3']:=51;
+xord['4']:=52;xord['5']:=53;xord['6']:=54;xord['7']:=55;xord['8']:=56;
+xord['9']:=57;xord[':']:=58;xord[';']:=59;xord['<']:=60;xord['=']:=61;
+xord['>']:=62;xord['?']:=63;xord['@']:=64;xord['A']:=65;xord['B']:=66;
+xord['C']:=67;xord['D']:=68;xord['E']:=69;xord['F']:=70;xord['G']:=71;
+xord['H']:=72;xord['I']:=73;xord['J']:=74;xord['K']:=75;xord['L']:=76;
+xord['M']:=77;xord['N']:=78;xord['O']:=79;xord['P']:=80;xord['Q']:=81;
+xord['R']:=82;xord['S']:=83;xord['T']:=84;xord['U']:=85;xord['V']:=86;
+xord['W']:=87;xord['X']:=88;xord['Y']:=89;xord['Z']:=90;xord['[']:=91;
+xord['\']:=92;xord[']']:=93;xord['^']:=94;xord['_']:=95;xord['`']:=96;
+xord['a']:=97;xord['b']:=98;xord['c']:=99;xord['d']:=100;xord['e']:=101;
+xord['f']:=102;xord['g']:=103;xord['h']:=104;xord['i']:=105;
+xord['j']:=106;xord['k']:=107;xord['l']:=108;xord['m']:=109;
+xord['n']:=110;xord['o']:=111;xord['p']:=112;xord['q']:=113;
+xord['r']:=114;xord['s']:=115;xord['t']:=116;xord['u']:=117;
+xord['v']:=118;xord['w']:=119;xord['x']:=120;xord['y']:=121;
+xord['z']:=122;xord['{']:=123;xord['|']:=124;xord['}']:=125;
+xord['~']:=126;{:20}{22:}line:=0;goodindent:=0;indent:=0;level:=0;{:22}
+{24:}limit:=0;loc:=0;leftln:=true;rightln:=true;inputhasended:=false;
+{:24}{26:}charsonline:=0;{:26}{37:}startptr:=1;start[1]:=0;dictptr:=0;
+{:37}{41:}for h:=0 to 100 do nhash[h]:=0;{:41}{70:}
+for d:=0 to 18*4-1 do headerbytes[d]:=0;headerbytes[8]:=11;
+headerbytes[9]:=85;headerbytes[10]:=78;headerbytes[11]:=83;
+headerbytes[12]:=80;headerbytes[13]:=69;headerbytes[14]:=67;
+headerbytes[15]:=73;headerbytes[16]:=70;headerbytes[17]:=73;
+headerbytes[18]:=69;headerbytes[19]:=68;
+for d:=48 to 59 do headerbytes[d]:=headerbytes[d-40];
+designsize:=10*1048576;designunits:=1048576;sevenbitsafeflag:=false;
+headerptr:=18*4;nl:=0;minnl:=0;nk:=0;ne:=0;np:=0;
+checksumspecified:=false;bchar:=256;{:70}{74:}charremainder[256]:=32767;
+for c:=0 to 255 do begin charwd[c]:=0;charht[c]:=0;chardp[c]:=0;
+charic[c]:=0;chartag[c]:=0;charremainder[c]:=0;end;
+memory[0]:=2147483647;memory[1]:=0;link[1]:=0;memory[2]:=0;link[2]:=0;
+memory[3]:=0;link[3]:=0;memory[4]:=0;link[4]:=0;memptr:=4;{:74}{119:}
+hashptr:=0;yligcycle:=256;for k:=0 to hashsize do hash[k]:=0;{:119}end;
+{:2}{27:}procedure showerrorcontext;var k:0..bufsize;
+begin writeln(' (line ',line:1,').');if not leftln then write('...');
+for k:=1 to loc do write(buffer[k]);writeln(' ');
+if not leftln then write(' ');for k:=1 to loc do write(' ');
+for k:=loc+1 to limit do write(buffer[k]);
+if rightln then writeln(' ')else writeln('...');charsonline:=0;end;{:27}
+{28:}procedure fillbuffer;begin leftln:=rightln;limit:=0;loc:=0;
+if leftln then begin if line>0 then readln(plfile);line:=line+1;end;
+if eof(plfile)then begin limit:=1;buffer[1]:=')';rightln:=false;
+inputhasended:=true;
+end else begin while(limit<bufsize-1)and(not eoln(plfile))do begin limit
+:=limit+1;read(plfile,buffer[limit]);end;buffer[limit+1]:=' ';
+rightln:=eoln(plfile);if leftln then{29:}
+begin while(loc<limit)and(buffer[loc+1]=' ')do loc:=loc+1;
+if loc<limit then begin if level=0 then if loc=0 then goodindent:=
+goodindent+1 else begin if goodindent>=10 then begin if charsonline>0
+then writeln(' ');
+write('Warning: Indented line occurred at level zero');showerrorcontext;
+end;goodindent:=0;indent:=0;
+end else if indent=0 then if loc mod level=0 then begin indent:=loc div
+level;goodindent:=1;
+end else goodindent:=0 else if indent*level=loc then goodindent:=
+goodindent+1 else begin if goodindent>=10 then begin if charsonline>0
+then writeln(' ');write('Warning: Inconsistent indentation; ',
+'you are at parenthesis level ',level:1);showerrorcontext;end;
+goodindent:=0;indent:=0;end;end;end{:29};end;end;{:28}{31:}
+procedure getkeywordchar;
+begin while(loc=limit)and(not rightln)do fillbuffer;
+if loc=limit then curchar:=32 else begin curchar:=xord[buffer[loc+1]];
+if curchar>=97 then curchar:=curchar-32;
+if((curchar>=48)and(curchar<=57))then loc:=loc+1 else if((curchar>=65)
+and(curchar<=90))then loc:=loc+1 else if curchar=47 then loc:=loc+1 else
+if curchar=62 then loc:=loc+1 else curchar:=32;end;end;{:31}{32:}
+procedure getnext;begin while loc=limit do fillbuffer;loc:=loc+1;
+curchar:=xord[buffer[loc]];
+if curchar>=97 then if curchar<=122 then curchar:=curchar-32 else begin
+if curchar=127 then begin begin if charsonline>0 then writeln(' ');
+write('Illegal character in the file');showerrorcontext;end;curchar:=63;
+end;end else if(curchar<=41)and(curchar>=40)then loc:=loc-1;end;{:32}
+{33:}procedure skiptoendofitem;var l:integer;begin l:=level;
+while level>=l do begin while loc=limit do fillbuffer;loc:=loc+1;
+if buffer[loc]=')'then level:=level-1 else if buffer[loc]='('then level
+:=level+1;end;
+if inputhasended then begin if charsonline>0 then writeln(' ');
+write('File ended unexpectedly: No closing ")"');showerrorcontext;end;
+curchar:=32;end;{:33}{35:}procedure finishtheproperty;
+begin while curchar=32 do getnext;
+if curchar<>41 then begin if charsonline>0 then writeln(' ');
+write('Junk after property value will be ignored');showerrorcontext;end;
+skiptoendofitem;end;{:35}{42:}procedure lookup;var k:0..20;j:0..600;
+notfound:boolean;begin{43:}curhash:=curname[1];
+for k:=2 to namelength do curhash:=(curhash+curhash+curname[k])mod 101{:
+43};notfound:=true;
+while notfound do begin if curhash=0 then curhash:=100 else curhash:=
+curhash-1;
+if nhash[curhash]=0 then notfound:=false else begin j:=start[nhash[
+curhash]];
+if start[nhash[curhash]+1]=j+namelength then begin notfound:=false;
+for k:=1 to namelength do if dictionary[j+k-1]<>curname[k]then notfound
+:=true;end;end;end;nameptr:=nhash[curhash];end;{:42}{45:}
+procedure entername(v:byte);var k:0..20;
+begin for k:=1 to namelength do curname[k]:=curname[k+20-namelength];
+lookup;nhash[curhash]:=startptr;equiv[startptr]:=v;
+for k:=1 to namelength do begin dictionary[dictptr]:=curname[k];
+dictptr:=dictptr+1;end;startptr:=startptr+1;start[startptr]:=dictptr;
+end;{:45}{49:}procedure getname;begin loc:=loc+1;level:=level+1;
+curchar:=32;while curchar=32 do getnext;
+if(curchar>41)or(curchar<40)then loc:=loc-1;namelength:=0;
+getkeywordchar;
+while curchar<>32 do begin if namelength=20 then curname[1]:=88 else
+namelength:=namelength+1;curname[namelength]:=curchar;getkeywordchar;
+end;lookup;if nameptr=0 then begin if charsonline>0 then writeln(' ');
+write('Sorry, I don''t know that property name');showerrorcontext;end;
+curcode:=equiv[nameptr];end;{:49}{51:}function getbyte:byte;
+var acc:integer;t:ASCIIcode;begin repeat getnext;until curchar<>32;
+t:=curchar;acc:=0;repeat getnext;until curchar<>32;if t=67 then{52:}
+if(curchar>=33)and(curchar<=126)and((curchar<40)or(curchar>41))then acc
+:=xord[buffer[loc]]else begin begin if charsonline>0 then writeln(' ');
+write('"C" value must be standard ASCII and not a paren');
+showerrorcontext;end;repeat getnext until(curchar=40)or(curchar=41);
+end{:52}else if t=68 then{53:}
+begin while(curchar>=48)and(curchar<=57)do begin acc:=acc*10+curchar-48;
+if acc>255 then begin begin begin if charsonline>0 then writeln(' ');
+write('This value shouldn''t exceed 255');showerrorcontext;end;
+repeat getnext until(curchar=40)or(curchar=41);end;acc:=0;curchar:=32;
+end else getnext;end;begin if(curchar>41)or(curchar<40)then loc:=loc-1;
+end;end{:53}else if t=79 then{54:}
+begin while(curchar>=48)and(curchar<=55)do begin acc:=acc*8+curchar-48;
+if acc>255 then begin begin begin if charsonline>0 then writeln(' ');
+write('This value shouldn''t exceed ''377');showerrorcontext;end;
+repeat getnext until(curchar=40)or(curchar=41);end;acc:=0;curchar:=32;
+end else getnext;end;begin if(curchar>41)or(curchar<40)then loc:=loc-1;
+end;end{:54}else if t=72 then{55:}
+begin while((curchar>=48)and(curchar<=57))or((curchar>=65)and(curchar<=
+70))do begin if curchar>=65 then curchar:=curchar-7;
+acc:=acc*16+curchar-48;
+if acc>255 then begin begin begin if charsonline>0 then writeln(' ');
+write('This value shouldn''t exceed "FF');showerrorcontext;end;
+repeat getnext until(curchar=40)or(curchar=41);end;acc:=0;curchar:=32;
+end else getnext;end;begin if(curchar>41)or(curchar<40)then loc:=loc-1;
+end;end{:55}else if t=70 then{56:}
+begin if curchar=66 then acc:=2 else if curchar=76 then acc:=4 else if
+curchar<>77 then acc:=18;getnext;
+if curchar=73 then acc:=acc+1 else if curchar<>82 then acc:=18;getnext;
+if curchar=67 then acc:=acc+6 else if curchar=69 then acc:=acc+12 else
+if curchar<>82 then acc:=18;
+if acc>=18 then begin begin begin if charsonline>0 then writeln(' ');
+write('Illegal face code, I changed it to MRR');showerrorcontext;end;
+repeat getnext until(curchar=40)or(curchar=41);end;acc:=0;end;end{:56}
+else begin begin if charsonline>0 then writeln(' ');
+write('You need "C" or "D" or "O" or "H" or "F" here');showerrorcontext;
+end;repeat getnext until(curchar=40)or(curchar=41);end;curchar:=32;
+getbyte:=acc;end;{:51}{59:}procedure getfourbytes;var c:integer;
+r:integer;q:integer;begin repeat getnext;until curchar<>32;r:=0;
+curbytes.b0:=0;curbytes.b1:=0;curbytes.b2:=0;curbytes.b3:=0;
+if curchar=72 then r:=16 else if curchar=79 then r:=8 else begin begin
+if charsonline>0 then writeln(' ');
+write('An octal ("O") or hex ("H") value is needed here');
+showerrorcontext;end;repeat getnext until(curchar=40)or(curchar=41);end;
+if r>0 then begin q:=256 div r;repeat getnext;until curchar<>32;
+while((curchar>=48)and(curchar<=57))or((curchar>=65)and(curchar<=70))do{
+60:}begin if curchar>=65 then curchar:=curchar-7;
+c:=(r*curbytes.b0)+(curbytes.b1 div q);
+if c>255 then begin curbytes.b0:=0;curbytes.b1:=0;curbytes.b2:=0;
+curbytes.b3:=0;
+if r=8 then begin begin if charsonline>0 then writeln(' ');
+write('Sorry, the maximum octal value is O 37777777777');
+showerrorcontext;end;repeat getnext until(curchar=40)or(curchar=41);
+end else begin begin if charsonline>0 then writeln(' ');
+write('Sorry, the maximum hex value is H FFFFFFFF');showerrorcontext;
+end;repeat getnext until(curchar=40)or(curchar=41);end;
+end else if curchar>=48+r then begin begin if charsonline>0 then writeln
+(' ');write('Illegal digit');showerrorcontext;end;
+repeat getnext until(curchar=40)or(curchar=41);
+end else begin curbytes.b0:=c;
+curbytes.b1:=(r*(curbytes.b1 mod q))+(curbytes.b2 div q);
+curbytes.b2:=(r*(curbytes.b2 mod q))+(curbytes.b3 div q);
+curbytes.b3:=(r*(curbytes.b3 mod q))+curchar-48;getnext;end;end{:60};
+end;end;{:59}{62:}function getfix:fixword;var negative:boolean;
+acc:integer;intpart:integer;j:0..7;begin repeat getnext;
+until curchar<>32;negative:=false;acc:=0;
+if(curchar<>82)and(curchar<>68)then begin begin if charsonline>0 then
+writeln(' ');write('An "R" or "D" value is needed here');
+showerrorcontext;end;repeat getnext until(curchar=40)or(curchar=41);
+end else begin{63:}repeat getnext;if curchar=45 then begin curchar:=32;
+negative:=true;end else if curchar=43 then curchar:=32;
+until curchar<>32{:63};while(curchar>=48)and(curchar<=57)do{64:}
+begin acc:=acc*10+curchar-48;
+if acc>=2048 then begin begin begin if charsonline>0 then writeln(' ');
+write('Real constants must be less than 2048');showerrorcontext;end;
+repeat getnext until(curchar=40)or(curchar=41);end;acc:=0;curchar:=32;
+end else getnext;end{:64};intpart:=acc;acc:=0;if curchar=46 then{66:}
+begin j:=0;getnext;
+while(curchar>=48)and(curchar<=57)do begin if j<7 then begin j:=j+1;
+fractiondigits[j]:=2097152*(curchar-48);end;getnext;end;acc:=0;
+while j>0 do begin acc:=fractiondigits[j]+(acc div 10);j:=j-1;end;
+acc:=(acc+10)div 20;end{:66};
+if(acc>=1048576)and(intpart=2047)then begin begin if charsonline>0 then
+writeln(' ');write('Real constants must be less than 2048');
+showerrorcontext;end;repeat getnext until(curchar=40)or(curchar=41);
+end else acc:=intpart*1048576+acc;end;
+if negative then getfix:=-acc else getfix:=acc;end;{:62}{75:}
+function sortin(h:pointer;d:fixword):pointer;var p:pointer;
+begin if(d=0)and(h<>1)then sortin:=0 else begin p:=h;
+while d>=memory[link[p]]do p:=link[p];
+if(d=memory[p])and(p<>h)then sortin:=p else if memptr=1032 then begin
+begin if charsonline>0 then writeln(' ');
+write('Memory overflow: more than 1028 widths, etc');showerrorcontext;
+end;writeln('Congratulations! It''s hard to make this error.');
+sortin:=p;end else begin memptr:=memptr+1;memory[memptr]:=d;
+link[memptr]:=link[p];link[p]:=memptr;memory[h]:=memory[h]+1;
+sortin:=memptr;end;end;end;{:75}{77:}function mincover(h:pointer;
+d:fixword):integer;var p:pointer;l:fixword;m:integer;begin m:=0;
+p:=link[h];nextd:=memory[0];while p<>0 do begin m:=m+1;l:=memory[p];
+while memory[link[p]]<=l+d do p:=link[p];p:=link[p];
+if memory[p]-l<nextd then nextd:=memory[p]-l;end;mincover:=m;end;{:77}
+{78:}function shorten(h:pointer;m:integer):fixword;var d:fixword;
+k:integer;begin if memory[h]>m then begin excess:=memory[h]-m;
+k:=mincover(h,0);d:=nextd;repeat d:=d+d;k:=mincover(h,d);until k<=m;
+d:=d div 2;k:=mincover(h,d);while k>m do begin d:=nextd;
+k:=mincover(h,d);end;shorten:=d;end else shorten:=0;end;{:78}{80:}
+procedure setindices(h:pointer;d:fixword);var p:pointer;q:pointer;
+m:byte;l:fixword;begin q:=h;p:=link[q];m:=0;while p<>0 do begin m:=m+1;
+l:=memory[p];index[p]:=m;while memory[link[p]]<=l+d do begin p:=link[p];
+index[p]:=m;excess:=excess-1;if excess=0 then d:=0;end;link[q]:=p;
+memory[p]:=l+(memory[p]-l)div 2;q:=p;p:=link[p];end;memory[h]:=m;end;
+{:80}{83:}procedure junkerror;
+begin begin if charsonline>0 then writeln(' ');
+write('There''s junk here that is not in parentheses');showerrorcontext;
+end;repeat getnext until(curchar=40)or(curchar=41);end;{:83}{86:}
+procedure readfourbytes(l:headerindex);begin getfourbytes;
+headerbytes[l]:=curbytes.b0;headerbytes[l+1]:=curbytes.b1;
+headerbytes[l+2]:=curbytes.b2;headerbytes[l+3]:=curbytes.b3;end;{:86}
+{87:}procedure readBCPL(l:headerindex;n:byte);var k:headerindex;
+begin k:=l;while curchar=32 do getnext;
+while(curchar<>40)and(curchar<>41)do begin if k<l+n then k:=k+1;
+if k<l+n then headerbytes[k]:=curchar;getnext;end;
+if k=l+n then begin begin if charsonline>0 then writeln(' ');
+write('String is too long; its first ',n-1:1,' characters will be kept')
+;showerrorcontext;end;k:=k-1;end;headerbytes[l]:=k-l;
+while k<l+n-1 do begin k:=k+1;headerbytes[k]:=0;end;end;{:87}{96:}
+procedure checktag(c:byte);begin case chartag[c]of 0:;
+1:begin if charsonline>0 then writeln(' ');
+write('This character already appeared in a LIGTABLE LABEL');
+showerrorcontext;end;2:begin if charsonline>0 then writeln(' ');
+write('This character already has a NEXTLARGER spec');showerrorcontext;
+end;3:begin if charsonline>0 then writeln(' ');
+write('This character already has a VARCHAR spec');showerrorcontext;end;
+end;end;{:96}{107:}procedure printoctal(c:byte);
+begin write('''',(c div 64):1,((c div 8)mod 8):1,(c mod 8):1);end;{:107}
+{121:}function hashinput(p,c:indx):boolean;label 30;var cc:0..3;
+zz:0..255;y:0..255;key:integer;t:integer;
+begin if hashptr=hashsize then begin hashinput:=false;goto 30;end;{122:}
+y:=ligkern[p].b1;t:=ligkern[p].b2;cc:=0;zz:=ligkern[p].b3;
+if t>=128 then zz:=y else begin case t of 0,6:;5,11:zz:=y;1,7:cc:=1;
+2:cc:=2;3:cc:=3;end;end{:122};key:=256*c+y+1;h:=(1009*key)mod hashsize;
+while hash[h]>0 do begin if hash[h]<=key then begin if hash[h]=key then
+begin hashinput:=false;goto 30;end;t:=hash[h];hash[h]:=key;key:=t;
+t:=class[h];class[h]:=cc;cc:=t;t:=ligz[h];ligz[h]:=zz;zz:=t;end;
+if h>0 then h:=h-1 else h:=hashsize;end;hash[h]:=key;class[h]:=cc;
+ligz[h]:=zz;hashptr:=hashptr+1;hashlist[hashptr]:=h;hashinput:=true;
+30:end;{:121}{123:}function f(h,x,y:indx):indx;forward;
+function eval(x,y:indx):indx;var key:integer;begin key:=256*x+y+1;
+h:=(1009*key)mod hashsize;
+while hash[h]>key do if h>0 then h:=h-1 else h:=hashsize;
+if hash[h]<key then eval:=y else eval:=f(h,x,y);end;{:123}{124:}
+function f;begin case class[h]of 0:;1:begin class[h]:=4;
+ligz[h]:=eval(ligz[h],y);class[h]:=0;end;2:begin class[h]:=4;
+ligz[h]:=eval(x,ligz[h]);class[h]:=0;end;3:begin class[h]:=4;
+ligz[h]:=eval(eval(x,ligz[h]),y);class[h]:=0;end;4:begin xligcycle:=x;
+yligcycle:=y;ligz[h]:=257;class[h]:=0;end;end;f:=ligz[h];end;{:124}
+{136:}procedure outscaled(x:fixword);var n:byte;m:0..65535;
+begin if abs(x/designunits)>=16.0 then begin writeln(
+'The relative dimension ',x/1048576:1:3,' is too large.');
+write(' (Must be less than 16*designsize');
+if designunits<>1048576 then write(' =',designunits/65536:1:3,
+' designunits');writeln(')');x:=0;end;
+if designunits<>1048576 then x:=round((x/designunits)*1048576.0);
+if x<0 then begin write(tfmfile,255);x:=x+16777216;if x<=0 then x:=1;
+end else begin write(tfmfile,0);if x>=16777216 then x:=16777215;end;
+n:=x div 65536;m:=x mod 65536;write(tfmfile,n);write(tfmfile,m div 256);
+write(tfmfile,m mod 256);end;{:136}{146:}procedure paramenter;begin{48:}
+namelength:=5;curname[16]:=83;curname[17]:=76;curname[18]:=65;
+curname[19]:=78;curname[20]:=84;entername(21);namelength:=5;
+curname[16]:=83;curname[17]:=80;curname[18]:=65;curname[19]:=67;
+curname[20]:=69;entername(22);namelength:=7;curname[14]:=83;
+curname[15]:=84;curname[16]:=82;curname[17]:=69;curname[18]:=84;
+curname[19]:=67;curname[20]:=72;entername(23);namelength:=6;
+curname[15]:=83;curname[16]:=72;curname[17]:=82;curname[18]:=73;
+curname[19]:=78;curname[20]:=75;entername(24);namelength:=7;
+curname[14]:=88;curname[15]:=72;curname[16]:=69;curname[17]:=73;
+curname[18]:=71;curname[19]:=72;curname[20]:=84;entername(25);
+namelength:=4;curname[17]:=81;curname[18]:=85;curname[19]:=65;
+curname[20]:=68;entername(26);namelength:=10;curname[11]:=69;
+curname[12]:=88;curname[13]:=84;curname[14]:=82;curname[15]:=65;
+curname[16]:=83;curname[17]:=80;curname[18]:=65;curname[19]:=67;
+curname[20]:=69;entername(27);namelength:=4;curname[17]:=78;
+curname[18]:=85;curname[19]:=77;curname[20]:=49;entername(28);
+namelength:=4;curname[17]:=78;curname[18]:=85;curname[19]:=77;
+curname[20]:=50;entername(29);namelength:=4;curname[17]:=78;
+curname[18]:=85;curname[19]:=77;curname[20]:=51;entername(30);
+namelength:=6;curname[15]:=68;curname[16]:=69;curname[17]:=78;
+curname[18]:=79;curname[19]:=77;curname[20]:=49;entername(31);
+namelength:=6;curname[15]:=68;curname[16]:=69;curname[17]:=78;
+curname[18]:=79;curname[19]:=77;curname[20]:=50;entername(32);
+namelength:=4;curname[17]:=83;curname[18]:=85;curname[19]:=80;
+curname[20]:=49;entername(33);namelength:=4;curname[17]:=83;
+curname[18]:=85;curname[19]:=80;curname[20]:=50;entername(34);
+namelength:=4;curname[17]:=83;curname[18]:=85;curname[19]:=80;
+curname[20]:=51;entername(35);namelength:=4;curname[17]:=83;
+curname[18]:=85;curname[19]:=66;curname[20]:=49;entername(36);
+namelength:=4;curname[17]:=83;curname[18]:=85;curname[19]:=66;
+curname[20]:=50;entername(37);namelength:=7;curname[14]:=83;
+curname[15]:=85;curname[16]:=80;curname[17]:=68;curname[18]:=82;
+curname[19]:=79;curname[20]:=80;entername(38);namelength:=7;
+curname[14]:=83;curname[15]:=85;curname[16]:=66;curname[17]:=68;
+curname[18]:=82;curname[19]:=79;curname[20]:=80;entername(39);
+namelength:=6;curname[15]:=68;curname[16]:=69;curname[17]:=76;
+curname[18]:=73;curname[19]:=77;curname[20]:=49;entername(40);
+namelength:=6;curname[15]:=68;curname[16]:=69;curname[17]:=76;
+curname[18]:=73;curname[19]:=77;curname[20]:=50;entername(41);
+namelength:=10;curname[11]:=65;curname[12]:=88;curname[13]:=73;
+curname[14]:=83;curname[15]:=72;curname[16]:=69;curname[17]:=73;
+curname[18]:=71;curname[19]:=72;curname[20]:=84;entername(42);
+namelength:=20;curname[1]:=68;curname[2]:=69;curname[3]:=70;
+curname[4]:=65;curname[5]:=85;curname[6]:=76;curname[7]:=84;
+curname[8]:=82;curname[9]:=85;curname[10]:=76;curname[11]:=69;
+curname[12]:=84;curname[13]:=72;curname[14]:=73;curname[15]:=67;
+curname[16]:=75;curname[17]:=78;curname[18]:=69;curname[19]:=83;
+curname[20]:=83;entername(28);namelength:=13;curname[8]:=66;
+curname[9]:=73;curname[10]:=71;curname[11]:=79;curname[12]:=80;
+curname[13]:=83;curname[14]:=80;curname[15]:=65;curname[16]:=67;
+curname[17]:=73;curname[18]:=78;curname[19]:=71;curname[20]:=49;
+entername(29);namelength:=13;curname[8]:=66;curname[9]:=73;
+curname[10]:=71;curname[11]:=79;curname[12]:=80;curname[13]:=83;
+curname[14]:=80;curname[15]:=65;curname[16]:=67;curname[17]:=73;
+curname[18]:=78;curname[19]:=71;curname[20]:=50;entername(30);
+namelength:=13;curname[8]:=66;curname[9]:=73;curname[10]:=71;
+curname[11]:=79;curname[12]:=80;curname[13]:=83;curname[14]:=80;
+curname[15]:=65;curname[16]:=67;curname[17]:=73;curname[18]:=78;
+curname[19]:=71;curname[20]:=51;entername(31);namelength:=13;
+curname[8]:=66;curname[9]:=73;curname[10]:=71;curname[11]:=79;
+curname[12]:=80;curname[13]:=83;curname[14]:=80;curname[15]:=65;
+curname[16]:=67;curname[17]:=73;curname[18]:=78;curname[19]:=71;
+curname[20]:=52;entername(32);namelength:=13;curname[8]:=66;
+curname[9]:=73;curname[10]:=71;curname[11]:=79;curname[12]:=80;
+curname[13]:=83;curname[14]:=80;curname[15]:=65;curname[16]:=67;
+curname[17]:=73;curname[18]:=78;curname[19]:=71;curname[20]:=53;
+entername(33);{:48};end;procedure nameenter;begin{47:}equiv[0]:=0;
+namelength:=8;curname[13]:=67;curname[14]:=72;curname[15]:=69;
+curname[16]:=67;curname[17]:=75;curname[18]:=83;curname[19]:=85;
+curname[20]:=77;entername(1);namelength:=10;curname[11]:=68;
+curname[12]:=69;curname[13]:=83;curname[14]:=73;curname[15]:=71;
+curname[16]:=78;curname[17]:=83;curname[18]:=73;curname[19]:=90;
+curname[20]:=69;entername(2);namelength:=11;curname[10]:=68;
+curname[11]:=69;curname[12]:=83;curname[13]:=73;curname[14]:=71;
+curname[15]:=78;curname[16]:=85;curname[17]:=78;curname[18]:=73;
+curname[19]:=84;curname[20]:=83;entername(3);namelength:=12;
+curname[9]:=67;curname[10]:=79;curname[11]:=68;curname[12]:=73;
+curname[13]:=78;curname[14]:=71;curname[15]:=83;curname[16]:=67;
+curname[17]:=72;curname[18]:=69;curname[19]:=77;curname[20]:=69;
+entername(4);namelength:=6;curname[15]:=70;curname[16]:=65;
+curname[17]:=77;curname[18]:=73;curname[19]:=76;curname[20]:=89;
+entername(5);namelength:=4;curname[17]:=70;curname[18]:=65;
+curname[19]:=67;curname[20]:=69;entername(6);namelength:=16;
+curname[5]:=83;curname[6]:=69;curname[7]:=86;curname[8]:=69;
+curname[9]:=78;curname[10]:=66;curname[11]:=73;curname[12]:=84;
+curname[13]:=83;curname[14]:=65;curname[15]:=70;curname[16]:=69;
+curname[17]:=70;curname[18]:=76;curname[19]:=65;curname[20]:=71;
+entername(7);namelength:=6;curname[15]:=72;curname[16]:=69;
+curname[17]:=65;curname[18]:=68;curname[19]:=69;curname[20]:=82;
+entername(8);namelength:=9;curname[12]:=70;curname[13]:=79;
+curname[14]:=78;curname[15]:=84;curname[16]:=68;curname[17]:=73;
+curname[18]:=77;curname[19]:=69;curname[20]:=78;entername(9);
+namelength:=8;curname[13]:=76;curname[14]:=73;curname[15]:=71;
+curname[16]:=84;curname[17]:=65;curname[18]:=66;curname[19]:=76;
+curname[20]:=69;entername(10);namelength:=12;curname[9]:=66;
+curname[10]:=79;curname[11]:=85;curname[12]:=78;curname[13]:=68;
+curname[14]:=65;curname[15]:=82;curname[16]:=89;curname[17]:=67;
+curname[18]:=72;curname[19]:=65;curname[20]:=82;entername(11);
+namelength:=9;curname[12]:=67;curname[13]:=72;curname[14]:=65;
+curname[15]:=82;curname[16]:=65;curname[17]:=67;curname[18]:=84;
+curname[19]:=69;curname[20]:=82;entername(12);namelength:=9;
+curname[12]:=80;curname[13]:=65;curname[14]:=82;curname[15]:=65;
+curname[16]:=77;curname[17]:=69;curname[18]:=84;curname[19]:=69;
+curname[20]:=82;entername(20);namelength:=6;curname[15]:=67;
+curname[16]:=72;curname[17]:=65;curname[18]:=82;curname[19]:=87;
+curname[20]:=68;entername(51);namelength:=6;curname[15]:=67;
+curname[16]:=72;curname[17]:=65;curname[18]:=82;curname[19]:=72;
+curname[20]:=84;entername(52);namelength:=6;curname[15]:=67;
+curname[16]:=72;curname[17]:=65;curname[18]:=82;curname[19]:=68;
+curname[20]:=80;entername(53);namelength:=6;curname[15]:=67;
+curname[16]:=72;curname[17]:=65;curname[18]:=82;curname[19]:=73;
+curname[20]:=67;entername(54);namelength:=10;curname[11]:=78;
+curname[12]:=69;curname[13]:=88;curname[14]:=84;curname[15]:=76;
+curname[16]:=65;curname[17]:=82;curname[18]:=71;curname[19]:=69;
+curname[20]:=82;entername(55);namelength:=7;curname[14]:=86;
+curname[15]:=65;curname[16]:=82;curname[17]:=67;curname[18]:=72;
+curname[19]:=65;curname[20]:=82;entername(56);namelength:=3;
+curname[18]:=84;curname[19]:=79;curname[20]:=80;entername(57);
+namelength:=3;curname[18]:=77;curname[19]:=73;curname[20]:=68;
+entername(58);namelength:=3;curname[18]:=66;curname[19]:=79;
+curname[20]:=84;entername(59);namelength:=3;curname[18]:=82;
+curname[19]:=69;curname[20]:=80;entername(60);namelength:=3;
+curname[18]:=69;curname[19]:=88;curname[20]:=84;entername(60);
+namelength:=7;curname[14]:=67;curname[15]:=79;curname[16]:=77;
+curname[17]:=77;curname[18]:=69;curname[19]:=78;curname[20]:=84;
+entername(0);namelength:=5;curname[16]:=76;curname[17]:=65;
+curname[18]:=66;curname[19]:=69;curname[20]:=76;entername(70);
+namelength:=4;curname[17]:=83;curname[18]:=84;curname[19]:=79;
+curname[20]:=80;entername(71);namelength:=4;curname[17]:=83;
+curname[18]:=75;curname[19]:=73;curname[20]:=80;entername(72);
+namelength:=3;curname[18]:=75;curname[19]:=82;curname[20]:=78;
+entername(73);namelength:=3;curname[18]:=76;curname[19]:=73;
+curname[20]:=71;entername(74);namelength:=4;curname[17]:=47;
+curname[18]:=76;curname[19]:=73;curname[20]:=71;entername(76);
+namelength:=5;curname[16]:=47;curname[17]:=76;curname[18]:=73;
+curname[19]:=71;curname[20]:=62;entername(80);namelength:=4;
+curname[17]:=76;curname[18]:=73;curname[19]:=71;curname[20]:=47;
+entername(75);namelength:=5;curname[16]:=76;curname[17]:=73;
+curname[18]:=71;curname[19]:=47;curname[20]:=62;entername(79);
+namelength:=5;curname[16]:=47;curname[17]:=76;curname[18]:=73;
+curname[19]:=71;curname[20]:=47;entername(77);namelength:=6;
+curname[15]:=47;curname[16]:=76;curname[17]:=73;curname[18]:=71;
+curname[19]:=47;curname[20]:=62;entername(81);namelength:=7;
+curname[14]:=47;curname[15]:=76;curname[16]:=73;curname[17]:=71;
+curname[18]:=47;curname[19]:=62;curname[20]:=62;entername(85);{:47};
+paramenter;end;procedure readligkern;var krnptr:0..maxkerns;c:byte;
+begin{94:}begin lkstepended:=false;
+while level=1 do begin while curchar=32 do getnext;
+if curchar=40 then{95:}begin getname;
+if curcode=0 then skiptoendofitem else if curcode<70 then begin begin if
+charsonline>0 then writeln(' ');
+write('This property name doesn''t belong in a LIGTABLE list');
+showerrorcontext;end;skiptoendofitem;
+end else begin case curcode of 70:{97:}
+begin while curchar=32 do getnext;
+if curchar=66 then begin charremainder[256]:=nl;
+repeat getnext until(curchar=40)or(curchar=41);
+end else begin begin if(curchar>41)or(curchar<40)then loc:=loc-1;end;
+c:=getbyte;checktag(c);chartag[c]:=1;charremainder[c]:=nl;end;
+if minnl<=nl then minnl:=nl+1;lkstepended:=false;end{:97};71:{99:}
+if not lkstepended then begin if charsonline>0 then writeln(' ');
+write('STOP must follow LIG or KRN');showerrorcontext;
+end else begin ligkern[nl-1].b0:=128;lkstepended:=false;end{:99};
+72:{100:}
+if not lkstepended then begin if charsonline>0 then writeln(' ');
+write('SKIP must follow LIG or KRN');showerrorcontext;
+end else begin c:=getbyte;
+if c>=128 then begin if charsonline>0 then writeln(' ');
+write('Maximum SKIP amount is 127');showerrorcontext;
+end else if nl+c>=maxligsteps then begin if charsonline>0 then writeln(
+' ');write('Sorry, LIGTABLE too long for me to handle');
+showerrorcontext;end else begin ligkern[nl-1].b0:=c;
+if minnl<=nl+c then minnl:=nl+c+1;end;lkstepended:=false;end{:100};
+73:{102:}begin ligkern[nl].b0:=0;ligkern[nl].b1:=getbyte;
+kern[nk]:=getfix;krnptr:=0;
+while kern[krnptr]<>kern[nk]do krnptr:=krnptr+1;
+if krnptr=nk then begin if nk<maxkerns then nk:=nk+1 else begin begin if
+charsonline>0 then writeln(' ');
+write('Sorry, too many different kerns for me to handle');
+showerrorcontext;end;krnptr:=krnptr-1;end;end;
+ligkern[nl].b2:=128+(krnptr div 256);ligkern[nl].b3:=krnptr mod 256;
+if nl>=maxligsteps-1 then begin if charsonline>0 then writeln(' ');
+write('Sorry, LIGTABLE too long for me to handle');showerrorcontext;
+end else nl:=nl+1;lkstepended:=true;end{:102};
+74,75,76,77,79,80,81,85:{101:}begin ligkern[nl].b0:=0;
+ligkern[nl].b2:=curcode-74;ligkern[nl].b1:=getbyte;
+ligkern[nl].b3:=getbyte;
+if nl>=maxligsteps-1 then begin if charsonline>0 then writeln(' ');
+write('Sorry, LIGTABLE too long for me to handle');showerrorcontext;
+end else nl:=nl+1;lkstepended:=true;end{:101};end;finishtheproperty;end;
+end{:95}else if curchar=41 then skiptoendofitem else junkerror;end;
+begin loc:=loc-1;level:=level+1;curchar:=41;end;end{:94};end;
+procedure readcharinfo;var c:byte;begin{103:}begin c:=getbyte;{108:}
+begin if charsonline=8 then begin writeln(' ');charsonline:=1;
+end else begin if charsonline>0 then write(' ');
+charsonline:=charsonline+1;end;printoctal(c);end{:108};
+while level=1 do begin while curchar=32 do getnext;
+if curchar=40 then{104:}begin getname;
+if curcode=0 then skiptoendofitem else if(curcode<51)or(curcode>56)then
+begin begin if charsonline>0 then writeln(' ');
+write('This property name doesn''t belong in a CHARACTER list');
+showerrorcontext;end;skiptoendofitem;
+end else begin case curcode of 51:charwd[c]:=sortin(1,getfix);
+52:charht[c]:=sortin(2,getfix);53:chardp[c]:=sortin(3,getfix);
+54:charic[c]:=sortin(4,getfix);55:begin checktag(c);chartag[c]:=2;
+charremainder[c]:=getbyte;end;56:{105:}
+begin if ne=256 then begin if charsonline>0 then writeln(' ');
+write('At most 256 VARCHAR specs are allowed');showerrorcontext;
+end else begin checktag(c);chartag[c]:=3;charremainder[c]:=ne;
+exten[ne].b0:=0;exten[ne].b1:=0;exten[ne].b2:=0;exten[ne].b3:=0;
+while level=2 do begin while curchar=32 do getnext;
+if curchar=40 then{106:}begin getname;
+if curcode=0 then skiptoendofitem else if(curcode<57)or(curcode>60)then
+begin begin if charsonline>0 then writeln(' ');
+write('This property name doesn''t belong in a VARCHAR list');
+showerrorcontext;end;skiptoendofitem;
+end else begin case curcode-(57)of 0:exten[ne].b0:=getbyte;
+1:exten[ne].b1:=getbyte;2:exten[ne].b2:=getbyte;3:exten[ne].b3:=getbyte;
+end;finishtheproperty;end;end{:106}
+else if curchar=41 then skiptoendofitem else junkerror;end;ne:=ne+1;
+begin loc:=loc-1;level:=level+1;curchar:=41;end;end;end{:105};end;
+finishtheproperty;end;end{:104}
+else if curchar=41 then skiptoendofitem else junkerror;end;
+if charwd[c]=0 then charwd[c]:=sortin(1,0);begin loc:=loc-1;
+level:=level+1;curchar:=41;end;end{:103};end;procedure readinput;
+var c:byte;begin{82:}curchar:=32;repeat while curchar=32 do getnext;
+if curchar=40 then{84:}begin getname;
+if curcode=0 then skiptoendofitem else if curcode>12 then begin begin if
+charsonline>0 then writeln(' ');
+write('This property name doesn''t belong on the outer level');
+showerrorcontext;end;skiptoendofitem;end else begin{85:}
+case curcode of 1:begin checksumspecified:=true;readfourbytes(0);end;
+2:{88:}begin nextd:=getfix;
+if nextd<1048576 then begin if charsonline>0 then writeln(' ');
+write('The design size must be at least 1');showerrorcontext;
+end else designsize:=nextd;end{:88};3:{89:}begin nextd:=getfix;
+if nextd<=0 then begin if charsonline>0 then writeln(' ');
+write('The number of units per design size must be positive');
+showerrorcontext;end else designunits:=nextd;end{:89};4:readBCPL(8,40);
+5:readBCPL(48,20);6:headerbytes[71]:=getbyte;7:{90:}
+begin while curchar=32 do getnext;
+if curchar=84 then sevenbitsafeflag:=true else if curchar=70 then
+sevenbitsafeflag:=false else begin if charsonline>0 then writeln(' ');
+write('The flag value should be "TRUE" or "FALSE"');showerrorcontext;
+end;repeat getnext until(curchar=40)or(curchar=41);end{:90};8:{91:}
+begin c:=getbyte;
+if c<18 then begin begin if charsonline>0 then writeln(' ');
+write('HEADER indices should be 18 or more');showerrorcontext;end;
+repeat getnext until(curchar=40)or(curchar=41);
+end else if 4*c+4>maxheaderbytes then begin begin if charsonline>0 then
+writeln(' ');
+write('This HEADER index is too big for my present table size');
+showerrorcontext;end;repeat getnext until(curchar=40)or(curchar=41);
+end else begin while headerptr<4*c+4 do begin headerbytes[headerptr]:=0;
+headerptr:=headerptr+1;end;readfourbytes(4*c);end;end{:91};9:{92:}
+begin while level=1 do begin while curchar=32 do getnext;
+if curchar=40 then{93:}begin getname;
+if curcode=0 then skiptoendofitem else if(curcode<20)or(curcode>=51)then
+begin begin if charsonline>0 then writeln(' ');
+write('This property name doesn''t belong in a FONTDIMEN list');
+showerrorcontext;end;skiptoendofitem;
+end else begin if curcode=20 then c:=getbyte else c:=curcode-20;
+if c=0 then begin begin if charsonline>0 then writeln(' ');
+write('PARAMETER index must not be zero');showerrorcontext;end;
+skiptoendofitem;
+end else if c>maxparamwords then begin begin if charsonline>0 then
+writeln(' ');
+write('This PARAMETER index is too big for my present table size');
+showerrorcontext;end;skiptoendofitem;
+end else begin while np<c do begin np:=np+1;param[np]:=0;end;
+param[c]:=getfix;finishtheproperty;end;end;end{:93}
+else if curchar=41 then skiptoendofitem else junkerror;end;
+begin loc:=loc-1;level:=level+1;curchar:=41;end;end{:92};10:readligkern;
+11:bchar:=getbyte;12:readcharinfo;end{:85};finishtheproperty;end;
+end{:84}
+else if(curchar=41)and not inputhasended then begin begin if charsonline
+>0 then writeln(' ');write('Extra right parenthesis');showerrorcontext;
+end;loc:=loc+1;curchar:=32;end else if not inputhasended then junkerror;
+until inputhasended{:82};end;procedure corrandcheck;var c:0..256;
+hh:0..hashsize;ligptr:0..maxligsteps;g:byte;begin{110:}
+if nl>0 then{116:}
+begin if charremainder[256]<32767 then begin ligkern[nl].b0:=255;
+ligkern[nl].b1:=0;ligkern[nl].b2:=0;ligkern[nl].b3:=0;nl:=nl+1;end;
+while minnl>nl do begin ligkern[nl].b0:=255;ligkern[nl].b1:=0;
+ligkern[nl].b2:=0;ligkern[nl].b3:=0;nl:=nl+1;end;
+if ligkern[nl-1].b0=0 then ligkern[nl-1].b0:=128;end{:116};
+sevenunsafe:=false;for c:=0 to 255 do if charwd[c]<>0 then{111:}
+case chartag[c]of 0:;1:{120:}begin ligptr:=charremainder[c];
+repeat if hashinput(ligptr,c)then begin if ligkern[ligptr].b2<128 then
+begin if ligkern[ligptr].b1<>bchar then begin g:=ligkern[ligptr].b1;
+if charwd[g]=0 then begin charwd[g]:=sortin(1,0);
+write('LIG character examined by',' ');printoctal(c);
+writeln(' had no CHARACTER spec.');end;end;begin g:=ligkern[ligptr].b3;
+if charwd[g]=0 then begin charwd[g]:=sortin(1,0);
+write('LIG character generated by',' ');printoctal(c);
+writeln(' had no CHARACTER spec.');end;end;
+if ligkern[ligptr].b3>=128 then if(c<128)or(c=256)then if(ligkern[ligptr
+].b1<128)or(ligkern[ligptr].b1=bchar)then sevenunsafe:=true;
+end else if ligkern[ligptr].b1<>bchar then begin g:=ligkern[ligptr].b1;
+if charwd[g]=0 then begin charwd[g]:=sortin(1,0);
+write('KRN character examined by',' ');printoctal(c);
+writeln(' had no CHARACTER spec.');end;end;end;
+if ligkern[ligptr].b0>=128 then ligptr:=nl else ligptr:=ligptr+1+ligkern
+[ligptr].b0;until ligptr>=nl;end{:120};2:begin g:=charremainder[c];
+if(g>=128)and(c<128)then sevenunsafe:=true;
+if charwd[g]=0 then begin charwd[g]:=sortin(1,0);
+write('The character NEXTLARGER than',' ');printoctal(c);
+writeln(' had no CHARACTER spec.');end;end;3:{112:}
+begin if exten[charremainder[c]].b0>0 then begin g:=exten[charremainder[
+c]].b0;if(g>=128)and(c<128)then sevenunsafe:=true;
+if charwd[g]=0 then begin charwd[g]:=sortin(1,0);
+write('TOP piece of character',' ');printoctal(c);
+writeln(' had no CHARACTER spec.');end;end;
+if exten[charremainder[c]].b1>0 then begin g:=exten[charremainder[c]].b1
+;if(g>=128)and(c<128)then sevenunsafe:=true;
+if charwd[g]=0 then begin charwd[g]:=sortin(1,0);
+write('MID piece of character',' ');printoctal(c);
+writeln(' had no CHARACTER spec.');end;end;
+if exten[charremainder[c]].b2>0 then begin g:=exten[charremainder[c]].b2
+;if(g>=128)and(c<128)then sevenunsafe:=true;
+if charwd[g]=0 then begin charwd[g]:=sortin(1,0);
+write('BOT piece of character',' ');printoctal(c);
+writeln(' had no CHARACTER spec.');end;end;
+begin g:=exten[charremainder[c]].b3;
+if(g>=128)and(c<128)then sevenunsafe:=true;
+if charwd[g]=0 then begin charwd[g]:=sortin(1,0);
+write('REP piece of character',' ');printoctal(c);
+writeln(' had no CHARACTER spec.');end;end;end{:112};end{:111};
+if charremainder[256]<32767 then begin c:=256;{120:}
+begin ligptr:=charremainder[c];
+repeat if hashinput(ligptr,c)then begin if ligkern[ligptr].b2<128 then
+begin if ligkern[ligptr].b1<>bchar then begin g:=ligkern[ligptr].b1;
+if charwd[g]=0 then begin charwd[g]:=sortin(1,0);
+write('LIG character examined by',' ');printoctal(c);
+writeln(' had no CHARACTER spec.');end;end;begin g:=ligkern[ligptr].b3;
+if charwd[g]=0 then begin charwd[g]:=sortin(1,0);
+write('LIG character generated by',' ');printoctal(c);
+writeln(' had no CHARACTER spec.');end;end;
+if ligkern[ligptr].b3>=128 then if(c<128)or(c=256)then if(ligkern[ligptr
+].b1<128)or(ligkern[ligptr].b1=bchar)then sevenunsafe:=true;
+end else if ligkern[ligptr].b1<>bchar then begin g:=ligkern[ligptr].b1;
+if charwd[g]=0 then begin charwd[g]:=sortin(1,0);
+write('KRN character examined by',' ');printoctal(c);
+writeln(' had no CHARACTER spec.');end;end;end;
+if ligkern[ligptr].b0>=128 then ligptr:=nl else ligptr:=ligptr+1+ligkern
+[ligptr].b0;until ligptr>=nl;end{:120};end;
+if sevenbitsafeflag and sevenunsafe then writeln(
+'The font is not really seven-bit-safe!');{125:}
+if hashptr<hashsize then for hh:=1 to hashptr do begin tt:=hashlist[hh];
+if class[tt]>0 then tt:=f(tt,(hash[tt]-1)div 256,(hash[tt]-1)mod 256);
+end;
+if(hashptr=hashsize)or(yligcycle<256)then begin if hashptr<hashsize then
+begin write('Infinite ligature loop starting with ');
+if xligcycle=256 then write('boundary')else printoctal(xligcycle);
+write(' and ');printoctal(yligcycle);writeln('!');
+end else writeln(
+'Sorry, I haven''t room for so many ligature/kern pairs!');
+writeln('All ligatures will be cleared.');
+for c:=0 to 255 do if chartag[c]=1 then begin chartag[c]:=0;
+charremainder[c]:=0;end;nl:=0;bchar:=256;charremainder[256]:=32767;
+end{:125};{126:}
+if nl>0 then for ligptr:=0 to nl-1 do if ligkern[ligptr].b2<128 then
+begin if ligkern[ligptr].b0<255 then begin begin c:=ligkern[ligptr].b1;
+if charwd[c]=0 then if c<>bchar then begin ligkern[ligptr].b1:=0;
+if charwd[0]=0 then charwd[0]:=sortin(1,0);
+write('Unused ','LIG step',' refers to nonexistent character ');
+printoctal(c);writeln('!');end;end;begin c:=ligkern[ligptr].b3;
+if charwd[c]=0 then if c<>bchar then begin ligkern[ligptr].b3:=0;
+if charwd[0]=0 then charwd[0]:=sortin(1,0);
+write('Unused ','LIG step',' refers to nonexistent character ');
+printoctal(c);writeln('!');end;end;end;
+end else begin c:=ligkern[ligptr].b1;
+if charwd[c]=0 then if c<>bchar then begin ligkern[ligptr].b1:=0;
+if charwd[0]=0 then charwd[0]:=sortin(1,0);
+write('Unused ','KRN step',' refers to nonexistent character ');
+printoctal(c);writeln('!');end;end;
+if ne>0 then for g:=0 to ne-1 do begin begin c:=exten[g].b0;
+if c>0 then if charwd[c]=0 then begin exten[g].b0:=0;
+if charwd[0]=0 then charwd[0]:=sortin(1,0);
+write('Unused ','VARCHAR TOP',' refers to nonexistent character ');
+printoctal(c);writeln('!');end;end;begin c:=exten[g].b1;
+if c>0 then if charwd[c]=0 then begin exten[g].b1:=0;
+if charwd[0]=0 then charwd[0]:=sortin(1,0);
+write('Unused ','VARCHAR MID',' refers to nonexistent character ');
+printoctal(c);writeln('!');end;end;begin c:=exten[g].b2;
+if c>0 then if charwd[c]=0 then begin exten[g].b2:=0;
+if charwd[0]=0 then charwd[0]:=sortin(1,0);
+write('Unused ','VARCHAR BOT',' refers to nonexistent character ');
+printoctal(c);writeln('!');end;end;begin c:=exten[g].b3;
+if charwd[c]=0 then begin exten[g].b3:=0;
+if charwd[0]=0 then charwd[0]:=sortin(1,0);
+write('Unused ','VARCHAR REP',' refers to nonexistent character ');
+printoctal(c);writeln('!');end;end;end{:126};for c:=0 to 255 do{113:}
+if chartag[c]=2 then begin g:=charremainder[c];
+while(g<c)and(chartag[g]=2)do g:=charremainder[g];
+if g=c then begin chartag[c]:=0;
+write('A cycle of NEXTLARGER characters has been broken at ');
+printoctal(c);writeln('.');end;end{:113};{115:}delta:=shorten(1,255);
+setindices(1,delta);
+if delta>0 then writeln('I had to round some ','width','s by ',(((delta
++1)div 2)/1048576):1:7,' units.');delta:=shorten(2,15);
+setindices(2,delta);
+if delta>0 then writeln('I had to round some ','height','s by ',(((delta
++1)div 2)/1048576):1:7,' units.');delta:=shorten(3,15);
+setindices(3,delta);
+if delta>0 then writeln('I had to round some ','depth','s by ',(((delta
++1)div 2)/1048576):1:7,' units.');delta:=shorten(4,63);
+setindices(4,delta);
+if delta>0 then writeln('I had to round some ','italic correction',
+'s by ',(((delta+1)div 2)/1048576):1:7,' units.');{:115}{:110}end;{:146}
+{147:}begin initialize;nameenter;readinput;writeln('.');corrandcheck;
+{128:}{130:}lh:=headerptr div 4;notfound:=true;bc:=0;
+while notfound do if(charwd[bc]>0)or(bc=255)then notfound:=false else bc
+:=bc+1;notfound:=true;ec:=255;
+while notfound do if(charwd[ec]>0)or(ec=0)then notfound:=false else ec:=
+ec-1;if bc>ec then bc:=1;memory[1]:=memory[1]+1;memory[2]:=memory[2]+1;
+memory[3]:=memory[3]+1;memory[4]:=memory[4]+1;{139:}{140:}labelptr:=0;
+labeltable[0].rr:=-1;
+for c:=bc to ec do if chartag[c]=1 then begin sortptr:=labelptr;
+while labeltable[sortptr].rr>charremainder[c]do begin labeltable[sortptr
++1]:=labeltable[sortptr];sortptr:=sortptr-1;end;
+labeltable[sortptr+1].cc:=c;labeltable[sortptr+1].rr:=charremainder[c];
+labelptr:=labelptr+1;end{:140};
+if bchar<256 then begin extralocneeded:=true;lkoffset:=1;
+end else begin extralocneeded:=false;lkoffset:=0;end;{141:}
+begin sortptr:=labelptr;
+if labeltable[sortptr].rr+lkoffset>255 then begin lkoffset:=0;
+extralocneeded:=false;
+repeat charremainder[labeltable[sortptr].cc]:=lkoffset;
+while labeltable[sortptr-1].rr=labeltable[sortptr].rr do begin sortptr:=
+sortptr-1;charremainder[labeltable[sortptr].cc]:=lkoffset;end;
+lkoffset:=lkoffset+1;sortptr:=sortptr-1;
+until lkoffset+labeltable[sortptr].rr<256;end;
+if lkoffset>0 then while sortptr>0 do begin charremainder[labeltable[
+sortptr].cc]:=charremainder[labeltable[sortptr].cc]+lkoffset;
+sortptr:=sortptr-1;end;end{:141};
+if charremainder[256]<32767 then begin ligkern[nl-1].b2:=(charremainder[
+256]+lkoffset)div 256;
+ligkern[nl-1].b3:=(charremainder[256]+lkoffset)mod 256;end{:139};
+lf:=6+lh+(ec-bc+1)+memory[1]+memory[2]+memory[3]+memory[4]+nl+lkoffset+
+nk+ne+np;{:130};{131:}write(tfmfile,(lf)div 256);
+write(tfmfile,(lf)mod 256);write(tfmfile,(lh)div 256);
+write(tfmfile,(lh)mod 256);write(tfmfile,(bc)div 256);
+write(tfmfile,(bc)mod 256);write(tfmfile,(ec)div 256);
+write(tfmfile,(ec)mod 256);write(tfmfile,(memory[1])div 256);
+write(tfmfile,(memory[1])mod 256);write(tfmfile,(memory[2])div 256);
+write(tfmfile,(memory[2])mod 256);write(tfmfile,(memory[3])div 256);
+write(tfmfile,(memory[3])mod 256);write(tfmfile,(memory[4])div 256);
+write(tfmfile,(memory[4])mod 256);write(tfmfile,(nl+lkoffset)div 256);
+write(tfmfile,(nl+lkoffset)mod 256);write(tfmfile,(nk)div 256);
+write(tfmfile,(nk)mod 256);write(tfmfile,(ne)div 256);
+write(tfmfile,(ne)mod 256);write(tfmfile,(np)div 256);
+write(tfmfile,(np)mod 256);{:131};{133:}
+if not checksumspecified then{134:}begin curbytes.b0:=bc;
+curbytes.b1:=ec;curbytes.b2:=bc;curbytes.b3:=ec;
+for c:=bc to ec do if charwd[c]>0 then begin tempwidth:=memory[charwd[c]
+];if designunits<>1048576 then tempwidth:=round((tempwidth/designunits)
+*1048576.0);tempwidth:=tempwidth+(c+4)*4194304;
+curbytes.b0:=(curbytes.b0+curbytes.b0+tempwidth)mod 255;
+curbytes.b1:=(curbytes.b1+curbytes.b1+tempwidth)mod 253;
+curbytes.b2:=(curbytes.b2+curbytes.b2+tempwidth)mod 251;
+curbytes.b3:=(curbytes.b3+curbytes.b3+tempwidth)mod 247;end;
+headerbytes[0]:=curbytes.b0;headerbytes[1]:=curbytes.b1;
+headerbytes[2]:=curbytes.b2;headerbytes[3]:=curbytes.b3;end{:134};
+headerbytes[4]:=designsize div 16777216;
+headerbytes[5]:=(designsize div 65536)mod 256;
+headerbytes[6]:=(designsize div 256)mod 256;
+headerbytes[7]:=designsize mod 256;
+if not sevenunsafe then headerbytes[68]:=128;
+for j:=0 to headerptr-1 do write(tfmfile,headerbytes[j]);{:133};{135:}
+index[0]:=0;for c:=bc to ec do begin write(tfmfile,index[charwd[c]]);
+write(tfmfile,index[charht[c]]*16+index[chardp[c]]);
+write(tfmfile,index[charic[c]]*4+chartag[c]);
+write(tfmfile,charremainder[c]);end{:135};{137:}
+for q:=1 to 4 do begin write(tfmfile,0);write(tfmfile,0);
+write(tfmfile,0);write(tfmfile,0);p:=link[q];
+while p>0 do begin outscaled(memory[p]);p:=link[p];end;end;{:137};{142:}
+if extralocneeded then begin write(tfmfile,255);write(tfmfile,bchar);
+write(tfmfile,0);write(tfmfile,0);
+end else for sortptr:=1 to lkoffset do begin t:=labeltable[labelptr].rr;
+if bchar<256 then begin write(tfmfile,255);write(tfmfile,bchar);
+end else begin write(tfmfile,254);write(tfmfile,0);end;
+write(tfmfile,(t+lkoffset)div 256);write(tfmfile,(t+lkoffset)mod 256);
+repeat labelptr:=labelptr-1;until labeltable[labelptr].rr<t;end;
+if nl>0 then for ligptr:=0 to nl-1 do begin write(tfmfile,ligkern[ligptr
+].b0);write(tfmfile,ligkern[ligptr].b1);
+write(tfmfile,ligkern[ligptr].b2);write(tfmfile,ligkern[ligptr].b3);end;
+if nk>0 then for krnptr:=0 to nk-1 do outscaled(kern[krnptr]){:142};
+{143:}if ne>0 then for c:=0 to ne-1 do begin write(tfmfile,exten[c].b0);
+write(tfmfile,exten[c].b1);write(tfmfile,exten[c].b2);
+write(tfmfile,exten[c].b3);end;{:143};{144:}
+for parptr:=1 to np do begin if parptr=1 then{145:}
+begin if param[1]<0 then begin param[1]:=param[1]+1073741824;
+write(tfmfile,(param[1]div 16777216)+192);
+end else write(tfmfile,param[1]div 16777216);
+write(tfmfile,(param[1]div 65536)mod 256);
+write(tfmfile,(param[1]div 256)mod 256);write(tfmfile,param[1]mod 256);
+end{:145}else outscaled(param[parptr]);end{:144}{:128};
+9999:writeln(' ');end.{:147}
diff --git a/systems/knuth/local/texware/pooltype.ch b/systems/knuth/local/texware/pooltype.ch
new file mode 100644
index 0000000000..c96ec0c8cb
--- /dev/null
+++ b/systems/knuth/local/texware/pooltype.ch
@@ -0,0 +1,92 @@
+% Change file for the Pooltype processor
+% Hacked together by don on 8/7/89 since the old pooltype.ch seems lost
+% 8-bit modifications made 9/11/89
+
+% Module numbers are from the standard TeXware report (CS1097)
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [0] WEAVE: print changes only
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{POOLTYPE changes for GNU Pascal}
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [2] Program header
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+@x
+@p program POOLtype(@!pool_file,@!output);
+label 9999; {this labels the end of the program}
+type @<Types in the outer block@>@/
+@y
+@p program POOLtype(@!output);
+label 9999; {this labels the end of the program}
+type UNIX_file_name=packed array[1..100] of char;
+@<Types in the outer block@>@/
+@z
+@x
+procedure initialize; {this procedure gets things started properly}
+@y
+@\
+@=#include "texwarext.h"@>
+@\@/
+procedure initialize; {this procedure gets things started properly}
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [5] Bytes
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@!ASCII_code=0..255; {eight-bit numbers}
+@y
+@!ASCII_code=ByteCard; {eight-bit numbers}
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [12] Permissiveness
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+for i:=0 to @'37 do xchr[i]:=' ';
+for i:=@'177 to @'377 do xchr[i]:=' ';
+@y
+for i:=0 to @'37 do xchr[i]:=chr(i);
+for i:=@'177 to @'377 do xchr[i]:=chr(i);
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [15] Beginning of main program
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+@x
+@p begin initialize;@/
+@y
+@p begin if argc < 2 then
+ abort('Usage: pooltype <pool-file>');
+initialize;@/
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [18] Input file declaration needs also a string
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+@x
+@!pool_file:packed file of text_char;
+@y
+@!pool_file:text; {GNU Pascal needs this simplication}
+@!pool_name:UNIX_file_name;
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [19] Opening the input file
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+@x
+reset(pool_file); xsum:=false;
+@y
+argv(1,pool_name); reset(pool_file,pool_name); xsum:=false;
+@z
diff --git a/systems/knuth/local/texware/pooltype.p b/systems/knuth/local/texware/pooltype.p
new file mode 100644
index 0000000000..c6526499f3
--- /dev/null
+++ b/systems/knuth/local/texware/pooltype.p
@@ -0,0 +1,57 @@
+{2:}program POOLtype(output);label 9999;
+type UNIXfilename=packed array[1..100]of char;{5:}ASCIIcode=ByteCard;
+{:5}var{7:}xord:array[char]of ASCIIcode;xchr:array[ASCIIcode]of char;
+{:7}{12:}k,l:0..255;m,n:char;s:integer;{:12}{13:}count:integer;{:13}
+{18:}poolfile:text;poolname:UNIXfilename;xsum:boolean;{:18}
+#include "dvityext.h"
+procedure initialize;var{6:}i:integer;{:6}begin{8:}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]:='~';{:8}{10:}for i:=0 to 31 do xchr[i]:=chr(i);
+for i:=127 to 255 do xchr[i]:=chr(i);{:10}{11:}
+for i:=0 to 255 do xord[chr(i)]:=127;
+for i:=128 to 255 do xord[xchr[i]]:=i;
+for i:=0 to 126 do xord[xchr[i]]:=i;{:11}{14:}count:=0;{:14}end;{:2}
+{15:}begin if argc<2 then begin writeln('Usage: pooltype <pool-file>');
+goto 9999;end;initialize;{16:}for k:=0 to 255 do begin write(k:3,': "');
+l:=k;if({17:}(k<32)or(k>126){:17})then begin write(xchr[94],xchr[94]);
+if k<64 then l:=k+64 else if k<128 then l:=k-64 else begin l:=k div 16;
+if l<10 then l:=l+48 else l:=l+87;write(xchr[l]);l:=k mod 16;
+if l<10 then l:=l+48 else l:=l+87;count:=count+1;end;count:=count+2;end;
+if l=34 then write(xchr[l],xchr[l])else write(xchr[l]);count:=count+1;
+writeln('"');end{:16};s:=256;{19:}argv(1,poolname);
+reset(poolfile,poolname);xsum:=false;
+if eof(poolfile)then begin writeln('! I can''t read the POOL file.');
+goto 9999;end;repeat{20:}
+if eof(poolfile)then begin writeln('! POOL file contained no check sum')
+;goto 9999;end;read(poolfile,m,n);
+if m<>'*'then begin if(xord[m]<48)or(xord[m]>57)or(xord[n]<48)or(xord[n]
+>57)then begin writeln('! POOL line doesn''t begin with two digits');
+goto 9999;end;l:=xord[m]*10+xord[n]-48*11;write(s:3,': "');
+count:=count+l;
+for k:=1 to l do begin if eoln(poolfile)then begin writeln('"');
+begin writeln('! That POOL line was too short');goto 9999;end;end;
+read(poolfile,m);write(xchr[xord[m]]);
+if xord[m]=34 then write(xchr[34]);end;writeln('"');s:=s+1;
+end else xsum:=true;readln(poolfile){:20};until xsum;
+if not eof(poolfile)then begin writeln(
+'! There''s junk after the check sum');goto 9999;end{:19};
+writeln('(',count:1,' characters in all.)');9999:end.{:15}
diff --git a/systems/knuth/local/texware/texwarext.h b/systems/knuth/local/texware/texwarext.h
new file mode 100644
index 0000000000..a183a12814
--- /dev/null
+++ b/systems/knuth/local/texware/texwarext.h
@@ -0,0 +1,5 @@
+argc:asmname '_p_argc' Integer;
+
+procedure argv(no:Integer;var str:UNIXfilename); external;
+
+function testreadaccess(var a:UNIXfilename):boolean; external;
diff --git a/systems/knuth/local/texware/tftopl.ch b/systems/knuth/local/texware/tftopl.ch
new file mode 100644
index 0000000000..2c1304d3b5
--- /dev/null
+++ b/systems/knuth/local/texware/tftopl.ch
@@ -0,0 +1,128 @@
+% Change file for the TFtoPL processor, for use with GNU Pascal.
+% (by Don Knuth, based on the work of Pavel Curtis in ../texware-sparc)
+
+% History:
+% 2000.04.30 Original version
+
+% The section numbers used in this file refer to the current numbers,
+% and, where different, also to those in the standard TeXware report (CS1097).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [0] WEAVE: print changes only
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@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 GNU Pascal}
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [1] Change banner string
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@d banner=='This is TFtoPL, Version 3.1' {printed when the program starts}
+@y
+@d banner=='This is TFtoPL, Version 3.1 for Linux'
+ {printed when the program starts}
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [2] Fix files in program statement; add external access procedure
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@p program TFtoPL(@!tfm_file,@!pl_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@>@/
+@y
+@p program TFtoPL(@!output);
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+type UNIX_file_name=packed array[1..100] of char;
+ @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+@\
+@=#include "texwarext.h"@>
+@\@/
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [6] Fix declaration of tfm_file; declare extra TFM-file variables
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@!tfm_file:packed file of 0..255;
+@y
+@!tfm_file:packed file of ByteCard; {files that contain binary data}
+@!tfm_name:UNIX_file_name;
+@!tfm_byte:integer;
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [7] Open TFM file
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@ On some systems you may have to do something special to read a
+packed file of bytes. For example, the following code didn't work
+when it was first tried at Stanford, because packed files have to be
+opened with a special switch setting on the \PASCAL\ that was used.
+@^system dependencies@>
+
+@<Set init...@>=
+reset(tfm_file);
+@y
+@ On some systems you may have to do something special to read a
+packed file of bytes.
+
+@<Set init...@>=
+if argc < 3 then begin
+ print_ln('Usage: tftopl <tfm-file> <pl-file>');
+ goto final_end;
+end;
+argv(1, tfm_name);
+if testreadaccess(tfm_name) then reset(tfm_file, tfm_name)
+else begin print_ln('I can''t read the TFM file!'); goto final_end;
+ end;
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [16] Declare pl_name
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@!pl_file:text;
+@y
+@!pl_file:text;
+@!pl_name: UNIX_file_name;
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [17] Open PL file
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@ @<Set init...@>=
+rewrite(pl_file);
+@y
+@ @<Set init...@>=
+argv(2, pl_name);
+rewrite(pl_file, pl_name);
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [18] Fix definition of byte
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@!byte=0..255; {unsigned eight-bit quantity}
+@y
+@!byte=ByteCard; {unsigned eight-bit quantity}
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [99, was 88] Add printing of newline at end of program
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+final_end:end.
+@y
+final_end: print_ln(' '); end.
+@z
diff --git a/systems/knuth/local/texware/tftopl.p b/systems/knuth/local/texware/tftopl.p
new file mode 100644
index 0000000000..4aaa676b47
--- /dev/null
+++ b/systems/knuth/local/texware/tftopl.p
@@ -0,0 +1,504 @@
+{2:}program TFtoPL(output);label{3:}9999;{:3}const{4:}tfmsize=30000;
+ligsize=5000;hashsize=5003;{:4}
+type UNIXfilename=packed array[1..100]of char;{18:}byte=ByteCard;
+index=0..tfmsize;{:18}var{6:}tfmfile:packed file of ByteCard;
+tfmname:UNIXfilename;tfmbyte:integer;{:6}{8:}
+lf,lh,bc,ec,nw,nh,nd,ni,nl,nk,ne,np:0..32767;{:8}{16:}plfile:text;
+plname:UNIXfilename;{:16}{19:}tfm:array[-1000..tfmsize]of byte;{:19}
+{22:}
+charbase,widthbase,heightbase,depthbase,italicbase,ligkernbase,kernbase,
+extenbase,parambase:integer;{:22}{25:}fonttype:0..2;{:25}{27:}
+ASCII04,ASCII10,ASCII14:packed array[1..32]of char;
+MBLstring,RIstring,RCEstring:packed array[1..3]of char;{:27}{29:}
+dig:array[0..11]of 0..9;{:29}{32:}level:0..5;{:32}{45:}charsonline:0..8;
+perfect:boolean;{:45}{47:}i:0..32767;c:0..256;d:0..3;k:index;r:0..65535;
+count:0..127;{:47}{63:}labeltable:array[0..258]of record cc:0..256;
+rr:0..ligsize;end;labelptr:0..257;sortptr:0..257;boundarychar:0..256;
+bcharlabel:0..32767;{:63}{65:}activity:array[0..ligsize]of 0..2;
+ai,acti:0..ligsize;{:65}{89:}hash:array[0..hashsize]of 0..66048;
+class:array[0..hashsize]of 0..4;ligz:array[0..hashsize]of 0..257;
+hashptr:0..hashsize;hashlist:array[0..hashsize]of 0..hashsize;
+h,hh:0..hashsize;xligcycle,yligcycle:0..256;{:89}
+#include "texwarext.h"
+procedure initialize;
+begin writeln('This is TFtoPL, Version 3.1 for Linux');{7:}
+if argc<3 then begin writeln('Usage: tftopl <tfm-file> <pl-file>');
+goto 9999;end;argv(1,tfmname);
+if testreadaccess(tfmname)then reset(tfmfile,tfmname)else begin writeln(
+'I can''t read the TFM file!');goto 9999;end;{:7}{17:}argv(2,plname);
+rewrite(plfile,plname);{:17}{28:}
+ASCII04:=' !"#$%&''()*+,-./0123456789:;<=>?';
+ASCII10:='@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
+ASCII14:='`abcdefghijklmnopqrstuvwxyz{|}~ ';MBLstring:='MBL';
+RIstring:='RI ';RCEstring:='RCE';{:28}{33:}level:=0;{:33}{46:}
+charsonline:=0;perfect:=true;{:46}{64:}boundarychar:=256;
+bcharlabel:=32767;labelptr:=0;labeltable[0].rr:=0;{:64}end;{:2}{30:}
+procedure outdigs(j:integer);begin repeat j:=j-1;write(plfile,dig[j]:1);
+until j=0;end;procedure printdigs(j:integer);begin repeat j:=j-1;
+write(dig[j]:1);until j=0;end;{:30}{31:}procedure printoctal(c:byte);
+var j:0..2;begin write('''');for j:=0 to 2 do begin dig[j]:=c mod 8;
+c:=c div 8;end;printdigs(3);end;{:31}{34:}procedure outln;var l:0..5;
+begin writeln(plfile);for l:=1 to level do write(plfile,' ');end;
+procedure left;begin level:=level+1;write(plfile,'(');end;
+procedure right;begin level:=level-1;write(plfile,')');outln;end;{:34}
+{35:}procedure outBCPL(k:index);var l:0..39;begin write(plfile,' ');
+l:=tfm[k];while l>0 do begin k:=k+1;l:=l-1;
+case tfm[k]div 32 of 1:write(plfile,ASCII04[1+(tfm[k]mod 32)]);
+2:write(plfile,ASCII10[1+(tfm[k]mod 32)]);
+3:write(plfile,ASCII14[1+(tfm[k]mod 32)]);end;end;end;{:35}{36:}
+procedure outoctal(k,l:index);var a:0..1023;b:0..32;j:0..11;
+begin write(plfile,' O ');a:=0;b:=0;j:=0;while l>0 do{37:}begin l:=l-1;
+if tfm[k+l]<>0 then begin while b>2 do begin dig[j]:=a mod 8;a:=a div 8;
+b:=b-3;j:=j+1;end;case b of 0:a:=tfm[k+l];1:a:=a+2*tfm[k+l];
+2:a:=a+4*tfm[k+l];end;end;b:=b+8;end{:37};
+while(a>0)or(j=0)do begin dig[j]:=a mod 8;a:=a div 8;j:=j+1;end;
+outdigs(j);end;{:36}{38:}procedure outchar(c:byte);
+begin if fonttype>0 then begin tfm[0]:=c;
+outoctal(0,1)end else if(c>=48)and(c<=57)then write(plfile,' C ',c-48:1)
+else if(c>=65)and(c<=90)then write(plfile,' C ',ASCII10[c-63])else if(c
+>=97)and(c<=122)then write(plfile,' C ',ASCII14[c-95])else begin tfm[0]
+:=c;outoctal(0,1);end;end;{:38}{39:}procedure outface(k:index);
+var s:0..1;b:0..8;
+begin if tfm[k]>=18 then outoctal(k,1)else begin write(plfile,' F ');
+s:=tfm[k]mod 2;b:=tfm[k]div 2;write(plfile,MBLstring[1+(b mod 3)]);
+write(plfile,RIstring[1+s]);write(plfile,RCEstring[1+(b div 3)]);end;
+end;{:39}{40:}procedure outfix(k:index);var a:0..4095;f:integer;j:0..12;
+delta:integer;begin write(plfile,' R ');a:=(tfm[k]*16)+(tfm[k+1]div 16);
+f:=((tfm[k+1]mod 16)*256+tfm[k+2])*256+tfm[k+3];if a>2047 then{43:}
+begin write(plfile,'-');a:=4096-a;if f>0 then begin f:=1048576-f;a:=a-1;
+end;end{:43};{41:}begin j:=0;repeat dig[j]:=a mod 10;a:=a div 10;j:=j+1;
+until a=0;outdigs(j);end{:41};{42:}begin write(plfile,'.');f:=10*f+5;
+delta:=10;repeat if delta>1048576 then f:=f+524288-(delta div 2);
+write(plfile,f div 1048576:1);f:=10*(f mod 1048576);delta:=delta*10;
+until f<=delta;end;{:42};end;{:40}{52:}procedure checkBCPL(k,l:index);
+var j:index;c:byte;begin if tfm[k]>=l then begin begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ',
+'String is too long; I''ve shortened it drastically.');end;tfm[k]:=1;
+end;for j:=k+1 to k+tfm[k]do begin c:=tfm[j];
+if(c=40)or(c=41)then begin begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ',
+'Parenthesis in string has been changed to slash.');end;tfm[j]:=47;
+end else if(c<32)or(c>126)then begin begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ','Nonstandard ASCII code has been blotted out.')
+;end;tfm[j]:=63;end else if(c>=97)and(c<=122)then tfm[j]:=c-32;end;end;
+{:52}{92:}procedure hashinput;label 30;var cc:0..3;zz:0..255;y:0..255;
+key:integer;t:integer;begin if hashptr=hashsize then goto 30;{93:}
+k:=4*(ligkernbase+(i));y:=tfm[k+1];t:=tfm[k+2];cc:=0;zz:=tfm[k+3];
+if t>=128 then zz:=y else begin case t of 0,6:;5,11:zz:=y;1,7:cc:=1;
+2:cc:=2;3:cc:=3;end;end{:93};key:=256*c+y+1;h:=(1009*key)mod hashsize;
+while hash[h]>0 do begin if hash[h]<=key then begin if hash[h]=key then
+goto 30;t:=hash[h];hash[h]:=key;key:=t;t:=class[h];class[h]:=cc;cc:=t;
+t:=ligz[h];ligz[h]:=zz;zz:=t;end;if h>0 then h:=h-1 else h:=hashsize;
+end;hash[h]:=key;class[h]:=cc;ligz[h]:=zz;hashptr:=hashptr+1;
+hashlist[hashptr]:=h;30:end;{:92}{94:}function f(h,x,y:index):index;
+forward;function eval(x,y:index):index;var key:integer;
+begin key:=256*x+y+1;h:=(1009*key)mod hashsize;
+while hash[h]>key do if h>0 then h:=h-1 else h:=hashsize;
+if hash[h]<key then eval:=y else eval:=f(h,x,y);end;{:94}{95:}
+function f;begin case class[h]of 0:;1:begin class[h]:=4;
+ligz[h]:=eval(ligz[h],y);class[h]:=0;end;2:begin class[h]:=4;
+ligz[h]:=eval(x,ligz[h]);class[h]:=0;end;3:begin class[h]:=4;
+ligz[h]:=eval(eval(x,ligz[h]),y);class[h]:=0;end;4:begin xligcycle:=x;
+yligcycle:=y;ligz[h]:=257;class[h]:=0;end;end;f:=ligz[h];end;{:95}{96:}
+function organize:boolean;label 9999,30;var tfmptr:index;begin{20:}
+read(tfmfile,tfm[0]);if tfm[0]>127 then begin writeln(
+'The first byte of the input file exceeds 127!');
+writeln('Sorry, but I can''t go on; are you sure this is a TFM?');
+goto 9999;end;if eof(tfmfile)then begin writeln(
+'The input file is only one byte long!');
+writeln('Sorry, but I can''t go on; are you sure this is a TFM?');
+goto 9999;end;read(tfmfile,tfm[1]);lf:=tfm[0]*256+tfm[1];
+if lf=0 then begin writeln(
+'The file claims to have length zero, but that''s impossible!');
+writeln('Sorry, but I can''t go on; are you sure this is a TFM?');
+goto 9999;end;if 4*lf-1>tfmsize then begin writeln(
+'The file is bigger than I can handle!');
+writeln('Sorry, but I can''t go on; are you sure this is a TFM?');
+goto 9999;end;
+for tfmptr:=2 to 4*lf-1 do begin if eof(tfmfile)then begin writeln(
+'The file has fewer bytes than it claims!');
+writeln('Sorry, but I can''t go on; are you sure this is a TFM?');
+goto 9999;end;read(tfmfile,tfm[tfmptr]);end;
+if not eof(tfmfile)then begin writeln(
+'There''s some extra junk at the end of the TFM file,');
+writeln('but I''ll proceed as if it weren''t there.');end{:20};{21:}
+begin tfmptr:=2;begin if tfm[tfmptr]>127 then begin writeln(
+'One of the subfile sizes is negative!');
+writeln('Sorry, but I can''t go on; are you sure this is a TFM?');
+goto 9999;end;lh:=tfm[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end;
+begin if tfm[tfmptr]>127 then begin writeln(
+'One of the subfile sizes is negative!');
+writeln('Sorry, but I can''t go on; are you sure this is a TFM?');
+goto 9999;end;bc:=tfm[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end;
+begin if tfm[tfmptr]>127 then begin writeln(
+'One of the subfile sizes is negative!');
+writeln('Sorry, but I can''t go on; are you sure this is a TFM?');
+goto 9999;end;ec:=tfm[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end;
+begin if tfm[tfmptr]>127 then begin writeln(
+'One of the subfile sizes is negative!');
+writeln('Sorry, but I can''t go on; are you sure this is a TFM?');
+goto 9999;end;nw:=tfm[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end;
+begin if tfm[tfmptr]>127 then begin writeln(
+'One of the subfile sizes is negative!');
+writeln('Sorry, but I can''t go on; are you sure this is a TFM?');
+goto 9999;end;nh:=tfm[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end;
+begin if tfm[tfmptr]>127 then begin writeln(
+'One of the subfile sizes is negative!');
+writeln('Sorry, but I can''t go on; are you sure this is a TFM?');
+goto 9999;end;nd:=tfm[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end;
+begin if tfm[tfmptr]>127 then begin writeln(
+'One of the subfile sizes is negative!');
+writeln('Sorry, but I can''t go on; are you sure this is a TFM?');
+goto 9999;end;ni:=tfm[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end;
+begin if tfm[tfmptr]>127 then begin writeln(
+'One of the subfile sizes is negative!');
+writeln('Sorry, but I can''t go on; are you sure this is a TFM?');
+goto 9999;end;nl:=tfm[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end;
+begin if tfm[tfmptr]>127 then begin writeln(
+'One of the subfile sizes is negative!');
+writeln('Sorry, but I can''t go on; are you sure this is a TFM?');
+goto 9999;end;nk:=tfm[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end;
+begin if tfm[tfmptr]>127 then begin writeln(
+'One of the subfile sizes is negative!');
+writeln('Sorry, but I can''t go on; are you sure this is a TFM?');
+goto 9999;end;ne:=tfm[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end;
+begin if tfm[tfmptr]>127 then begin writeln(
+'One of the subfile sizes is negative!');
+writeln('Sorry, but I can''t go on; are you sure this is a TFM?');
+goto 9999;end;np:=tfm[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end;
+if lh<2 then begin writeln('The header length is only ',lh:1,'!');
+writeln('Sorry, but I can''t go on; are you sure this is a TFM?');
+goto 9999;end;if nl>4*ligsize then begin writeln(
+'The lig/kern program is longer than I can handle!');
+writeln('Sorry, but I can''t go on; are you sure this is a TFM?');
+goto 9999;end;
+if(bc>ec+1)or(ec>255)then begin writeln('The character code range ',bc:1
+,'..',ec:1,'is illegal!');
+writeln('Sorry, but I can''t go on; are you sure this is a TFM?');
+goto 9999;end;if(nw=0)or(nh=0)or(nd=0)or(ni=0)then begin writeln(
+'Incomplete subfiles for character dimensions!');
+writeln('Sorry, but I can''t go on; are you sure this is a TFM?');
+goto 9999;end;
+if ne>256 then begin writeln('There are ',ne:1,' extensible recipes!');
+writeln('Sorry, but I can''t go on; are you sure this is a TFM?');
+goto 9999;end;
+if lf<>6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np then begin writeln(
+'Subfile sizes don''t add up to the stated total!');
+writeln('Sorry, but I can''t go on; are you sure this is a TFM?');
+goto 9999;end;end{:21};{23:}begin charbase:=6+lh-bc;
+widthbase:=charbase+ec+1;heightbase:=widthbase+nw;
+depthbase:=heightbase+nh;italicbase:=depthbase+nd;
+ligkernbase:=italicbase+ni;kernbase:=ligkernbase+nl;
+extenbase:=kernbase+nk;parambase:=extenbase+ne-1;end{:23};
+organize:=true;goto 30;9999:organize:=false;30:end;{:96}{97:}
+procedure dosimplethings;var i:0..32767;begin{48:}begin fonttype:=0;
+if lh>=12 then begin{53:}begin checkBCPL(32,40);
+if(tfm[32]>=11)and(tfm[33]=84)and(tfm[34]=69)and(tfm[35]=88)and(tfm[36]=
+32)and(tfm[37]=77)and(tfm[38]=65)and(tfm[39]=84)and(tfm[40]=72)and(tfm[
+41]=32)then begin if(tfm[42]=83)and(tfm[43]=89)then fonttype:=1 else if(
+tfm[42]=69)and(tfm[43]=88)then fonttype:=2;end;end{:53};
+if lh>=17 then begin{55:}left;write(plfile,'FAMILY');checkBCPL(72,20);
+outBCPL(72);right{:55};if lh>=18 then{56:}begin left;
+write(plfile,'FACE');outface(95);right;for i:=18 to lh-1 do begin left;
+write(plfile,'HEADER D ',i:1);outoctal(24+4*i,4);right;end;end{:56};end;
+{54:}left;write(plfile,'CODINGSCHEME');outBCPL(32);right{:54};end;{51:}
+left;write(plfile,'DESIGNSIZE');
+if tfm[28]>127 then begin begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ','Design size ','negative','!');end;
+writeln('I''ve set it to 10 points.');write(plfile,' D 10');
+end else if(tfm[28]=0)and(tfm[29]<16)then begin begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ','Design size ','too small','!');end;
+writeln('I''ve set it to 10 points.');write(plfile,' D 10');
+end else outfix(28);right;
+write(plfile,'(COMMENT DESIGNSIZE IS IN POINTS)');outln;
+write(plfile,'(COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)');
+outln{:51};{49:}left;write(plfile,'CHECKSUM');outoctal(24,4);right{:49};
+{57:}if(lh>17)and(tfm[92]>127)then begin left;
+write(plfile,'SEVENBITSAFEFLAG TRUE');right;end{:57};end{:48};{58:}
+if np>0 then begin left;write(plfile,'FONTDIMEN');outln;
+for i:=1 to np do{60:}begin left;
+if i=1 then write(plfile,'SLANT')else begin if(tfm[4*(parambase+i)]>0)
+and(tfm[4*(parambase+i)]<255)then begin tfm[4*(parambase+i)]:=0;
+tfm[(4*(parambase+i))+1]:=0;tfm[(4*(parambase+i))+2]:=0;
+tfm[(4*(parambase+i))+3]:=0;begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ','Parameter',' ',i:1,' is too big;');end;
+writeln('I have set it to zero.');end;{61:}
+if i<=7 then case i of 2:write(plfile,'SPACE');
+3:write(plfile,'STRETCH');4:write(plfile,'SHRINK');
+5:write(plfile,'XHEIGHT');6:write(plfile,'QUAD');
+7:write(plfile,'EXTRASPACE')end else if(i<=22)and(fonttype=1)then case i
+of 8:write(plfile,'NUM1');9:write(plfile,'NUM2');
+10:write(plfile,'NUM3');11:write(plfile,'DENOM1');
+12:write(plfile,'DENOM2');13:write(plfile,'SUP1');
+14:write(plfile,'SUP2');15:write(plfile,'SUP3');16:write(plfile,'SUB1');
+17:write(plfile,'SUB2');18:write(plfile,'SUPDROP');
+19:write(plfile,'SUBDROP');20:write(plfile,'DELIM1');
+21:write(plfile,'DELIM2');
+22:write(plfile,'AXISHEIGHT')end else if(i<=13)and(fonttype=2)then if i=
+8 then write(plfile,'DEFAULTRULETHICKNESS')else write(plfile,
+'BIGOPSPACING',i-8:1)else write(plfile,'PARAMETER D ',i:1){:61};end;
+outfix(4*(parambase+i));right;end{:60};right;end;{59:}
+if(fonttype=1)and(np<>22)then writeln(
+'Unusual number of fontdimen parameters for a math symbols font (',np:1,
+' not 22).')else if(fonttype=2)and(np<>13)then writeln(
+'Unusual number of fontdimen parameters for an extension font (',np:1,
+' not 13).'){:59};{:58};{62:}
+if(tfm[4*widthbase]>0)or(tfm[4*widthbase+1]>0)or(tfm[4*widthbase+2]>0)or
+(tfm[4*widthbase+3]>0)then begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ','width[0] should be zero.');end;
+if(tfm[4*heightbase]>0)or(tfm[4*heightbase+1]>0)or(tfm[4*heightbase+2]>0
+)or(tfm[4*heightbase+3]>0)then begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ','height[0] should be zero.');end;
+if(tfm[4*depthbase]>0)or(tfm[4*depthbase+1]>0)or(tfm[4*depthbase+2]>0)or
+(tfm[4*depthbase+3]>0)then begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ','depth[0] should be zero.');end;
+if(tfm[4*italicbase]>0)or(tfm[4*italicbase+1]>0)or(tfm[4*italicbase+2]>0
+)or(tfm[4*italicbase+3]>0)then begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ','italic[0] should be zero.');end;
+for i:=0 to nw-1 do if(tfm[4*(widthbase+i)]>0)and(tfm[4*(widthbase+i)]<
+255)then begin tfm[4*(widthbase+i)]:=0;tfm[(4*(widthbase+i))+1]:=0;
+tfm[(4*(widthbase+i))+2]:=0;tfm[(4*(widthbase+i))+3]:=0;
+begin perfect:=false;if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ','Width',' ',i:1,' is too big;');end;
+writeln('I have set it to zero.');end;
+for i:=0 to nh-1 do if(tfm[4*(heightbase+i)]>0)and(tfm[4*(heightbase+i)]
+<255)then begin tfm[4*(heightbase+i)]:=0;tfm[(4*(heightbase+i))+1]:=0;
+tfm[(4*(heightbase+i))+2]:=0;tfm[(4*(heightbase+i))+3]:=0;
+begin perfect:=false;if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ','Height',' ',i:1,' is too big;');end;
+writeln('I have set it to zero.');end;
+for i:=0 to nd-1 do if(tfm[4*(depthbase+i)]>0)and(tfm[4*(depthbase+i)]<
+255)then begin tfm[4*(depthbase+i)]:=0;tfm[(4*(depthbase+i))+1]:=0;
+tfm[(4*(depthbase+i))+2]:=0;tfm[(4*(depthbase+i))+3]:=0;
+begin perfect:=false;if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ','Depth',' ',i:1,' is too big;');end;
+writeln('I have set it to zero.');end;
+for i:=0 to ni-1 do if(tfm[4*(italicbase+i)]>0)and(tfm[4*(italicbase+i)]
+<255)then begin tfm[4*(italicbase+i)]:=0;tfm[(4*(italicbase+i))+1]:=0;
+tfm[(4*(italicbase+i))+2]:=0;tfm[(4*(italicbase+i))+3]:=0;
+begin perfect:=false;if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ','Italic correction',' ',i:1,' is too big;');
+end;writeln('I have set it to zero.');end;
+if nk>0 then for i:=0 to nk-1 do if(tfm[4*(kernbase+i)]>0)and(tfm[4*(
+kernbase+i)]<255)then begin tfm[4*(kernbase+i)]:=0;
+tfm[(4*(kernbase+i))+1]:=0;tfm[(4*(kernbase+i))+2]:=0;
+tfm[(4*(kernbase+i))+3]:=0;begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ','Kern',' ',i:1,' is too big;');end;
+writeln('I have set it to zero.');end;{:62}end;{:97}{98:}
+procedure docharacters;var c:byte;k:index;ai:0..ligsize;begin{78:}
+sortptr:=0;
+for c:=bc to ec do if tfm[4*(charbase+c)]>0 then begin if charsonline=8
+then begin writeln(' ');charsonline:=1;
+end else begin if charsonline>0 then write(' ');
+charsonline:=charsonline+1;end;printoctal(c);left;
+write(plfile,'CHARACTER');outchar(c);outln;{79:}begin left;
+write(plfile,'CHARWD');
+if tfm[4*(charbase+c)]>=nw then begin perfect:=false;writeln(' ');
+write('Width',' index for character ');printoctal(c);
+writeln(' is too large;');writeln('so I reset it to zero.');
+end else outfix(4*(widthbase+tfm[4*(charbase+c)]));right;end{:79};
+if(tfm[4*(charbase+c)+1]div 16)>0 then{80:}
+if(tfm[4*(charbase+c)+1]div 16)>=nh then begin perfect:=false;
+writeln(' ');write('Height',' index for character ');printoctal(c);
+writeln(' is too large;');writeln('so I reset it to zero.');
+end else begin left;write(plfile,'CHARHT');
+outfix(4*(heightbase+(tfm[4*(charbase+c)+1]div 16)));right;end{:80};
+if(tfm[4*(charbase+c)+1]mod 16)>0 then{81:}
+if(tfm[4*(charbase+c)+1]mod 16)>=nd then begin perfect:=false;
+writeln(' ');write('Depth',' index for character ');printoctal(c);
+writeln(' is too large;');writeln('so I reset it to zero.');
+end else begin left;write(plfile,'CHARDP');
+outfix(4*(depthbase+(tfm[4*(charbase+c)+1]mod 16)));right;end{:81};
+if(tfm[4*(charbase+c)+2]div 4)>0 then{82:}
+if(tfm[4*(charbase+c)+2]div 4)>=ni then begin perfect:=false;
+writeln(' ');write('Italic correction',' index for character ');
+printoctal(c);writeln(' is too large;');
+writeln('so I reset it to zero.');end else begin left;
+write(plfile,'CHARIC');
+outfix(4*(italicbase+(tfm[4*(charbase+c)+2]div 4)));right;end{:82};
+case(tfm[4*(charbase+c)+2]mod 4)of 0:;1:{83:}begin left;
+write(plfile,'COMMENT');outln;i:=tfm[4*(charbase+c)+3];
+r:=4*(ligkernbase+(i));if tfm[r]>128 then i:=256*tfm[r+2]+tfm[r+3];
+repeat{74:}begin k:=4*(ligkernbase+(i));
+if tfm[k]>128 then begin if 256*tfm[k+2]+tfm[k+3]>=nl then begin perfect
+:=false;if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ',
+'Ligature unconditional stop command address is too big.');end;
+end else if tfm[k+2]>=128 then{76:}
+begin if((tfm[k+1]<bc)or(tfm[k+1]>ec)or(tfm[4*(charbase+tfm[k+1])]=0))
+then if tfm[k+1]<>boundarychar then begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+write('Bad TFM file: ','Kern step for',' nonexistent character ');
+printoctal(tfm[k+1]);writeln('.');tfm[k+1]:=bc;end;left;
+write(plfile,'KRN');outchar(tfm[k+1]);r:=256*(tfm[k+2]-128)+tfm[k+3];
+if r>=nk then begin begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ','Kern index too large.');end;
+write(plfile,' R 0.0');end else outfix(4*(kernbase+r));right;end{:76}
+else{77:}
+begin if((tfm[k+1]<bc)or(tfm[k+1]>ec)or(tfm[4*(charbase+tfm[k+1])]=0))
+then if tfm[k+1]<>boundarychar then begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+write('Bad TFM file: ','Ligature step for',' nonexistent character ');
+printoctal(tfm[k+1]);writeln('.');tfm[k+1]:=bc;end;
+if((tfm[k+3]<bc)or(tfm[k+3]>ec)or(tfm[4*(charbase+tfm[k+3])]=0))then
+begin perfect:=false;if charsonline>0 then writeln(' ');charsonline:=0;
+write('Bad TFM file: ','Ligature step produces the',
+' nonexistent character ');printoctal(tfm[k+3]);writeln('.');
+tfm[k+3]:=bc;end;left;r:=tfm[k+2];
+if(r=4)or((r>7)and(r<>11))then begin writeln(
+'Ligature step with nonstandard code changed to LIG');r:=0;tfm[k+2]:=0;
+end;if r mod 4>1 then write(plfile,'/');write(plfile,'LIG');
+if odd(r)then write(plfile,'/');while r>3 do begin write(plfile,'>');
+r:=r-4;end;outchar(tfm[k+1]);outchar(tfm[k+3]);right;end{:77};
+if tfm[k]>0 then if level=1 then{75:}
+begin if tfm[k]>=128 then write(plfile,'(STOP)')else begin count:=0;
+for ai:=i+1 to i+tfm[k]do if activity[ai]=2 then count:=count+1;
+write(plfile,'(SKIP D ',count:1,')');end;outln;end{:75};end{:74};
+if tfm[k]>=128 then i:=nl else i:=i+1+tfm[k];until i>=nl;right;end{:83};
+2:{84:}begin r:=tfm[4*(charbase+c)+3];
+if((r<bc)or(r>ec)or(tfm[4*(charbase+r)]=0))then begin begin perfect:=
+false;if charsonline>0 then writeln(' ');charsonline:=0;
+write('Bad TFM file: ','Character list link to',
+' nonexistent character ');printoctal(r);writeln('.');end;
+tfm[4*(charbase+c)+2]:=4*(tfm[4*(charbase+c)+2]div 4)+0;
+end else begin while(r<c)and((tfm[4*(charbase+r)+2]mod 4)=2)do r:=tfm[4*
+(charbase+r)+3];if r=c then begin begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ','Cycle in a character list!');end;
+write('Character ');printoctal(c);writeln(' now ends the list.');
+tfm[4*(charbase+c)+2]:=4*(tfm[4*(charbase+c)+2]div 4)+0;
+end else begin left;write(plfile,'NEXTLARGER');
+outchar(tfm[4*(charbase+c)+3]);right;end;end;end{:84};3:{85:}
+if tfm[4*(charbase+c)+3]>=ne then begin begin perfect:=false;
+writeln(' ');write('Extensible',' index for character ');printoctal(c);
+writeln(' is too large;');writeln('so I reset it to zero.');end;
+tfm[4*(charbase+c)+2]:=4*(tfm[4*(charbase+c)+2]div 4)+0;
+end else begin left;write(plfile,'VARCHAR');outln;{86:}
+for k:=0 to 3 do if(k=3)or(tfm[4*(extenbase+tfm[4*(charbase+c)+3])+k]>0)
+then begin left;case k of 0:write(plfile,'TOP');1:write(plfile,'MID');
+2:write(plfile,'BOT');3:write(plfile,'REP')end;
+if((tfm[4*(extenbase+tfm[4*(charbase+c)+3])+k]<bc)or(tfm[4*(extenbase+
+tfm[4*(charbase+c)+3])+k]>ec)or(tfm[4*(charbase+tfm[4*(extenbase+tfm[4*(
+charbase+c)+3])+k])]=0))then outchar(c)else outchar(tfm[4*(extenbase+tfm
+[4*(charbase+c)+3])+k]);right;end{:86};right;end{:85};end;right;end{:78}
+;end;{:98}{99:}begin initialize;if not organize then goto 9999;
+dosimplethings;{66:}
+if nl>0 then begin for ai:=0 to nl-1 do activity[ai]:=0;{69:}
+if tfm[4*(ligkernbase+(0))]=255 then begin left;
+write(plfile,'BOUNDARYCHAR');boundarychar:=tfm[4*(ligkernbase+(0))+1];
+outchar(boundarychar);right;activity[0]:=1;end;
+if tfm[4*(ligkernbase+(nl-1))]=255 then begin r:=256*tfm[4*(ligkernbase+
+(nl-1))+2]+tfm[4*(ligkernbase+(nl-1))+3];
+if r>=nl then begin perfect:=false;writeln(' ');
+write('Ligature/kern starting index for boundarychar is too large;');
+writeln('so I removed it.');end else begin labelptr:=1;
+labeltable[1].cc:=256;labeltable[1].rr:=r;bcharlabel:=r;activity[r]:=2;
+end;activity[nl-1]:=1;end{:69};end;{67:}
+for c:=bc to ec do if(tfm[4*(charbase+c)+2]mod 4)=1 then begin r:=tfm[4*
+(charbase+c)+3];
+if r<nl then begin if tfm[4*(ligkernbase+(r))]>128 then begin r:=256*tfm
+[4*(ligkernbase+(r))+2]+tfm[4*(ligkernbase+(r))+3];
+if r<nl then if activity[tfm[4*(charbase+c)+3]]=0 then activity[tfm[4*(
+charbase+c)+3]]:=1;end;end;if r>=nl then begin perfect:=false;
+writeln(' ');write('Ligature/kern starting index for character ');
+printoctal(c);writeln(' is too large;');writeln('so I removed it.');
+tfm[4*(charbase+c)+2]:=4*(tfm[4*(charbase+c)+2]div 4)+0;end else{68:}
+begin sortptr:=labelptr;
+while labeltable[sortptr].rr>r do begin labeltable[sortptr+1]:=
+labeltable[sortptr];sortptr:=sortptr-1;end;labeltable[sortptr+1].cc:=c;
+labeltable[sortptr+1].rr:=r;labelptr:=labelptr+1;activity[r]:=2;end{:68}
+;end;labeltable[labelptr+1].rr:=ligsize;{:67};if nl>0 then begin left;
+write(plfile,'LIGTABLE');outln;{70:}
+for ai:=0 to nl-1 do if activity[ai]=2 then begin r:=tfm[4*(ligkernbase+
+(ai))];if r<128 then begin r:=r+ai+1;
+if r>=nl then begin begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ','Ligature/kern step ',ai:1,' skips too far;');
+end;writeln('I made it stop.');tfm[4*(ligkernbase+(ai))]:=128;
+end else activity[r]:=2;end;end{:70};{71:}sortptr:=1;
+for acti:=0 to nl-1 do if activity[acti]<>1 then begin i:=acti;{73:}
+if activity[i]=0 then begin if level=1 then begin left;
+write(plfile,'COMMENT THIS PART OF THE PROGRAM IS NEVER USED!');outln;
+end end else if level=2 then right{:73};{72:}
+while i=labeltable[sortptr].rr do begin left;write(plfile,'LABEL');
+if labeltable[sortptr].cc=256 then write(plfile,' BOUNDARYCHAR')else
+outchar(labeltable[sortptr].cc);right;sortptr:=sortptr+1;end{:72};{74:}
+begin k:=4*(ligkernbase+(i));
+if tfm[k]>128 then begin if 256*tfm[k+2]+tfm[k+3]>=nl then begin perfect
+:=false;if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ',
+'Ligature unconditional stop command address is too big.');end;
+end else if tfm[k+2]>=128 then{76:}
+begin if((tfm[k+1]<bc)or(tfm[k+1]>ec)or(tfm[4*(charbase+tfm[k+1])]=0))
+then if tfm[k+1]<>boundarychar then begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+write('Bad TFM file: ','Kern step for',' nonexistent character ');
+printoctal(tfm[k+1]);writeln('.');tfm[k+1]:=bc;end;left;
+write(plfile,'KRN');outchar(tfm[k+1]);r:=256*(tfm[k+2]-128)+tfm[k+3];
+if r>=nk then begin begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad TFM file: ','Kern index too large.');end;
+write(plfile,' R 0.0');end else outfix(4*(kernbase+r));right;end{:76}
+else{77:}
+begin if((tfm[k+1]<bc)or(tfm[k+1]>ec)or(tfm[4*(charbase+tfm[k+1])]=0))
+then if tfm[k+1]<>boundarychar then begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+write('Bad TFM file: ','Ligature step for',' nonexistent character ');
+printoctal(tfm[k+1]);writeln('.');tfm[k+1]:=bc;end;
+if((tfm[k+3]<bc)or(tfm[k+3]>ec)or(tfm[4*(charbase+tfm[k+3])]=0))then
+begin perfect:=false;if charsonline>0 then writeln(' ');charsonline:=0;
+write('Bad TFM file: ','Ligature step produces the',
+' nonexistent character ');printoctal(tfm[k+3]);writeln('.');
+tfm[k+3]:=bc;end;left;r:=tfm[k+2];
+if(r=4)or((r>7)and(r<>11))then begin writeln(
+'Ligature step with nonstandard code changed to LIG');r:=0;tfm[k+2]:=0;
+end;if r mod 4>1 then write(plfile,'/');write(plfile,'LIG');
+if odd(r)then write(plfile,'/');while r>3 do begin write(plfile,'>');
+r:=r-4;end;outchar(tfm[k+1]);outchar(tfm[k+3]);right;end{:77};
+if tfm[k]>0 then if level=1 then{75:}
+begin if tfm[k]>=128 then write(plfile,'(STOP)')else begin count:=0;
+for ai:=i+1 to i+tfm[k]do if activity[ai]=2 then count:=count+1;
+write(plfile,'(SKIP D ',count:1,')');end;outln;end{:75};end{:74};end;
+if level=2 then right{:71};right;{90:}hashptr:=0;yligcycle:=256;
+for hh:=0 to hashsize do hash[hh]:=0;
+for c:=bc to ec do if(tfm[4*(charbase+c)+2]mod 4)=1 then begin i:=tfm[4*
+(charbase+c)+3];
+if tfm[4*(ligkernbase+(i))]>128 then i:=256*tfm[4*(ligkernbase+(i))+2]+
+tfm[4*(ligkernbase+(i))+3];{91:}repeat hashinput;
+k:=tfm[4*(ligkernbase+(i))];if k>=128 then i:=nl else i:=i+1+k;
+until i>=nl{:91};end;if bcharlabel<nl then begin c:=256;i:=bcharlabel;
+{91:}repeat hashinput;k:=tfm[4*(ligkernbase+(i))];
+if k>=128 then i:=nl else i:=i+1+k;until i>=nl{:91};end;
+if hashptr=hashsize then begin writeln(
+'Sorry, I haven''t room for so many ligature/kern pairs!');goto 9999;
+end;for hh:=1 to hashptr do begin r:=hashlist[hh];
+if class[r]>0 then r:=f(r,(hash[r]-1)div 256,(hash[r]-1)mod 256);end;
+if yligcycle<256 then begin write(
+'Infinite ligature loop starting with ');
+if xligcycle=256 then write('boundary')else printoctal(xligcycle);
+write(' and ');printoctal(yligcycle);writeln('!');
+write(plfile,'(INFINITE LIGATURE LOOP MUST BE BROKEN!)');goto 9999;
+end{:90};end{:66};{87:}
+if ne>0 then for c:=0 to ne-1 do for d:=0 to 3 do begin k:=4*(extenbase+
+c)+d;if(tfm[k]>0)or(d=3)then begin if((tfm[k]<bc)or(tfm[k]>ec)or(tfm[4*(
+charbase+tfm[k])]=0))then begin begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+write('Bad TFM file: ','Extensible recipe involves the',
+' nonexistent character ');printoctal(tfm[k]);writeln('.');end;
+if d<3 then tfm[k]:=0;end;end;end{:87};docharacters;writeln('.');
+if level<>0 then writeln('This program isn''t working!');
+if not perfect then write(plfile,
+'(COMMENT THE TFM FILE WAS BAD, SO THE DATA HAS BEEN CHANGED!)');
+9999:writeln(' ');end.{:99}
diff --git a/systems/knuth/local/texware/tftopl.pool b/systems/knuth/local/texware/tftopl.pool
new file mode 100644
index 0000000000..f6df1aa211
--- /dev/null
+++ b/systems/knuth/local/texware/tftopl.pool
@@ -0,0 +1,2 @@
+11texwarext.h
+*039917878