summaryrefslogtreecommitdiff
path: root/systems/knuth/local/etc
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/etc
Initial commit
Diffstat (limited to 'systems/knuth/local/etc')
-rw-r--r--systems/knuth/local/etc/Makefile46
-rw-r--r--systems/knuth/local/etc/dvityext.h17
-rw-r--r--systems/knuth/local/etc/texwarext.h5
-rw-r--r--systems/knuth/local/etc/vftovp.ch227
-rw-r--r--systems/knuth/local/etc/vftovp.p807
-rw-r--r--systems/knuth/local/etc/vptovf.ch108
-rw-r--r--systems/knuth/local/etc/vptovf.p1112
7 files changed, 2322 insertions, 0 deletions
diff --git a/systems/knuth/local/etc/Makefile b/systems/knuth/local/etc/Makefile
new file mode 100644
index 0000000000..7917e58eca
--- /dev/null
+++ b/systems/knuth/local/etc/Makefile
@@ -0,0 +1,46 @@
+# Make executable files for this workstation, using the master TeX sources
+
+PFLAGS= -g -I..
+CFLAGS= -g -I..
+PC= gpc
+
+all: vftovp vptovf
+
+%.p: %.ch
+ tangle ../../dist/etc/$*.web $*.ch
+# the next line formerly necessary; but not with Linux's (Web2C) tangle
+# mv ../../dist/etc/$*.p .
+
+%.ch: ../../dist/etc/%.web
+ touch $*.ch
+
+%.o: %.p
+ ${PC} ${PFLAGS} -c $*.p
+
+dvityext.c: ../texware/dvityext.c
+ cp ../texware/dvityext.c .
+
+texwarext.h: ../texware/texwarext.h
+ cp ../texware/texwarext.h .
+
+dvityext.h: ../texware/dvityext.h
+ cp ../texware/dvityext.h .
+
+vftovp: vftovp.o dvityext.o
+ ${PC} ${PFLAGS} -o vftovp vftovp.o dvityext.o
+
+vptovf: vptovf.o
+ ${PC} ${PFLAGS} -o vptovf vptovf.o dvityext.o
+
+dvityext.o: dvityext.c ../GPCtypes.h ../texpaths.h
+
+vptovf.o: texwarext.h
+
+vftovp.o: dvityext.h
+
+install: # doit make install "PROG=vftovp"
+ mv $(PROG) /usr/local/bin/$(PROG)
+
+clean:
+# rm -f *.p *.o *~ dvityext.c ../../dist/etc/*.pool
+ rm -f *.p *.o *~ dvityext.c *.pool core texwarext.h
diff --git a/systems/knuth/local/etc/dvityext.h b/systems/knuth/local/etc/dvityext.h
new file mode 100644
index 0000000000..ab9a63da75
--- /dev/null
+++ b/systems/knuth/local/etc/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/etc/texwarext.h b/systems/knuth/local/etc/texwarext.h
new file mode 100644
index 0000000000..a183a12814
--- /dev/null
+++ b/systems/knuth/local/etc/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/etc/vftovp.ch b/systems/knuth/local/etc/vftovp.ch
new file mode 100644
index 0000000000..d529a97d10
--- /dev/null
+++ b/systems/knuth/local/etc/vftovp.ch
@@ -0,0 +1,227 @@
+% Change file for the VFtoVP processor, for use with GNU Pascal
+% (by Don Knuth; see ../etc-sparc for its prehistory)
+
+% History:
+% 2000.04.30 Initial version
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [0] WEAVE: print changes only
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{VF\lowercase{to}VP changes for GNU Pascal}
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [1] Change banner string
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@d banner=='This is VFtoVP, Version 1.2' {printed when the program starts}
+@y
+@d banner=='This is VFtoVP, Version 1.2 for Linux'
+ {printed when the program starts}
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [2] Fix files in program statement; add external access procedures
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@p program VFtoVP(@!vf_file,@!tfm_file,@!vpl_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 VFtoVP(@!output);
+label @<Labels in the outer block@>@/
+const @<Constants in the outer block@>@/
+type UNIX_file_name=packed array[1..100] of char;
+byte_file=packed file of ByteCard;
+ @<Types in the outer block@>@/
+var @<Globals in the outer block@>@/
+@\
+@=#include "dvityext.h"@>
+@\@/
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [3] Add a label
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@<Labels...@>=final_end;
+@y
+@<Labels...@>=final_end-1, final_end;
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [4] 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
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [7] Fix declaration of vf_file; declare extra VF-file variables
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@!vf_file:packed file of byte;
+@y
+@!vf_file:byte_file; {files that contain binary data}
+@!vf_name:UNIX_file_name;
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [10] Fix declaration of tfm_file; declare extra TFM-file variables
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@!tfm_file:packed file of byte;
+@y
+@!tfm_file:byte_file; {files that contain binary data}
+@!tfm_name:UNIX_file_name;
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [11] Open binary files
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@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); reset(vf_file);
+@y
+@ On some systems you may have to do something special to read a
+packed file of bytes.
+
+@<Set init...@>=
+if argc < 4 then begin
+ print_ln('Usage: vftovp <vf-file> <tfm-file> <vpl-file>');
+ goto final_end-1;
+end;
+argv(1, vf_name); argv(2, tfm_name);
+if testreadaccess(vf_name) then reset(vf_file, vf_name)
+else begin print_ln('I can''t read the VF file!'); goto final_end-1;
+ end;
+if testreadaccess(tfm_name) then reset(tfm_file, tfm_name)
+else begin print_ln('I can''t read the TFM file!'); goto final_end-1;
+ end;
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [20] Declare vpl_name
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@!vpl_file:text;
+@y
+@!vpl_file:text;
+@!vpl_name: UNIX_file_name;
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [21] Open VPL file
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@ @<Set init...@>=
+rewrite(vpl_file);
+@y
+@ @<Set init...@>=
+setpaths; {read environment, to find TEXFONTS, if there}
+argv(3, vpl_name);
+rewrite(vpl_file, vpl_name);
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [37] Declare real_name_of_file
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@!cur_name:packed array[1..name_length] of char; {external name,
+ with no lower case letters}
+@y
+@!cur_name,@!real_name_of_file:external UNIX_file_name;
+ {external names}
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [39] Open a local TFM file using the normal font paths
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+reset(tfm_file,cur_name);
+@^system dependencies@>
+if eof(tfm_file) then
+ print_ln('---not loaded, TFM file can''t be opened!')
+@.TFM file can\'t be opened@>
+else begin font_bc:=0; font_ec:=256; {will cause error if not modified soon}
+@y
+if not testaccess(4,3) then
+ print_ln('---not loaded, TFM file can''t be opened!')
+@.TFM file can\'t be opened@>
+else begin reset(tfm_file,real_name_of_file);
+ font_bc:=0; font_ec:=256; {will cause error if not modified soon}
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [42] 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
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [43] 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 a=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 (vf[k]>="a")and(vf[k]<="z") then
+ cur_name[r]:=xchr[vf[k]-@'40]
+ else cur_name[r]:=xchr[vf[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[vf[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
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [133] Add printing of newlines at end of program
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+final_end:end.
+@y
+final_end: out_ln; final_end-1: print_ln(' '); end.
+@z
diff --git a/systems/knuth/local/etc/vftovp.p b/systems/knuth/local/etc/vftovp.p
new file mode 100644
index 0000000000..df8f5f78b7
--- /dev/null
+++ b/systems/knuth/local/etc/vftovp.p
@@ -0,0 +1,807 @@
+{2:}program VFtoVP(output);label{3:}9998,9999;{:3}const{4:}
+tfmsize=30000;vfsize=10000;maxfonts=300;ligsize=5000;hashsize=5003;
+namelength=100;maxstack=50;{:4}
+type UNIXfilename=packed array[1..100]of char;
+bytefile=packed file of ByteCard;{5:}byte=0..255;{:5}{22:}
+index=0..tfmsize;{:22}var{7:}vffile:bytefile;vfname:UNIXfilename;{:7}
+{10:}tfmfile:bytefile;tfmname:UNIXfilename;{:10}{12:}
+lf,lh,bc,ec,nw,nh,nd,ni,nl,nk,ne,np:0..32767;{:12}{20:}vplfile:text;
+vplname:UNIXfilename;{:20}{23:}tfm:array[-1000..tfmsize]of byte;{:23}
+{26:}
+charbase,widthbase,heightbase,depthbase,italicbase,ligkernbase,kernbase,
+extenbase,parambase:integer;{:26}{29:}fonttype:0..2;{:29}{30:}
+vf:array[0..vfsize]of byte;fontnumber:array[0..maxfonts]of integer;
+fontstart,fontchars:array[0..maxfonts]of 0..vfsize;fontptr:0..maxfonts;
+packetstart,packetend:array[byte]of 0..vfsize;packetfound:boolean;
+tempbyte:byte;count:integer;realdsize:real;pl:integer;vfptr:0..vfsize;
+vfcount:integer;{:30}{37:}a:integer;l:integer;
+curname,realnameoffile:external UNIXfilename;b0,b1,b2,b3:byte;
+fontlh:0..32767;fontbc,fontec:0..32767;{:37}{42:}
+defaultdirectory:packed array[1..9]of char;{:42}{49:}
+ASCII04,ASCII10,ASCII14:packed array[1..32]of char;
+xchr:packed array[0..255]of char;
+MBLstring,RIstring,RCEstring:packed array[1..3]of char;{:49}{51:}
+dig:array[0..11]of 0..9;{:51}{54:}level:0..5;{:54}{67:}charsonline:0..8;
+perfect:boolean;{:67}{69:}i:0..32767;c:0..256;d:0..3;k:index;r:0..65535;
+{:69}{85:}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;
+{:85}{87:}activity:array[0..ligsize]of 0..2;ai,acti:0..ligsize;{:87}
+{111:}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;{:111}{123:}top:0..maxstack;
+wstack,xstack,ystack,zstack:array[0..maxstack]of integer;
+vflimit:0..vfsize;o:byte;{:123}
+#include "dvityext.h"
+procedure initialize;var k:integer;
+begin writeln('This is VFtoVP, Version 1.2 for Linux');{11:}
+if argc<4 then begin writeln(
+'Usage: vftovp <vf-file> <tfm-file> <vpl-file>');goto 9998;end;
+argv(1,vfname);argv(2,tfmname);
+if testreadaccess(vfname)then reset(vffile,vfname)else begin writeln(
+'I can''t read the VF file!');goto 9998;end;
+if testreadaccess(tfmname)then reset(tfmfile,tfmname)else begin writeln(
+'I can''t read the TFM file!');goto 9998;end;{:11}{21:}setpaths;
+argv(3,vplname);rewrite(vplfile,vplname);{:21}{50:}
+ASCII04:=' !"#$%&''()*+,-./0123456789:;<=>?';
+ASCII10:='@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_';
+ASCII14:='`abcdefghijklmnopqrstuvwxyz{|}~?';
+for k:=0 to 255 do xchr[k]:='?';
+for k:=0 to 31 do begin xchr[k+32]:=ASCII04[k+1];
+xchr[k+64]:=ASCII10[k+1];xchr[k+96]:=ASCII14[k+1];end;MBLstring:='MBL';
+RIstring:='RI ';RCEstring:='RCE';{:50}{55:}level:=0;{:55}{68:}
+charsonline:=0;perfect:=true;{:68}{86:}boundarychar:=256;
+bcharlabel:=32767;labelptr:=0;labeltable[0].rr:=0;{:86}end;{:2}{38:}
+procedure readtfmword;
+begin if eof(tfmfile)then b0:=0 else read(tfmfile,b0);
+if eof(tfmfile)then b1:=0 else read(tfmfile,b1);
+if eof(tfmfile)then b2:=0 else read(tfmfile,b2);
+if eof(tfmfile)then b3:=0 else read(tfmfile,b3);end;{:38}{45:}
+function vfread(k:integer):integer;var b:byte;a:integer;
+begin vfcount:=vfcount+k;if eof(vffile)then b:=0 else read(vffile,b);
+a:=b;if k=4 then if b>=128 then a:=a-256;
+while k>1 do begin if eof(vffile)then b:=0 else read(vffile,b);
+a:=256*a+b;k:=k-1;end;vfread:=a;end;{:45}{47:}
+function tfmwidth(c:byte):integer;var a:integer;k:index;
+begin k:=4*(widthbase+tfm[4*(charbase+c)]);a:=tfm[k];
+if a>=128 then a:=a-256;
+tfmwidth:=((256*a+tfm[k+1])*256+tfm[k+2])*256+tfm[k+3];end;{:47}{52:}
+procedure outdigs(j:integer);begin repeat j:=j-1;
+write(vplfile,dig[j]:1);until j=0;end;procedure printdigs(j:integer);
+begin repeat j:=j-1;write(dig[j]:1);until j=0;end;{:52}{53:}
+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;
+{:53}{56:}procedure outln;var l:0..5;begin writeln(vplfile);
+for l:=1 to level do write(vplfile,' ');end;procedure left;
+begin level:=level+1;write(vplfile,'(');end;procedure right;
+begin level:=level-1;write(vplfile,')');outln;end;{:56}{57:}
+procedure outBCPL(k:index);var l:0..39;begin write(vplfile,' ');
+l:=tfm[k];while l>0 do begin k:=k+1;l:=l-1;write(vplfile,xchr[tfm[k]]);
+end;end;{:57}{58:}procedure outoctal(k,l:index);var a:0..1023;b:0..32;
+j:0..11;begin write(vplfile,' O ');a:=0;b:=0;j:=0;while l>0 do{59:}
+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{:59};
+while(a>0)or(j=0)do begin dig[j]:=a mod 8;a:=a div 8;j:=j+1;end;
+outdigs(j);end;{:58}{60:}procedure outchar(c:byte);
+begin if fonttype>0 then begin tfm[0]:=c;
+outoctal(0,1)end else if((c>=48)and(c<=57))or((c>=65)and(c<=90))or((c>=
+97)and(c<=122))then write(vplfile,' C ',xchr[c])else begin tfm[0]:=c;
+outoctal(0,1);end;end;{:60}{61:}procedure outface(k:index);var s:0..1;
+b:0..8;
+begin if tfm[k]>=18 then outoctal(k,1)else begin write(vplfile,' F ');
+s:=tfm[k]mod 2;b:=tfm[k]div 2;write(vplfile,MBLstring[1+(b mod 3)]);
+write(vplfile,RIstring[1+s]);write(vplfile,RCEstring[1+(b div 3)]);end;
+end;{:61}{62:}procedure outfix(k:index);var a:0..4095;f:integer;j:0..12;
+delta:integer;begin write(vplfile,' 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{65:}
+begin write(vplfile,'-');a:=4096-a;if f>0 then begin f:=1048576-f;
+a:=a-1;end;end{:65};{63:}begin j:=0;repeat dig[j]:=a mod 10;a:=a div 10;
+j:=j+1;until a=0;outdigs(j);end{:63};{64:}begin write(vplfile,'.');
+f:=10*f+5;delta:=10;
+repeat if delta>1048576 then f:=f+524288-(delta div 2);
+write(vplfile,f div 1048576:1);f:=10*(f mod 1048576);delta:=delta*10;
+until f<=delta;end;{:64};end;{:62}{74:}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;
+{:74}{114:}procedure hashinput;label 10;var cc:0..3;zz:0..255;y:0..255;
+key:integer;t:integer;begin if hashptr=hashsize then goto 10;{115:}
+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{:115};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 10;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;10:end;{:114}{116:}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;{:116}{117:}
+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;{:117}
+{118:}function stringbalance(k,l:integer):boolean;label 45,10;
+var j,bal:integer;begin if l>0 then if vf[k]=32 then goto 45;bal:=0;
+for j:=k to k+l-1 do begin if(vf[j]<32)or(vf[j]>=127)then goto 45;
+if vf[j]=40 then bal:=bal+1 else if vf[j]=41 then if bal=0 then goto 45
+else bal:=bal-1;end;if bal>0 then goto 45;stringbalance:=true;goto 10;
+45:stringbalance:=false;10:end;{:118}{120:}
+procedure outasfix(x:integer);var k:1..3;
+begin if abs(x)>=16777216 then begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad VF file: ','Oversize dimension has been reset to zero.');
+end;if x>=0 then tfm[28]:=0 else begin tfm[28]:=255;x:=x+16777216;end;
+for k:=3 downto 1 do begin tfm[28+k]:=x mod 256;x:=x div 256;end;
+outfix(28);end;{:120}{125:}function getbytes(k:integer;
+signed:boolean):integer;var a:integer;
+begin if vfptr+k>vflimit then begin begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad VF file: ','Packet ended prematurely');end;
+k:=vflimit-vfptr;end;a:=vf[vfptr];
+if(k=4)or signed then if a>=128 then a:=a-256;vfptr:=vfptr+1;
+while k>1 do begin a:=a*256+vf[vfptr];vfptr:=vfptr+1;k:=k-1;end;
+getbytes:=a;end;{:125}{131:}function vfinput:boolean;label 9999,10;
+var vfptr:0..vfsize;k:integer;c:integer;begin{31:}read(vffile,tempbyte);
+if tempbyte<>247 then begin writeln('The first byte isn''t `pre''!');
+writeln('Sorry, but I can''t go on; are you sure this is a VF?');
+goto 9999;end;{32:}
+if eof(vffile)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 VF?');
+goto 9999;end;read(vffile,tempbyte);if tempbyte<>202 then begin writeln(
+'Wrong VF version number in second byte!');
+writeln('Sorry, but I can''t go on; are you sure this is a VF?');
+goto 9999;end;if eof(vffile)then begin writeln(
+'The input file is only two bytes long!');
+writeln('Sorry, but I can''t go on; are you sure this is a VF?');
+goto 9999;end;read(vffile,tempbyte);vfcount:=11;vfptr:=0;
+if vfptr+tempbyte>=vfsize 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 VF?');
+goto 9999;end;
+for k:=vfptr to vfptr+tempbyte-1 do begin if eof(vffile)then begin
+writeln('The file ended prematurely!');
+writeln('Sorry, but I can''t go on; are you sure this is a VF?');
+goto 9999;end;read(vffile,vf[k]);end;vfcount:=vfcount+tempbyte;
+vfptr:=vfptr+tempbyte;for k:=0 to vfptr-1 do write(xchr[vf[k]]);
+writeln(' ');count:=0;
+for k:=0 to 7 do begin if eof(vffile)then begin writeln(
+'The file ended prematurely!');
+writeln('Sorry, but I can''t go on; are you sure this is a VF?');
+goto 9999;end;read(vffile,tempbyte);
+if tempbyte=tfm[24+k]then count:=count+1;end;
+realdsize:=(((tfm[28]*256+tfm[29])*256+tfm[30])*256+tfm[31])/1048576;
+if count<>8 then begin writeln('Check sum and/or design size mismatch.')
+;writeln('Data from TFM file will be assumed correct.');end{:32};{33:}
+for k:=0 to 255 do packetstart[k]:=vfsize;fontptr:=0;packetfound:=false;
+fontstart[0]:=vfptr;repeat if eof(vffile)then begin writeln(
+'File ended without a postamble!');tempbyte:=248;
+end else begin read(vffile,tempbyte);vfcount:=vfcount+1;
+if tempbyte<>248 then if tempbyte>242 then{35:}
+begin if packetfound or(tempbyte>=247)then begin writeln('Illegal byte '
+,tempbyte:1,' at beginning of character packet!');
+writeln('Sorry, but I can''t go on; are you sure this is a VF?');
+goto 9999;end;fontnumber[fontptr]:=vfread(tempbyte-242);
+if fontptr=maxfonts then begin writeln(
+'I can''t handle that many fonts!');
+writeln('Sorry, but I can''t go on; are you sure this is a VF?');
+goto 9999;end;if vfptr+14>=vfsize 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 VF?');
+goto 9999;end;
+for k:=vfptr to vfptr+13 do begin if eof(vffile)then begin writeln(
+'The file ended prematurely!');
+writeln('Sorry, but I can''t go on; are you sure this is a VF?');
+goto 9999;end;read(vffile,vf[k]);end;vfcount:=vfcount+14;
+vfptr:=vfptr+14;
+if vf[vfptr-10]>0 then begin writeln('Mapped font size is too big!');
+writeln('Sorry, but I can''t go on; are you sure this is a VF?');
+goto 9999;end;a:=vf[vfptr-2];l:=vf[vfptr-1];
+if vfptr+a+l>=vfsize 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 VF?');
+goto 9999;end;
+for k:=vfptr to vfptr+a+l-1 do begin if eof(vffile)then begin writeln(
+'The file ended prematurely!');
+writeln('Sorry, but I can''t go on; are you sure this is a VF?');
+goto 9999;end;read(vffile,vf[k]);end;vfcount:=vfcount+a+l;
+vfptr:=vfptr+a+l;{36:}write('MAPFONT ',fontptr:1,': ');
+for k:=fontstart[fontptr]+14 to vfptr-1 do write(xchr[vf[k]]);
+k:=fontstart[fontptr]+5;
+writeln(' at ',(((vf[k]*256+vf[k+1])*256+vf[k+2])/1048576)*realdsize:2:2
+,'pt'){:36};{39:}fontchars[fontptr]:=vfptr;{44:}
+for k:=1 to namelength do curname[k]:=' ';r:=0;
+for k:=fontstart[fontptr]+14 to vfptr-1 do begin r:=r+1;
+if r+4>namelength then begin writeln('Font name too long for me!');
+writeln('Sorry, but I can''t go on; are you sure this is a VF?');
+goto 9999;end;curname[r]:=xchr[vf[k]];end;curname[r+1]:='.';
+curname[r+2]:='t';curname[r+3]:='f';curname[r+4]:='m';
+curname[r+5]:=chr(0);{:44};
+if not testaccess(4,3)then writeln(
+'---not loaded, TFM file can''t be opened!')else begin reset(tfmfile,
+realnameoffile);fontbc:=0;fontec:=256;readtfmword;
+if b2<128 then begin fontlh:=b2*256+b3;readtfmword;
+if(b0<128)and(b2<128)then begin fontbc:=b0*256+b1;fontec:=b2*256+b3;end;
+end;if fontbc<=fontec then if fontec>255 then writeln(
+'---not loaded, bad TFM file!')else begin for k:=0 to 3+fontlh do begin
+readtfmword;if k=4 then{40:}
+if b0+b1+b2+b3>0 then if(b0<>vf[fontstart[fontptr]])or(b1<>vf[fontstart[
+fontptr]+1])or(b2<>vf[fontstart[fontptr]+2])or(b3<>vf[fontstart[fontptr]
++3])then begin writeln(
+'Check sum in VF file being replaced by TFM check sum');
+vf[fontstart[fontptr]]:=b0;vf[fontstart[fontptr]+1]:=b1;
+vf[fontstart[fontptr]+2]:=b2;vf[fontstart[fontptr]+3]:=b3;end{:40};
+if k=5 then{41:}
+if(b0<>vf[fontstart[fontptr]+8])or(b1<>vf[fontstart[fontptr]+9])or(b2<>
+vf[fontstart[fontptr]+10])or(b3<>vf[fontstart[fontptr]+11])then begin
+writeln('Design size in VF file being replaced by TFM design size');
+vf[fontstart[fontptr]+8]:=b0;vf[fontstart[fontptr]+9]:=b1;
+vf[fontstart[fontptr]+10]:=b2;vf[fontstart[fontptr]+11]:=b3;end{:41};
+end;for k:=fontbc to fontec do begin readtfmword;
+if b0>0 then begin vf[vfptr]:=k;vfptr:=vfptr+1;
+if vfptr=vfsize then begin writeln('I''m out of VF memory!');
+writeln('Sorry, but I can''t go on; are you sure this is a VF?');
+goto 9999;end;end;end;end;if eof(tfmfile)then writeln(
+'---trouble is brewing, TFM file ended too soon!');end;
+vfptr:=vfptr+1{:39};fontptr:=fontptr+1;fontstart[fontptr]:=vfptr;
+end{:35}else{46:}begin if tempbyte=242 then begin pl:=vfread(4);
+c:=vfread(4);count:=vfread(4);end else begin pl:=tempbyte;c:=vfread(1);
+count:=vfread(3);end;
+if((c<bc)or(c>ec)or(tfm[4*(charbase+c)]=0))then begin writeln(
+'Character ',c:1,' does not exist!');
+writeln('Sorry, but I can''t go on; are you sure this is a VF?');
+goto 9999;end;if packetstart[c]<vfsize then writeln(
+'Discarding earlier packet for character ',c:1);
+if count<>tfmwidth(c)then writeln('Incorrect TFM width for character ',c
+:1,' in VF file');if pl<0 then begin writeln('Negative packet length!');
+writeln('Sorry, but I can''t go on; are you sure this is a VF?');
+goto 9999;end;packetstart[c]:=vfptr;
+if vfptr+pl>=vfsize 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 VF?');
+goto 9999;end;
+for k:=vfptr to vfptr+pl-1 do begin if eof(vffile)then begin writeln(
+'The file ended prematurely!');
+writeln('Sorry, but I can''t go on; are you sure this is a VF?');
+goto 9999;end;read(vffile,vf[k]);end;vfcount:=vfcount+pl;
+vfptr:=vfptr+pl;packetend[c]:=vfptr-1;packetfound:=true;end{:46};end;
+until tempbyte=248{:33};{34:}
+while(tempbyte=248)and not eof(vffile)do begin read(vffile,tempbyte);
+vfcount:=vfcount+1;end;if not eof(vffile)then begin writeln(
+'There''s some extra junk at the end of the VF file.');
+writeln('I''ll proceed as if it weren''t there.');end;
+if vfcount mod 4<>0 then writeln('VF data not a multiple of 4 bytes'){:
+34}{:31};vfinput:=true;goto 10;9999:vfinput:=false;10:end;
+function organize:boolean;label 9999,10;var tfmptr:index;begin{24:}
+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{:24};{25:}
+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{:25};{27:}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{:27};
+organize:=vfinput;goto 10;9999:organize:=false;10:end;{:131}{132:}
+procedure dosimplethings;var i:0..32767;f:0..vfsize;k:integer;
+begin{119:}if stringbalance(0,fontstart[0])then begin left;
+write(vplfile,'VTITLE ');
+for k:=0 to fontstart[0]-1 do write(vplfile,xchr[vf[k]]);right;
+end else begin perfect:=false;if charsonline>0 then writeln(' ');
+charsonline:=0;
+writeln('Bad VF file: ','Title is not a balanced ASCII string');
+end{:119};{70:}begin fonttype:=0;if lh>=12 then begin{75:}
+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{:75};
+if lh>=17 then begin{77:}left;write(vplfile,'FAMILY');checkBCPL(72,20);
+outBCPL(72);right{:77};if lh>=18 then{78:}begin left;
+write(vplfile,'FACE');outface(95);right;for i:=18 to lh-1 do begin left;
+write(vplfile,'HEADER D ',i:1);outoctal(24+4*i,4);right;end;end{:78};
+end;{76:}left;write(vplfile,'CODINGSCHEME');outBCPL(32);right{:76};end;
+{73:}left;write(vplfile,'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(vplfile,' 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(vplfile,' D 10');
+end else outfix(28);right;
+write(vplfile,'(COMMENT DESIGNSIZE IS IN POINTS)');outln;
+write(vplfile,'(COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)');
+outln{:73};{71:}left;write(vplfile,'CHECKSUM');outoctal(24,4);right{:71}
+;{79:}if(lh>17)and(tfm[92]>127)then begin left;
+write(vplfile,'SEVENBITSAFEFLAG TRUE');right;end{:79};end{:70};{80:}
+if np>0 then begin left;write(vplfile,'FONTDIMEN');outln;
+for i:=1 to np do{82:}begin left;
+if i=1 then write(vplfile,'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;{83:}
+if i<=7 then case i of 2:write(vplfile,'SPACE');
+3:write(vplfile,'STRETCH');4:write(vplfile,'SHRINK');
+5:write(vplfile,'XHEIGHT');6:write(vplfile,'QUAD');
+7:write(vplfile,'EXTRASPACE')end else if(i<=22)and(fonttype=1)then case
+i of 8:write(vplfile,'NUM1');9:write(vplfile,'NUM2');
+10:write(vplfile,'NUM3');11:write(vplfile,'DENOM1');
+12:write(vplfile,'DENOM2');13:write(vplfile,'SUP1');
+14:write(vplfile,'SUP2');15:write(vplfile,'SUP3');
+16:write(vplfile,'SUB1');17:write(vplfile,'SUB2');
+18:write(vplfile,'SUPDROP');19:write(vplfile,'SUBDROP');
+20:write(vplfile,'DELIM1');21:write(vplfile,'DELIM2');
+22:write(vplfile,'AXISHEIGHT')end else if(i<=13)and(fonttype=2)then if i
+=8 then write(vplfile,'DEFAULTRULETHICKNESS')else write(vplfile,
+'BIGOPSPACING',i-8:1)else write(vplfile,'PARAMETER D ',i:1){:83};end;
+outfix(4*(parambase+i));right;end{:82};right;end;{81:}
+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).'){:81};{:80};{121:}for f:=0 to fontptr-1 do begin left;
+write(vplfile,'MAPFONT D ',f:1);outln;{122:}a:=vf[fontstart[f]+12];
+l:=vf[fontstart[f]+13];
+if a>0 then if not stringbalance(fontstart[f]+14,a)then begin perfect:=
+false;if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad VF file: ','Improper font area will be ignored');
+end else begin left;write(vplfile,'FONTAREA ');
+for k:=fontstart[f]+14 to fontstart[f]+a+13 do write(vplfile,xchr[vf[k]]
+);right;end;
+if(l=0)or not stringbalance(fontstart[f]+14+a,l)then begin perfect:=
+false;if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad VF file: ','Improper font name will be ignored');
+end else begin left;write(vplfile,'FONTNAME ');
+for k:=fontstart[f]+14+a to fontstart[f]+a+l+13 do write(vplfile,xchr[vf
+[k]]);right;end{:122};for k:=0 to 11 do tfm[k]:=vf[fontstart[f]+k];
+if tfm[0]+tfm[1]+tfm[2]+tfm[3]>0 then begin left;
+write(vplfile,'FONTCHECKSUM');outoctal(0,4);right;end;left;
+write(vplfile,'FONTAT');outfix(4);right;left;write(vplfile,'FONTDSIZE');
+outfix(8);right;right;end{:121};{84:}
+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;{:84};end;{:132}{133:}
+function domap(c:byte):boolean;label 9999,10;var k:integer;f:0..vfsize;
+begin{124:}if packetstart[c]=vfsize then begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad VF file: ','Missing packet for character ',c:1);
+end else begin left;write(vplfile,'MAP');outln;top:=0;wstack[0]:=0;
+xstack[0]:=0;ystack[0]:=0;zstack[0]:=0;vfptr:=packetstart[c];
+vflimit:=packetend[c]+1;f:=0;while vfptr<vflimit do begin o:=vf[vfptr];
+vfptr:=vfptr+1;case o of{126:}138:;
+141:begin if top=maxstack then begin writeln('Stack overflow!');
+goto 9999;end;top:=top+1;wstack[top]:=wstack[top-1];
+xstack[top]:=xstack[top-1];ystack[top]:=ystack[top-1];
+zstack[top]:=zstack[top-1];write(vplfile,'(PUSH)');outln;end;
+142:if top=0 then begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad VF file: ','More pops than pushes!');
+end else begin top:=top-1;write(vplfile,'(POP)');outln;end;
+132,137:begin if o=137 then write(vplfile,'(PUSH)');left;
+write(vplfile,'SETRULE');outasfix(getbytes(4,true));
+outasfix(getbytes(4,true));if o=137 then write(vplfile,')(POP');right;
+end;{:126}{127:}143,144,145,146:begin write(vplfile,'(MOVERIGHT');
+outasfix(getbytes(o-142,true));write(vplfile,')');outln;end;
+147,148,149,150,151:begin if o<>147 then wstack[top]:=getbytes(o-147,
+true);write(vplfile,'(MOVERIGHT');outasfix(wstack[top]);
+write(vplfile,')');outln;end;
+152,153,154,155,156:begin if o<>152 then xstack[top]:=getbytes(o-152,
+true);write(vplfile,'(MOVERIGHT');outasfix(xstack[top]);
+write(vplfile,')');outln;end;
+157,158,159,160:begin write(vplfile,'(MOVEDOWN');
+outasfix(getbytes(o-156,true));write(vplfile,')');outln;end;
+161,162,163,164,165:begin if o<>161 then ystack[top]:=getbytes(o-161,
+true);write(vplfile,'(MOVEDOWN');outasfix(ystack[top]);
+write(vplfile,')');outln;end;
+166,167,168,169,170:begin if o<>166 then zstack[top]:=getbytes(o-166,
+true);write(vplfile,'(MOVEDOWN');outasfix(zstack[top]);
+write(vplfile,')');outln;end;{:127}{128:}
+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,235,236,237,238:begin f:=0;
+if o>=235 then fontnumber[fontptr]:=getbytes(o-234,false)else fontnumber
+[fontptr]:=o-171;while fontnumber[f]<>fontnumber[fontptr]do f:=f+1;
+if f=fontptr then begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad VF file: ','Undeclared font selected');
+end else begin write(vplfile,'(SELECTFONT D ',f:1,')');outln;end;end;
+{:128}{129:}
+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,128,129,130,131,133,134,135,
+136:begin if o>=128 then if o>=133 then c:=getbytes(o-132,false)else c:=
+getbytes(o-127,false)else c:=o;if f=fontptr then begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad VF file: ','Character ',c:1,
+' in undeclared font will be ignored');
+end else begin vf[fontstart[f+1]-1]:=c;k:=fontchars[f];
+while vf[k]<>c do k:=k+1;
+if k=fontstart[f+1]-1 then begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad VF file: ','Character ',c:1,' in font ',f:1,
+' will be ignored');
+end else begin if o>=133 then write(vplfile,'(PUSH)');left;
+write(vplfile,'SETCHAR');outchar(c);
+if o>=133 then write(vplfile,')(POP');right;end;end;end;{:129}{130:}
+239,240,241,242:begin k:=getbytes(o-238,false);
+if k<0 then begin perfect:=false;if charsonline>0 then writeln(' ');
+charsonline:=0;writeln('Bad VF file: ','String of negative length!');
+end else begin left;if k+vfptr>vflimit then begin begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad VF file: ','Special command truncated to packet length');
+end;k:=vflimit-vfptr;end;
+if(k>64)or not stringbalance(vfptr,k)then begin write(vplfile,
+'SPECIALHEX ');
+while k>0 do begin if k mod 32=0 then outln else if k mod 4=0 then write
+(vplfile,' ');begin a:=vf[vfptr]div 16;
+if a<10 then write(vplfile,a:1)else write(vplfile,xchr[a+55]);end;
+begin a:=vf[vfptr]mod 16;
+if a<10 then write(vplfile,a:1)else write(vplfile,xchr[a+55]);end;
+vfptr:=vfptr+1;k:=k-1;end;end else begin write(vplfile,'SPECIAL ');
+while k>0 do begin write(vplfile,xchr[vf[vfptr]]);vfptr:=vfptr+1;k:=k-1;
+end;end;right;end;end;{:130}
+139,140,243,244,245,246,247,248,249,250,251,252,253,254,255:begin
+perfect:=false;if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad VF file: ','Illegal DVI code ',o:1,' will be ignored');end;
+end;end;if top>0 then begin begin perfect:=false;
+if charsonline>0 then writeln(' ');charsonline:=0;
+writeln('Bad VF file: ','More pushes than pops!');end;
+repeat write(vplfile,'(POP)');top:=top-1;until top=0;end;right;end{:124}
+;domap:=true;goto 10;9999:domap:=false;10:end;
+function docharacters:boolean;label 9999,10;var c:byte;k:index;
+ai:0..ligsize;begin{100:}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(vplfile,'CHARACTER');outchar(c);outln;{101:}begin left;
+write(vplfile,'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{:101};
+if(tfm[4*(charbase+c)+1]div 16)>0 then{102:}
+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(vplfile,'CHARHT');
+outfix(4*(heightbase+(tfm[4*(charbase+c)+1]div 16)));right;end{:102};
+if(tfm[4*(charbase+c)+1]mod 16)>0 then{103:}
+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(vplfile,'CHARDP');
+outfix(4*(depthbase+(tfm[4*(charbase+c)+1]mod 16)));right;end{:103};
+if(tfm[4*(charbase+c)+2]div 4)>0 then{104:}
+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(vplfile,'CHARIC');
+outfix(4*(italicbase+(tfm[4*(charbase+c)+2]div 4)));right;end{:104};
+case(tfm[4*(charbase+c)+2]mod 4)of 0:;1:{105:}begin left;
+write(vplfile,'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{96:}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{98:}
+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(vplfile,'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(vplfile,' R 0.0');end else outfix(4*(kernbase+r));right;end{:98}
+else{99:}
+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(vplfile,'/');write(vplfile,'LIG');
+if odd(r)then write(vplfile,'/');while r>3 do begin write(vplfile,'>');
+r:=r-4;end;outchar(tfm[k+1]);outchar(tfm[k+3]);right;end{:99};
+if tfm[k]>0 then if level=1 then{97:}
+begin if tfm[k]>=128 then write(vplfile,'(STOP)')else begin count:=0;
+for ai:=i+1 to i+tfm[k]do if activity[ai]=2 then count:=count+1;
+write(vplfile,'(SKIP D ',count:1,')');end;outln;end{:97};end{:96};
+if tfm[k]>=128 then i:=nl else i:=i+1+tfm[k];until i>=nl;right;end{:105}
+;2:{106:}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(vplfile,'NEXTLARGER');
+outchar(tfm[4*(charbase+c)+3]);right;end;end;end{:106};3:{107:}
+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(vplfile,'VARCHAR');outln;{108:}
+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(vplfile,'TOP');1:write(vplfile,'MID');
+2:write(vplfile,'BOT');3:write(vplfile,'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{:108};right;end{:107};end;
+if not domap(c)then goto 9999;right;end{:100};docharacters:=true;
+goto 10;9999:docharacters:=false;10:end;{:133}{134:}begin initialize;
+if not organize then goto 9999;dosimplethings;{88:}
+if nl>0 then begin for ai:=0 to nl-1 do activity[ai]:=0;{91:}
+if tfm[4*(ligkernbase+(0))]=255 then begin left;
+write(vplfile,'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{:91};end;{89:}
+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{90:}
+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{:90}
+;end;labeltable[labelptr+1].rr:=ligsize;{:89};if nl>0 then begin left;
+write(vplfile,'LIGTABLE');outln;{92:}
+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{:92};{93:}sortptr:=1;
+for acti:=0 to nl-1 do if activity[acti]<>1 then begin i:=acti;{95:}
+if activity[i]=0 then begin if level=1 then begin left;
+write(vplfile,'COMMENT THIS PART OF THE PROGRAM IS NEVER USED!');outln;
+end end else if level=2 then right{:95};{94:}
+while i=labeltable[sortptr].rr do begin left;write(vplfile,'LABEL');
+if labeltable[sortptr].cc=256 then write(vplfile,' BOUNDARYCHAR')else
+outchar(labeltable[sortptr].cc);right;sortptr:=sortptr+1;end{:94};{96:}
+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{98:}
+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(vplfile,'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(vplfile,' R 0.0');end else outfix(4*(kernbase+r));right;end{:98}
+else{99:}
+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(vplfile,'/');write(vplfile,'LIG');
+if odd(r)then write(vplfile,'/');while r>3 do begin write(vplfile,'>');
+r:=r-4;end;outchar(tfm[k+1]);outchar(tfm[k+3]);right;end{:99};
+if tfm[k]>0 then if level=1 then{97:}
+begin if tfm[k]>=128 then write(vplfile,'(STOP)')else begin count:=0;
+for ai:=i+1 to i+tfm[k]do if activity[ai]=2 then count:=count+1;
+write(vplfile,'(SKIP D ',count:1,')');end;outln;end{:97};end{:96};end;
+if level=2 then right{:93};right;{112:}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];{113:}repeat hashinput;
+k:=tfm[4*(ligkernbase+(i))];if k>=128 then i:=nl else i:=i+1+k;
+until i>=nl{:113};end;if bcharlabel<nl then begin c:=256;i:=bcharlabel;
+{113:}repeat hashinput;k:=tfm[4*(ligkernbase+(i))];
+if k>=128 then i:=nl else i:=i+1+k;until i>=nl{:113};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(vplfile,'(INFINITE LIGATURE LOOP MUST BE BROKEN!)');goto 9999;
+end{:112};end{:88};{109:}
+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{:109};
+if not docharacters then goto 9999;writeln('.');
+if level<>0 then writeln('This program isn''t working!');
+if not perfect then begin write(vplfile,
+'(COMMENT THE TFM AND/OR VF FILE WAS BAD, ');
+write(vplfile,'SO THE DATA HAS BEEN CHANGED!)');end;9999:outln;
+9998:writeln(' ');end.{:134}
diff --git a/systems/knuth/local/etc/vptovf.ch b/systems/knuth/local/etc/vptovf.ch
new file mode 100644
index 0000000000..b3ae4055fe
--- /dev/null
+++ b/systems/knuth/local/etc/vptovf.ch
@@ -0,0 +1,108 @@
+% Change file for the VPtoVF processor, for use with GNU Pascal
+% (by Don Knuth; see ../etc-sparc for its prehistory)
+
+% History:
+% 2000.04.30 Initial version
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [0] WEAVE: print changes only
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+\pageno=\contentspagenumber \advance\pageno by 1
+@y
+\pageno=\contentspagenumber \advance\pageno by 1
+\let\maybe=\iffalse
+\def\title{VP\lowercase{to}VF changes for GNU Pascal}
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [1] Change banner string
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@d banner=='This is VPtoVF, Version 1.5' {printed when the program starts}
+@y
+@d banner=='This is VPtoVF, Version 1.5 for Linux'
+ {printed when the program starts}
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [2] Fix filenames in program statement; add `final_end' label; add access
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@p program VPtoVF(@!vpl_file,@!vf_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 VPtoVF(@!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 VPL file
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+reset(vpl_file);
+@y
+if argc < 4 then begin
+ print_ln('Usage: vptovf <vpl-file> <vf-file> <tfm-file>');
+ goto final_end;
+end;
+argv(1, vpl_name);
+if testreadaccess(vpl_name) then reset(vpl_file, vpl_name)
+else begin print_ln('I can''t read the VPL file!'); goto final_end;
+ end;
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [21] Change type of output files and declare extra binary-file variables
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@x
+@!vf_file:packed file of 0..255;
+@!tfm_file:packed file of 0..255;
+@y
+@!vf_file,
+@!tfm_file : packed file of ByteCard;
+@!vf_name, @!tfm_name,
+@!vpl_name : UNIX_file_name;
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [22] Open output files
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+@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(vf_file); 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, vf_name); argv(3, tfm_name);
+rewrite(vf_file, vf_name); rewrite(tfm_file, tfm_name);
+@z
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% [181] 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/etc/vptovf.p b/systems/knuth/local/etc/vptovf.p
new file mode 100644
index 0000000000..f2f3fdc0c9
--- /dev/null
+++ b/systems/knuth/local/etc/vptovf.p
@@ -0,0 +1,1112 @@
+{2:}program VPtoVF(output);label 9999;const{3:}bufsize=60;
+maxheaderbytes=100;vfsize=10000;maxstack=100;maxparamwords=30;
+maxligsteps=5000;maxkerns=500;hashsize=5003;{:3}
+type UNIXfilename=packed array[1..100]of char;{23:}byte=0..255;
+ASCIIcode=32..127;{:23}{66:}fourbytes=record b0:byte;b1:byte;b2:byte;
+b3:byte;end;{:66}{71:}fixword=integer;{:71}{78:}
+headerindex=0..maxheaderbytes;indx=0..32767;{:78}{81:}pointer=0..1032;
+{:81}var{5:}vplfile:text;{:5}{21:}
+vffile,tfmfile:packed file of ByteCard;
+vfname,tfmname,vplname:UNIXfilename;{:21}{24:}
+xord:array[char]of ASCIIcode;{:24}{27:}line:integer;goodindent:integer;
+indent:integer;level:integer;{:27}{29:}leftln,rightln:boolean;
+limit:0..bufsize;loc:0..bufsize;buffer:array[1..bufsize]of char;
+inputhasended:boolean;{:29}{31:}charsonline:0..8;{:31}{36:}
+curchar:ASCIIcode;{:36}{44:}start:array[1..100]of 0..666;
+dictionary:array[0..666]of ASCIIcode;startptr:0..100;dictptr:0..666;
+{:44}{46:}curname:array[1..20]of ASCIIcode;namelength:0..20;
+nameptr:0..100;{:46}{47:}nhash:array[0..140]of 0..100;curhash:0..140;
+{:47}{52:}equiv:array[0..100]of byte;curcode:byte;{:52}{67:}
+curbytes:fourbytes;zerobytes:fourbytes;{:67}{75:}
+fractiondigits:array[1..7]of integer;{:75}{77:}
+headerbytes:array[headerindex]of byte;headerptr:headerindex;
+designsize:fixword;designunits:fixword;frozendu:boolean;
+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;vf:array[0..vfsize]of byte;
+vfptr:0..vfsize;vtitlestart:0..vfsize;vtitlelength:byte;
+packetstart:array[byte]of 0..vfsize;packetlength:array[byte]of integer;
+fontptr:0..256;curfont:0..256;fnamestart:array[byte]of 0..vfsize;
+fnamelength:array[byte]of byte;fareastart:array[byte]of 0..vfsize;
+farealength:array[byte]of byte;fontchecksum:array[byte]of fourbytes;
+fontnumber:array[0..256]of fourbytes;fontat:array[byte]of fixword;
+fontdsize:array[byte]of fixword;{:77}{82:}
+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;{:82}{86:}nextd:fixword;{:86}
+{89:}index:array[pointer]of byte;excess:byte;{:89}{91:}c:byte;x:fixword;
+k:integer;{:91}{113:}lkstepended:boolean;krnptr:0..maxkerns;{:113}{123:}
+hstack:array[0..maxstack]of 0..2;vstack:array[0..maxstack]of 0..2;
+wstack,xstack,ystack,zstack:array[0..maxstack]of fixword;
+stackptr:0..maxstack;{:123}{138:}sevenunsafe:boolean;{:138}{143:}
+delta:fixword;{:143}{147:}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;{:147}{158:}bc:byte;ec:byte;lh:byte;
+lf:0..32767;notfound:boolean;tempwidth:fixword;{:158}{161:}
+j:0..maxheaderbytes;p:pointer;q:1..4;parptr:0..maxparamwords;{:161}
+{167:}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;{:167}{175:}vcount:integer;{:175}
+#include "texwarext.h"
+procedure initialize;var{25:}k:integer;{:25}{48:}h:0..140;{:48}{79:}
+d:headerindex;{:79}{83:}c:byte;{:83}
+begin writeln('This is VPtoVF, Version 1.5 for Linux');{6:}
+if argc<4 then begin writeln(
+'Usage: vptovf <vpl-file> <vf-file> <tfm-file>');goto 9999;end;
+argv(1,vplname);
+if testreadaccess(vplname)then reset(vplfile,vplname)else begin writeln(
+'I can''t read the VPL file!');goto 9999;end;{:6}{22:}argv(2,vfname);
+argv(3,tfmname);rewrite(vffile,vfname);rewrite(tfmfile,tfmname);{:22}
+{26:}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;{:26}{28:}
+line:=0;goodindent:=0;indent:=0;level:=0;{:28}{30:}limit:=0;loc:=0;
+leftln:=true;rightln:=true;inputhasended:=false;{:30}{32:}
+charsonline:=0;{:32}{45:}startptr:=1;start[1]:=0;dictptr:=0;{:45}{49:}
+for h:=0 to 140 do nhash[h]:=0;{:49}{68:}zerobytes.b0:=0;
+zerobytes.b1:=0;zerobytes.b2:=0;zerobytes.b3:=0;{:68}{80:}
+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;frozendu:=false;
+sevenbitsafeflag:=false;headerptr:=18*4;nl:=0;minnl:=0;nk:=0;ne:=0;
+np:=0;checksumspecified:=false;bchar:=256;vfptr:=0;vtitlestart:=0;
+vtitlelength:=0;fontptr:=0;for k:=0 to 255 do packetstart[k]:=vfsize;
+for k:=0 to 127 do packetlength[k]:=1;
+for k:=128 to 255 do packetlength[k]:=2;{:80}{84:}
+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;{:84}{148:}hashptr:=0;yligcycle:=256;
+for k:=0 to hashsize do hash[k]:=0;{:148}end;{:2}{33:}
+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;{:33}
+{34:}procedure fillbuffer;begin leftln:=rightln;limit:=0;loc:=0;
+if leftln then begin if line>0 then readln(vplfile);line:=line+1;end;
+if eof(vplfile)then begin limit:=1;buffer[1]:=')';rightln:=false;
+inputhasended:=true;
+end else begin while(limit<bufsize-1)and(not eoln(vplfile))do begin
+limit:=limit+1;read(vplfile,buffer[limit]);end;buffer[limit+1]:=' ';
+rightln:=eoln(vplfile);if leftln then{35:}
+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{:35};end;end;{:34}{37:}
+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;{:37}{38:}
+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;{:38}
+{39:}function gethex:byte;var a:integer;begin repeat getnext;
+until curchar<>32;a:=curchar-41;if a>0 then begin a:=curchar-48;
+if curchar>57 then if curchar<65 then a:=-1 else a:=curchar-55;end;
+if(a<0)or(a>15)then begin begin if charsonline>0 then writeln(' ');
+write('Illegal hexadecimal digit');showerrorcontext;end;gethex:=0;
+end else gethex:=a;end;{:39}{40:}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;{:40}{41:}procedure copytoendofitem;label 30;
+var l:integer;nonblankfound:boolean;begin l:=level;nonblankfound:=false;
+while true do begin while loc=limit do fillbuffer;
+if buffer[loc+1]=')'then if level=l then goto 30 else level:=level-1;
+loc:=loc+1;if buffer[loc]='('then level:=level+1;
+if buffer[loc]<>' 'then nonblankfound:=true;
+if nonblankfound then if xord[buffer[loc]]=127 then begin begin if
+charsonline>0 then writeln(' ');write('Illegal character in the file');
+showerrorcontext;end;begin vf[vfptr]:=63;
+if vfptr=vfsize then begin if charsonline>0 then writeln(' ');
+write('I''m out of memory---increase my vfsize!');showerrorcontext;
+end else vfptr:=vfptr+1;end;end else begin vf[vfptr]:=xord[buffer[loc]];
+if vfptr=vfsize then begin if charsonline>0 then writeln(' ');
+write('I''m out of memory---increase my vfsize!');showerrorcontext;
+end else vfptr:=vfptr+1;end;end;30:end;{:41}{43:}
+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;{:43}{50:}procedure lookup;var k:0..20;j:0..666;
+notfound:boolean;begin{51:}curhash:=curname[1];
+for k:=2 to namelength do curhash:=(curhash+curhash+curname[k])mod 141{:
+51};notfound:=true;
+while notfound do begin if curhash=0 then curhash:=140 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;{:50}{53:}
+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;{:53}{58:}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;{:58}{60:}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{61:}
+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{:61}else if t=68 then{62:}
+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{:62}else if t=79 then{63:}
+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{:63}else if t=72 then{64:}
+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{:64}else if t=70 then{65:}
+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{:65}
+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;{:60}{69:}procedure getfourbytes;var c:integer;
+r:integer;begin repeat getnext;until curchar<>32;r:=0;
+curbytes:=zerobytes;
+if curchar=72 then r:=16 else if curchar=79 then r:=8 else if curchar=68
+then r:=10 else begin begin if charsonline>0 then writeln(' ');
+write('Decimal ("D"), octal ("O"), or hex ("H") value needed here');
+showerrorcontext;end;repeat getnext until(curchar=40)or(curchar=41);end;
+if r>0 then begin repeat getnext;until curchar<>32;
+while((curchar>=48)and(curchar<=57))or((curchar>=65)and(curchar<=70))do{
+70:}begin if curchar>=65 then curchar:=curchar-7;
+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 c:=curbytes.b3*r+curchar-48;curbytes.b3:=c mod 256;
+c:=curbytes.b2*r+c div 256;curbytes.b2:=c mod 256;
+c:=curbytes.b1*r+c div 256;curbytes.b1:=c mod 256;
+c:=curbytes.b0*r+c div 256;
+if c<256 then curbytes.b0:=c else begin curbytes:=zerobytes;
+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 if r=10 then begin begin if charsonline>0 then writeln(' ');
+write('Sorry, the maximum decimal value is D 4294967295');
+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;getnext;end;
+end{:70};end;end;{:69}{72:}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{73:}repeat getnext;if curchar=45 then begin curchar:=32;
+negative:=true;end else if curchar=43 then curchar:=32;
+until curchar<>32{:73};while(curchar>=48)and(curchar<=57)do{74:}
+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{:74};intpart:=acc;acc:=0;if curchar=46 then{76:}
+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{:76};
+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;{:72}{85:}
+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;{:85}{87:}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;{:87}
+{88:}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;{:88}{90:}
+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;
+{:90}{93:}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;{:93}{96:}
+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;{:96}
+{97:}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;{:97}{111:}
+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;{:111}{124:}{128:}procedure vffix(opcode:byte;x:fixword);
+var negative:boolean;k:0..4;t:integer;begin frozendu:=true;
+if designunits<>1048576 then x:=round((x/designunits)*1048576.0);
+if x>=0 then negative:=false else begin negative:=true;x:=-1-x;end;
+if opcode=0 then begin k:=4;t:=16777216;end else begin t:=127;k:=1;
+while x>t do begin t:=256*t+255;k:=k+1;end;begin vf[vfptr]:=opcode+k-1;
+if vfptr=vfsize then begin if charsonline>0 then writeln(' ');
+write('I''m out of memory---increase my vfsize!');showerrorcontext;
+end else vfptr:=vfptr+1;end;t:=t div 128+1;end;
+repeat if negative then begin begin vf[vfptr]:=255-(x div t);
+if vfptr=vfsize then begin if charsonline>0 then writeln(' ');
+write('I''m out of memory---increase my vfsize!');showerrorcontext;
+end else vfptr:=vfptr+1;end;negative:=false;x:=(x div t)*t+t-1-x;
+end else begin vf[vfptr]:=(x div t)mod 256;
+if vfptr=vfsize then begin if charsonline>0 then writeln(' ');
+write('I''m out of memory---increase my vfsize!');showerrorcontext;
+end else vfptr:=vfptr+1;end;k:=k-1;t:=t div 256;until k=0;end;{:128}
+procedure readpacket(c:byte);var cc:byte;x:fixword;h,v:0..2;
+specialstart:0..vfsize;k:0..vfsize;begin packetstart[c]:=vfptr;
+stackptr:=0;h:=0;v:=0;curfont:=0;
+while level=2 do begin while curchar=32 do getnext;
+if curchar=40 then{125:}begin getname;
+if curcode=0 then skiptoendofitem else if(curcode<80)or(curcode>90)then
+begin begin if charsonline>0 then writeln(' ');
+write('This property name doesn''t belong in a MAP list');
+showerrorcontext;end;skiptoendofitem;
+end else begin case curcode of 80:{126:}begin getfourbytes;
+fontnumber[fontptr]:=curbytes;curfont:=0;
+while(fontnumber[curfont].b3<>fontnumber[fontptr].b3)or(fontnumber[
+curfont].b2<>fontnumber[fontptr].b2)or(fontnumber[curfont].b1<>
+fontnumber[fontptr].b1)or(fontnumber[curfont].b0<>fontnumber[fontptr].b0
+)do curfont:=curfont+1;
+if curfont=fontptr then begin if charsonline>0 then writeln(' ');
+write('Undefined MAPFONT cannot be selected');showerrorcontext;
+end else if curfont<64 then begin vf[vfptr]:=171+curfont;
+if vfptr=vfsize then begin if charsonline>0 then writeln(' ');
+write('I''m out of memory---increase my vfsize!');showerrorcontext;
+end else vfptr:=vfptr+1;end else begin begin vf[vfptr]:=235;
+if vfptr=vfsize then begin if charsonline>0 then writeln(' ');
+write('I''m out of memory---increase my vfsize!');showerrorcontext;
+end else vfptr:=vfptr+1;end;begin vf[vfptr]:=curfont;
+if vfptr=vfsize then begin if charsonline>0 then writeln(' ');
+write('I''m out of memory---increase my vfsize!');showerrorcontext;
+end else vfptr:=vfptr+1;end;end;end{:126};81:{127:}
+if curfont=fontptr then begin if charsonline>0 then writeln(' ');
+write('Character cannot be typeset in undefined font');showerrorcontext;
+end else begin cc:=getbyte;if cc>=128 then begin vf[vfptr]:=128;
+if vfptr=vfsize then begin if charsonline>0 then writeln(' ');
+write('I''m out of memory---increase my vfsize!');showerrorcontext;
+end else vfptr:=vfptr+1;end;begin vf[vfptr]:=cc;
+if vfptr=vfsize then begin if charsonline>0 then writeln(' ');
+write('I''m out of memory---increase my vfsize!');showerrorcontext;
+end else vfptr:=vfptr+1;end;end{:127};82:{129:}
+begin begin vf[vfptr]:=132;
+if vfptr=vfsize then begin if charsonline>0 then writeln(' ');
+write('I''m out of memory---increase my vfsize!');showerrorcontext;
+end else vfptr:=vfptr+1;end;vffix(0,getfix);vffix(0,getfix);end{:129};
+83,84:{130:}begin if curcode=83 then x:=getfix else x:=-getfix;
+if h=0 then begin wstack[stackptr]:=x;h:=1;vffix(148,x);
+end else if x=wstack[stackptr]then begin vf[vfptr]:=147;
+if vfptr=vfsize then begin if charsonline>0 then writeln(' ');
+write('I''m out of memory---increase my vfsize!');showerrorcontext;
+end else vfptr:=vfptr+1;end else if h=1 then begin xstack[stackptr]:=x;
+h:=2;vffix(153,x);
+end else if x=xstack[stackptr]then begin vf[vfptr]:=152;
+if vfptr=vfsize then begin if charsonline>0 then writeln(' ');
+write('I''m out of memory---increase my vfsize!');showerrorcontext;
+end else vfptr:=vfptr+1;end else vffix(143,x);end{:130};85,86:{131:}
+begin if curcode=85 then x:=getfix else x:=-getfix;
+if v=0 then begin ystack[stackptr]:=x;v:=1;vffix(162,x);
+end else if x=ystack[stackptr]then begin vf[vfptr]:=161;
+if vfptr=vfsize then begin if charsonline>0 then writeln(' ');
+write('I''m out of memory---increase my vfsize!');showerrorcontext;
+end else vfptr:=vfptr+1;end else if v=1 then begin zstack[stackptr]:=x;
+v:=2;vffix(167,x);
+end else if x=zstack[stackptr]then begin vf[vfptr]:=166;
+if vfptr=vfsize then begin if charsonline>0 then writeln(' ');
+write('I''m out of memory---increase my vfsize!');showerrorcontext;
+end else vfptr:=vfptr+1;end else vffix(157,x);end{:131};87:{132:}
+if stackptr=maxstack then begin if charsonline>0 then writeln(' ');
+write('Don''t push so much---stack is full!');showerrorcontext;
+end else begin begin vf[vfptr]:=141;
+if vfptr=vfsize then begin if charsonline>0 then writeln(' ');
+write('I''m out of memory---increase my vfsize!');showerrorcontext;
+end else vfptr:=vfptr+1;end;hstack[stackptr]:=h;vstack[stackptr]:=v;
+stackptr:=stackptr+1;h:=0;v:=0;end{:132};88:{133:}
+if stackptr=0 then begin if charsonline>0 then writeln(' ');
+write('Empty stack cannot be popped');showerrorcontext;
+end else begin begin vf[vfptr]:=142;
+if vfptr=vfsize then begin if charsonline>0 then writeln(' ');
+write('I''m out of memory---increase my vfsize!');showerrorcontext;
+end else vfptr:=vfptr+1;end;stackptr:=stackptr-1;h:=hstack[stackptr];
+v:=vstack[stackptr];end{:133};89,90:{134:}begin begin vf[vfptr]:=239;
+if vfptr=vfsize then begin if charsonline>0 then writeln(' ');
+write('I''m out of memory---increase my vfsize!');showerrorcontext;
+end else vfptr:=vfptr+1;end;begin vf[vfptr]:=0;
+if vfptr=vfsize then begin if charsonline>0 then writeln(' ');
+write('I''m out of memory---increase my vfsize!');showerrorcontext;
+end else vfptr:=vfptr+1;end;specialstart:=vfptr;
+if curcode=89 then copytoendofitem else begin repeat x:=gethex;
+if curchar>41 then begin vf[vfptr]:=x*16+gethex;
+if vfptr=vfsize then begin if charsonline>0 then writeln(' ');
+write('I''m out of memory---increase my vfsize!');showerrorcontext;
+end else vfptr:=vfptr+1;end;until curchar<=41;end;
+if vfptr-specialstart>255 then{135:}
+if vfptr+3>vfsize then begin begin if charsonline>0 then writeln(' ');
+write('Special command being clipped---no room left!');showerrorcontext;
+end;vfptr:=specialstart+255;vf[specialstart-1]:=255;
+end else begin for k:=vfptr downto specialstart do vf[k+3]:=vf[k];
+x:=vfptr-specialstart;vfptr:=vfptr+3;vf[specialstart-2]:=242;
+vf[specialstart-1]:=x div 16777216;
+vf[specialstart]:=(x div 65536)mod 256;
+vf[specialstart+1]:=(x div 256)mod 256;vf[specialstart+2]:=x mod 256;
+end{:135}else vf[specialstart-1]:=vfptr-specialstart;end{:134};end;
+finishtheproperty;end;end{:125}
+else if curchar=41 then skiptoendofitem else junkerror;end;
+while stackptr>0 do begin begin if charsonline>0 then writeln(' ');
+write('Missing POP supplied');showerrorcontext;end;begin vf[vfptr]:=142;
+if vfptr=vfsize then begin if charsonline>0 then writeln(' ');
+write('I''m out of memory---increase my vfsize!');showerrorcontext;
+end else vfptr:=vfptr+1;end;stackptr:=stackptr-1;end;
+packetlength[c]:=vfptr-packetstart[c];begin loc:=loc-1;level:=level+1;
+curchar:=41;end;end;{:124}{136:}procedure printoctal(c:byte);
+begin write('''',(c div 64):1,((c div 8)mod 8):1,(c mod 8):1);end;{:136}
+{150:}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;{151:}
+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{:151};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;{:150}{152:}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;{:152}{153:}
+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;{:153}
+{165:}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;{:165}{176:}procedure voutint(x:integer);
+begin if x>=0 then write(vffile,x div 16777216)else begin write(vffile,
+255);x:=x+16777216;end;write(vffile,(x div 65536)mod 256);
+write(vffile,(x div 256)mod 256);write(vffile,x mod 256);end;{:176}
+{180:}procedure paramenter;begin{57:}namelength:=5;curname[16]:=83;
+curname[17]:=76;curname[18]:=65;curname[19]:=78;curname[20]:=84;
+entername(31);namelength:=5;curname[16]:=83;curname[17]:=80;
+curname[18]:=65;curname[19]:=67;curname[20]:=69;entername(32);
+namelength:=7;curname[14]:=83;curname[15]:=84;curname[16]:=82;
+curname[17]:=69;curname[18]:=84;curname[19]:=67;curname[20]:=72;
+entername(33);namelength:=6;curname[15]:=83;curname[16]:=72;
+curname[17]:=82;curname[18]:=73;curname[19]:=78;curname[20]:=75;
+entername(34);namelength:=7;curname[14]:=88;curname[15]:=72;
+curname[16]:=69;curname[17]:=73;curname[18]:=71;curname[19]:=72;
+curname[20]:=84;entername(35);namelength:=4;curname[17]:=81;
+curname[18]:=85;curname[19]:=65;curname[20]:=68;entername(36);
+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(37);
+namelength:=4;curname[17]:=78;curname[18]:=85;curname[19]:=77;
+curname[20]:=49;entername(38);namelength:=4;curname[17]:=78;
+curname[18]:=85;curname[19]:=77;curname[20]:=50;entername(39);
+namelength:=4;curname[17]:=78;curname[18]:=85;curname[19]:=77;
+curname[20]:=51;entername(40);namelength:=6;curname[15]:=68;
+curname[16]:=69;curname[17]:=78;curname[18]:=79;curname[19]:=77;
+curname[20]:=49;entername(41);namelength:=6;curname[15]:=68;
+curname[16]:=69;curname[17]:=78;curname[18]:=79;curname[19]:=77;
+curname[20]:=50;entername(42);namelength:=4;curname[17]:=83;
+curname[18]:=85;curname[19]:=80;curname[20]:=49;entername(43);
+namelength:=4;curname[17]:=83;curname[18]:=85;curname[19]:=80;
+curname[20]:=50;entername(44);namelength:=4;curname[17]:=83;
+curname[18]:=85;curname[19]:=80;curname[20]:=51;entername(45);
+namelength:=4;curname[17]:=83;curname[18]:=85;curname[19]:=66;
+curname[20]:=49;entername(46);namelength:=4;curname[17]:=83;
+curname[18]:=85;curname[19]:=66;curname[20]:=50;entername(47);
+namelength:=7;curname[14]:=83;curname[15]:=85;curname[16]:=80;
+curname[17]:=68;curname[18]:=82;curname[19]:=79;curname[20]:=80;
+entername(48);namelength:=7;curname[14]:=83;curname[15]:=85;
+curname[16]:=66;curname[17]:=68;curname[18]:=82;curname[19]:=79;
+curname[20]:=80;entername(49);namelength:=6;curname[15]:=68;
+curname[16]:=69;curname[17]:=76;curname[18]:=73;curname[19]:=77;
+curname[20]:=49;entername(50);namelength:=6;curname[15]:=68;
+curname[16]:=69;curname[17]:=76;curname[18]:=73;curname[19]:=77;
+curname[20]:=50;entername(51);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(52);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(38);
+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(39);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(40);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(41);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(42);
+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(43);{:57};end;
+procedure vplenter;begin{56:}namelength:=6;curname[15]:=86;
+curname[16]:=84;curname[17]:=73;curname[18]:=84;curname[19]:=76;
+curname[20]:=69;entername(12);namelength:=7;curname[14]:=77;
+curname[15]:=65;curname[16]:=80;curname[17]:=70;curname[18]:=79;
+curname[19]:=78;curname[20]:=84;entername(13);namelength:=3;
+curname[18]:=77;curname[19]:=65;curname[20]:=80;entername(66);
+namelength:=8;curname[13]:=70;curname[14]:=79;curname[15]:=78;
+curname[16]:=84;curname[17]:=78;curname[18]:=65;curname[19]:=77;
+curname[20]:=69;entername(20);namelength:=8;curname[13]:=70;
+curname[14]:=79;curname[15]:=78;curname[16]:=84;curname[17]:=65;
+curname[18]:=82;curname[19]:=69;curname[20]:=65;entername(21);
+namelength:=12;curname[9]:=70;curname[10]:=79;curname[11]:=78;
+curname[12]:=84;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(22);namelength:=6;curname[15]:=70;
+curname[16]:=79;curname[17]:=78;curname[18]:=84;curname[19]:=65;
+curname[20]:=84;entername(23);namelength:=9;curname[12]:=70;
+curname[13]:=79;curname[14]:=78;curname[15]:=84;curname[16]:=68;
+curname[17]:=83;curname[18]:=73;curname[19]:=90;curname[20]:=69;
+entername(24);namelength:=10;curname[11]:=83;curname[12]:=69;
+curname[13]:=76;curname[14]:=69;curname[15]:=67;curname[16]:=84;
+curname[17]:=70;curname[18]:=79;curname[19]:=78;curname[20]:=84;
+entername(80);namelength:=7;curname[14]:=83;curname[15]:=69;
+curname[16]:=84;curname[17]:=67;curname[18]:=72;curname[19]:=65;
+curname[20]:=82;entername(81);namelength:=7;curname[14]:=83;
+curname[15]:=69;curname[16]:=84;curname[17]:=82;curname[18]:=85;
+curname[19]:=76;curname[20]:=69;entername(82);namelength:=9;
+curname[12]:=77;curname[13]:=79;curname[14]:=86;curname[15]:=69;
+curname[16]:=82;curname[17]:=73;curname[18]:=71;curname[19]:=72;
+curname[20]:=84;entername(83);namelength:=8;curname[13]:=77;
+curname[14]:=79;curname[15]:=86;curname[16]:=69;curname[17]:=76;
+curname[18]:=69;curname[19]:=70;curname[20]:=84;entername(84);
+namelength:=8;curname[13]:=77;curname[14]:=79;curname[15]:=86;
+curname[16]:=69;curname[17]:=68;curname[18]:=79;curname[19]:=87;
+curname[20]:=78;entername(85);namelength:=6;curname[15]:=77;
+curname[16]:=79;curname[17]:=86;curname[18]:=69;curname[19]:=85;
+curname[20]:=80;entername(86);namelength:=4;curname[17]:=80;
+curname[18]:=85;curname[19]:=83;curname[20]:=72;entername(87);
+namelength:=3;curname[18]:=80;curname[19]:=79;curname[20]:=80;
+entername(88);namelength:=7;curname[14]:=83;curname[15]:=80;
+curname[16]:=69;curname[17]:=67;curname[18]:=73;curname[19]:=65;
+curname[20]:=76;entername(89);namelength:=10;curname[11]:=83;
+curname[12]:=80;curname[13]:=69;curname[14]:=67;curname[15]:=73;
+curname[16]:=65;curname[17]:=76;curname[18]:=72;curname[19]:=69;
+curname[20]:=88;entername(90);{:56};end;procedure nameenter;begin{55:}
+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(14);
+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(30);namelength:=6;
+curname[15]:=67;curname[16]:=72;curname[17]:=65;curname[18]:=82;
+curname[19]:=87;curname[20]:=68;entername(61);namelength:=6;
+curname[15]:=67;curname[16]:=72;curname[17]:=65;curname[18]:=82;
+curname[19]:=72;curname[20]:=84;entername(62);namelength:=6;
+curname[15]:=67;curname[16]:=72;curname[17]:=65;curname[18]:=82;
+curname[19]:=68;curname[20]:=80;entername(63);namelength:=6;
+curname[15]:=67;curname[16]:=72;curname[17]:=65;curname[18]:=82;
+curname[19]:=73;curname[20]:=67;entername(64);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(65);namelength:=7;
+curname[14]:=86;curname[15]:=65;curname[16]:=82;curname[17]:=67;
+curname[18]:=72;curname[19]:=65;curname[20]:=82;entername(67);
+namelength:=3;curname[18]:=84;curname[19]:=79;curname[20]:=80;
+entername(68);namelength:=3;curname[18]:=77;curname[19]:=73;
+curname[20]:=68;entername(69);namelength:=3;curname[18]:=66;
+curname[19]:=79;curname[20]:=84;entername(70);namelength:=3;
+curname[18]:=82;curname[19]:=69;curname[20]:=80;entername(71);
+namelength:=3;curname[18]:=69;curname[19]:=88;curname[20]:=84;
+entername(71);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(100);namelength:=4;curname[17]:=83;curname[18]:=84;
+curname[19]:=79;curname[20]:=80;entername(101);namelength:=4;
+curname[17]:=83;curname[18]:=75;curname[19]:=73;curname[20]:=80;
+entername(102);namelength:=3;curname[18]:=75;curname[19]:=82;
+curname[20]:=78;entername(103);namelength:=3;curname[18]:=76;
+curname[19]:=73;curname[20]:=71;entername(104);namelength:=4;
+curname[17]:=47;curname[18]:=76;curname[19]:=73;curname[20]:=71;
+entername(106);namelength:=5;curname[16]:=47;curname[17]:=76;
+curname[18]:=73;curname[19]:=71;curname[20]:=62;entername(110);
+namelength:=4;curname[17]:=76;curname[18]:=73;curname[19]:=71;
+curname[20]:=47;entername(105);namelength:=5;curname[16]:=76;
+curname[17]:=73;curname[18]:=71;curname[19]:=47;curname[20]:=62;
+entername(109);namelength:=5;curname[16]:=47;curname[17]:=76;
+curname[18]:=73;curname[19]:=71;curname[20]:=47;entername(107);
+namelength:=6;curname[15]:=47;curname[16]:=76;curname[17]:=73;
+curname[18]:=71;curname[19]:=47;curname[20]:=62;entername(111);
+namelength:=7;curname[14]:=47;curname[15]:=76;curname[16]:=73;
+curname[17]:=71;curname[18]:=47;curname[19]:=62;curname[20]:=62;
+entername(115);{:55};vplenter;paramenter;end;procedure readligkern;
+var krnptr:0..maxkerns;c:byte;begin{109:}begin lkstepended:=false;
+while level=1 do begin while curchar=32 do getnext;
+if curchar=40 then{110:}begin getname;
+if curcode=0 then skiptoendofitem else if curcode<100 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 100:{112:}
+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{:112};101:{114:}
+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{:114};
+102:{115:}
+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{:115};
+103:{117:}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{:117};
+104,105,106,107,109,110,111,115:{116:}begin ligkern[nl].b0:=0;
+ligkern[nl].b2:=curcode-104;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{:116};end;finishtheproperty;end;
+end{:110}else if curchar=41 then skiptoendofitem else junkerror;end;
+begin loc:=loc-1;level:=level+1;curchar:=41;end;end{:109};end;
+procedure readcharinfo;var c:byte;begin{118:}begin c:=getbyte;{137:}
+begin if charsonline=8 then begin writeln(' ');charsonline:=1;
+end else begin if charsonline>0 then write(' ');
+charsonline:=charsonline+1;end;printoctal(c);end{:137};
+while level=1 do begin while curchar=32 do getnext;
+if curchar=40 then{119:}begin getname;
+if curcode=0 then skiptoendofitem else if(curcode<61)or(curcode>67)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 61:charwd[c]:=sortin(1,getfix);
+62:charht[c]:=sortin(2,getfix);63:chardp[c]:=sortin(3,getfix);
+64:charic[c]:=sortin(4,getfix);65:begin checktag(c);chartag[c]:=2;
+charremainder[c]:=getbyte;end;66:readpacket(c);67:{120:}
+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]:=zerobytes;while level=2 do begin while curchar=32 do getnext;
+if curchar=40 then{121:}begin getname;
+if curcode=0 then skiptoendofitem else if(curcode<68)or(curcode>71)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-(68)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{:121}
+else if curchar=41 then skiptoendofitem else junkerror;end;ne:=ne+1;
+begin loc:=loc-1;level:=level+1;curchar:=41;end;end;end{:120};end;
+finishtheproperty;end;end{:119}
+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{:118};end;procedure readinput;
+var c:byte;begin{92:}curchar:=32;repeat while curchar=32 do getnext;
+if curchar=40 then{94:}begin getname;
+if curcode=0 then skiptoendofitem else if curcode>14 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{95:}
+case curcode of 1:begin checksumspecified:=true;readfourbytes(0);end;
+2:{98:}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{:98};3:{99:}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 if frozendu then begin if charsonline>0 then writeln(' ');
+write('Sorry, it''s too late to change the design units');
+showerrorcontext;end else designunits:=nextd;end{:99};4:readBCPL(8,40);
+5:readBCPL(48,20);6:headerbytes[71]:=getbyte;7:{100:}
+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{:100};8:{101:}
+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{:101};9:{102:}
+begin while level=1 do begin while curchar=32 do getnext;
+if curchar=40 then{103:}begin getname;
+if curcode=0 then skiptoendofitem else if(curcode<30)or(curcode>=61)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=30 then c:=getbyte else c:=curcode-30;
+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{:103}
+else if curchar=41 then skiptoendofitem else junkerror;end;
+begin loc:=loc-1;level:=level+1;curchar:=41;end;end{:102};
+10:readligkern;11:bchar:=getbyte;12:begin vtitlestart:=vfptr;
+copytoendofitem;
+if vfptr>vtitlestart+255 then begin begin if charsonline>0 then writeln(
+' ');write('VTITLE clipped to 255 characters');showerrorcontext;end;
+vtitlelength:=255;end else vtitlelength:=vfptr-vtitlestart;end;13:{104:}
+begin getfourbytes;fontnumber[fontptr]:=curbytes;curfont:=0;
+while(fontnumber[curfont].b3<>fontnumber[fontptr].b3)or(fontnumber[
+curfont].b2<>fontnumber[fontptr].b2)or(fontnumber[curfont].b1<>
+fontnumber[fontptr].b1)or(fontnumber[curfont].b0<>fontnumber[fontptr].b0
+)do curfont:=curfont+1;if curfont=fontptr then if fontptr<256 then{105:}
+begin fontptr:=fontptr+1;fnamestart[curfont]:=vfsize;
+fnamelength[curfont]:=4;fareastart[curfont]:=vfsize;
+farealength[curfont]:=0;fontchecksum[curfont]:=zerobytes;
+fontat[curfont]:=1048576;fontdsize[curfont]:=10485760;end{:105}
+else begin if charsonline>0 then writeln(' ');
+write('I can handle only 256 different mapfonts');showerrorcontext;end;
+if curfont=fontptr then skiptoendofitem else while level=1 do begin
+while curchar=32 do getnext;if curchar=40 then{106:}begin getname;
+if curcode=0 then skiptoendofitem else if(curcode<20)or(curcode>24)then
+begin begin if charsonline>0 then writeln(' ');
+write('This property name doesn''t belong in a MAPFONT list');
+showerrorcontext;end;skiptoendofitem;
+end else begin case curcode of 20:{107:}
+begin fnamestart[curfont]:=vfptr;copytoendofitem;
+if vfptr>fnamestart[curfont]+255 then begin begin if charsonline>0 then
+writeln(' ');write('FONTNAME clipped to 255 characters');
+showerrorcontext;end;fnamelength[curfont]:=255;
+end else fnamelength[curfont]:=vfptr-fnamestart[curfont];end{:107};
+21:{108:}begin fareastart[curfont]:=vfptr;copytoendofitem;
+if vfptr>fareastart[curfont]+255 then begin begin if charsonline>0 then
+writeln(' ');write('FONTAREA clipped to 255 characters');
+showerrorcontext;end;farealength[curfont]:=255;
+end else farealength[curfont]:=vfptr-fareastart[curfont];end{:108};
+22:begin getfourbytes;fontchecksum[curfont]:=curbytes;end;
+23:begin frozendu:=true;
+if designunits=1048576 then fontat[curfont]:=getfix else fontat[curfont]
+:=round((getfix/designunits)*1048576.0);end;
+24:fontdsize[curfont]:=getfix;end;finishtheproperty;end;end{:106}
+else if curchar=41 then skiptoendofitem else junkerror;end;
+begin loc:=loc-1;level:=level+1;curchar:=41;end;end{:104};
+14:readcharinfo;end{:95};finishtheproperty;end;end{:94}
+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{:92};end;procedure corrandcheck;var c:0..256;
+hh:0..hashsize;ligptr:0..maxligsteps;g:byte;begin{139:}
+if nl>0 then{145:}
+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{:145};
+sevenunsafe:=false;for c:=0 to 255 do if charwd[c]<>0 then{140:}
+case chartag[c]of 0:;1:{149:}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{:149};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:{141:}
+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{:141};end{:140};
+if charremainder[256]<32767 then begin c:=256;{149:}
+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{:149};end;
+if sevenbitsafeflag and sevenunsafe then writeln(
+'The font is not really seven-bit-safe!');{154:}
+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{:154};{155:}
+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{:155};for c:=0 to 255 do{142:}
+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{:142};{144:}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.');{:144}{:139}end;
+procedure vfoutput;var c:byte;curfont:0..256;k:integer;begin{177:}
+write(vffile,247);write(vffile,202);write(vffile,vtitlelength);
+for k:=0 to vtitlelength-1 do write(vffile,vf[vtitlestart+k]);
+for k:=0 to 7 do write(vffile,headerbytes[k]);vcount:=vtitlelength+11;
+for curfont:=0 to fontptr-1 do{178:}begin write(vffile,243);
+write(vffile,curfont);write(vffile,fontchecksum[curfont].b0);
+write(vffile,fontchecksum[curfont].b1);
+write(vffile,fontchecksum[curfont].b2);
+write(vffile,fontchecksum[curfont].b3);voutint(fontat[curfont]);
+voutint(fontdsize[curfont]);write(vffile,farealength[curfont]);
+write(vffile,fnamelength[curfont]);
+for k:=0 to farealength[curfont]-1 do write(vffile,vf[fareastart[curfont
+]+k]);if fnamestart[curfont]=vfsize then begin write(vffile,78);
+write(vffile,85);write(vffile,76);write(vffile,76);
+end else for k:=0 to fnamelength[curfont]-1 do write(vffile,vf[
+fnamestart[curfont]+k]);
+vcount:=vcount+12+farealength[curfont]+fnamelength[curfont];end{:178};
+for c:=bc to ec do if charwd[c]>0 then{179:}begin x:=memory[charwd[c]];
+if designunits<>1048576 then x:=round((x/designunits)*1048576.0);
+if(packetlength[c]>241)or(x<0)or(x>=16777216)then begin write(vffile,242
+);voutint(packetlength[c]);voutint(c);voutint(x);
+vcount:=vcount+13+packetlength[c];
+end else begin write(vffile,packetlength[c]);write(vffile,c);
+write(vffile,x div 65536);write(vffile,(x div 256)mod 256);
+write(vffile,x mod 256);vcount:=vcount+5+packetlength[c];end;
+if packetstart[c]=vfsize then begin if c>=128 then write(vffile,128);
+write(vffile,c);
+end else for k:=0 to packetlength[c]-1 do write(vffile,vf[packetstart[c]
++k]);end{:179};repeat write(vffile,248);vcount:=vcount+1;
+until vcount mod 4=0{:177};end;{:180}{181:}begin initialize;nameenter;
+readinput;writeln('.');corrandcheck;{157:}{159:}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;{168:}{169:}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{:169};
+if bchar<256 then begin extralocneeded:=true;lkoffset:=1;
+end else begin extralocneeded:=false;lkoffset:=0;end;{170:}
+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{:170};
+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{:168};
+lf:=6+lh+(ec-bc+1)+memory[1]+memory[2]+memory[3]+memory[4]+nl+lkoffset+
+nk+ne+np;{:159};{160:}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);{:160};{162:}
+if not checksumspecified then{163:}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{:163};
+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]);{:162};{164:}
+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{:164};{166:}
+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;{:166};{171:}
+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]){:171};
+{172:}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;{:172};{173:}
+for parptr:=1 to np do begin if parptr=1 then{174:}
+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{:174}else outscaled(param[parptr]);end{:173}{:157};vfoutput;
+9999:writeln(' ');end.{:181}