diff options
author | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
---|---|---|
committer | Norbert Preining <norbert@preining.info> | 2019-09-02 13:46:59 +0900 |
commit | e0c6872cf40896c7be36b11dcc744620f10adf1d (patch) | |
tree | 60335e10d2f4354b0674ec22d7b53f0f8abee672 /systems/knuth/local |
Initial commit
Diffstat (limited to 'systems/knuth/local')
255 files changed, 54805 insertions, 0 deletions
diff --git a/systems/knuth/local/GPCtypes.h b/systems/knuth/local/GPCtypes.h new file mode 100644 index 0000000000..59196bcfa8 --- /dev/null +++ b/systems/knuth/local/GPCtypes.h @@ -0,0 +1,108 @@ +/* some typedefs to allow C extensions in GPC programs */ +#include <stdio.h> + +typedef enum {FALSE, TRUE} bool; +typedef struct Fdr* FDR; +typedef int (*t_InFunc) (void *, char *, int, int *); +typedef int (*t_OutFunc)(void *, const char *, int, int *); +typedef enum { foReset, foRewrite, foAppend, foSeekRead, foSeekWrite, foSeekUpdate } TOpenMode; +typedef void (*TOpenProc) (void *, TOpenMode); +typedef size_t (*TReadFunc) (void *, char *, size_t); +typedef size_t (*TWriteFunc) (void *, const char *, size_t); +typedef void (*TFlushProc) (void *); +typedef void (*TCloseProc) (void *); +typedef void (*TDoneProc) (void *); + +typedef long long int UnixTimeType; /* This is hard-coded in the compiler. Do not change here. */ +#define FILE_BUFSIZE 1024 + +typedef struct { + int Capacity; + int length; + char string [256]; /* the length is actually variable */ +} STRING; + +typedef struct +{ + char Bound; + char Force; + char Extensions_valid; + char Readable; + char Writable; + char Executable; + char Existing; + char Directory; + long long int Size; + UnixTimeType AccessTime; + UnixTimeType ModificationTime; + UnixTimeType ChangeTime; + int Error; + FILE *CFile; + STRING Name; +} GPC_BINDING; + +struct Fdr { + unsigned char *FilBuf; /* address of the file buffer in heap */ + int FilSta; /* status bits; see below */ + int FilSiz; /* buffer size: if packed then in bits else bytes */ + /* THE ABOVE FIELDS ACCESSED BY COMPILER */ + /* The fields below are used only by RTS */ + /* Internal buffering and used for ReadStr/WriteStr */ + unsigned char *BufPtr; /* NOT the Standard Pascal file buffer, that is (*FilBuf) */ + int BufSize; + int BufPos; + int Flags; + char *FilNam; /* Internal name of the file */ + char *ExtNam; /* External name of the file */ + FILE *FilJfn; /* FILE pointer */ + int RtsSta; /* run time system status bits */ + FDR NxtFdr; /* FDR chain pointer */ + GPC_BINDING *Binding; /* Binding of the file */ + char *BoundName; /* Name the binding refers to as a CString */ + int BindingChanged; + t_InFunc hack_InFunc; + t_OutFunc hack_OutFunc; + void *PrivateData; + TOpenProc OpenProc; + TReadFunc ReadFunc; + TWriteFunc WriteFunc; + TFlushProc FlushProc; + TCloseProc CloseProc; + TDoneProc DoneProc; + unsigned char InternalBuffer [FILE_BUFSIZE]; /* NOT the Standard Pascal file buffer, that is (*FilBuf) */ +}; + +/* FilSta bit definitions */ + +#define FiUnd (1 << 0) /* File buffer is totally undefined */ +#define FiEof (1 << 2) /* End of file is true */ +#define FiEln (1 << 3) /* End of line is true. Textfiles only */ +#define FiTxt (1 << 4) /* It's a TEXT file */ +#define FiExt (1 << 5) /* External file */ +#define FiExtB (1 << 6) /* External or bound file */ +#define FiPck (1 << 7) /* Packed file */ +#define FiClr (1 << 8) /* Empty file */ +#define FiLzy (1 << 9) /* This file is lazy */ +#define FiEofOK (1 << 10) /* Internal flag if FiUnd is set: Accept EOF without EOLN */ +#define FiDacc (1 << 11) /* This is a direct access file */ +#define FiLget (1 << 12) /* Must do a get before buffer reference (Lazy I/O) */ +#define FiByte (1 << 13) /* File buffer is actually one byte size */ +#define FiBindable (1 << 15) /* File is bindable */ + +/* RtsSta bit definitions */ + +#define FiNOP 0 /* File has not been opened */ +#define FiRONLY (1 << 0) /* File opened but is read only */ +#define FiORE (1 << 1) /* File open for reading */ +#define FiWRI (1 << 2) /* File open for writing */ +#define FiRND (1 << 3) /* File open for random access */ +#define FiWONLY (1 << 4) /* File opened but is write only */ +/* RtsSta: Device specific bits */ +#define FiTTY (1 << 10) /* TTY: flush output before GET */ +#define FiSEEK (1 << 12) /* File is seekable */ +#define FiSIZEK (1 << 13) /* Size of file is known */ +#define FiFLUSH (1 << 14) /* flush after write */ + +extern int _p_argc; /* argument count on command line */ +extern char **_p_argv; /* argument vector on command line */ +extern char **_p_envp; /* environment vector */ diff --git a/systems/knuth/local/Makefile b/systems/knuth/local/Makefile new file mode 100644 index 0000000000..da0b13cc0e --- /dev/null +++ b/systems/knuth/local/Makefile @@ -0,0 +1,12 @@ +# This is an example Makefile for the binarydemo program only + +PFLAGS= -g +CFLAGS= -g +PC= gpc + +bdemo: bdemo_ext.h bdemo_ext.o binarydemo.o + ${PC} ${PFLAGS} -o bdemo binarydemo.o bdemo_ext.o + +clean: + rm -f *.o *~ core btest bdemo + diff --git a/systems/knuth/local/Makefile-sparc b/systems/knuth/local/Makefile-sparc new file mode 100644 index 0000000000..fb16ac3492 --- /dev/null +++ b/systems/knuth/local/Makefile-sparc @@ -0,0 +1,12 @@ +# This is an example Makefile for the binarydemo program only + +PFLAGS= -g +CFLAGS= -g +PC= time pc + +bdemo: bdemo_ext.h bdemo_ext.o binarydemo.o + pc ${PFLAGS} -o bdemo binarydemo.o bdemo_ext.o + +clean: + rm -f *.o *~ core btest bdemo + diff --git a/systems/knuth/local/bdemo_ext.c b/systems/knuth/local/bdemo_ext.c new file mode 100644 index 0000000000..91fedf8f61 --- /dev/null +++ b/systems/knuth/local/bdemo_ext.c @@ -0,0 +1,81 @@ +/* External procedures for the binary demo program using GPC */ + +#include "GPCtypes.h" /* defines GNU Pascal I/O structure */ +#include <string.h> +#include <unistd.h> +#include <sys/stat.h> + +#define namelength 100 /* should agree with binarydemo.p */ + +bool Argv(int n, char* str) +{ + register char *s,*t; + if (n<0 || n>=_p_argc) return FALSE; + s=_p_argv[n]; + if (strlen(s) >= namelength) return FALSE; + for (t=str; *s; s++,t++) *t=*s; + *t='\0'; + return TRUE; +} + +void Bread(FDR filep, char *x) +{ + /* reads a character WITHOUT using the Pascal runtime buffers etc */ + register char c; + c=getc(filep->FilJfn); + *x=c; +} + +bool Testeof(FDR filep) +{ + register int c; + register FILE *iop; /* stdio-style FILE pointer */ + + iop = filep->FilJfn; + if (feof(iop)) return TRUE; + c = getc(iop); + if (c == EOF) return TRUE; + else { + ungetc(c,iop); + return FALSE; + } +} + +bool Testreadaccess(char *fn) +{ + return access(fn,R_OK)? FALSE: TRUE; +} + +bool Testwriteaccess(fn) + char *fn; +{ + int f; + f = creat(fn,0666); /* we try to create a new file, because + simply testing write access with access(fn,W_OK) + will fail when the file doesn't exist */ + if (f >= 0) { + close(f); return TRUE; + } else return FALSE; +} + +int Flength(FDR filep) +{ + register FILE *iop; /* stdio-style FILE pointer */ + register long pos; /* current file position */ + register int len; /* the file length */ + + iop = filep->FilJfn; + pos = ftell(iop); + fseek(iop,0L,SEEK_END); + len = ftell(iop); + fseek(iop,pos,0); + return len; +} + +void Movetobyte(FDR filep,int cnt) +{ + register FILE *iop; /* stdio-style FILE pointer */ + + iop = filep->FilJfn; + fseek(iop,(long)cnt,SEEK_SET); +} diff --git a/systems/knuth/local/bdemo_ext.c-sparc b/systems/knuth/local/bdemo_ext.c-sparc new file mode 100644 index 0000000000..c0b78334da --- /dev/null +++ b/systems/knuth/local/bdemo_ext.c-sparc @@ -0,0 +1,84 @@ +/* External procedures for the binary demo program */ + +#include "h00vars.h" /* defines Pascal I/O structure */ + +#define namelength 100 /* should agree with binarydemo.p */ + +movetobyte(filep,cnt) + register struct iorec *filep; + int cnt; +{ + register FILE *iop; /* stdio-style FILE pointer */ + + iop = filep->fbuf; + fseek(iop,(long)cnt,0); +} + +bool testeof(filep) + register struct iorec *filep; +{ + register char c; + register FILE *iop; /* stdio-style FILE pointer */ + + if (filep->funit & EOFF) + return(TRUE); + else { /* check to see if next is EOF */ + iop = filep->fbuf; + c = getc(iop); + if (c == EOF) + return(TRUE); + else { + ungetc(c,iop); + return(FALSE); + } + } +} + +bool testreadaccess(fn) + char *fn; +{ + register char *p; + + fn[namelength-1] = ' '; + p = fn; + while (*p++ != ' '); + p--; + *p = '\0'; + if (access(fn,4)==0) { + *p = ' '; return(TRUE);} + else {*p = ' '; return(FALSE);} +} + +bool testwriteaccess(fn) + char *fn; +{ + register char *p; + int f; + + fn[namelength-1] = ' '; + p=fn; + while (*p++ != ' '); + p--; + *p = '\0'; + f = creat(fn,0666); /* we try to create a new file, because + simply testing write access with access(fn,2) + will fail when the file doesn't exist */ + *p = ' '; + if (f >= 0) {close(f); return(TRUE);} + else return(FALSE); +} + +int flength(filep) + register struct iorec *filep; +{ + register FILE *iop; /* stdio-style FILE pointer */ + register long pos; /* current file position */ + register int len; /* the file length */ + + iop = filep->fbuf; + pos = ftell(iop); + fseek(iop,0L,2); + len = ftell(iop); + fseek(iop,pos,0); + return(len); +} diff --git a/systems/knuth/local/bdemo_ext.h b/systems/knuth/local/bdemo_ext.h new file mode 100644 index 0000000000..f8eaa69bf2 --- /dev/null +++ b/systems/knuth/local/bdemo_ext.h @@ -0,0 +1,15 @@ +{names of external C routines to include in GNU Pascal binarydemo program} + +function argv(no:Integer;var str:UNIXfilename):boolean; external; + +procedure bread(var a:bytefile; var x:byte); external; + +function testeof(var f:bytefile):boolean; external; + +function testreadaccess(var a:UNIXfilename):boolean; external; + +function testwriteaccess(var a:UNIXfilename):boolean; external; + +function flength(var f:bytefile):integer; external; + +procedure movetobyte(var f:bytefile; n:integer); external; diff --git a/systems/knuth/local/bdemo_ext.h-sparc b/systems/knuth/local/bdemo_ext.h-sparc new file mode 100644 index 0000000000..97309edc0a --- /dev/null +++ b/systems/knuth/local/bdemo_ext.h-sparc @@ -0,0 +1,11 @@ +{names of external C routines to include in Pascal binarydemo program} + +function testeof(var f:bytefile):boolean; external; + +function testreadaccess(var a:UNIXfilename):boolean; external; + +function testwriteaccess(var a:UNIXfilename):boolean; external; + +function flength(var f:bytefile):integer; external; + +procedure movetobyte(var f:bytefile; n:integer); external; diff --git a/systems/knuth/local/binarydemo.p b/systems/knuth/local/binarydemo.p Binary files differnew file mode 100644 index 0000000000..2430f9ac00 --- /dev/null +++ b/systems/knuth/local/binarydemo.p diff --git a/systems/knuth/local/binarydemo.p-sparc b/systems/knuth/local/binarydemo.p-sparc new file mode 100644 index 0000000000..13371e071c --- /dev/null +++ b/systems/knuth/local/binarydemo.p-sparc @@ -0,0 +1,48 @@ +program bdemo(output); {demonstrates binary file I/O in Pascal, + using external C routines to help out} +label 9999; +const namelength=100; +type byte=-128..127; + bytefile=packed file of byte; + UNIXfilename=packed array[1..namelength] of char; +var fname:UNIXfilename; + bfile:bytefile; + k,l:integer; +#include "bdemo_ext.h" +procedure printstatus(n:integer); +var x:byte; +begin if testeof(bfile) then writeln('Byte ',n:1,' is EOF') +else begin read(bfile,x); writeln('Byte ',n:1,' is ',x:1); + end; +end; +begin if argc=1 then {no file name argument given on command line} + begin writeln('Creating test file btest'); + fname:='btest'; + if not testwriteaccess(fname) then + begin writeln('I couldn''t create it!'); goto 9999; + end; + rewrite(bfile,fname); + for k:=-128 to 127 do write(bfile,k); + end +else begin argv(1,fname); k:=1; + while (k<namelength)and(fname[k]<>' ') do k:=k+1; + writeln('Examining file ',fname:k,':'); + end; +if not testreadaccess(fname) then + begin writeln('I couldn''t read it!'); goto 9999; + end; +reset(bfile,fname); +l:=flength(bfile); +writeln('The file is ',l:1,' bytes long'); +printstatus(1); +if l>0 then + begin printstatus(2); + if l>1 then + begin movetobyte(bfile,l-2); printstatus(l-1); + end; + movetobyte(bfile,l-1); printstatus(l); + printstatus(l+1); + movetobyte(bfile,l div 2); printstatus(l div 2 + 1); + movetobyte(bfile,1); printstatus(2); + end; +9999:end. diff --git a/systems/knuth/local/cm/bible12.mf b/systems/knuth/local/cm/bible12.mf new file mode 100644 index 0000000000..ce74383a7c --- /dev/null +++ b/systems/knuth/local/cm/bible12.mf @@ -0,0 +1,75 @@ +% Computer Modern Bold Extended Text Italic Halfslanted 12 point +if unknown cmbase: input cmbase fi + +font_identifier:="CMBIBL"; font_size 12pt#; + +u#:=25/36pt#; % unit width +width_adj#:=13/36pt#; % width adjustment for certain characters +serif_fit#:=0pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=8/36pt#; % extra sidebar near uppercase serifs +letter_fit#:=13/36pt#; % extra space added to all sidebars + +body_height#:=324/36pt#; % height of tallest characters +asc_height#:=300/36pt#; % height of lowercase ascenders +cap_height#:=296.4/36pt#; % height of caps +fig_height#:=278.4/36pt#; % height of numerals +x_height#:=192/36pt#; % height of lowercase without ascenders +math_axis#:=108/36pt#; % axis of symmetry for math symbols +bar_height#:=102/36pt#; % height of crossbar in lowercase e +comma_depth#:=84/36pt#; % depth of comma below baseline +desc_depth#:=84/36pt#; % depth of lowercase descenders + +crisp#:=15/36pt#; % diameter of serif corners +tiny#:=15/36pt#; % diameter of rounded corners +fine#:=10/36pt#; % diameter of sharply rounded corners +thin_join#:=11/36pt#; % width of extrafine details +hair#:=23/36pt#; % lowercase hairline breadth +stem#:=44/36pt#; % lowercase stem breadth +curve#:=48/36pt#; % lowercase curve breadth +ess#:=41/36pt#; % breadth in middle of lowercase s +flare#:=45/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=57/36pt#; % diameter of dots +cap_hair#:=24/36pt#; % uppercase hairline breadth +cap_stem#:=53/36pt#; % uppercase stem breadth +cap_curve#:=56/36pt#; % uppercase curve breadth +cap_ess#:=54/36pt#; % breadth in middle of uppercase s +rule_thickness#:=.66pt#; % thickness of lines in math symbols + +dish#:=1/36pt#; % amount erased at top or bottom of serifs +bracket#:=12/36pt#; % vertical distance from serif base to tangent +jut#:=33/36pt#; % protrusion of lowercase serifs +cap_jut#:=46/36pt#; % protrusion of uppercase serifs +beak_jut#:=12/36pt#; % horizontal protrusion of beak serifs +beak#:=84/36pt#; % vertical protrusion of beak serifs +vair#:=16/36pt#; % vertical diameter of hairlines +notch_cut#:=12pt#; % maximum breadth above or below notches +bar#:=18.5/36pt#; % lowercase bar thickness +slab#:=18.5/36pt#; % serif and arm thickness +cap_bar#:=18.5/36pt#; % uppercase bar thickness +cap_band#:=18.5/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=12pt#; % max breadth above/below uppercase notches +serif_drop#:=3.6/36pt#; % vertical drop of sloped serifs +stem_corr#:=2/36pt#; % for small refinements of stem breadth +vair_corr#:=1.5/36pt#; % for small refinements of hairline height +apex_corr#:=0pt#; % extra width at diagonal junctions + +o#:=6/36pt#; % amount of overshoot for curves +apex_o#:=6/36pt#; % amount of overshoot for diagonal junctions + +slant:=1/8; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=1; % factor applied to weights of heavy characters +math_spread:=.4; % extra openness of math symbols +superness:=8/11; % parameter for superellipses +superpull:=1/8; % extra openness inside bowls +beak_darkness:=.4; % fraction of triangle inside beak serifs +ligs:=2; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=false; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=false; % should all characters have the same width? +variant_g:=true; % should an italic-style g be used? +low_asterisk:=false; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +generate textit % switch to the driver file diff --git a/systems/knuth/local/cm/cccsc10.mf b/systems/knuth/local/cm/cccsc10.mf new file mode 100644 index 0000000000..3e82a4e05d --- /dev/null +++ b/systems/knuth/local/cm/cccsc10.mf @@ -0,0 +1,110 @@ +% Concrete Math Roman Caps and Small Caps 10 point +if unknown cmbase: input cmbase fi + +font_identifier:="CCCSC"; font_size 10pt#; + +% first come parameters used to set the uppercase letters +% (including some for lowercase that aren't actually used) +u#:=21/36pt#; % unit width +width_adj#:=0pt#; % width adjustment for certain characters +serif_fit#:=1/36pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=3/36pt#; % extra sidebar near uppercase serifs +letter_fit#:=5/36pt#; % extra space added to all sidebars + +body_height#:=270/36pt#; % height of tallest characters +asc_height#:=250/36pt#; % height of lowercase ascenders +cap_height#:=246/36pt#; % height of caps +fig_height#:=232/36pt#; % height of numerals +x_height#:=155/36pt#; % height of lowercase without ascenders +math_axis#:=90/36pt#; % axis of symmetry for math symbols +bar_height#:=87/36pt#; % height of crossbar in lowercase e +comma_depth#:=70/36pt#; % depth of comma below baseline +desc_depth#:=70/36pt#; % depth of lowercase descenders + +crisp#:=0pt#; % diameter of serif corners +tiny#:=11/36pt#; % diameter of rounded corners +fine#:=6/36pt#; % diameter of sharply rounded corners +thin_join#:=17/36pt#; % width of extrafine details +hair#:=21/36pt#; % lowercase hairline breadth +stem#:=25/36pt#; % lowercase stem breadth +curve#:=27/36pt#; % lowercase curve breadth +ess#:=25/36pt#; % breadth in middle of lowercase s +flare#:=29/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=38/36pt#; % diameter of dots +cap_hair#:=21/36pt#; % uppercase hairline breadth +cap_stem#:=27/36pt#; % uppercase stem breadth +cap_curve#:=28/36pt#; % uppercase curve breadth +cap_ess#:=27/36pt#; % breadth in middle of uppercase s +rule_thickness#:=.4pt#; % thickness of lines in math symbols + +dish#:=0/36pt#; % amount erased at top or bottom of serifs +bracket#:=5/36pt#; % vertical distance from serif base to tangent +jut#:=30/36pt#; % protrusion of lowercase serifs +cap_jut#:=32/36pt#; % protrusion of uppercase serifs +beak_jut#:=10/36pt#; % horizontal protrusion of beak serifs +beak#:=70/36pt#; % vertical protrusion of beak serifs +vair#:=21/36pt#; % vertical diameter of hairlines +notch_cut#:=30/36pt#; % maximum breadth above or below notches +bar#:=21/36pt#; % lowercase bar thickness +slab#:=21/36pt#; % serif and arm thickness +cap_bar#:=21/36pt#; % uppercase bar thickness +cap_band#:=21/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=1pt#; % max breadth above/below uppercase notches +serif_drop#:=5/36pt#; % vertical drop of sloped serifs +stem_corr#:=1/36pt#; % for small refinements of stem breadth +vair_corr#:=1/36pt#; % for small refinements of hairline height +apex_corr#:=0pt#; % extra width at diagonal junctions + +o#:=4/36pt#; % amount of overshoot for curves +apex_o#:=3/36pt#; % amount of overshoot for diagonal junctions + +slant:=0; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=.95; % factor applied to weights of heavy characters +math_spread:=0; % extra openness of math symbols +superness:=8/11; % parameter for superellipses +superpull:=1/15; % extra openness inside bowls +beak_darkness:=4/30; % fraction of triangle inside beak serifs +ligs:=1; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=false; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=false; % should all characters have the same width? +variant_g:=false; % should an italic-style g be used? +low_asterisk:=false; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +% now come replacements used to set the lowercase caps + +lower.u#:=16/36pt#; % unit width +lower.width_adj#:=0pt#; % width adjustment for certain characters +lower.cap_serif_fit#:=2/36pt#; % extra sidebar near uppercase serifs +lower.letter_fit#:=2.4/36pt#; % extra space added to all sidebars + +lower.body_height#:=200/36pt#; % height of tallest characters +lower.cap_height#:=185/36pt#; % height of caps +lower.x_height#:=116/36pt#; % height of lowercase without ascenders +lower.bar_height#:=65/36pt#; % height of crossbar in lowercase e +lower.comma_depth#:=52/36pt#; % depth of comma below baseline + +lower.flare#:=22/36pt#; % diameter of bulbs or breadth of terminals +lower.cap_hair#:=21/36pt#; % uppercase hairline breadth +lower.stem#:=23/36pt#; % lowercase stem breadth +lower.cap_stem#:=24/36pt#; % uppercase stem breadth +lower.cap_curve#:=26/36pt#; % uppercase curve breadth +lower.cap_ess#:=24/36pt#; % breadth in middle of uppercase s + +lower.cap_jut#:=24/36pt#; % protrusion of uppercase serifs +lower.beak_jut#:=7/36pt#; % horizontal protrusion of beak serifs +lower.beak#:=52/36pt#; % vertical protrusion of beak serifs +lower.slab#:=21/36pt#; % serif and arm thickness +lower.cap_bar#:=21/36pt#; % uppercase bar thickness +lower.cap_band#:=21/36pt#; % uppercase thickness above/below lobes +lower.cap_notch_cut#:=27/36pt#; % max breadth above/below uppercase notches + +lower.o#:=3/36pt#; % amount of overshoot for curves +lower.apex_o#:=3/36pt#; % amount of overshoot for diagonal junctions + +lower.fudge:=.93; % factor applied to weights of heavy characters + +generate csc % switch to the driver file diff --git a/systems/knuth/local/cm/ccmi10.mf b/systems/knuth/local/cm/ccmi10.mf new file mode 100644 index 0000000000..58e340fb11 --- /dev/null +++ b/systems/knuth/local/cm/ccmi10.mf @@ -0,0 +1,75 @@ +% Concrete Math Italic 10 point +if unknown cmbase: input cmbase fi + +font_identifier:="CCMI"; font_size 10pt#; + +u#:=20/36pt#; % unit width +width_adj#:=0pt#; % width adjustment for certain characters +serif_fit#:=1/36pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=3/36pt#; % extra sidebar near uppercase serifs +letter_fit#:=0pt#; % extra space added to all sidebars + +body_height#:=270/36pt#; % height of tallest characters +asc_height#:=250/36pt#; % height of lowercase ascenders +cap_height#:=246/36pt#; % height of caps +fig_height#:=232/36pt#; % height of numerals +x_height#:=165/36pt#; % height of lowercase without ascenders +math_axis#:=90/36pt#; % axis of symmetry for math symbols +bar_height#:=92/36pt#; % height of crossbar in lowercase e +comma_depth#:=70/36pt#; % depth of comma below baseline +desc_depth#:=70/36pt#; % depth of lowercase descenders + +crisp#:=0pt#; % diameter of serif corners +tiny#:=11/36pt#; % diameter of rounded corners +fine#:=6/36pt#; % diameter of sharply rounded corners +thin_join#:=17/36pt#; % width of extrafine details +hair#:=21/36pt#; % lowercase hairline breadth +stem#:=25/36pt#; % lowercase stem breadth +curve#:=27/36pt#; % lowercase curve breadth +ess#:=25/36pt#; % breadth in middle of lowercase s +flare#:=29/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=38/36pt#; % diameter of dots +cap_hair#:=21/36pt#; % uppercase hairline breadth +cap_stem#:=27/36pt#; % uppercase stem breadth +cap_curve#:=28/36pt#; % uppercase curve breadth +cap_ess#:=27/36pt#; % breadth in middle of uppercase s +rule_thickness#:=.4pt#; % thickness of lines in math symbols + +dish#:=0/36pt#; % amount erased at top or bottom of serifs +bracket#:=5/36pt#; % vertical distance from serif base to tangent +jut#:=30/36pt#; % protrusion of lowercase serifs +cap_jut#:=32/36pt#; % protrusion of uppercase serifs +beak_jut#:=10/36pt#; % horizontal protrusion of beak serifs +beak#:=70/36pt#; % vertical protrusion of beak serifs +vair#:=21/36pt#; % vertical diameter of hairlines +notch_cut#:=30/36pt#; % maximum breadth above or below notches +bar#:=21/36pt#; % lowercase bar thickness +slab#:=21/36pt#; % serif and arm thickness +cap_bar#:=21/36pt#; % uppercase bar thickness +cap_band#:=21/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=1pt#; % max breadth above/below uppercase notches +serif_drop#:=5/36pt#; % vertical drop of sloped serifs +stem_corr#:=1/36pt#; % for small refinements of stem breadth +vair_corr#:=1/36pt#; % for small refinements of hairline height +apex_corr#:=0pt#; % extra width at diagonal junctions + +o#:=4/36pt#; % amount of overshoot for curves +apex_o#:=3/36pt#; % amount of overshoot for diagonal junctions + +slant:=.25; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=.95; % factor applied to weights of heavy characters +math_spread:=0; % extra openness of math symbols +superness:=8/11; % parameter for superellipses +superpull:=1/15; % extra openness inside bowls +beak_darkness:=4/30; % fraction of triangle inside beak serifs +ligs:=2; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=false; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=false; % should all characters have the same width? +variant_g:=true; % should an italic-style g be used? +low_asterisk:=false; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +generate mathit % switch to the driver file diff --git a/systems/knuth/local/cm/ccmic9.mf b/systems/knuth/local/cm/ccmic9.mf new file mode 100644 index 0000000000..91e93d78b9 --- /dev/null +++ b/systems/knuth/local/cm/ccmic9.mf @@ -0,0 +1,75 @@ +% Concrete Slanted Condensed Oldstyle Digits 9 point +if unknown cmbase: input cmbase fi + +font_identifier:="CCMIC"; font_size 9pt#; + +u#:=16/36pt#; % unit width +width_adj#:=0pt#; % width adjustment for certain characters +serif_fit#:=0pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=2/36pt#; % extra sidebar near uppercase serifs +letter_fit#:=0pt#; % extra space added to all sidebars + +body_height#:=243/36pt#; % height of tallest characters +asc_height#:=225/36pt#; % height of lowercase ascenders +cap_height#:=221.4/36pt#; % height of caps +fig_height#:=208.8/36pt#; % height of numerals +x_height#:=155/36pt#; % height of lowercase without ascenders +math_axis#:=81/36pt#; % axis of symmetry for math symbols +bar_height#:=85/36pt#; % height of crossbar in lowercase e +comma_depth#:=63/36pt#; % depth of comma below baseline +desc_depth#:=63/36pt#; % depth of lowercase descenders + +crisp#:=0pt#; % diameter of serif corners +tiny#:=9/36pt#; % diameter of rounded corners +fine#:=6/36pt#; % diameter of sharply rounded corners +thin_join#:=13/36pt#; % width of extrafine details +hair#:=16/36pt#; % lowercase hairline breadth +stem#:=22/36pt#; % lowercase stem breadth +curve#:=23/36pt#; % lowercase curve breadth +ess#:=25/36pt#; % breadth in middle of lowercase s +flare#:=28/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=35/36pt#; % diameter of dots +cap_hair#:=16/36pt#; % uppercase hairline breadth +cap_stem#:=23/36pt#; % uppercase stem breadth +cap_curve#:=24/36pt#; % uppercase curve breadth +cap_ess#:=23/36pt#; % breadth in middle of uppercase s +rule_thickness#:=.38pt#; % thickness of lines in math symbols + +dish#:=0/36pt#; % amount erased at top or bottom of serifs +bracket#:=5/36pt#; % vertical distance from serif base to tangent +jut#:=15/36pt#; % protrusion of lowercase serifs +cap_jut#:=16/36pt#; % protrusion of uppercase serifs +beak_jut#:=9.2/36pt#; % horizontal protrusion of beak serifs +beak#:=63/36pt#; % vertical protrusion of beak serifs +vair#:=15/36pt#; % vertical diameter of hairlines +notch_cut#:=27/36pt#; % maximum breadth above or below notches +bar#:=15/36pt#; % lowercase bar thickness +slab#:=15/36pt#; % serif and arm thickness +cap_bar#:=15/36pt#; % uppercase bar thickness +cap_band#:=15/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=.9pt#; % max breadth above/below uppercase notches +serif_drop#:=3.6/36pt#; % vertical drop of sloped serifs +stem_corr#:=1/36pt#; % for small refinements of stem breadth +vair_corr#:=1/36pt#; % for small refinements of hairline height +apex_corr#:=0pt#; % extra width at diagonal junctions + +o#:=4/36pt#; % amount of overshoot for curves +apex_o#:=3/36pt#; % amount of overshoot for diagonal junctions + +slant:=1/6; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=1; % factor applied to weights of heavy characters +math_spread:=.2; % extra openness of math symbols +superness:=8/11; % parameter for superellipses +superpull:=1/15; % extra openness inside bowls +beak_darkness:=5/30; % fraction of triangle inside beak serifs +ligs:=2; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=false; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=false; % should all characters have the same width? +variant_g:=true; % should an italic-style g be used? +low_asterisk:=false; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +generate odigs % switch to the driver file diff --git a/systems/knuth/local/cm/ccr10.mf b/systems/knuth/local/cm/ccr10.mf new file mode 100644 index 0000000000..630a9edf45 --- /dev/null +++ b/systems/knuth/local/cm/ccr10.mf @@ -0,0 +1,75 @@ +% Concrete Roman 10 point +if unknown cmbase: input cmbase fi + +font_identifier:="CCR"; font_size 10pt#; + +u#:=20/36pt#; % unit width +width_adj#:=0pt#; % width adjustment for certain characters +serif_fit#:=1/36pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=3/36pt#; % extra sidebar near uppercase serifs +letter_fit#:=0pt#; % extra space added to all sidebars + +body_height#:=270/36pt#; % height of tallest characters +asc_height#:=250/36pt#; % height of lowercase ascenders +cap_height#:=246/36pt#; % height of caps +fig_height#:=232/36pt#; % height of numerals +x_height#:=165/36pt#; % height of lowercase without ascenders +math_axis#:=90/36pt#; % axis of symmetry for math symbols +bar_height#:=92/36pt#; % height of crossbar in lowercase e +comma_depth#:=70/36pt#; % depth of comma below baseline +desc_depth#:=70/36pt#; % depth of lowercase descenders + +crisp#:=0pt#; % diameter of serif corners +tiny#:=11/36pt#; % diameter of rounded corners +fine#:=6/36pt#; % diameter of sharply rounded corners +thin_join#:=17/36pt#; % width of extrafine details +hair#:=21/36pt#; % lowercase hairline breadth +stem#:=25/36pt#; % lowercase stem breadth +curve#:=27/36pt#; % lowercase curve breadth +ess#:=25/36pt#; % breadth in middle of lowercase s +flare#:=29/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=38/36pt#; % diameter of dots +cap_hair#:=21/36pt#; % uppercase hairline breadth +cap_stem#:=27/36pt#; % uppercase stem breadth +cap_curve#:=28/36pt#; % uppercase curve breadth +cap_ess#:=27/36pt#; % breadth in middle of uppercase s +rule_thickness#:=.4pt#; % thickness of lines in math symbols + +dish#:=0/36pt#; % amount erased at top or bottom of serifs +bracket#:=5/36pt#; % vertical distance from serif base to tangent +jut#:=30/36pt#; % protrusion of lowercase serifs +cap_jut#:=32/36pt#; % protrusion of uppercase serifs +beak_jut#:=10/36pt#; % horizontal protrusion of beak serifs +beak#:=70/36pt#; % vertical protrusion of beak serifs +vair#:=21/36pt#; % vertical diameter of hairlines +notch_cut#:=30/36pt#; % maximum breadth above or below notches +bar#:=21/36pt#; % lowercase bar thickness +slab#:=21/36pt#; % serif and arm thickness +cap_bar#:=21/36pt#; % uppercase bar thickness +cap_band#:=21/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=1pt#; % max breadth above/below uppercase notches +serif_drop#:=5/36pt#; % vertical drop of sloped serifs +stem_corr#:=1/36pt#; % for small refinements of stem breadth +vair_corr#:=1/36pt#; % for small refinements of hairline height +apex_corr#:=0pt#; % extra width at diagonal junctions + +o#:=4/36pt#; % amount of overshoot for curves +apex_o#:=3/36pt#; % amount of overshoot for diagonal junctions + +slant:=0; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=.95; % factor applied to weights of heavy characters +math_spread:=0; % extra openness of math symbols +superness:=8/11; % parameter for superellipses +superpull:=1/15; % extra openness inside bowls +beak_darkness:=4/30; % fraction of triangle inside beak serifs +ligs:=2; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=false; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=false; % should all characters have the same width? +variant_g:=false; % should an italic-style g be used? +low_asterisk:=false; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +generate roman % switch to the driver file diff --git a/systems/knuth/local/cm/ccr5.mf b/systems/knuth/local/cm/ccr5.mf new file mode 100644 index 0000000000..f2927069be --- /dev/null +++ b/systems/knuth/local/cm/ccr5.mf @@ -0,0 +1,75 @@ +% Concrete Roman 5 point +if unknown cmbase: input cmbase fi + +font_identifier:="CCR"; font_size 5pt#; + +u#:=12.5/36pt#; % unit width +width_adj#:=0pt#; % width adjustment for certain characters +serif_fit#:=1/36pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=2/36pt#; % extra sidebar near uppercase serifs +letter_fit#:=5/36pt#; % extra space added to all sidebars + +body_height#:=135/36pt#; % height of tallest characters +asc_height#:=125/36pt#; % height of lowercase ascenders +cap_height#:=123/36pt#; % height of caps +fig_height#:=116/36pt#; % height of numerals +x_height#:=82.5/36pt#; % height of lowercase without ascenders +math_axis#:=45/36pt#; % axis of symmetry for math symbols +bar_height#:=43.5/36pt#; % height of crossbar in lowercase e +comma_depth#:=35/36pt#; % depth of comma below baseline +desc_depth#:=35/36pt#; % depth of lowercase descenders + +crisp#:=0pt#; % diameter of serif corners +tiny#:=6/36pt#; % diameter of rounded corners +fine#:=5/36pt#; % diameter of sharply rounded corners +thin_join#:=11/36pt#; % width of extrafine details +hair#:=14/36pt#; % lowercase hairline breadth +stem#:=16/36pt#; % lowercase stem breadth +curve#:=17/36pt#; % lowercase curve breadth +ess#:=12/36pt#; % breadth in middle of lowercase s +flare#:=18/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=22/36pt#; % diameter of dots +cap_hair#:=14/36pt#; % uppercase hairline breadth +cap_stem#:=17/36pt#; % uppercase stem breadth +cap_curve#:=18/36pt#; % uppercase curve breadth +cap_ess#:=14/36pt#; % breadth in middle of uppercase s +rule_thickness#:=.28pt#; % thickness of lines in math symbols + +dish#:=0/36pt#; % amount erased at top or bottom of serifs +bracket#:=3/36pt#; % vertical distance from serif base to tangent +jut#:=17/36pt#; % protrusion of lowercase serifs +cap_jut#:=18/36pt#; % protrusion of uppercase serifs +beak_jut#:=6/36pt#; % horizontal protrusion of beak serifs +beak#:=35/36pt#; % vertical protrusion of beak serifs +vair#:=14/36pt#; % vertical diameter of hairlines +notch_cut#:=15/36pt#; % maximum breadth above or below notches +bar#:=14/36pt#; % lowercase bar thickness +slab#:=14/36pt#; % serif and arm thickness +cap_bar#:=14/36pt#; % uppercase bar thickness +cap_band#:=14/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=.5pt#; % max breadth above/below uppercase notches +serif_drop#:=2/36pt#; % vertical drop of sloped serifs +stem_corr#:=.7/36pt#; % for small refinements of stem breadth +vair_corr#:=.5/36pt#; % for small refinements of hairline height +apex_corr#:=0pt#; % extra width at diagonal junctions + +o#:=3/36pt#; % amount of overshoot for curves +apex_o#:=2/36pt#; % amount of overshoot for diagonal junctions + +slant:=0; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=.95; % factor applied to weights of heavy characters +math_spread:=1; % extra openness of math symbols +superness:=8/11; % parameter for superellipses +superpull:=1/15; % extra openness inside bowls +beak_darkness:=4/30; % fraction of triangle inside beak serifs +ligs:=1; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=false; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=false; % should all characters have the same width? +variant_g:=false; % should an italic-style g be used? +low_asterisk:=false; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +generate roman % switch to the driver file diff --git a/systems/knuth/local/cm/ccr6.mf b/systems/knuth/local/cm/ccr6.mf new file mode 100644 index 0000000000..f6d0cebeef --- /dev/null +++ b/systems/knuth/local/cm/ccr6.mf @@ -0,0 +1,75 @@ +% Concrete Roman 6 point +if unknown cmbase: input cmbase fi + +font_identifier:="CCR"; font_size 6pt#; + +u#:=14/36pt#; % unit width +width_adj#:=0pt#; % width adjustment for certain characters +serif_fit#:=1/36pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=2.2/36pt#; % extra sidebar near uppercase serifs +letter_fit#:=3/36pt#; % extra space added to all sidebars + +body_height#:=162/36pt#; % height of tallest characters +asc_height#:=150/36pt#; % height of lowercase ascenders +cap_height#:=147.6/36pt#; % height of caps +fig_height#:=139.2/36pt#; % height of numerals +x_height#:=99/36pt#; % height of lowercase without ascenders +math_axis#:=54/36pt#; % axis of symmetry for math symbols +bar_height#:=52.2/36pt#; % height of crossbar in lowercase e +comma_depth#:=42/36pt#; % depth of comma below baseline +desc_depth#:=42/36pt#; % depth of lowercase descenders + +crisp#:=0pt#; % diameter of serif corners +tiny#:=7/36pt#; % diameter of rounded corners +fine#:=6/36pt#; % diameter of sharply rounded corners +thin_join#:=12/36pt#; % width of extrafine details +hair#:=15/36pt#; % lowercase hairline breadth +stem#:=18/36pt#; % lowercase stem breadth +curve#:=19/36pt#; % lowercase curve breadth +ess#:=17/36pt#; % breadth in middle of lowercase s +flare#:=20/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=26/36pt#; % diameter of dots +cap_hair#:=15/36pt#; % uppercase hairline breadth +cap_stem#:=19/36pt#; % uppercase stem breadth +cap_curve#:=20/36pt#; % uppercase curve breadth +cap_ess#:=19/36pt#; % breadth in middle of uppercase s +rule_thickness#:=.31pt#; % thickness of lines in math symbols + +dish#:=0/36pt#; % amount erased at top or bottom of serifs +bracket#:=3/36pt#; % vertical distance from serif base to tangent +jut#:=19/36pt#; % protrusion of lowercase serifs +cap_jut#:=20/36pt#; % protrusion of uppercase serifs +beak_jut#:=6.8/36pt#; % horizontal protrusion of beak serifs +beak#:=42/36pt#; % vertical protrusion of beak serifs +vair#:=15/36pt#; % vertical diameter of hairlines +notch_cut#:=18/36pt#; % maximum breadth above or below notches +bar#:=15/36pt#; % lowercase bar thickness +slab#:=15/36pt#; % serif and arm thickness +cap_bar#:=15/36pt#; % uppercase bar thickness +cap_band#:=15/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=.6pt#; % max breadth above/below uppercase notches +serif_drop#:=2.4/36pt#; % vertical drop of sloped serifs +stem_corr#:=.8/36pt#; % for small refinements of stem breadth +vair_corr#:=.7/36pt#; % for small refinements of hairline height +apex_corr#:=0pt#; % extra width at diagonal junctions + +o#:=3/36pt#; % amount of overshoot for curves +apex_o#:=3/36pt#; % amount of overshoot for diagonal junctions + +slant:=0; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=.95; % factor applied to weights of heavy characters +math_spread:=.8; % extra openness of math symbols +superness:=8/11; % parameter for superellipses +superpull:=1/15; % extra openness inside bowls +beak_darkness:=4/30; % fraction of triangle inside beak serifs +ligs:=2; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=false; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=false; % should all characters have the same width? +variant_g:=false; % should an italic-style g be used? +low_asterisk:=false; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +generate roman % switch to the driver file diff --git a/systems/knuth/local/cm/ccr7.mf b/systems/knuth/local/cm/ccr7.mf new file mode 100644 index 0000000000..8d6255249e --- /dev/null +++ b/systems/knuth/local/cm/ccr7.mf @@ -0,0 +1,75 @@ +% Concrete Roman 7 point +if unknown cmbase: input cmbase fi + +font_identifier:="CCR"; font_size 7pt#; + +u#:=15.5/36pt#; % unit width +width_adj#:=0pt#; % width adjustment for certain characters +serif_fit#:=1/36pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=2.4/36pt#; % extra sidebar near uppercase serifs +letter_fit#:=2/36pt#; % extra space added to all sidebars + +body_height#:=189/36pt#; % height of tallest characters +asc_height#:=175/36pt#; % height of lowercase ascenders +cap_height#:=172.2/36pt#; % height of caps +fig_height#:=162.4/36pt#; % height of numerals +x_height#:=115.5/36pt#; % height of lowercase without ascenders +math_axis#:=63/36pt#; % axis of symmetry for math symbols +bar_height#:=60.9/36pt#; % height of crossbar in lowercase e +comma_depth#:=49/36pt#; % depth of comma below baseline +desc_depth#:=49/36pt#; % depth of lowercase descenders + +crisp#:=0pt#; % diameter of serif corners +tiny#:=8/36pt#; % diameter of rounded corners +fine#:=6/36pt#; % diameter of sharply rounded corners +thin_join#:=13/36pt#; % width of extrafine details +hair#:=17/36pt#; % lowercase hairline breadth +stem#:=20/36pt#; % lowercase stem breadth +curve#:=21.5/36pt#; % lowercase curve breadth +ess#:=20/36pt#; % breadth in middle of lowercase s +flare#:=22/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=29/36pt#; % diameter of dots +cap_hair#:=17/36pt#; % uppercase hairline breadth +cap_stem#:=21.5/36pt#; % uppercase stem breadth +cap_curve#:=22.5/36pt#; % uppercase curve breadth +cap_ess#:=21.5/36pt#; % breadth in middle of uppercase s +rule_thickness#:=.34pt#; % thickness of lines in math symbols + +dish#:=0/36pt#; % amount erased at top or bottom of serifs +bracket#:=4/36pt#; % vertical distance from serif base to tangent +jut#:=21/36pt#; % protrusion of lowercase serifs +cap_jut#:=23/36pt#; % protrusion of uppercase serifs +beak_jut#:=7.6/36pt#; % horizontal protrusion of beak serifs +beak#:=49/36pt#; % vertical protrusion of beak serifs +vair#:=17/36pt#; % vertical diameter of hairlines +notch_cut#:=21/36pt#; % maximum breadth above or below notches +bar#:=17/36pt#; % lowercase bar thickness +slab#:=17/36pt#; % serif and arm thickness +cap_bar#:=17/36pt#; % uppercase bar thickness +cap_band#:=17/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=.7pt#; % max breadth above/below uppercase notches +serif_drop#:=2.8/36pt#; % vertical drop of sloped serifs +stem_corr#:=.9/36pt#; % for small refinements of stem breadth +vair_corr#:=.9/36pt#; % for small refinements of hairline height +apex_corr#:=0pt#; % extra width at diagonal junctions + +o#:=3/36pt#; % amount of overshoot for curves +apex_o#:=3/36pt#; % amount of overshoot for diagonal junctions + +slant:=0; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=.95; % factor applied to weights of heavy characters +math_spread:=.6; % extra openness of math symbols +superness:=8/11; % parameter for superellipses +superpull:=1/15; % extra openness inside bowls +beak_darkness:=4/30; % fraction of triangle inside beak serifs +ligs:=2; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=false; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=false; % should all characters have the same width? +variant_g:=false; % should an italic-style g be used? +low_asterisk:=false; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +generate roman % switch to the driver file diff --git a/systems/knuth/local/cm/ccr8.mf b/systems/knuth/local/cm/ccr8.mf new file mode 100644 index 0000000000..4b78beb62e --- /dev/null +++ b/systems/knuth/local/cm/ccr8.mf @@ -0,0 +1,75 @@ +% Concrete Roman 8 point +if unknown cmbase: input cmbase fi + +font_identifier:="CCR"; font_size 8pt#; + +u#:=17/36pt#; % unit width +width_adj#:=0pt#; % width adjustment for certain characters +serif_fit#:=1/36pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=2.6/36pt#; % extra sidebar near uppercase serifs +letter_fit#:=0pt#; % extra space added to all sidebars + +body_height#:=216/36pt#; % height of tallest characters +asc_height#:=200/36pt#; % height of lowercase ascenders +cap_height#:=196.8/36pt#; % height of caps +fig_height#:=185.6/36pt#; % height of numerals +x_height#:=132/36pt#; % height of lowercase without ascenders +math_axis#:=72/36pt#; % axis of symmetry for math symbols +bar_height#:=69.6/36pt#; % height of crossbar in lowercase e +comma_depth#:=56/36pt#; % depth of comma below baseline +desc_depth#:=56/36pt#; % depth of lowercase descenders + +crisp#:=0pt#; % diameter of serif corners +tiny#:=9/36pt#; % diameter of rounded corners +fine#:=6/36pt#; % diameter of sharply rounded corners +thin_join#:=15/36pt#; % width of extrafine details +hair#:=19/36pt#; % lowercase hairline breadth +stem#:=22/36pt#; % lowercase stem breadth +curve#:=24/36pt#; % lowercase curve breadth +ess#:=22/36pt#; % breadth in middle of lowercase s +flare#:=24/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=32/36pt#; % diameter of dots +cap_hair#:=19/36pt#; % uppercase hairline breadth +cap_stem#:=24/36pt#; % uppercase stem breadth +cap_curve#:=25/36pt#; % uppercase curve breadth +cap_ess#:=24/36pt#; % breadth in middle of uppercase s +rule_thickness#:=.36pt#; % thickness of lines in math symbols + +dish#:=0/36pt#; % amount erased at top or bottom of serifs +bracket#:=4/36pt#; % vertical distance from serif base to tangent +jut#:=24/36pt#; % protrusion of lowercase serifs +cap_jut#:=26/36pt#; % protrusion of uppercase serifs +beak_jut#:=8.4/36pt#; % horizontal protrusion of beak serifs +beak#:=56/36pt#; % vertical protrusion of beak serifs +vair#:=19/36pt#; % vertical diameter of hairlines +notch_cut#:=24/36pt#; % maximum breadth above or below notches +bar#:=19/36pt#; % lowercase bar thickness +slab#:=19/36pt#; % serif and arm thickness +cap_bar#:=19/36pt#; % uppercase bar thickness +cap_band#:=19/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=.8pt#; % max breadth above/below uppercase notches +serif_drop#:=3.2/36pt#; % vertical drop of sloped serifs +stem_corr#:=1/36pt#; % for small refinements of stem breadth +vair_corr#:=1/36pt#; % for small refinements of hairline height +apex_corr#:=0pt#; % extra width at diagonal junctions + +o#:=3/36pt#; % amount of overshoot for curves +apex_o#:=3/36pt#; % amount of overshoot for diagonal junctions + +slant:=0; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=.95; % factor applied to weights of heavy characters +math_spread:=.4; % extra openness of math symbols +superness:=8/11; % parameter for superellipses +superpull:=1/15; % extra openness inside bowls +beak_darkness:=4/30; % fraction of triangle inside beak serifs +ligs:=2; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=false; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=false; % should all characters have the same width? +variant_g:=false; % should an italic-style g be used? +low_asterisk:=false; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +generate roman % switch to the driver file diff --git a/systems/knuth/local/cm/ccr9.mf b/systems/knuth/local/cm/ccr9.mf new file mode 100644 index 0000000000..03ca68075a --- /dev/null +++ b/systems/knuth/local/cm/ccr9.mf @@ -0,0 +1,75 @@ +% Concrete Roman 9 point +if unknown cmbase: input cmbase fi + +font_identifier:="CCR"; font_size 9pt#; + +u#:=18.5/36pt#; % unit width +width_adj#:=0pt#; % width adjustment for certain characters +serif_fit#:=1/36pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=2.8/36pt#; % extra sidebar near uppercase serifs +letter_fit#:=0pt#; % extra space added to all sidebars + +body_height#:=243/36pt#; % height of tallest characters +asc_height#:=225/36pt#; % height of lowercase ascenders +cap_height#:=221.4/36pt#; % height of caps +fig_height#:=208.8/36pt#; % height of numerals +x_height#:=148.5/36pt#; % height of lowercase without ascenders +math_axis#:=81/36pt#; % axis of symmetry for math symbols +bar_height#:=78.3/36pt#; % height of crossbar in lowercase e +comma_depth#:=63/36pt#; % depth of comma below baseline +desc_depth#:=63/36pt#; % depth of lowercase descenders + +crisp#:=0pt#; % diameter of serif corners +tiny#:=10/36pt#; % diameter of rounded corners +fine#:=6/36pt#; % diameter of sharply rounded corners +thin_join#:=17/36pt#; % width of extrafine details +hair#:=20/36pt#; % lowercase hairline breadth +stem#:=24/36pt#; % lowercase stem breadth +curve#:=26/36pt#; % lowercase curve breadth +ess#:=24/36pt#; % breadth in middle of lowercase s +flare#:=26/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=35/36pt#; % diameter of dots +cap_hair#:=20/36pt#; % uppercase hairline breadth +cap_stem#:=26/36pt#; % uppercase stem breadth +cap_curve#:=27/36pt#; % uppercase curve breadth +cap_ess#:=24/36pt#; % breadth in middle of uppercase s +rule_thickness#:=.38pt#; % thickness of lines in math symbols + +dish#:=0/36pt#; % amount erased at top or bottom of serifs +bracket#:=5/36pt#; % vertical distance from serif base to tangent +jut#:=27/36pt#; % protrusion of lowercase serifs +cap_jut#:=29/36pt#; % protrusion of uppercase serifs +beak_jut#:=9.2/36pt#; % horizontal protrusion of beak serifs +beak#:=63/36pt#; % vertical protrusion of beak serifs +vair#:=20/36pt#; % vertical diameter of hairlines +notch_cut#:=27/36pt#; % maximum breadth above or below notches +bar#:=20/36pt#; % lowercase bar thickness +slab#:=20/36pt#; % serif and arm thickness +cap_bar#:=20/36pt#; % uppercase bar thickness +cap_band#:=20/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=.9pt#; % max breadth above/below uppercase notches +serif_drop#:=3.6/36pt#; % vertical drop of sloped serifs +stem_corr#:=1/36pt#; % for small refinements of stem breadth +vair_corr#:=1/36pt#; % for small refinements of hairline height +apex_corr#:=0pt#; % extra width at diagonal junctions + +o#:=4/36pt#; % amount of overshoot for curves +apex_o#:=3/36pt#; % amount of overshoot for diagonal junctions + +slant:=0; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=.95; % factor applied to weights of heavy characters +math_spread:=.2; % extra openness of math symbols +superness:=8/11; % parameter for superellipses +superpull:=1/15; % extra openness inside bowls +beak_darkness:=4/30; % fraction of triangle inside beak serifs +ligs:=2; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=false; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=false; % should all characters have the same width? +variant_g:=false; % should an italic-style g be used? +low_asterisk:=false; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +generate roman % switch to the driver file diff --git a/systems/knuth/local/cm/ccsl10.mf b/systems/knuth/local/cm/ccsl10.mf new file mode 100644 index 0000000000..9adc55ef9d --- /dev/null +++ b/systems/knuth/local/cm/ccsl10.mf @@ -0,0 +1,75 @@ +% Concrete Slanted Roman 10 point +if unknown cmbase: input cmbase fi + +font_identifier:="CCSL"; font_size 10pt#; + +u#:=20/36pt#; % unit width +width_adj#:=0pt#; % width adjustment for certain characters +serif_fit#:=1/36pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=3/36pt#; % extra sidebar near uppercase serifs +letter_fit#:=0pt#; % extra space added to all sidebars + +body_height#:=270/36pt#; % height of tallest characters +asc_height#:=250/36pt#; % height of lowercase ascenders +cap_height#:=246/36pt#; % height of caps +fig_height#:=232/36pt#; % height of numerals +x_height#:=165/36pt#; % height of lowercase without ascenders +math_axis#:=90/36pt#; % axis of symmetry for math symbols +bar_height#:=92/36pt#; % height of crossbar in lowercase e +comma_depth#:=70/36pt#; % depth of comma below baseline +desc_depth#:=70/36pt#; % depth of lowercase descenders + +crisp#:=0pt#; % diameter of serif corners +tiny#:=11/36pt#; % diameter of rounded corners +fine#:=6/36pt#; % diameter of sharply rounded corners +thin_join#:=17/36pt#; % width of extrafine details +hair#:=21/36pt#; % lowercase hairline breadth +stem#:=25/36pt#; % lowercase stem breadth +curve#:=27/36pt#; % lowercase curve breadth +ess#:=25/36pt#; % breadth in middle of lowercase s +flare#:=29/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=38/36pt#; % diameter of dots +cap_hair#:=21/36pt#; % uppercase hairline breadth +cap_stem#:=27/36pt#; % uppercase stem breadth +cap_curve#:=28/36pt#; % uppercase curve breadth +cap_ess#:=27/36pt#; % breadth in middle of uppercase s +rule_thickness#:=.4pt#; % thickness of lines in math symbols + +dish#:=0/36pt#; % amount erased at top or bottom of serifs +bracket#:=5/36pt#; % vertical distance from serif base to tangent +jut#:=30/36pt#; % protrusion of lowercase serifs +cap_jut#:=32/36pt#; % protrusion of uppercase serifs +beak_jut#:=10/36pt#; % horizontal protrusion of beak serifs +beak#:=70/36pt#; % vertical protrusion of beak serifs +vair#:=21/36pt#; % vertical diameter of hairlines +notch_cut#:=30/36pt#; % maximum breadth above or below notches +bar#:=21/36pt#; % lowercase bar thickness +slab#:=21/36pt#; % serif and arm thickness +cap_bar#:=21/36pt#; % uppercase bar thickness +cap_band#:=21/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=1pt#; % max breadth above/below uppercase notches +serif_drop#:=5/36pt#; % vertical drop of sloped serifs +stem_corr#:=1/36pt#; % for small refinements of stem breadth +vair_corr#:=1/36pt#; % for small refinements of hairline height +apex_corr#:=0pt#; % extra width at diagonal junctions + +o#:=4/36pt#; % amount of overshoot for curves +apex_o#:=3/36pt#; % amount of overshoot for diagonal junctions + +slant:=1/6; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=.95; % factor applied to weights of heavy characters +math_spread:=0; % extra openness of math symbols +superness:=8/11; % parameter for superellipses +superpull:=1/15; % extra openness inside bowls +beak_darkness:=4/30; % fraction of triangle inside beak serifs +ligs:=2; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=false; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=false; % should all characters have the same width? +variant_g:=false; % should an italic-style g be used? +low_asterisk:=false; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +generate roman % switch to the driver file diff --git a/systems/knuth/local/cm/ccsl9.mf b/systems/knuth/local/cm/ccsl9.mf new file mode 100644 index 0000000000..d848ad9758 --- /dev/null +++ b/systems/knuth/local/cm/ccsl9.mf @@ -0,0 +1,75 @@ +% Concrete Slanted Roman 9 point +if unknown cmbase: input cmbase fi + +font_identifier:="CCSL"; font_size 9pt#; + +u#:=18.5/36pt#; % unit width +width_adj#:=0pt#; % width adjustment for certain characters +serif_fit#:=1/36pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=2.8/36pt#; % extra sidebar near uppercase serifs +letter_fit#:=0pt#; % extra space added to all sidebars + +body_height#:=243/36pt#; % height of tallest characters +asc_height#:=225/36pt#; % height of lowercase ascenders +cap_height#:=221.4/36pt#; % height of caps +fig_height#:=208.8/36pt#; % height of numerals +x_height#:=148.5/36pt#; % height of lowercase without ascenders +math_axis#:=81/36pt#; % axis of symmetry for math symbols +bar_height#:=78.3/36pt#; % height of crossbar in lowercase e +comma_depth#:=63/36pt#; % depth of comma below baseline +desc_depth#:=63/36pt#; % depth of lowercase descenders + +crisp#:=0pt#; % diameter of serif corners +tiny#:=10/36pt#; % diameter of rounded corners +fine#:=6/36pt#; % diameter of sharply rounded corners +thin_join#:=17/36pt#; % width of extrafine details +hair#:=20/36pt#; % lowercase hairline breadth +stem#:=24/36pt#; % lowercase stem breadth +curve#:=26/36pt#; % lowercase curve breadth +ess#:=24/36pt#; % breadth in middle of lowercase s +flare#:=26/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=35/36pt#; % diameter of dots +cap_hair#:=20/36pt#; % uppercase hairline breadth +cap_stem#:=26/36pt#; % uppercase stem breadth +cap_curve#:=27/36pt#; % uppercase curve breadth +cap_ess#:=24/36pt#; % breadth in middle of uppercase s +rule_thickness#:=.38pt#; % thickness of lines in math symbols + +dish#:=0/36pt#; % amount erased at top or bottom of serifs +bracket#:=5/36pt#; % vertical distance from serif base to tangent +jut#:=27/36pt#; % protrusion of lowercase serifs +cap_jut#:=29/36pt#; % protrusion of uppercase serifs +beak_jut#:=9.2/36pt#; % horizontal protrusion of beak serifs +beak#:=63/36pt#; % vertical protrusion of beak serifs +vair#:=20/36pt#; % vertical diameter of hairlines +notch_cut#:=27/36pt#; % maximum breadth above or below notches +bar#:=20/36pt#; % lowercase bar thickness +slab#:=20/36pt#; % serif and arm thickness +cap_bar#:=20/36pt#; % uppercase bar thickness +cap_band#:=20/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=.9pt#; % max breadth above/below uppercase notches +serif_drop#:=3.6/36pt#; % vertical drop of sloped serifs +stem_corr#:=1/36pt#; % for small refinements of stem breadth +vair_corr#:=1/36pt#; % for small refinements of hairline height +apex_corr#:=0pt#; % extra width at diagonal junctions + +o#:=4/36pt#; % amount of overshoot for curves +apex_o#:=3/36pt#; % amount of overshoot for diagonal junctions + +slant:=1/6; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=.95; % factor applied to weights of heavy characters +math_spread:=.2; % extra openness of math symbols +superness:=8/11; % parameter for superellipses +superpull:=1/15; % extra openness inside bowls +beak_darkness:=4/30; % fraction of triangle inside beak serifs +ligs:=2; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=false; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=false; % should all characters have the same width? +variant_g:=false; % should an italic-style g be used? +low_asterisk:=false; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +generate roman % switch to the driver file diff --git a/systems/knuth/local/cm/ccslc9.mf b/systems/knuth/local/cm/ccslc9.mf new file mode 100644 index 0000000000..4f61534e7c --- /dev/null +++ b/systems/knuth/local/cm/ccslc9.mf @@ -0,0 +1,75 @@ +% Concrete Slanted Condensed Roman 9 point +if unknown cmbase: input cmbase fi + +font_identifier:="CCSLC"; font_size 9pt#; + +u#:=16/36pt#; % unit width +width_adj#:=0pt#; % width adjustment for certain characters +serif_fit#:=0pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=2/36pt#; % extra sidebar near uppercase serifs +letter_fit#:=0pt#; % extra space added to all sidebars + +body_height#:=243/36pt#; % height of tallest characters +asc_height#:=225/36pt#; % height of lowercase ascenders +cap_height#:=221.4/36pt#; % height of caps +fig_height#:=208.8/36pt#; % height of numerals +x_height#:=155/36pt#; % height of lowercase without ascenders +math_axis#:=81/36pt#; % axis of symmetry for math symbols +bar_height#:=85/36pt#; % height of crossbar in lowercase e +comma_depth#:=63/36pt#; % depth of comma below baseline +desc_depth#:=63/36pt#; % depth of lowercase descenders + +crisp#:=0pt#; % diameter of serif corners +tiny#:=9/36pt#; % diameter of rounded corners +fine#:=6/36pt#; % diameter of sharply rounded corners +thin_join#:=13/36pt#; % width of extrafine details +hair#:=16/36pt#; % lowercase hairline breadth +stem#:=22/36pt#; % lowercase stem breadth +curve#:=23/36pt#; % lowercase curve breadth +ess#:=25/36pt#; % breadth in middle of lowercase s +flare#:=28/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=35/36pt#; % diameter of dots +cap_hair#:=16/36pt#; % uppercase hairline breadth +cap_stem#:=23/36pt#; % uppercase stem breadth +cap_curve#:=24/36pt#; % uppercase curve breadth +cap_ess#:=23/36pt#; % breadth in middle of uppercase s +rule_thickness#:=.38pt#; % thickness of lines in math symbols + +dish#:=0/36pt#; % amount erased at top or bottom of serifs +bracket#:=5/36pt#; % vertical distance from serif base to tangent +jut#:=15/36pt#; % protrusion of lowercase serifs +cap_jut#:=16/36pt#; % protrusion of uppercase serifs +beak_jut#:=9.2/36pt#; % horizontal protrusion of beak serifs +beak#:=63/36pt#; % vertical protrusion of beak serifs +vair#:=15/36pt#; % vertical diameter of hairlines +notch_cut#:=27/36pt#; % maximum breadth above or below notches +bar#:=15/36pt#; % lowercase bar thickness +slab#:=15/36pt#; % serif and arm thickness +cap_bar#:=15/36pt#; % uppercase bar thickness +cap_band#:=15/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=.9pt#; % max breadth above/below uppercase notches +serif_drop#:=3.6/36pt#; % vertical drop of sloped serifs +stem_corr#:=1/36pt#; % for small refinements of stem breadth +vair_corr#:=1/36pt#; % for small refinements of hairline height +apex_corr#:=0pt#; % extra width at diagonal junctions + +o#:=4/36pt#; % amount of overshoot for curves +apex_o#:=3/36pt#; % amount of overshoot for diagonal junctions + +slant:=1/6; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=1; % factor applied to weights of heavy characters +math_spread:=.2; % extra openness of math symbols +superness:=8/11; % parameter for superellipses +superpull:=1/15; % extra openness inside bowls +beak_darkness:=5/30; % fraction of triangle inside beak serifs +ligs:=2; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=false; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=false; % should all characters have the same width? +variant_g:=false; % should an italic-style g be used? +low_asterisk:=false; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +generate roman % switch to the driver file diff --git a/systems/knuth/local/cm/ccti10.mf b/systems/knuth/local/cm/ccti10.mf new file mode 100644 index 0000000000..2b2bc504e5 --- /dev/null +++ b/systems/knuth/local/cm/ccti10.mf @@ -0,0 +1,75 @@ +% Concrete Text Italic 10 point +if unknown cmbase: input cmbase fi + +font_identifier:="CCTI"; font_size 10pt#; + +u#:=20/36pt#; % unit width +width_adj#:=0pt#; % width adjustment for certain characters +serif_fit#:=1/36pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=3/36pt#; % extra sidebar near uppercase serifs +letter_fit#:=9/36pt#; % extra space added to all sidebars + +body_height#:=270/36pt#; % height of tallest characters +asc_height#:=250/36pt#; % height of lowercase ascenders +cap_height#:=246/36pt#; % height of caps +fig_height#:=232/36pt#; % height of numerals +x_height#:=165/36pt#; % height of lowercase without ascenders +math_axis#:=90/36pt#; % axis of symmetry for math symbols +bar_height#:=92/36pt#; % height of crossbar in lowercase e +comma_depth#:=70/36pt#; % depth of comma below baseline +desc_depth#:=70/36pt#; % depth of lowercase descenders + +crisp#:=11/36pt#; % diameter of serif corners +tiny#:=11/36pt#; % diameter of rounded corners +fine#:=6/36pt#; % diameter of sharply rounded corners +thin_join#:=17/36pt#; % width of extrafine details +hair#:=21/36pt#; % lowercase hairline breadth +stem#:=24/36pt#; % lowercase stem breadth +curve#:=26/36pt#; % lowercase curve breadth +ess#:=24/36pt#; % breadth in middle of lowercase s +flare#:=28/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=38/36pt#; % diameter of dots +cap_hair#:=21/36pt#; % uppercase hairline breadth +cap_stem#:=26/36pt#; % uppercase stem breadth +cap_curve#:=27/36pt#; % uppercase curve breadth +cap_ess#:=26/36pt#; % breadth in middle of uppercase s +rule_thickness#:=.4pt#; % thickness of lines in math symbols + +dish#:=0/36pt#; % amount erased at top or bottom of serifs +bracket#:=5/36pt#; % vertical distance from serif base to tangent +jut#:=30/36pt#; % protrusion of lowercase serifs +cap_jut#:=32/36pt#; % protrusion of uppercase serifs +beak_jut#:=10/36pt#; % horizontal protrusion of beak serifs +beak#:=70/36pt#; % vertical protrusion of beak serifs +vair#:=21/36pt#; % vertical diameter of hairlines +notch_cut#:=30/36pt#; % maximum breadth above or below notches +bar#:=21/36pt#; % lowercase bar thickness +slab#:=21/36pt#; % serif and arm thickness +cap_bar#:=21/36pt#; % uppercase bar thickness +cap_band#:=21/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=1pt#; % max breadth above/below uppercase notches +serif_drop#:=5/36pt#; % vertical drop of sloped serifs +stem_corr#:=1/36pt#; % for small refinements of stem breadth +vair_corr#:=1/36pt#; % for small refinements of hairline height +apex_corr#:=0pt#; % extra width at diagonal junctions + +o#:=4/36pt#; % amount of overshoot for curves +apex_o#:=3/36pt#; % amount of overshoot for diagonal junctions + +slant:=.25; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=.95; % factor applied to weights of heavy characters +math_spread:=0; % extra openness of math symbols +superness:=8/11; % parameter for superellipses +superpull:=1/15; % extra openness inside bowls +beak_darkness:=4/30; % fraction of triangle inside beak serifs +ligs:=2; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=false; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=false; % should all characters have the same width? +variant_g:=true; % should an italic-style g be used? +low_asterisk:=false; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +generate textit % switch to the driver file diff --git a/systems/knuth/local/cm/cmbxcd10.mf b/systems/knuth/local/cm/cmbxcd10.mf new file mode 100644 index 0000000000..cd1f0f0b0e --- /dev/null +++ b/systems/knuth/local/cm/cmbxcd10.mf @@ -0,0 +1,75 @@ +% Computer Modern Bold Extended Roman 10 point, Caps and Digits Only +if unknown cmbase: input cmbase fi + +font_identifier:="CMBXCD"; font_size 10pt#; + +u#:=23/36pt#; % unit width +width_adj#:=11/36pt#; % width adjustment for certain characters +serif_fit#:=0pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=7/36pt#; % extra sidebar near uppercase serifs +letter_fit#:=0pt#; % extra space added to all sidebars + +body_height#:=270/36pt#; % height of tallest characters +asc_height#:=250/36pt#; % height of lowercase ascenders +cap_height#:=247/36pt#; % height of caps +fig_height#:=232/36pt#; % height of numerals +x_height#:=160/36pt#; % height of lowercase without ascenders +math_axis#:=90/36pt#; % axis of symmetry for math symbols +bar_height#:=85/36pt#; % height of crossbar in lowercase e +comma_depth#:=70/36pt#; % depth of comma below baseline +desc_depth#:=70/36pt#; % depth of lowercase descenders + +crisp#:=0pt#; % diameter of serif corners +tiny#:=13/36pt#; % diameter of rounded corners +fine#:=10/36pt#; % diameter of sharply rounded corners +thin_join#:=10/36pt#; % width of extrafine details +hair#:=17/36pt#; % lowercase hairline breadth +stem#:=41/36pt#; % lowercase stem breadth +curve#:=46/36pt#; % lowercase curve breadth +ess#:=38/36pt#; % breadth in middle of lowercase s +flare#:=45/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=56/36pt#; % diameter of dots +cap_hair#:=19/36pt#; % uppercase hairline breadth +cap_stem#:=51/36pt#; % uppercase stem breadth +cap_curve#:=55/36pt#; % uppercase curve breadth +cap_ess#:=53/36pt#; % breadth in middle of uppercase s +rule_thickness#:=.6pt#; % thickness of lines in math symbols + +dish#:=1/36pt#; % amount erased at top or bottom of serifs +bracket#:=10/36pt#; % vertical distance from serif base to tangent +jut#:=25/36pt#; % protrusion of lowercase serifs +cap_jut#:=39/36pt#; % protrusion of uppercase serifs +beak_jut#:=11/36pt#; % horizontal protrusion of beak serifs +beak#:=70/36pt#; % vertical protrusion of beak serifs +vair#:=13/36pt#; % vertical diameter of hairlines +notch_cut#:=10pt#; % maximum breadth above or below notches +bar#:=17/36pt#; % lowercase bar thickness +slab#:=17/36pt#; % serif and arm thickness +cap_bar#:=17/36pt#; % uppercase bar thickness +cap_band#:=17/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=10pt#; % max breadth above/below uppercase notches +serif_drop#:=3/36pt#; % vertical drop of sloped serifs +stem_corr#:=2/36pt#; % for small refinements of stem breadth +vair_corr#:=1.5/36pt#; % for small refinements of hairline height +apex_corr#:=0pt#; % extra width at diagonal junctions + +o#:=4/36pt#; % amount of overshoot for curves +apex_o#:=3/36pt#; % amount of overshoot for diagonal junctions + +slant:=0; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=1; % factor applied to weights of heavy characters +math_spread:=.5; % extra openness of math symbols +superness:=8/11; % parameter for superellipses +superpull:=1/8; % extra openness inside bowls +beak_darkness:=.4; % fraction of triangle inside beak serifs +ligs:=2; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=false; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=false; % should all characters have the same width? +variant_g:=false; % should an italic-style g be used? +low_asterisk:=false; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +generate title % switch to the driver file diff --git a/systems/knuth/local/cm/cmbxti12.mf b/systems/knuth/local/cm/cmbxti12.mf new file mode 100644 index 0000000000..299c83ad67 --- /dev/null +++ b/systems/knuth/local/cm/cmbxti12.mf @@ -0,0 +1,75 @@ +% Computer Modern Bold Extended Text Italic 12 point +if unknown cmbase: input cmbase fi + +font_identifier:="CMBXTI"; font_size 12pt#; + +u#:=24.9/36pt#; % unit width +width_adj#:=13/36pt#; % width adjustment for certain characters +serif_fit#:=0pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=8/36pt#; % extra sidebar near uppercase serifs +letter_fit#:=12.5/36pt#; % extra space added to all sidebars + +body_height#:=324/36pt#; % height of tallest characters +asc_height#:=300/36pt#; % height of lowercase ascenders +cap_height#:=296.4/36pt#; % height of caps +fig_height#:=278.8/36pt#; % height of numerals +x_height#:=192/36pt#; % height of lowercase without ascenders +math_axis#:=108/36pt#; % axis of symmetry for math symbols +bar_height#:=102/36pt#; % height of crossbar in lowercase e +comma_depth#:=84/36pt#; % depth of comma below baseline +desc_depth#:=84/36pt#; % depth of lowercase descenders + +crisp#:=13/36pt#; % diameter of serif corners +tiny#:=13/36pt#; % diameter of rounded corners +fine#:=10/36pt#; % diameter of sharply rounded corners +thin_join#:=10.5/36pt#; % width of extrafine details +hair#:=21.5/36pt#; % lowercase hairline breadth +stem#:=44/36pt#; % lowercase stem breadth +curve#:=49/36pt#; % lowercase curve breadth +ess#:=41/36pt#; % breadth in middle of lowercase s +flare#:=48/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=59/36pt#; % diameter of dots +cap_hair#:=23/36pt#; % uppercase hairline breadth +cap_stem#:=55/36pt#; % uppercase stem breadth +cap_curve#:=59/36pt#; % uppercase curve breadth +cap_ess#:=54/36pt#; % breadth in middle of uppercase s +rule_thickness#:=.66pt#; % thickness of lines in math symbols + +dish#:=1/36pt#; % amount erased at top or bottom of serifs +bracket#:=12/36pt#; % vertical distance from serif base to tangent +jut#:=32/36pt#; % protrusion of lowercase serifs +cap_jut#:=46/36pt#; % protrusion of uppercase serifs +beak_jut#:=11.3/36pt#; % horizontal protrusion of beak serifs +beak#:=84/36pt#; % vertical protrusion of beak serifs +vair#:=14.3/36pt#; % vertical diameter of hairlines +notch_cut#:=12pt#; % maximum breadth above or below notches +bar#:=18.5/36pt#; % lowercase bar thickness +slab#:=18.5/36pt#; % serif and arm thickness +cap_bar#:=18.5/36pt#; % uppercase bar thickness +cap_band#:=18.5/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=12pt#; % max breadth above/below uppercase notches +serif_drop#:=3.6/36pt#; % vertical drop of sloped serifs +stem_corr#:=2/36pt#; % for small refinements of stem breadth +vair_corr#:=1.5/36pt#; % for small refinements of hairline height +apex_corr#:=0pt#; % extra width at diagonal junctions + +o#:=7/36pt#; % amount of overshoot for curves +apex_o#:=7/36pt#; % amount of overshoot for diagonal junctions + +slant:=.25; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=1; % factor applied to weights of heavy characters +math_spread:=.4; % extra openness of math symbols +superness:=8/11; % parameter for superellipses +superpull:=1/8; % extra openness inside bowls +beak_darkness:=.4; % fraction of triangle inside beak serifs +ligs:=2; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=false; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=false; % should all characters have the same width? +variant_g:=true; % should an italic-style g be used? +low_asterisk:=false; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +generate textit % switch to the driver file diff --git a/systems/knuth/local/cm/cmbxti7.mf b/systems/knuth/local/cm/cmbxti7.mf new file mode 100644 index 0000000000..984c903eed --- /dev/null +++ b/systems/knuth/local/cm/cmbxti7.mf @@ -0,0 +1,75 @@ +% Computer Modern Bold Extended Text Italic 7 point +if unknown cmbase: input cmbase fi + +font_identifier:="CMBXTI"; font_size 7pt#; + +u#:=16.5/36pt#; % unit width +width_adj#:=8.6/36pt#; % width adjustment for certain characters +serif_fit#:=0pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=4.6/36pt#; % extra sidebar near uppercase serifs +letter_fit#:=9/36pt#; % extra space added to all sidebars + +body_height#:=189/36pt#; % height of tallest characters +asc_height#:=175/36pt#; % height of lowercase ascenders +cap_height#:=172.9/36pt#; % height of caps +fig_height#:=162.4/36pt#; % height of numerals +x_height#:=112/36pt#; % height of lowercase without ascenders +math_axis#:=63/36pt#; % axis of symmetry for math symbols +bar_height#:=58/36pt#; % height of crossbar in lowercase e +comma_depth#:=49/36pt#; % depth of comma below baseline +desc_depth#:=49/36pt#; % depth of lowercase descenders + +crisp#:=11/36pt#; % diameter of serif corners +tiny#:=11/36pt#; % diameter of rounded corners +fine#:=9/36pt#; % diameter of sharply rounded corners +thin_join#:=9/36pt#; % width of extrafine details +hair#:=17.8/36pt#; % lowercase hairline breadth +stem#:=30/36pt#; % lowercase stem breadth +curve#:=33/36pt#; % lowercase curve breadth +ess#:=27/36pt#; % breadth in middle of lowercase s +flare#:=33/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=39/36pt#; % diameter of dots +cap_hair#:=20/36pt#; % uppercase hairline breadth +cap_stem#:=36/36pt#; % uppercase stem breadth +cap_curve#:=39/36pt#; % uppercase curve breadth +cap_ess#:=34/36pt#; % breadth in middle of uppercase s +rule_thickness#:=.51pt#; % thickness of lines in math symbols + +dish#:=.9/36pt#; % amount erased at top or bottom of serifs +bracket#:=7/36pt#; % vertical distance from serif base to tangent +jut#:=19/36pt#; % protrusion of lowercase serifs +cap_jut#:=46/36pt#; % protrusion of uppercase serifs +beak_jut#:=7.7/36pt#; % horizontal protrusion of beak serifs +beak#:=84/36pt#; % vertical protrusion of beak serifs +vair#:=11.5/36pt#; % vertical diameter of hairlines +notch_cut#:=7pt#; % maximum breadth above or below notches +bar#:=14/36pt#; % lowercase bar thickness +slab#:=14/36pt#; % serif and arm thickness +cap_bar#:=14/36pt#; % uppercase bar thickness +cap_band#:=14/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=7pt#; % max breadth above/below uppercase notches +serif_drop#:=2.1/36pt#; % vertical drop of sloped serifs +stem_corr#:=1.7/36pt#; % for small refinements of stem breadth +vair_corr#:=1.2/36pt#; % for small refinements of hairline height +apex_corr#:=0pt#; % extra width at diagonal junctions + +o#:=4/36pt#; % amount of overshoot for curves +apex_o#:=4/36pt#; % amount of overshoot for diagonal junctions + +slant:=.25; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=1; % factor applied to weights of heavy characters +math_spread:=1.1; % extra openness of math symbols +superness:=8/11; % parameter for superellipses +superpull:=1/8; % extra openness inside bowls +beak_darkness:=.4; % fraction of triangle inside beak serifs +ligs:=2; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=false; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=false; % should all characters have the same width? +variant_g:=true; % should an italic-style g be used? +low_asterisk:=false; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +generate textit % switch to the driver file diff --git a/systems/knuth/local/cm/cmcscsl10.mf b/systems/knuth/local/cm/cmcscsl10.mf new file mode 100644 index 0000000000..8c6280bb67 --- /dev/null +++ b/systems/knuth/local/cm/cmcscsl10.mf @@ -0,0 +1,110 @@ +% Computer Modern Roman Caps and Small Caps Slanted 10 point +if unknown cmbase: input cmbase fi + +font_identifier:="CMCSCSL"; font_size 10pt#; + +% first come parameters used to set the uppercase letters +% (including some for lowercase that aren't actually used) +u#:=21/36pt#; % unit width +width_adj#:=0pt#; % width adjustment for certain characters +serif_fit#:=0pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=5/36pt#; % extra sidebar near uppercase serifs +letter_fit#:=5/36pt#; % extra space added to all sidebars + +body_height#:=270/36pt#; % height of tallest characters +asc_height#:=250/36pt#; % height of lowercase ascenders +cap_height#:=246/36pt#; % height of caps +fig_height#:=232/36pt#; % height of numerals +x_height#:=155/36pt#; % height of lowercase without ascenders +math_axis#:=90/36pt#; % axis of symmetry for math symbols +bar_height#:=87/36pt#; % height of crossbar in lowercase e +comma_depth#:=70/36pt#; % depth of comma below baseline +desc_depth#:=70/36pt#; % depth of lowercase descenders + +crisp#:=0pt#; % diameter of serif corners +tiny#:=8/36pt#; % diameter of rounded corners +fine#:=7/36pt#; % diameter of sharply rounded corners +thin_join#:=7/36pt#; % width of extrafine details +hair#:=9/36pt#; % lowercase hairline breadth +stem#:=25/36pt#; % lowercase stem breadth +curve#:=30/36pt#; % lowercase curve breadth +ess#:=27/36pt#; % breadth in middle of lowercase s +flare#:=33/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=38/36pt#; % diameter of dots +cap_hair#:=11/36pt#; % uppercase hairline breadth +cap_stem#:=32/36pt#; % uppercase stem breadth +cap_curve#:=37/36pt#; % uppercase curve breadth +cap_ess#:=35/36pt#; % breadth in middle of uppercase s +rule_thickness#:=.4pt#; % thickness of lines in math symbols + +dish#:=1/36pt#; % amount erased at top or bottom of serifs +bracket#:=20/36pt#; % vertical distance from serif base to tangent +jut#:=28/36pt#; % protrusion of lowercase serifs +cap_jut#:=37/36pt#; % protrusion of uppercase serifs +beak_jut#:=10/36pt#; % horizontal protrusion of beak serifs +beak#:=70/36pt#; % vertical protrusion of beak serifs +vair#:=8/36pt#; % vertical diameter of hairlines +notch_cut#:=10pt#; % maximum breadth above or below notches +bar#:=11/36pt#; % lowercase bar thickness +slab#:=11/36pt#; % serif and arm thickness +cap_bar#:=11/36pt#; % uppercase bar thickness +cap_band#:=11/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=10pt#; % max breadth above/below uppercase notches +serif_drop#:=4/36pt#; % vertical drop of sloped serifs +stem_corr#:=1/36pt#; % for small refinements of stem breadth +vair_corr#:=1/36pt#; % for small refinements of hairline height +apex_corr#:=0pt#; % extra width at diagonal junctions + +o#:=8/36pt#; % amount of overshoot for curves +apex_o#:=8/36pt#; % amount of overshoot for diagonal junctions + +slant:=1/6; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=1; % factor applied to weights of heavy characters +math_spread:=0; % extra openness of math symbols +superness:=1/sqrt2; % parameter for superellipses +superpull:=1/6; % extra openness inside bowls +beak_darkness:=11/30; % fraction of triangle inside beak serifs +ligs:=1; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=false; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=false; % should all characters have the same width? +variant_g:=false; % should an italic-style g be used? +low_asterisk:=false; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +% now come replacements used to set the lowercase caps + +lower.u#:=16/36pt#; % unit width +lower.width_adj#:=0pt#; % width adjustment for certain characters +lower.cap_serif_fit#:=4/36pt#; % extra sidebar near uppercase serifs +lower.letter_fit#:=2.4/36pt#; % extra space added to all sidebars + +lower.body_height#:=200/36pt#; % height of tallest characters +lower.cap_height#:=185/36pt#; % height of caps +lower.x_height#:=116/36pt#; % height of lowercase without ascenders +lower.bar_height#:=65/36pt#; % height of crossbar in lowercase e +lower.comma_depth#:=52/36pt#; % depth of comma below baseline + +lower.flare#:=25/36pt#; % diameter of bulbs or breadth of terminals +lower.cap_hair#:=9.1/36pt#; % uppercase hairline breadth +lower.stem#:=21/36pt#; % lowercase stem breadth +lower.cap_stem#:=26/36pt#; % uppercase stem breadth +lower.cap_curve#:=31/36pt#; % uppercase curve breadth +lower.cap_ess#:=28/36pt#; % breadth in middle of uppercase s + +lower.cap_jut#:=26/36pt#; % protrusion of uppercase serifs +lower.beak_jut#:=7/36pt#; % horizontal protrusion of beak serifs +lower.beak#:=52/36pt#; % vertical protrusion of beak serifs +lower.slab#:=9.1/36pt#; % serif and arm thickness +lower.cap_bar#:=9.1/36pt#; % uppercase bar thickness +lower.cap_band#:=9.1/36pt#; % uppercase thickness above/below lobes +lower.cap_notch_cut#:=10pt#; % max breadth above/below uppercase notches + +lower.o#:=5/36pt#; % amount of overshoot for curves +lower.apex_o#:=4/36pt#; % amount of overshoot for diagonal junctions + +lower.fudge:=1; % factor applied to weights of heavy characters + +generate csc % switch to the driver file diff --git a/systems/knuth/local/cm/cmfibs8.mf b/systems/knuth/local/cm/cmfibs8.mf new file mode 100644 index 0000000000..f4b9c09ba2 --- /dev/null +++ b/systems/knuth/local/cm/cmfibs8.mf @@ -0,0 +1,75 @@ +% Computer Modern Roman Fibonacci Slanted Font +if unknown cmbase: input cmbase fi + +font_identifier:="CMFIBS"; font_size 8pt#; + +u#:=21/36pt#; % unit width +width_adj#:=0pt#; % width adjustment for certain characters +serif_fit#:=-2/36pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=0pt#; % extra sidebar near uppercase serifs +letter_fit#:=0pt#; % extra space added to all sidebars + +body_height#:=233/36pt#; % height of tallest characters +asc_height#:=233/36pt#; % height of lowercase ascenders +cap_height#:=233/36pt#; % height of caps +fig_height#:=233/36pt#; % height of numerals +x_height#:=144/36pt#; % height of lowercase without ascenders +math_axis#:=89/36pt#; % axis of symmetry for math symbols +bar_height#:=89/36pt#; % height of crossbar in lowercase e +comma_depth#:=55/36pt#; % depth of comma below baseline +desc_depth#:=55/36pt#; % depth of lowercase descenders + +crisp#:=0pt#; % diameter of serif corners +tiny#:=13/36pt#; % diameter of rounded corners +fine#:=13/36pt#; % diameter of sharply rounded corners +thin_join#:=13/36pt#; % width of extrafine details +hair#:=21/36pt#; % lowercase hairline breadth +stem#:=34/36pt#; % lowercase stem breadth +curve#:=39/36pt#; % lowercase curve breadth +ess#:=34/36pt#; % breadth in middle of lowercase s +flare#:=34/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=34/36pt#; % diameter of dots +cap_hair#:=21/36pt#; % uppercase hairline breadth +cap_stem#:=34/36pt#; % uppercase stem breadth +cap_curve#:=39/36pt#; % uppercase curve breadth +cap_ess#:=34/36pt#; % breadth in middle of uppercase s +rule_thickness#:=21/36pt#; % thickness of lines in math symbols + +dish#:=1/36pt#; % amount erased at top or bottom of serifs +bracket#:=21/36pt#; % vertical distance from serif base to tangent +jut#:=21/36pt#; % protrusion of lowercase serifs +cap_jut#:=21/36pt#; % protrusion of uppercase serifs +beak_jut#:=13/36pt#; % horizontal protrusion of beak serifs +beak#:=55/36pt#; % vertical protrusion of beak serifs +vair#:=13/36pt#; % vertical diameter of hairlines +notch_cut#:=8pt#; % maximum breadth above or below notches +bar#:=13/36pt#; % lowercase bar thickness +slab#:=13/36pt#; % serif and arm thickness +cap_bar#:=13/36pt#; % uppercase bar thickness +cap_band#:=13/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=8pt#; % max breadth above/below uppercase notches +serif_drop#:=3/36pt#; % vertical drop of sloped serifs +stem_corr#:=1/36pt#; % for small refinements of stem breadth +vair_corr#:=1/36pt#; % for small refinements of hairline height +apex_corr#:=0pt#; % extra width at diagonal junctions + +o#:=8/36pt#; % amount of overshoot for curves +apex_o#:=8/36pt#; % amount of overshoot for diagonal junctions + +slant:=sqrt5-2; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=1; % factor applied to weights of heavy characters +math_spread:=3/8; % extra openness of math symbols +superness:=1/sqrt2; % parameter for superellipses +superpull:=1/13; % extra openness inside bowls +beak_darkness:=5/13; % fraction of triangle inside beak serifs +ligs:=2; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=false; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=false; % should all characters have the same width? +variant_g:=false; % should an italic-style g be used? +low_asterisk:=false; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +generate roman % switch to the driver file diff --git a/systems/knuth/local/cm/cmitt12.mf b/systems/knuth/local/cm/cmitt12.mf new file mode 100644 index 0000000000..44a3841c0d --- /dev/null +++ b/systems/knuth/local/cm/cmitt12.mf @@ -0,0 +1,75 @@ +% Computer Modern Italic Typewriter Text for use with 12 point +if unknown cmbase: input cmbase fi + +font_identifier:="CMITT"; font_size 12pt#; + +u#:=24.7/36pt#; % unit width +width_adj#:=0pt#; % width adjustment for certain characters +serif_fit#:=0pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=0pt#; % extra sidebar near uppercase serifs +letter_fit#:=18/36pt#; % extra space added to all sidebars + +body_height#:=300/36pt#; % height of tallest characters +asc_height#:=264/36pt#; % height of lowercase ascenders +cap_height#:=264/36pt#; % height of caps +fig_height#:=264/36pt#; % height of numerals +x_height#:=186/36pt#; % height of lowercase without ascenders +math_axis#:=132/36pt#; % axis of symmetry for math symbols +bar_height#:=95/36pt#; % height of crossbar in lowercase e +comma_depth#:=60/36pt#; % depth of comma below baseline +desc_depth#:=96/36pt#; % depth of lowercase descenders + +crisp#:=25/36pt#; % diameter of serif corners +tiny#:=25/36pt#; % diameter of rounded corners +fine#:=22/36pt#; % diameter of sharply rounded corners +thin_join#:=22/36pt#; % width of extrafine details +hair#:=28/36pt#; % lowercase hairline breadth +stem#:=28/36pt#; % lowercase stem breadth +curve#:=28/36pt#; % lowercase curve breadth +ess#:=25/36pt#; % breadth in middle of lowercase s +flare#:=35/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=39/36pt#; % diameter of dots +cap_hair#:=28/36pt#; % uppercase hairline breadth +cap_stem#:=28/36pt#; % uppercase stem breadth +cap_curve#:=28/36pt#; % uppercase curve breadth +cap_ess#:=28/36pt#; % breadth in middle of uppercase s +rule_thickness#:=28/36pt#; % thickness of lines in math symbols + +dish#:=0pt#; % amount erased at top or bottom of serifs +bracket#:=0pt#; % vertical distance from serif base to tangent +jut#:=46/36pt#; % protrusion of lowercase serifs +cap_jut#:=39/36pt#; % protrusion of uppercase serifs +beak_jut#:=0pt#; % horizontal protrusion of beak serifs +beak#:=39/36pt#; % vertical protrusion of beak serifs +vair#:=25/36pt#; % vertical diameter of hairlines +notch_cut#:=28/36pt#; % maximum breadth above or below notches +bar#:=25/36pt#; % lowercase bar thickness +slab#:=25/36pt#; % serif and arm thickness +cap_bar#:=25/36pt#; % uppercase bar thickness +cap_band#:=25/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=28/36pt#; % max breadth above/below uppercase notches +serif_drop#:=0pt#; % vertical drop of sloped serifs +stem_corr#:=0pt#; % for small refinements of stem breadth +vair_corr#:=1.5pt#; % for small refinements of hairline height +apex_corr#:=11/36pt#; % extra width at diagonal junctions + +o#:=5/36pt#; % amount of overshoot for curves +apex_o#:=4/36pt#; % amount of overshoot for diagonal junctions + +slant:=1/4; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=0.86; % factor applied to weights of heavy characters +math_spread:=-1; % extra openness of math symbols +superness:=1/sqrt2; % parameter for superellipses +superpull:=0; % extra openness inside bowls +beak_darkness:=0; % fraction of triangle inside beak serifs +ligs:=0; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=true; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=true; % should all characters have the same width? +variant_g:=true; % should an italic-style g be used? +low_asterisk:=true; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +generate textit % switch to the driver file diff --git a/systems/knuth/local/cm/cmitt9.mf b/systems/knuth/local/cm/cmitt9.mf new file mode 100644 index 0000000000..fdcd169893 --- /dev/null +++ b/systems/knuth/local/cm/cmitt9.mf @@ -0,0 +1,75 @@ +% Computer Modern Italic Typewriter Text for use with 9 point +if unknown cmbase: input cmbase fi + +font_identifier:="CMITT"; font_size 9pt#; + +u#:=18.9/36pt#; % unit width +width_adj#:=0pt#; % width adjustment for certain characters +serif_fit#:=0pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=0pt#; % extra sidebar near uppercase serifs +letter_fit#:=14/36pt#; % extra space added to all sidebars + +body_height#:=225/36pt#; % height of tallest characters +asc_height#:=198/36pt#; % height of lowercase ascenders +cap_height#:=198/36pt#; % height of caps +fig_height#:=198/36pt#; % height of numerals +x_height#:=139.5/36pt#; % height of lowercase without ascenders +math_axis#:=99/36pt#; % axis of symmetry for math symbols +bar_height#:=71/36pt#; % height of crossbar in lowercase e +comma_depth#:=45/36pt#; % depth of comma below baseline +desc_depth#:=72/36pt#; % depth of lowercase descenders + +crisp#:=21/36pt#; % diameter of serif corners +tiny#:=21/36pt#; % diameter of rounded corners +fine#:=20/36pt#; % diameter of sharply rounded corners +thin_join#:=20/36pt#; % width of extrafine details +hair#:=24/36pt#; % lowercase hairline breadth +stem#:=24/36pt#; % lowercase stem breadth +curve#:=24/36pt#; % lowercase curve breadth +ess#:=21/36pt#; % breadth in middle of lowercase s +flare#:=30/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=33/36pt#; % diameter of dots +cap_hair#:=24/36pt#; % uppercase hairline breadth +cap_stem#:=24/36pt#; % uppercase stem breadth +cap_curve#:=24/36pt#; % uppercase curve breadth +cap_ess#:=24/36pt#; % breadth in middle of uppercase s +rule_thickness#:=24/36pt#; % thickness of lines in math symbols + +dish#:=0pt#; % amount erased at top or bottom of serifs +bracket#:=0pt#; % vertical distance from serif base to tangent +jut#:=36/36pt#; % protrusion of lowercase serifs +cap_jut#:=31/36pt#; % protrusion of uppercase serifs +beak_jut#:=0pt#; % horizontal protrusion of beak serifs +beak#:=31/36pt#; % vertical protrusion of beak serifs +vair#:=21/36pt#; % vertical diameter of hairlines +notch_cut#:=24/36pt#; % maximum breadth above or below notches +bar#:=21/36pt#; % lowercase bar thickness +slab#:=21/36pt#; % serif and arm thickness +cap_bar#:=21/36pt#; % uppercase bar thickness +cap_band#:=21/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=24/36pt#; % max breadth above/below uppercase notches +serif_drop#:=0pt#; % vertical drop of sloped serifs +stem_corr#:=0pt#; % for small refinements of stem breadth +vair_corr#:=1/36pt#; % for small refinements of hairline height +apex_corr#:=9/36pt#; % extra width at diagonal junctions + +o#:=3.5/36pt#; % amount of overshoot for curves +apex_o#:=3/36pt#; % amount of overshoot for diagonal junctions + +slant:=1/4; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=0.81; % factor applied to weights of heavy characters +math_spread:=-1; % extra openness of math symbols +superness:=1/sqrt2; % parameter for superellipses +superpull:=0; % extra openness inside bowls +beak_darkness:=0; % fraction of triangle inside beak serifs +ligs:=0; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=true; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=true; % should all characters have the same width? +variant_g:=true; % should an italic-style g be used? +low_asterisk:=true; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +generate textit % switch to the driver file diff --git a/systems/knuth/local/cm/cmman.mf b/systems/knuth/local/cm/cmman.mf new file mode 100644 index 0000000000..8cd476f622 --- /dev/null +++ b/systems/knuth/local/cm/cmman.mf @@ -0,0 +1,855 @@ +% Variants of Computer Modern, specially for the TeX/METAFONT manuals + +if unknown cmbase: input cmbase fi +mode_setup; + +def generate suffix t= enddef; + +inner cmchar; + +font_size 10pt#; +font_identifier "CMMAN"; +font_coding_scheme "PI"; + +input cmtt10; font_setup; + +cmchar "Cross between 0 and O"; +beginchar("0",9u#,fig_height#,0); +italcorr fig_height#*slant-.5u#; +adjust_fit(0,0); +penpos1(vair,90); penpos3(vair,-90); penpos2(curve,180); penpos4(curve,0); +superness:=.77; +x2r=round max(.7u,1.45u-.5curve); x4r=w-x2r; x1=x3=.5w; +y1r=h+o; y3r=-o; y2=y4=.5h-vair_corr; y2l:=y4l:=.52h; +penstroke pulled_arc.e(1,2) & pulled_arc.e(2,3) + & pulled_arc.e(3,4) & pulled_arc.e(4,1) & cycle; % bowl +penlabels(1,2,3,4); endchar; + +input cmssq8; slant:=sind 12/cosd 12; font_setup; + +cmchar "Lowercase Greek beta"; +beginchar(oct"014",9.5u#,asc_height#,desc_depth#); +italcorr .5[x_height#,asc_height#]*slant-u#; +adjust_fit(0,0); pickup fine.nib; +pos0(hair,180); pos1(hair,180); pos2(vair,90); +pos3(stem,0); pos4(vair,-90); pos5(hair,-180); +pos6(vair,-270); pos7(curve,-360); pos8(vair,-450); pos9(hair,-540); +x0=x1=x9; lft x0l=hround(1.5u-.5hair); x2=x4=x6=x8=.5w+.25u; +rt x3r=hround(w-1.5u); rt x7r=hround(w-1.5u+.5curve); rt x5l=hround(x4-u); +bot y0=-d; y1=top y6r=x_height; top y2r=h+oo; y3=.5[y2,y4]; +y5=.5[y4,y6]; top y6r-bot y4r=vstem+eps; bot y8=-oo; y7=y9=.5[y6,y8]; +if y6l<y4l: y6l:=y4l:=y5; fi +filldraw stroke z0e---z1e...pulled_arc.e(2,3) + & pulled_arc.e(3,4)...{up}z5e; % stem and upper bowl +filldraw stroke z5e{up}...pulled_arc.e(6,7) + & pulled_arc.e(7,8)...{up}z9e; % lower bowl +math_fit(desc_depth#*slant+.5hair#-u#,.7x_height#*slant+.5curve#-1.5u#); +penlabels(0,1,2,3,4,5,6,7,8,9); endchar; + +cmchar "Lowercase thorn"; +beginchar(oct"015",10u#+serif_fit#,asc_height#,desc_depth#); +italcorr .5x_height#*slant+min(.5curve#-.85u#,-.1u#); +adjust_fit(serif_fit#,0); +pickup tiny.nib; pos1(stem',0); pos2(stem,0); +pos0'(stem',0); pos0(stem,0); z0l=z0'l; x0'=x1; x0=x2; +lft x1l=hround(2.5u-.5stem'); top y1=h; +numeric edge; edge=rt x2r; +pickup fine.nib; pos3(if hefty:thin_join else: hair fi,180); +pos4(vair',90); pos5(curve,0); pos6(vair,-90); +rt x3l=1/3[rt x2,edge]; y3=1/8[bar_height,x_height]; +x4l=w-.5(w-serif_fit)+.5u; top y4r=x_height+oo; +rt x5r=hround min(w-1.35u+.5curve,w-.6u); y5=.5x_height; +x6=x3; bot y6r=-oo; +(x,y4r)=whatever[z3l,z4l]; x4r:=min(x,.5[x5r,x4]); +filldraw stroke z3e{up}...{right}z4e&super_arc.e(4,5) + &z5e{down}...{5(x6-x5),y6-y5}z6e; % bowl +y0=ypart(((edge,h)--(edge,0))intersectionpoint(z3l{up}...{right}z4l)); +pickup tiny.nib; bot y2=-d; +filldraw stroke z1e--z0'e--z0e--z2e; % stem +pickup crisp.nib; pos8(hair,0); pos7'(stem,0); +z7'=z2; x8l=x7'l; bot y8=0; +filldraw stroke z7'e--z8e; % point +if serifs: sloped_serif.l(1,0',a,1/3,jut,serif_drop); % upper serif + dish_serif(2,0,b,1/3,jut,c,1/3,0); fi % lower serif +penlabels(0,1,2,3,4,5,6,8); endchar; + +input cmr10; font_setup; + +message "Parentheses"; +code:=ASCII "0"; % the characters will be 123456789: +for c=0,1,2,4,infinity: +cmchar "Left paren with curl "&decimal c; +beginchar(incr code,7u#,body_height#,paren_depth#); +italcorr body_height#*slant-.5u#; +adjust_fit(0,0); pickup fine.nib; +pos1(vair,0); pos2(.75[hair,stem],0); pos3(vair,0); +rt x1r=rt x3r=round(w-u); lft x2l=round(x1-4u if monospace: +4/3u fi); +top y1=h; y2=.5[y1,y3]=math_axis; +filldraw stroke z1e{curl c}..z2e..{curl c}z3e; % arc +penlabels(1,2,3); endchar; + +cmchar "Right paren with curl "&decimal c; +beginchar(incr code,7u#,body_height#,paren_depth#); +italcorr math_axis#*slant-.5u#; +adjust_fit(0,0); pickup fine.nib; +pos1(vair,0); pos2(.75[hair,stem],0); pos3(vair,0); +lft x1l=lft x3l=round u; rt x2r=round(x1+4u if monospace: -4/3u fi); +top y1=h; y2=.5[y1,y3]=math_axis; +filldraw stroke z1e{curl c}..z2e..{curl c}z3e; % arc +penlabels(1,2,3); endchar; +endfor + +message "big G"; +u#:=50/36pt#; % unit width +width_adj#:=0pt#; % width adjustment for certain characters +serif_fit#:=0pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=0/36pt#; % extra sidebar near uppercase serifs +letter_fit#:=0pt#; % extra space added to all sidebars + +body_height#:=12pt#+250/36pt#; % height of tallest characters +asc_height#:=body_height#; % height of lowercase ascenders +cap_height#:=body_height#; % height of caps +fig_height#:=body_height#; % height of numerals +x_height#:=155/250asc_height#; % height of lowercase without ascenders +math_axis#:=90/250asc_height#; % axis of symmetry for math symbols +bar_height#:=87/250asc_height#; % height of crossbar in lowercase e +comma_depth#:=70/250asc_height#;% depth of comma below baseline +desc_depth#:=comma_depth#; % depth of lowercase descenders + +crisp#:=0pt#; % diameter of serif corners +tiny#:=1.2/36pt#; % diameter of rounded corners +fine#:=1.1/36pt#; % diameter of sharply rounded corners +thin_join#:=1.1/36pt#; % width of extrafine details +hair#:=14/36pt#; % lowercase hairline breadth +stem#:=75/36pt#; % lowercase stem breadth +curve#:=90/36pt#; % lowercase curve breadth +ess#:=81/36pt#; % breadth in middle of lowercase s +flare#:=66/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=114/36pt#; % diameter of dots +cap_hair#:=17/36pt#; % uppercase hairline breadth +cap_stem#:=96/36pt#; % uppercase stem breadth +cap_curve#:=111/36pt#; % uppercase curve breadth +cap_ess#:=105/36pt#; % breadth in middle of uppercase s +rule_thickness#:=1pt#; % thickness of lines in math symbols + +dish#:=2/36pt#; % amount erased at top or bottom of serifs +bracket#:=50/36pt#; % vertical distance from serif base to tangent +jut#:=70/36pt#; % protrusion of lowercase serifs +cap_jut#:=2.5pt#; % protrusion of uppercase serifs +beak_jut#:=25/36pt#; % horizontal protrusion of beak serifs +beak#:=comma_depth#; % vertical protrusion of beak serifs +vair#:=12/36pt#; % vertical diameter of hairlines +notch_cut#:=22pt#; % maximum breadth above or below notches +bar#:=17/36pt#; % lowercase bar thickness +slab#:=17/36pt#; % serif and arm thickness +cap_bar#:=17/36pt#; % uppercase bar thickness +cap_band#:=17/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=22pt#; % max breadth above/below uppercase notches +serif_drop#:=10/36pt#; % vertical drop of sloped serifs +stem_corr#:=3/36pt#; % for small refinements of stem breadth +vair_corr#:=2/36pt#; % for small refinements of hairline height +apex_corr#:=0pt#; % extra width at diagonal junctions + +o#:=12/36pt#; % amount of overshoot for curves +apex_o#:=12/36pt#; % amount of overshoot for diagonal junctions + +slant:=0; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=1; % factor applied to weights of heavy characters +math_spread:=0; % extra openness of math symbols +superness:=1/sqrt2; % parameter for superellipses +superpull:=1/6; % extra openness inside bowls +beak_darkness:=11/30; % fraction of triangle inside beak serifs +ligs:=2; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=false; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=false; % should all characters have the same width? +variant_g:=false; % should an italic-style g be used? +low_asterisk:=false; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +font_setup; + +cmchar "The letter G"; +if serifs: beginchar("G",14u#,cap_height#,0); + italcorr cap_height#*slant-1.5u#-.5cap_serif_fit#; + adjust_fit(0,.5cap_serif_fit#); + pickup tiny.nib; pos0(cap_stem,0); pos7(cap_stem,0); + rt x0r=hround(w-2u); y0=good.y(.1[bar_height,x_height]+1); x7=x0; + pickup fine.nib; + if hefty: bot y7=0; pos5(cap_stem,0); x5=x0; top y5=tiny.top y0; + else: pos5(cap_hair,0); pos8(cap_stem,0); + y7=.5bar_height; z5l=z8l; z8=z7; x9=x8r; bot y9=0; + filldraw z8l{down}..{4(x9-x8),y9-y8}z9--z8r--cycle; fi % spur + pos1(cap_hair,0); pos2(cap_band,90); + pos3(cap_curve,180); pos4(cap_band,270); + rt x1r=hround(w-2u); lft x3r=hround u; x2=x4=.55[x3,x1]; + top y2r=h+o; bot y4r=-o; y3=.5[y2,y4]; + bot y1=vround max(.6h,x_height-.5vair); + (x2l',y2l)=whatever[z2r,z1l]; x2l:=x2l'; + (x4l',y4l)=whatever[z4r,z5l]; x4l:=x4l'; + filldraw stroke z1e{x2-x1,10(y2-y1)} + ...pulled_arc.e(2,3) & pulled_arc.e(3,4)...z5e{up}; % arc + x6=x1r; top y6=h+o; x1r-x1'=2cap_curve-fine; y1'=y1; + path upper_arc; upper_arc=z1{x2-x1,10(y2-y1)}..{left}z2; + numeric t; t=xpart(upper_arc intersectiontimes (z6--z1')); + filldraw subpath(0,t) of upper_arc--z6--z1r--z1--cycle; % barb + pickup tiny.nib; filldraw stroke z0e--z7e; % stem + dish_serif(0,7,a,1/3,max(cap_jut,2.25u),b,1/3,1.25u); % serif + math_fit(-.3cap_height#*slant-.5u#,ic#); +else: beginchar("G",12u#,cap_height#,0); + italcorr cap_height#*slant-.5u#; + adjust_fit(0,0); + pickup fine.nib; pos1(1.2flare,80); pos2(slab,90); + pos3(cap_curve,180); pos4(slab,270); pos5(flare,270); + rt x1r=hround(w-1.35u); x2=x4=.5w+u; + lft x3r=hround max(u,2u-.5cap_curve); rt x5l=hround(w-1.2u); + top y1r=vround .93h+o; top y2r=h+o; y3=.5h; + bot y4r=-o; bot y5r=vround .07h-o; + filldraw stroke rterm.e(2,1,right,.9,4)&super_arc.e(2,3) + & super_arc.e(3,4) & term.e(4,5,right,1,4); % arc and terminals + pos0(stem,0); pos7(stem,0); + z7r=z5r; x0=x7; top y0=1+vround .35[bar_height,x_height]; + filldraw stroke z0e--z7e; % stem + pos8(cap_bar,90); pos9(cap_bar,90); + z0r=z9r; y8=y9; lft x8=hround x4; + filldraw stroke z8e--z9e; % bar + math_fit(-.3cap_height#*slant-.5u#,.5ic#); fi +penlabels(0,1,1',2,3,4,5,6,7,8,9); endchar; + +message "The TeXbook title"; +f:=20/3; % magnification factor (based mostly on cmssdc10) +u#:=f*19/36pt#; % unit width +width_adj#:=f*15/36pt#; % width adjustment for certain characters +serif_fit#:=-f*8/36pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=-f*9/36pt#; % extra sidebar near uppercase serifs +letter_fit#:=-.2u#; % extra space added to all sidebars + +body_height#:=f*270/36pt#; % height of tallest characters +asc_height#:=f*265/36pt#; % height of lowercase ascenders +cap_height#:=f*265/36pt#; % height of caps +fig_height#:=f*265/36pt#; % height of numerals +x_height#:=f*170/36pt#; % height of lowercase without ascenders +math_axis#:=f*95/36pt#; % axis of symmetry for math symbols +bar_height#:=f*95/36pt#; % height of crossbar in lowercase e +comma_depth#:=f*40/36pt#; % depth of comma below baseline +desc_depth#:=f*60/36pt#; % depth of lowercase descenders + +crisp#:=5*23/36pt#; % diameter of serif corners +tiny#:=5*23/36pt#; % diameter of rounded corners +fine#:=5*8/36pt#; % diameter of sharply rounded corners +thin_join#:=12*8/36pt#; % width of extrafine details +hair#:=5*40/36pt#; % lowercase hairline breadth +stem#:=5*40/36pt#; % lowercase stem breadth +curve#:=5*40/36pt#; % lowercase curve breadth +ess#:=5*37/36pt#; % breadth in middle of lowercase s +flare#:=5*31/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=5*38/36pt#; % diameter of dots +cap_hair#:=5*40/36pt#; % uppercase hairline breadth +cap_stem#:=5*44/36pt#; % uppercase stem breadth +cap_curve#:=5*44/36pt#; % uppercase curve breadth +cap_ess#:=5*42/36pt#; % breadth in middle of uppercase s +rule_thickness#:=5*25/36pt#; % thickness of lines in math symbols + +dish#:=0pt#; % amount erased at top or bottom of serifs +bracket#:=0pt#; % vertical distance from serif base to tangent +jut#:=0pt#; % protrusion of lowercase serifs +cap_jut#:=0pt#; % protrusion of uppercase serifs +beak_jut#:=0pt#; % horizontal protrusion of beak serifs +beak#:=f*1.5/36pt#; % vertical protrusion of beak serifs +vair#:=6*23/36pt#; % vertical diameter of hairlines +notch_cut#:=6*40/36pt#; % maximum breadth above or below notches +bar#:=6*23/36pt#; % lowercase bar thickness +slab#:=6*31/36pt#; % serif and arm thickness +cap_bar#:=6*29/36pt#; % uppercase bar thickness +cap_band#:=6*27/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=6*37/36pt#; % max breadth above/below uppercase notches +serif_drop#:=f*2/36pt#; % vertical drop of sloped serifs +stem_corr#:=5*1/36pt#; % for small refinements of stem breadth +vair_corr#:=5*2/36pt#; % for small refinements of hairline height +apex_corr#:=f*14/36pt#; % extra width at diagonal junctions + +o#:=f*7/36pt#; % amount of overshoot for curves +apex_o#:=0pt#; % amount of overshoot for diagonal junctions + +slant:=0; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=.91; % factor applied to weights of heavy characters +math_spread:=-.3; % extra openness of math symbols +superness:=.74; % parameter for superellipses +superpull:=1/18; % extra openness inside bowls +beak_darkness:=0; % fraction of triangle inside beak serifs +ligs:=2; % level of ligatures to be included + +square_dots:=true; % should dots be square? +hefty:=true; % should we try hard not to be overweight? +serifs:=false; % should serifs and bulbs be attached? +monospace:=false; % should all characters have the same width? +variant_g:=true; % should an italic-style g be used? +low_asterisk:=false; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +font_setup; + +cmchar "The letter T"; +beginchar("T",13u#-width_adj#,cap_height#,0); +italcorr cap_height#*slant-beak_jut#-.25u#; +adjust_fit(0,0); +h:=vround(h-2stem_corr); +pickup tiny.nib; pos1(cap_stem,0); pos2(cap_stem,0); +lft x1l=lft x2l=hround(.5w-.5cap_stem); top y1=h; bot y2=0; +filldraw stroke z1e--z2e; % stem +pickup crisp.nib; pos3(slab,90); pos4(hair,0); +top y3r=h; x3=x1; rt x4r=hround(w-.65u); y4=good.y(y3l-beak); +arm(3,4,e,beak_darkness,.7beak_jut); % right arm and beak +pos5(hair,180); x5=w-x4; y5=y4; +arm(3,5,f,beak_darkness,-.7beak_jut); % left arm and beak +if serifs: dish_serif(1,2,a,1/3,.5cap_jut,b,1/3,.5cap_jut); % upper bracketing + dish_serif(2,1,c,1/3,1.414cap_jut,d,1/3,1.414cap_jut); fi % lower serif +math_fit(-.75cap_height#*slant,ic#-2.5u#); penlabels(1,2,3,4,5,6); endchar; + +cmchar "The letter h"; +beginchar("h",10u#,asc_height#,0); +italcorr .5[bar_height#,x_height#]*slant-serif_fit#+.5stem#-2u#; +adjust_fit(serif_fit#+stem_shift#,serif_fit#-stem_shift#); +pickup tiny.nib; pos1(stem,0); pos2(stem,0); +pos1'(stem',0); pos2'(stem',0); pos3(stem,0); +lft x1l=hround(2.5u-.5stem); x1l=x1'l=x2l=x2'l; x3=w-x1; +top y1=h; bot y2=0; y1=y1'; y2=y2'; +filldraw stroke z1'e--z2'e; % left stem +h_stroke(2,a,3,4); % arch and right stem +if serifs: sloped_serif.l(1',2',b,1/3,jut,serif_drop); % upper left serif + numeric inner_jut; pickup tiny.nib; + if rt x2r+jut+.5u+1<=lft x4l-jut: inner_jut=jut; + else: rt x2r+jut+.5u+1=lft x4l-inner_jut; fi + dish_serif(2,1,c,1/3,jut,d,1/3,jut); % lower left serif + dish_serif(4,3,e,1/3,inner_jut,f,1/3,jut); fi % lower right serif +penlabels(1,2,3,4); endchar; + +cmchar "The letter e"; +beginchar("e",7.25u#+max(.75u#,.5curve#),x_height#,0); +italcorr .5[bar_height#,x_height#]*slant+.5min(curve#-1.5u#,0); +adjust_fit(if monospace: .25u#,.5u# else: 0,0 fi); +numeric left_curve,right_curve; +left_curve=right_curve+6stem_corr=curve if not serifs: -3stem_corr fi; +if right_curve<tiny.breadth: right_curve:=tiny.breadth; fi +if left_curve<tiny.breadth: left_curve:=tiny.breadth; fi +pickup tiny.nib; pos1(right_curve,0); +pos2(vair,90); pos3(left_curve,180); +y1=good.y bar_height; top y2r=h+vround 1.5oo; y0l=bot y1; +rt x1r=hround min(w-.5u,w-u+.5right_curve); +lft x3r=hround max(.5u,1.25u-.5left_curve); x2=.5w+.25u; +{{interim superness:=more_super; + filldraw stroke super_arc.e(1,2)}}; % right bowl +y3=.5[y2,y4]; bot y4r=-oo; x4=x2+.25u; +if serifs: pos4(vair',270); pos5(hair,360); + y5=max(good.y(.5bar_height-.9),y4l+vair); x5r=x1r; + (x,y4l)=whatever[z4r,z5]; x4l:=x; + filldraw stroke pulled_arc.e(2,3) & pulled_arc.e(3,4) + ...{x5-x4,5(y5-y4)}z5e; % left bowl, arc, and terminal +else: pos4(vair,270); + filldraw stroke super_arc.e(2,3) & super_arc.e(3,4); % left bowl and arc + pickup fine.nib; pos4'(vair,270); z4=z4'; + pos5(.5[vair,flare],275); rt x5r=hround(w-.6u); + y5r=good.y(y5r+1/3bar_height-y5); y5l:=good.y y5l; x5l:=good.x x5l; + filldraw stroke term.e(4',5,right,1,4); fi % terminal +path testpath; testpath=super_arc.r(2,3) & super_arc.r(3,4); +y1'r=y0r=y0l+.6[thin_join,vair]; y1'l=y0l; x1'l=x1'r=x1; +forsuffixes $=l,r: + x0$=xpart(((0,y0$)--(x1,y0$)) intersectionpoint testpath); endfor +fill stroke z0e--z1'e; % crossbar +penlabels(0,1,2,3,4,5); endchar; + +cmchar "The letter E"; +beginchar("E",12u#-width_adj#,cap_height#,0); +italcorr cap_height#*slant-beak_jut#-.5u#; +adjust_fit(cap_serif_fit#,0); +h:=vround(h-stem_corr); +pickup tiny.nib; pos1(cap_stem,0); pos2(cap_stem,0); +lft x1l=lft x2l=hround max(2u,3u-.5cap_stem); top y1=h; bot y2=0; +filldraw stroke z1e--z2e; % stem +pickup crisp.nib; pos3(slab,90); pos4(hair,0); +top y3r=h; x3=x1; rt x4r=hround(w-u); y4=good.y(y3l-beak); +arm(3,4,e,beak_darkness,beak_jut); % upper arm and beak +pos5(cap_bar,-90); pos6(hair,0); +top y5l=vround(.52[y2,y1]+.5cap_bar); x5=x1; +pos0(cap_bar,90); pos7(hair,0); +z0=z5; x6=x7; y6-y5l=y0l-y7; +if serifs: rt x6r=hround(w-4.4u+.5hair); y6=good.y(y5l+.6beak); + rt x9r=hround(w-.5u); +else: rt x6r=hround(w-1.5u); y6=y5l; rt x9r=hround(w-.75u); fi +arm(5,6,f,beak_darkness,0); arm(0,7,g,beak_darkness,0); % middle arm and serif +pos8(slab if not serifs:+2stem_corr fi,-90); pos9(hair,0); +bot y8r=0; x8=x2; y9=y8l+7/6beak; +arm(8,9,h,beak_darkness,1.5beak_jut); % lower arm and beak +if serifs: dish_serif(1,2,a,1/3,cap_jut,b,1/3,.5cap_jut); % upper serif + dish_serif(2,1,c,1/3,cap_jut,d,1/3,.5cap_jut); fi % lower serif +math_fit(0,.5ic#); penlabels(0,1,2,3,4,5,6,7,8,9); endchar; + +cmchar "The letter X"; +beginchar("X",13u#,cap_height#,0); +italcorr cap_height#*slant-.25u#; +adjust_fit(cap_serif_fit#,cap_serif_fit#); +numeric stem[],outer_jut,xjut,alpha[]; +stem1=cap_stem-2stem_corr; stem2=min(cap_hair,stem1); +outer_jut=.75cap_jut; xjut= if serifs: (stem1-stem2)/4 else: 0 fi; +x1l=l+letter_fit+.5u+outer_jut; x2r=r-letter_fit-u-outer_jut-xjut; +x3l=l+letter_fit+.25u+outer_jut+xjut; x4r=r-letter_fit-.25u-outer_jut; +y1=y2=h; y3=y4=0; +alpha1=diag_ratio(1,stem1,h,x4r-x1l); +alpha2=diag_ratio(1,stem2,h,x2r-x3l); +penpos1(alpha1*stem1,0); penpos2(alpha2*stem2,0); +penpos3(alpha2*stem2,0); penpos4(alpha1*stem1,0); +if hefty: z0=whatever[z1,z4]=whatever[z2,z3]; + x12=x34=x0; y13=y24=y0; + z12=whatever[z2l,z3l]; z13=whatever[z2l,z3l]; + z24=whatever[z2r,z3r]; z34=whatever[z2r,z3r]; + forsuffixes $=13,24,34: z$'=.1[z$,z0]; endfor + fill diag_end(12,1r,.5,1,1l,13')--z13'--diag_end(13',3l,1,.5,3r,34')--z34' + --diag_end(34',4l,.5,1,4r,24')--z24' + --diag_end(24',2r,1,.5,2l,12)--z12--cycle; % diagonals +else: fill diag_end(4r,1r,.5,1,1l,4l) + --diag_end(1l,4l,.5,1,4r,1r)--cycle; % left diagonal + fill diag_end(2l,3l,.5,1,3r,2r) + --diag_end(3r,2r,.5,1,2l,3l)--cycle; fi % right diagonal +if serifs: numeric inner_jut[]; pickup tiny.nib; + prime_points_inside(1,4); prime_points_inside(2,3); + prime_points_inside(3,2); prime_points_inside(4,1); + if rt x1'r+cap_jut+.5u+1<=lft x2'l-cap_jut-xjut: inner_jut1=cap_jut; + else: rt x1'r+inner_jut1+.5u+1=lft x2'l-inner_jut1-xjut; fi + if rt x3'r+cap_jut+.5u+1<=lft x4'l-cap_jut-xjut: inner_jut2=cap_jut; + else: rt x3'r+inner_jut2+.5u+1=lft x4'l-inner_jut2-xjut; fi + dish_serif(1',4,a,1/3,outer_jut,b,2/3,inner_jut1); % upper left serif + dish_serif(4',1,c,2/3,inner_jut2,d,1/3,outer_jut); % lower right serif + dish_serif(2',3,e,2/3,inner_jut1+xjut, + f,1/2,outer_jut+xjut)(dark); % upper right serif + dish_serif(3',2,g,1/2,outer_jut+xjut, + h,2/3,inner_jut2+xjut)(dark); fi % lower left serif +math_fit(0,.5ic#); penlabels(0,1,2,3,4,12,13,24,34); endchar; + +cmchar "The letter b"; +beginchar("b",10u#+serif_fit#,asc_height#,0); +italcorr .5x_height#*slant+min(.5curve#-u#,-.25u#); +adjust_fit(serif_fit#,0); +pickup tiny.nib; pos1(stem',0); pos2(stem,0); +pos0'(stem',0); pos0(stem,0); z0l=z0'l; x0'=x1; x0=x2; +lft x1l=hround(2.5u-.5stem'); top y1=h; +numeric edge; edge=rt x2r; +pickup fine.nib; pos3(if hefty:thin_join else: hair fi,180); +pos4(vair,90); pos5(curve,0); +pos6(vair,-90); penpos7(x3l-x3r,-180); +rt x3l=1/3[rt x2,edge]; y3=1/8[bar_height,x_height]; +x4l=w-.5(w-serif_fit)+.5u; top y4r=x_height+oo; +rt x5r=hround min(w-1.35u+.5curve,w-.6u); y5=.5x_height; +x6l=x4l-.2u; bot y6r=-oo; +x7=x3; y7=min(y3,y6+y4-y3+.6vair); +(x,y4r)=whatever[z3l,z4l]; x4r:=min(x,.5[x4,x5r]); +(x',y6r)=whatever[z7l,z6l]; x6r:=min(x',.5[x6,x5r]); +filldraw stroke z3e{up}...pulled_arc.e(4,5)&pulled_arc.e(5,6)...{up}z7e; % bowl +y0=ypart(((edge,h)--(edge,0))intersectionpoint(z3l{up}...{right}z4l)); +y2=ypart(((edge,h)--(edge,0))intersectionpoint(z6l{left}...{up}z7l)); +pickup tiny.nib; filldraw stroke z1e--z0'e--z0e--z2e; % stem +pickup crisp.nib; pos8(hair,0); pos7'(stem,0); +z7'=z2; x8l=x7'l; bot y8=0; +filldraw stroke z7'e--z8e; % point +if serifs: sloped_serif.l(1,0',a,1/3,jut,serif_drop); fi % upper serif +penlabels(0,1,2,3,4,5,6,7,8); endchar; + +cmchar "The letter o"; +beginchar("o",9u#,x_height#,0); +italcorr .7x_height#*slant; +adjust_fit(if monospace: .5u#,.5u# else: 0,0 fi); +penpos1(vair,90); penpos3(vair',-90); +penpos2(curve,180); penpos4(curve,0); +x2r=hround max(.5u,1.25u-.5curve); +x4r=w-x2r; x1=x3=.5w; y1r=h+vround 1.5oo; y3r=-oo; +y2=y4=.5h-vair_corr; y2l:=y4l:=.52h; +penstroke pulled_arc.e(1,2) & pulled_arc.e(2,3) + & pulled_arc.e(3,4) & pulled_arc.e(4,1) & cycle; % bowl +penlabels(1,2,3,4); endchar; + +cmchar "The letter k"; +beginchar("k",9.5u#,asc_height#,0); +italcorr x_height#*slant-.2u#; +adjust_fit(serif_fit#,serif_fit#); pickup tiny.nib; +numeric right_jut,stem[],alpha[]; +stem1=max(tiny.breadth,hround(fudged.stem-stem_corr)); +stem2=max(tiny.breadth,hround(fudged.stem-2stem_corr)); +stem3=max(tiny.breadth,hround(fudged.hair-4stem_corr)); +stem4=max(tiny.breadth,hround(fudged.stem-3stem_corr)); +if serifs: right_jut=.6jut; else: right_jut=.4tiny; fi +pos1(stem1,0); pos2(stem2,0); top y1=h; bot y2=0; +lft x1l=lft x2l=hround(2.5u-.5stem1); +top y3=x_height; rt x3r=hround(r-letter_fit-.7u-right_jut); +bot y6=0; rt x6r=hround(r-letter_fit-.3u-right_jut); +x4=x11=x1; y4=.7bar_height; y11=y3; +alpha1=diag_ratio(1,.5(stem3-tiny),y3-y4,x3r-x4); +alpha2=diag_ratio(1,.5(stem4-tiny),y11-y6,x6r-x1); +penpos3(alpha1*(stem3-tiny),0); penpos4(whatever,-90); +z5=.5[z5l,z5r]; penpos6(alpha2*(stem4-tiny),0); +forsuffixes $=l,r: y3'$=x_height; y6'$=0; z4$=z3'$+whatever*(z3-z4); + z5$=z6'$+whatever*(z11-z6)=whatever[z3,z4]; endfor +z3'r=z3r+penoffset z3-z4 of currentpen+whatever*(z3-z4); +% we have also |z3'l=z3l+penoffset z4-z3 of currentpen+whatever*(z3-z4)|;\] +z6'r=z6r+penoffset z11-z6 of currentpen+whatever*(z11-z6); +z6'l=z6l+penoffset z6-z11 of currentpen+whatever*(z11-z6); +fill z4r--diag_end(4r,3'r,1,.5,3'l,4l)--z4l--cycle; % upper diagonal +fill z5l--diag_end(5l,6'l,.5,1,6'r,5r)--z5r--cycle; % lower diagonal +pos0(stem1,0); pos0'(stem2,0); y0=y0'; x0=x1; x0'=x2; +rt z0r=whatever[z3,z4]; filldraw stroke z1e..z0e--z0'e..z2e; % stem +if serifs: numeric inner_jut; + if rt x2r+jut+.5u+1<=lft x6l-jut: inner_jut=jut; + else: rt x2r+inner_jut+.5u+1=lft x6l-inner_jut; fi + sloped_serif.l(1,0,a,1/3,jut,serif_drop); % upper stem serif + dish_serif(2,0',b,1/3,jut,c,1/3,inner_jut); % lower stem serif + dish_serif(3,4,d,2/3,1.4jut,e,1/2,right_jut)(dark); % upper diagonal serif + dish_serif(6,5,f,1/2,inner_jut,g,1/3,right_jut)(dark);fi % lower diagonal serif +penlabels(0,1,2,3,4,5,6,11); endchar; + +message "Typewriter type variant g"; % 9pt +u#:=18.9/36pt#; % unit width +width_adj#:=0pt#; % width adjustment for certain characters +serif_fit#:=0pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=0pt#; % extra sidebar near uppercase serifs +letter_fit#:=0pt#; % extra space added to all sidebars + +body_height#:=225/36pt#; % height of tallest characters +asc_height#:=198/36pt#; % height of lowercase ascenders +cap_height#:=198/36pt#; % height of caps +fig_height#:=198/36pt#; % height of numerals +x_height#:=139.5/36pt#; % height of lowercase without ascenders +math_axis#:=99/36pt#; % axis of symmetry for math symbols +bar_height#:=71/36pt#; % height of crossbar in lowercase e +comma_depth#:=45/36pt#; % depth of comma below baseline +desc_depth#:=72/36pt#; % depth of lowercase descenders + +crisp#:=21/36pt#; % diameter of serif corners +tiny#:=21/36pt#; % diameter of rounded corners +fine#:=20/36pt#; % diameter of sharply rounded corners +thin_join#:=20/36pt#; % width of extrafine details +hair#:=24/36pt#; % lowercase hairline breadth +stem#:=24/36pt#; % lowercase stem breadth +curve#:=24/36pt#; % lowercase curve breadth +ess#:=21/36pt#; % breadth in middle of lowercase s +flare#:=30/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=33/36pt#; % diameter of dots +cap_hair#:=24/36pt#; % uppercase hairline breadth +cap_stem#:=24/36pt#; % uppercase stem breadth +cap_curve#:=24/36pt#; % uppercase curve breadth +cap_ess#:=24/36pt#; % breadth in middle of uppercase s +rule_thickness#:=24/36pt#; % thickness of lines in math symbols + +dish#:=0pt#; % amount erased at top or bottom of serifs +bracket#:=0pt#; % vertical distance from serif base to tangent +jut#:=31/36pt#; % protrusion of lowercase serifs +cap_jut#:=31/36pt#; % protrusion of uppercase serifs +beak_jut#:=0pt#; % horizontal protrusion of beak serifs +beak#:=31/36pt#; % vertical protrusion of beak serifs +vair#:=21/36pt#; % vertical diameter of hairlines +notch_cut#:=24/36pt#; % maximum breadth above or below notches +bar#:=21/36pt#; % lowercase bar thickness +slab#:=21/36pt#; % serif and arm thickness +cap_bar#:=21/36pt#; % uppercase bar thickness +cap_band#:=21/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=24/36pt#; % max breadth above/below uppercase notches +serif_drop#:=0pt#; % vertical drop of sloped serifs +stem_corr#:=0pt#; % for small refinements of stem breadth +vair_corr#:=0pt#; % for small refinements of hairline height +apex_corr#:=9/36pt#; % extra width at diagonal junctions + +o#:=3.5/36pt#; % amount of overshoot for curves +apex_o#:=3/36pt#; % amount of overshoot for diagonal junctions + +slant:=0; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=0.81; % factor applied to weights of heavy characters +math_spread:=-1; % extra openness of math symbols +superness:=1/sqrt2; % parameter for superellipses +superpull:=0; % extra openness inside bowls +beak_darkness:=0; % fraction of triangle inside beak serifs +ligs:=0; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=true; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=true; % should all characters have the same width? +variant_g:=false; % should an italic-style g be used? +low_asterisk:=true; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +font_setup; + +cmchar "Variant letter g"; +beginchar("x",10u#+serif_fit#,x_height#,desc_depth#); +italcorr x_height#*slant-serif_fit#+.5stem#-2u# if serifs:+.5u# fi; +adjust_fit(0,serif_fit# if serifs: -.5u# fi); +pickup tiny.nib; pos1(stem',0); pos2(stem,0); +pos0'(stem',0); pos0(stem,0); z0r=z0'r; x0'=x1; x0=x2; +rt x1r=hround(w-2.5u+.5stem'); +numeric edge; edge=lft x2l; +path edge_path; edge_path=(edge,h)--(edge,0); +pickup fine.nib; pos3(if hefty:thin_join else: hair fi,0); +pos4(vair,90); pos5(curve,180); pos6(vair,270); penpos7(x3r-x3l,360); +lft x3l=min(lft x3l-(rt x3r-tiny.rt x2r),2/3[lft x2,edge]); y3=bar_height; +x4l=.5(w-serif_fit)-.3u; top y4r=x_height+oo; +lft x5r=hround max(1.35u-.5curve,.6u); y5=.5x_height; +x6l=x4l-.2u; bot y6r=vround 1/3vair; +lft x7l=edge; y7=min(y3,y6+y4-y3+.6vair); +(x,y4r)=whatever[z3l,z4l]; x4r:=max(x,.5[x5r,x4]); +(x',y6r)=whatever[z7l,z6l]; x6r:=max(x',.5[x5r,x6]); +filldraw stroke z3e{up}...{left}z4e&super_arc.e(4,5) + &super_arc.e(5,6)&z6e{right}...{up}z7e; % bowl +y1=ypart(edge_path intersectionpoint(z3l{up}...{left}z4l)); +y0=ypart(edge_path intersectionpoint(z7l{down}...{left}z6l)); +pickup tiny.nib; bot y2=if serifs: -.25d else: 0 fi; +filldraw stroke z1e--z0'e--z0e--z2e; % stem +pickup crisp.nib; +pos8(hround(hair-stem_corr),0); pos7'(stem',0); +z7'=z1; x8r=x7'r; top y8=h+oo; +filldraw stroke z7'e--z8e; % point +if serifs: pickup tiny.nib; + pos9(vair,-90); x9=.5[x2,x10]; bot y9r=-d-o-1; + pos10(hair,-180); lft x10r=hround u; y10=-.75d+.5flare; + pos11(flare,-180); z11r=z10r; + bulb(9,10,11); filldraw stroke super_arc.e(2,9); % tail +else: pickup fine.nib; pos2'(stem,0); z2'=z2; + z2''r=z2'r; z2''=z2'; z2''l=(x2'l,0); + pos9(vair,-90); x9=4.5u; bot y9r=-d-o-1; + pos10(.5[vair,flare],-90); lft x10=hround 1.25u; + y10r=good.y -5/6d; y10l:=good.y y10l; + filldraw stroke z2'e..z2''e&super_arc.e(2'',9) + & term.e(9,10,left,.9,4); fi % tail +penlabels(0,1,2,3,4,5,6,7,8,9,10,11); endchar; + +message "Normal roman variant g"; % 10pt + +u#:=20/36pt#; % unit width +width_adj#:=0pt#; % width adjustment for certain characters +serif_fit#:=0pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=5/36pt#; % extra sidebar near uppercase serifs +letter_fit#:=0pt#; % extra space added to all sidebars + +body_height#:=270/36pt#; % height of tallest characters +asc_height#:=250/36pt#; % height of lowercase ascenders +cap_height#:=246/36pt#; % height of caps +fig_height#:=232/36pt#; % height of numerals +x_height#:=155/36pt#; % height of lowercase without ascenders +math_axis#:=90/36pt#; % axis of symmetry for math symbols +bar_height#:=87/36pt#; % height of crossbar in lowercase e +comma_depth#:=70/36pt#; % depth of comma below baseline +desc_depth#:=70/36pt#; % depth of lowercase descenders + +crisp#:=0pt#; % diameter of serif corners +tiny#:=8/36pt#; % diameter of rounded corners +fine#:=7/36pt#; % diameter of sharply rounded corners +thin_join#:=7/36pt#; % width of extrafine details +hair#:=9/36pt#; % lowercase hairline breadth +stem#:=25/36pt#; % lowercase stem breadth +curve#:=30/36pt#; % lowercase curve breadth +ess#:=27/36pt#; % breadth in middle of lowercase s +flare#:=33/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=38/36pt#; % diameter of dots +cap_hair#:=11/36pt#; % uppercase hairline breadth +cap_stem#:=32/36pt#; % uppercase stem breadth +cap_curve#:=37/36pt#; % uppercase curve breadth +cap_ess#:=35/36pt#; % breadth in middle of uppercase s +rule_thickness#:=.4pt#; % thickness of lines in math symbols + +dish#:=1/36pt#; % amount erased at top or bottom of serifs +bracket#:=20/36pt#; % vertical distance from serif base to tangent +jut#:=28/36pt#; % protrusion of lowercase serifs +cap_jut#:=37/36pt#; % protrusion of uppercase serifs +beak_jut#:=10/36pt#; % horizontal protrusion of beak serifs +beak#:=70/36pt#; % vertical protrusion of beak serifs +vair#:=8/36pt#; % vertical diameter of hairlines +notch_cut#:=10pt#; % maximum breadth above or below notches +bar#:=11/36pt#; % lowercase bar thickness +slab#:=11/36pt#; % serif and arm thickness +cap_bar#:=11/36pt#; % uppercase bar thickness +cap_band#:=11/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=10pt#; % max breadth above/below uppercase notches +serif_drop#:=4/36pt#; % vertical drop of sloped serifs +stem_corr#:=1/36pt#; % for small refinements of stem breadth +vair_corr#:=1/36pt#; % for small refinements of hairline height +apex_corr#:=0pt#; % extra width at diagonal junctions + +o#:=8/36pt#; % amount of overshoot for curves +apex_o#:=8/36pt#; % amount of overshoot for diagonal junctions + +slant:=0; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=1; % factor applied to weights of heavy characters +math_spread:=0; % extra openness of math symbols +superness:=1/sqrt2; % parameter for superellipses +superpull:=1/6; % extra openness inside bowls +beak_darkness:=11/30; % fraction of triangle inside beak serifs +ligs:=2; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=false; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=false; % should all characters have the same width? +variant_g:=false; % should an italic-style g be used? +low_asterisk:=false; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +font_setup; + +cmchar "Variant letter g"; +beginchar("y",10u#+serif_fit#,x_height#,desc_depth#); +italcorr x_height#*slant-serif_fit#+.5stem#-2u# if serifs:+.5u# fi; +adjust_fit(0,serif_fit# if serifs: -.5u# fi); +pickup tiny.nib; pos1(stem',0); pos2(stem,0); +pos0'(stem',0); pos0(stem,0); z0r=z0'r; x0'=x1; x0=x2; +rt x1r=hround(w-2.5u+.5stem'); +numeric edge; edge=lft x2l; +path edge_path; edge_path=(edge,h)--(edge,0); +pickup fine.nib; pos3(if hefty:thin_join else: hair fi,0); +pos4(vair,90); pos5(curve,180); pos6(vair,270); penpos7(x3r-x3l,360); +lft x3l=min(lft x3l-(rt x3r-tiny.rt x2r),2/3[lft x2,edge]); y3=bar_height; +x4l=.5(w-serif_fit)-.3u; top y4r=x_height+oo; +lft x5r=hround max(1.35u-.5curve,.6u); y5=.5x_height; +x6l=x4l-.2u; bot y6r=vround 1/3vair; +lft x7l=edge; y7=min(y3,y6+y4-y3+.6vair); +(x,y4r)=whatever[z3l,z4l]; x4r:=max(x,.5[x5r,x4]); +(x',y6r)=whatever[z7l,z6l]; x6r:=max(x',.5[x5r,x6]); +filldraw stroke z3e{up}...{left}z4e&super_arc.e(4,5) + &super_arc.e(5,6)&z6e{right}...{up}z7e; % bowl +y1=ypart(edge_path intersectionpoint(z3l{up}...{left}z4l)); +y0=ypart(edge_path intersectionpoint(z7l{down}...{left}z6l)); +pickup tiny.nib; bot y2=if serifs: -.25d else: 0 fi; +filldraw stroke z1e--z0'e--z0e--z2e; % stem +pickup crisp.nib; +pos8(hround(hair-stem_corr),0); pos7'(stem',0); +z7'=z1; x8r=x7'r; top y8=h+oo; +filldraw stroke z7'e--z8e; % point +if serifs: pickup tiny.nib; + pos9(vair,-90); x9=.5[x2,x10]; bot y9r=-d-o-1; + pos10(hair,-180); lft x10r=hround u; y10=-.75d+.5flare; + pos11(flare,-180); z11r=z10r; + bulb(9,10,11); filldraw stroke super_arc.e(2,9); % tail +else: pickup fine.nib; pos2'(stem,0); z2'=z2; + z2''r=z2'r; z2''=z2'; z2''l=(x2'l,0); + pos9(vair,-90); x9=4.5u; bot y9r=-d-o-1; + pos10(.5[vair,flare],-90); lft x10=hround 1.25u; + y10r=good.y -5/6d; y10l:=good.y y10l; + filldraw stroke z2'e..z2''e&super_arc.e(2'',9) + & term.e(9,10,left,.9,4); fi % tail +penlabels(0,1,2,3,4,5,6,7,8,9,10,11); endchar; + +message "Bold roman variant g"; % 9pt + +u#:=21.3/36pt#; % unit width +width_adj#:=10.2/36pt#; % width adjustment for certain characters +serif_fit#:=0pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=6.2/36pt#; % extra sidebar near uppercase serifs +letter_fit#:=0pt#; % extra space added to all sidebars + +body_height#:=243/36pt#; % height of tallest characters +asc_height#:=225/36pt#; % height of lowercase ascenders +cap_height#:=222.3/36pt#; % height of caps +fig_height#:=208.8/36pt#; % height of numerals +x_height#:=144/36pt#; % height of lowercase without ascenders +math_axis#:=81/36pt#; % axis of symmetry for math symbols +bar_height#:=76/36pt#; % height of crossbar in lowercase e +comma_depth#:=63/36pt#; % depth of comma below baseline +desc_depth#:=63/36pt#; % depth of lowercase descenders + +crisp#:=0pt#; % diameter of serif corners +tiny#:=13/36pt#; % diameter of rounded corners +fine#:=10/36pt#; % diameter of sharply rounded corners +thin_join#:=10/36pt#; % width of extrafine details +hair#:=16.6/36pt#; % lowercase hairline breadth +stem#:=38/36pt#; % lowercase stem breadth +curve#:=43/36pt#; % lowercase curve breadth +ess#:=35/36pt#; % breadth in middle of lowercase s +flare#:=42/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=51/36pt#; % diameter of dots +cap_hair#:=19/36pt#; % uppercase hairline breadth +cap_stem#:=47/36pt#; % uppercase stem breadth +cap_curve#:=51/36pt#; % uppercase curve breadth +cap_ess#:=48/36pt#; % breadth in middle of uppercase s +rule_thickness#:=.57pt#; % thickness of lines in math symbols + +dish#:=1/36pt#; % amount erased at top or bottom of serifs +bracket#:=9/36pt#; % vertical distance from serif base to tangent +jut#:=22/36pt#; % protrusion of lowercase serifs +cap_jut#:=35/36pt#; % protrusion of uppercase serifs +beak_jut#:=10.2/36pt#; % horizontal protrusion of beak serifs +beak#:=63/36pt#; % vertical protrusion of beak serifs +vair#:=12.5/36pt#; % vertical diameter of hairlines +notch_cut#:=9pt#; % maximum breadth above or below notches +bar#:=16/36pt#; % lowercase bar thickness +slab#:=16/36pt#; % serif and arm thickness +cap_bar#:=16/36pt#; % uppercase bar thickness +cap_band#:=16/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=9pt#; % max breadth above/below uppercase notches +serif_drop#:=2.7/36pt#; % vertical drop of sloped serifs +stem_corr#:=1.9/36pt#; % for small refinements of stem breadth +vair_corr#:=1.4/36pt#; % for small refinements of hairline height +apex_corr#:=0pt#; % extra width at diagonal junctions + +o#:=4/36pt#; % amount of overshoot for curves +apex_o#:=3/36pt#; % amount of overshoot for diagonal junctions + +slant:=0; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=1; % factor applied to weights of heavy characters +math_spread:=.7; % extra openness of math symbols +superness:=8/11; % parameter for superellipses +superpull:=1/8; % extra openness inside bowls +beak_darkness:=.4; % fraction of triangle inside beak serifs +ligs:=2; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=false; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=false; % should all characters have the same width? +variant_g:=false; % should an italic-style g be used? +low_asterisk:=false; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +font_setup; + +cmchar "Variant letter g"; +beginchar("z",10u#+serif_fit#,x_height#,desc_depth#); +italcorr x_height#*slant-serif_fit#+.5stem#-2u# if serifs:+.5u# fi; +adjust_fit(0,serif_fit# if serifs: -.5u# fi); +pickup tiny.nib; pos1(stem',0); pos2(stem,0); +pos0'(stem',0); pos0(stem,0); z0r=z0'r; x0'=x1; x0=x2; +rt x1r=hround(w-2.5u+.5stem'); +numeric edge; edge=lft x2l; +path edge_path; edge_path=(edge,h)--(edge,0); +pickup fine.nib; pos3(if hefty:thin_join else: hair fi,0); +pos4(vair,90); pos5(curve,180); pos6(vair,270); penpos7(x3r-x3l,360); +lft x3l=min(lft x3l-(rt x3r-tiny.rt x2r),2/3[lft x2,edge]); y3=bar_height; +x4l=.5(w-serif_fit)-.3u; top y4r=x_height+oo; +lft x5r=hround max(1.35u-.5curve,.6u); y5=.5x_height; +x6l=x4l-.2u; bot y6r=vround 1/3vair; +lft x7l=edge; y7=min(y3,y6+y4-y3+.6vair); +(x,y4r)=whatever[z3l,z4l]; x4r:=max(x,.5[x5r,x4]); +(x',y6r)=whatever[z7l,z6l]; x6r:=max(x',.5[x5r,x6]); +filldraw stroke z3e{up}...{left}z4e&super_arc.e(4,5) + &super_arc.e(5,6)&z6e{right}...{up}z7e; % bowl +y1=ypart(edge_path intersectionpoint(z3l{up}...{left}z4l)); +y0=ypart(edge_path intersectionpoint(z7l{down}...{left}z6l)); +pickup tiny.nib; bot y2=if serifs: -.25d else: 0 fi; +filldraw stroke z1e--z0'e--z0e--z2e; % stem +pickup crisp.nib; +pos8(hround(hair-stem_corr),0); pos7'(stem',0); +z7'=z1; x8r=x7'r; top y8=h+oo; +filldraw stroke z7'e--z8e; % point +if serifs: pickup tiny.nib; + pos9(vair,-90); x9=.5[x2,x10]; bot y9r=-d-o-1; + pos10(hair,-180); lft x10r=hround u; y10=-.75d+.5flare; + pos11(flare,-180); z11r=z10r; + bulb(9,10,11); filldraw stroke super_arc.e(2,9); % tail +else: pickup fine.nib; pos2'(stem,0); z2'=z2; + z2''r=z2'r; z2''=z2'; z2''l=(x2'l,0); + pos9(vair,-90); x9=4.5u; bot y9r=-d-o-1; + pos10(.5[vair,flare],-90); lft x10=hround 1.25u; + y10r=good.y -5/6d; y10l:=good.y y10l; + filldraw stroke z2'e..z2''e&super_arc.e(2'',9) + & term.e(9,10,left,.9,4); fi % tail +penlabels(0,1,2,3,4,5,6,7,8,9,10,11); endchar; + +font_identifier "CMMAN"; % restore the clobbered value + +bye diff --git a/systems/knuth/local/cm/cmntex10.mf b/systems/knuth/local/cm/cmntex10.mf new file mode 100644 index 0000000000..6266c5a40b --- /dev/null +++ b/systems/knuth/local/cm/cmntex10.mf @@ -0,0 +1,78 @@ +% Computer Modern Narrow TeX extended ASCII characters for use with 10 point +if unknown cmbase: input cmbase fi + +font_identifier:="CMNTEX"; font_size 10pt#; + +u#:=(26pc#/84)/9; % unit width (84 characters = 26 picas, for DT book) +width_adj#:=0pt#; % width adjustment for certain characters +serif_fit#:=0pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=0pt#; % extra sidebar near uppercase serifs +letter_fit#:=0pt#; % extra space added to all sidebars + +body_height#:=250/36pt#; % height of tallest characters +asc_height#:=220/36pt#; % height of lowercase ascenders +cap_height#:=220/36pt#; % height of caps +fig_height#:=220/36pt#; % height of numerals +x_height#:=155/36pt#; % height of lowercase without ascenders +math_axis#:=110/36pt#; % axis of symmetry for math symbols +bar_height#:=79/36pt#; % height of crossbar in lowercase e +comma_depth#:=50/36pt#; % depth of comma below baseline +desc_depth#:=80/36pt#; % depth of lowercase descenders + +crisp#:=17/36pt#; % diameter of serif corners +tiny#:=17/36pt#; % diameter of rounded corners +fine#:=16/36pt#; % diameter of sharply rounded corners +thin_join#:=16/36pt#; % width of extrafine details +hair#:=20/36pt#; % lowercase hairline breadth +stem#:=20/36pt#; % lowercase stem breadth +curve#:=20/36pt#; % lowercase curve breadth +ess#:=17/36pt#; % breadth in middle of lowercase s +flare#:=25/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=28/36pt#; % diameter of dots +cap_hair#:=20/36pt#; % uppercase hairline breadth +cap_stem#:=20/36pt#; % uppercase stem breadth +cap_curve#:=20/36pt#; % uppercase curve breadth +cap_ess#:=20/36pt#; % breadth in middle of uppercase s +rule_thickness#:=20/36pt#; % thickness of lines in math symbols + +dish#:=0pt#; % amount erased at top or bottom of serifs +bracket#:=0pt#; % vertical distance from serif base to tangent +jut#:=25/36pt#; % protrusion of lowercase serifs +cap_jut#:=25/36pt#; % protrusion of uppercase serifs +beak_jut#:=0pt#; % horizontal protrusion of beak serifs +beak#:=25/36pt#; % vertical protrusion of beak serifs +vair#:=17/36pt#; % vertical diameter of hairlines +notch_cut#:=20/36pt#; % maximum breadth above or below notches +bar#:=17/36pt#; % lowercase bar thickness +slab#:=17/36pt#; % serif and arm thickness +cap_bar#:=17/36pt#; % uppercase bar thickness +cap_band#:=17/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=20/36pt#; % max breadth above/below uppercase notches +serif_drop#:=0pt#; % vertical drop of sloped serifs +stem_corr#:=0pt#; % for small refinements of stem breadth +vair_corr#:=0pt#; % for small refinements of hairline height +apex_corr#:=7/36pt#; % extra width at diagonal junctions + +o#:=3/36pt#; % amount of overshoot for curves +apex_o#:=3/36pt#; % amount of overshoot for diagonal junctions + +slant:=.25; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=0.81; % factor applied to weights of heavy characters +math_spread:=-1; % extra openness of math symbols +superness:=1/sqrt2; % parameter for superellipses +superpull:=0; % extra openness inside bowls +beak_darkness:=0; % fraction of triangle inside beak serifs +ligs:=0; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=true; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=true; % should all characters have the same width? +variant_g:=false; % should an italic-style g be used? +low_asterisk:=true; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +extra_beginchar:=extra_beginchar&"rule_thickness:=hair;" % for lowres + & "pickup pencircle scaled rule_thickness; rule.nib:=savepen; clearpen;"; + +generate texset % switch to the driver file diff --git a/systems/knuth/local/cm/cmntt10.mf b/systems/knuth/local/cm/cmntt10.mf new file mode 100644 index 0000000000..85e965bb16 --- /dev/null +++ b/systems/knuth/local/cm/cmntt10.mf @@ -0,0 +1,78 @@ +% Computer Modern Narrow TeX extended ASCII characters for use with 10 point +if unknown cmbase: input cmbase fi + +font_identifier:="CMNTT"; font_size 10pt#; + +u#:=(26pc#/84)/9; % unit width (84 characters = 26 picas, for DT book) +width_adj#:=0pt#; % width adjustment for certain characters +serif_fit#:=0pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=0pt#; % extra sidebar near uppercase serifs +letter_fit#:=0pt#; % extra space added to all sidebars + +body_height#:=250/36pt#; % height of tallest characters +asc_height#:=220/36pt#; % height of lowercase ascenders +cap_height#:=220/36pt#; % height of caps +fig_height#:=220/36pt#; % height of numerals +x_height#:=155/36pt#; % height of lowercase without ascenders +math_axis#:=110/36pt#; % axis of symmetry for math symbols +bar_height#:=79/36pt#; % height of crossbar in lowercase e +comma_depth#:=50/36pt#; % depth of comma below baseline +desc_depth#:=80/36pt#; % depth of lowercase descenders + +crisp#:=17/36pt#; % diameter of serif corners +tiny#:=17/36pt#; % diameter of rounded corners +fine#:=16/36pt#; % diameter of sharply rounded corners +thin_join#:=16/36pt#; % width of extrafine details +hair#:=20/36pt#; % lowercase hairline breadth +stem#:=20/36pt#; % lowercase stem breadth +curve#:=20/36pt#; % lowercase curve breadth +ess#:=17/36pt#; % breadth in middle of lowercase s +flare#:=25/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=28/36pt#; % diameter of dots +cap_hair#:=20/36pt#; % uppercase hairline breadth +cap_stem#:=20/36pt#; % uppercase stem breadth +cap_curve#:=20/36pt#; % uppercase curve breadth +cap_ess#:=20/36pt#; % breadth in middle of uppercase s +rule_thickness#:=20/36pt#; % thickness of lines in math symbols + +dish#:=0pt#; % amount erased at top or bottom of serifs +bracket#:=0pt#; % vertical distance from serif base to tangent +jut#:=25/36pt#; % protrusion of lowercase serifs +cap_jut#:=25/36pt#; % protrusion of uppercase serifs +beak_jut#:=0pt#; % horizontal protrusion of beak serifs +beak#:=25/36pt#; % vertical protrusion of beak serifs +vair#:=17/36pt#; % vertical diameter of hairlines +notch_cut#:=20/36pt#; % maximum breadth above or below notches +bar#:=17/36pt#; % lowercase bar thickness +slab#:=17/36pt#; % serif and arm thickness +cap_bar#:=17/36pt#; % uppercase bar thickness +cap_band#:=17/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=20/36pt#; % max breadth above/below uppercase notches +serif_drop#:=0pt#; % vertical drop of sloped serifs +stem_corr#:=0pt#; % for small refinements of stem breadth +vair_corr#:=0pt#; % for small refinements of hairline height +apex_corr#:=7/36pt#; % extra width at diagonal junctions + +o#:=3/36pt#; % amount of overshoot for curves +apex_o#:=3/36pt#; % amount of overshoot for diagonal junctions + +slant:=0; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=0.81; % factor applied to weights of heavy characters +math_spread:=-1; % extra openness of math symbols +superness:=1/sqrt2; % parameter for superellipses +superpull:=0; % extra openness inside bowls +beak_darkness:=0; % fraction of triangle inside beak serifs +ligs:=0; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=true; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=true; % should all characters have the same width? +variant_g:=false; % should an italic-style g be used? +low_asterisk:=true; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +extra_beginchar:=extra_beginchar&"rule_thickness:=hair;" % for lowres + & "pickup pencircle scaled rule_thickness; rule.nib:=savepen; clearpen;"; + +generate roman % switch to the driver file diff --git a/systems/knuth/local/cm/cmsl6.mf b/systems/knuth/local/cm/cmsl6.mf new file mode 100644 index 0000000000..73227738d2 --- /dev/null +++ b/systems/knuth/local/cm/cmsl6.mf @@ -0,0 +1,75 @@ +% Computer Modern Slanted Roman 6 point +if unknown cmbase: input cmbase fi + +font_identifier:="CMSL"; font_size 6pt#; + +u#:=14/36pt#; % unit width +width_adj#:=0pt#; % width adjustment for certain characters +serif_fit#:=0pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=2.8/36pt#; % extra sidebar near uppercase serifs +letter_fit#:=3/36pt#; % extra space added to all sidebars + +body_height#:=162/36pt#; % height of tallest characters +asc_height#:=150/36pt#; % height of lowercase ascenders +cap_height#:=147.6/36pt#; % height of caps +fig_height#:=139.2/36pt#; % height of numerals +x_height#:=93/36pt#; % height of lowercase without ascenders +math_axis#:=54/36pt#; % axis of symmetry for math symbols +bar_height#:=52.2/36pt#; % height of crossbar in lowercase e +comma_depth#:=42/36pt#; % depth of comma below baseline +desc_depth#:=42/36pt#; % depth of lowercase descenders + +crisp#:=0pt#; % diameter of serif corners +tiny#:=7/36pt#; % diameter of rounded corners +fine#:=6/36pt#; % diameter of sharply rounded corners +thin_join#:=6/36pt#; % width of extrafine details +hair#:=8/36pt#; % lowercase hairline breadth +stem#:=18/36pt#; % lowercase stem breadth +curve#:=20.5/36pt#; % lowercase curve breadth +ess#:=17/36pt#; % breadth in middle of lowercase s +flare#:=21/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=26/36pt#; % diameter of dots +cap_hair#:=8.5/36pt#; % uppercase hairline breadth +cap_stem#:=21.5/36pt#; % uppercase stem breadth +cap_curve#:=24/36pt#; % uppercase curve breadth +cap_ess#:=19/36pt#; % breadth in middle of uppercase s +rule_thickness#:=.31pt#; % thickness of lines in math symbols + +dish#:=.8/36pt#; % amount erased at top or bottom of serifs +bracket#:=12/36pt#; % vertical distance from serif base to tangent +jut#:=17/36pt#; % protrusion of lowercase serifs +cap_jut#:=23/36pt#; % protrusion of uppercase serifs +beak_jut#:=6.8/36pt#; % horizontal protrusion of beak serifs +beak#:=42/36pt#; % vertical protrusion of beak serifs +vair#:=7/36pt#; % vertical diameter of hairlines +notch_cut#:=6pt#; % maximum breadth above or below notches +bar#:=8.5/36pt#; % lowercase bar thickness +slab#:=8.5/36pt#; % serif and arm thickness +cap_bar#:=8.5/36pt#; % uppercase bar thickness +cap_band#:=8.5/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=6pt#; % max breadth above/below uppercase notches +serif_drop#:=2.4/36pt#; % vertical drop of sloped serifs +stem_corr#:=.8/36pt#; % for small refinements of stem breadth +vair_corr#:=.7/36pt#; % for small refinements of hairline height +apex_corr#:=0pt#; % extra width at diagonal junctions + +o#:=4.5/36pt#; % amount of overshoot for curves +apex_o#:=4.5/36pt#; % amount of overshoot for diagonal junctions + +slant:=1/6; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=1; % factor applied to weights of heavy characters +math_spread:=.8; % extra openness of math symbols +superness:=1/sqrt2; % parameter for superellipses +superpull:=1/6; % extra openness inside bowls +beak_darkness:=11/30; % fraction of triangle inside beak serifs +ligs:=2; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=false; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=false; % should all characters have the same width? +variant_g:=false; % should an italic-style g be used? +low_asterisk:=false; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +generate roman % switch to the driver file diff --git a/systems/knuth/local/cm/cmsltt9.mf b/systems/knuth/local/cm/cmsltt9.mf new file mode 100644 index 0000000000..324d8029d3 --- /dev/null +++ b/systems/knuth/local/cm/cmsltt9.mf @@ -0,0 +1,75 @@ +% Computer Modern Slanted Typewriter Text for use with 9 point +if unknown cmbase: input cmbase fi + +font_identifier:="CMSLTT"; font_size 9pt#; + +u#:=18.9/36pt#; % unit width +width_adj#:=0pt#; % width adjustment for certain characters +serif_fit#:=0pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=0pt#; % extra sidebar near uppercase serifs +letter_fit#:=0pt#; % extra space added to all sidebars + +body_height#:=225/36pt#; % height of tallest characters +asc_height#:=198/36pt#; % height of lowercase ascenders +cap_height#:=198/36pt#; % height of caps +fig_height#:=198/36pt#; % height of numerals +x_height#:=139.5/36pt#; % height of lowercase without ascenders +math_axis#:=99/36pt#; % axis of symmetry for math symbols +bar_height#:=71/36pt#; % height of crossbar in lowercase e +comma_depth#:=45/36pt#; % depth of comma below baseline +desc_depth#:=72/36pt#; % depth of lowercase descenders + +crisp#:=21/36pt#; % diameter of serif corners +tiny#:=21/36pt#; % diameter of rounded corners +fine#:=20/36pt#; % diameter of sharply rounded corners +thin_join#:=20/36pt#; % width of extrafine details +hair#:=24/36pt#; % lowercase hairline breadth +stem#:=24/36pt#; % lowercase stem breadth +curve#:=24/36pt#; % lowercase curve breadth +ess#:=21/36pt#; % breadth in middle of lowercase s +flare#:=30/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=33/36pt#; % diameter of dots +cap_hair#:=24/36pt#; % uppercase hairline breadth +cap_stem#:=24/36pt#; % uppercase stem breadth +cap_curve#:=24/36pt#; % uppercase curve breadth +cap_ess#:=24/36pt#; % breadth in middle of uppercase s +rule_thickness#:=24/36pt#; % thickness of lines in math symbols + +dish#:=0pt#; % amount erased at top or bottom of serifs +bracket#:=0pt#; % vertical distance from serif base to tangent +jut#:=31/36pt#; % protrusion of lowercase serifs +cap_jut#:=31/36pt#; % protrusion of uppercase serifs +beak_jut#:=0pt#; % horizontal protrusion of beak serifs +beak#:=31/36pt#; % vertical protrusion of beak serifs +vair#:=21/36pt#; % vertical diameter of hairlines +notch_cut#:=24/36pt#; % maximum breadth above or below notches +bar#:=21/36pt#; % lowercase bar thickness +slab#:=21/36pt#; % serif and arm thickness +cap_bar#:=21/36pt#; % uppercase bar thickness +cap_band#:=21/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=24/36pt#; % max breadth above/below uppercase notches +serif_drop#:=0pt#; % vertical drop of sloped serifs +stem_corr#:=0pt#; % for small refinements of stem breadth +vair_corr#:=0pt#; % for small refinements of hairline height +apex_corr#:=9/36pt#; % extra width at diagonal junctions + +o#:=3.5/36pt#; % amount of overshoot for curves +apex_o#:=3/36pt#; % amount of overshoot for diagonal junctions + +slant:=1/6; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=0.81; % factor applied to weights of heavy characters +math_spread:=-1; % extra openness of math symbols +superness:=1/sqrt2; % parameter for superellipses +superpull:=0; % extra openness inside bowls +beak_darkness:=0; % fraction of triangle inside beak serifs +ligs:=0; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=true; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=true; % should all characters have the same width? +variant_g:=false; % should an italic-style g be used? +low_asterisk:=true; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +generate roman % switch to the driver file diff --git a/systems/knuth/local/cm/cmssbxo10.mf b/systems/knuth/local/cm/cmssbxo10.mf new file mode 100644 index 0000000000..d7d7345fe1 --- /dev/null +++ b/systems/knuth/local/cm/cmssbxo10.mf @@ -0,0 +1,75 @@ +% Computer Modern Slanted Sans Serif Bold Extended 10 pt +if unknown cmbase: input cmbase fi + +font_identifier:="CMSSBXO"; font_size 10pt#; % "O" is for "oblique" + +u#:=22/36pt#; % unit width +width_adj#:=22/36pt#; % width adjustment for certain characters +serif_fit#:=-9/36pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=-11/36pt#; % extra sidebar near uppercase serifs +letter_fit#:=0pt#; % extra space added to all sidebars + +body_height#:=270/36pt#; % height of tallest characters +asc_height#:=250/36pt#; % height of lowercase ascenders +cap_height#:=250/36pt#; % height of caps +fig_height#:=250/36pt#; % height of numerals +x_height#:=165/36pt#; % height of lowercase without ascenders +math_axis#:=90/36pt#; % axis of symmetry for math symbols +bar_height#:=90/36pt#; % height of crossbar in lowercase e +comma_depth#:=38/36pt#; % depth of comma below baseline +desc_depth#:=70/36pt#; % depth of lowercase descenders + +crisp#:=26/36pt#; % diameter of serif corners +tiny#:=26/36pt#; % diameter of rounded corners +fine#:=9/36pt#; % diameter of sharply rounded corners +thin_join#:=9/36pt#; % width of extrafine details +hair#:=49/36pt#; % lowercase hairline breadth +stem#:=49/36pt#; % lowercase stem breadth +curve#:=49/36pt#; % lowercase curve breadth +ess#:=43/36pt#; % breadth in middle of lowercase s +flare#:=40/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=47/36pt#; % diameter of dots +cap_hair#:=49/36pt#; % uppercase hairline breadth +cap_stem#:=53/36pt#; % uppercase stem breadth +cap_curve#:=53/36pt#; % uppercase curve breadth +cap_ess#:=51/36pt#; % breadth in middle of uppercase s +rule_thickness#:=30/36pt#; % thickness of lines in math symbols + +dish#:=0pt#; % amount erased at top or bottom of serifs +bracket#:=0pt#; % vertical distance from serif base to tangent +jut#:=0pt#; % protrusion of lowercase serifs +cap_jut#:=0pt#; % protrusion of uppercase serifs +beak_jut#:=0pt#; % horizontal protrusion of beak serifs +beak#:=1.5/36pt#; % vertical protrusion of beak serifs +vair#:=26/36pt#; % vertical diameter of hairlines +notch_cut#:=49/36pt#; % maximum breadth above or below notches +bar#:=26/36pt#; % lowercase bar thickness +slab#:=36/36pt#; % serif and arm thickness +cap_bar#:=34/36pt#; % uppercase bar thickness +cap_band#:=31/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=45/36pt#; % max breadth above/below uppercase notches +serif_drop#:=2/36pt#; % vertical drop of sloped serifs +stem_corr#:=1/36pt#; % for small refinements of stem breadth +vair_corr#:=2/36pt#; % for small refinements of hairline height +apex_corr#:=18/36pt#; % extra width at diagonal junctions + +o#:=8/36pt#; % amount of overshoot for curves +apex_o#:=0pt#; % amount of overshoot for diagonal junctions + +slant:=sind 12/cosd 12; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=.88; % factor applied to weights of heavy characters +math_spread:=.5; % extra openness of math symbols +superness:=3/4; % parameter for superellipses +superpull:=1/18; % extra openness inside bowls +beak_darkness:=0; % fraction of triangle inside beak serifs +ligs:=2; % level of ligatures to be included + +square_dots:=true; % should dots be square? +hefty:=true; % should we try hard not to be overweight? +serifs:=false; % should serifs and bulbs be attached? +monospace:=false; % should all characters have the same width? +variant_g:=false; % should an italic-style g be used? +low_asterisk:=false; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +generate roman % switch to the driver file diff --git a/systems/knuth/local/cm/cmsslu30.mf b/systems/knuth/local/cm/cmsslu30.mf new file mode 100644 index 0000000000..9e5ec2a031 --- /dev/null +++ b/systems/knuth/local/cm/cmsslu30.mf @@ -0,0 +1,75 @@ +% Computer Modern Sans Serif Light UltraCondensed for C+T title pages +if unknown cmbase: input cmbase fi + +font_identifier:="CMSSLU"; font_size 30pt#; + +u#:=30/36pt#; % unit width +width_adj#:=20/36pt#; % width adjustment for certain characters +serif_fit#:=-12/36pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=-15/36pt#; % extra sidebar near uppercase serifs +letter_fit#:=0pt#; % extra space added to all sidebars + +body_height#:=750/36pt#; % height of tallest characters +asc_height#:=750/36pt#; % height of lowercase ascenders +cap_height#:=750/36pt#; % height of caps +fig_height#:=750/36pt#; % height of numerals +x_height#:=510/36pt#; % height of lowercase without ascenders +math_axis#:=.5cap_height#; % axis of symmetry for math symbols +bar_height#:=285/36pt#; % height of crossbar in lowercase e +comma_depth#:=120/36pt#; % depth of comma below baseline +desc_depth#:=180/36pt#; % depth of lowercase descenders + +crisp#:=23/36pt#; % diameter of serif corners +tiny#:=23/36pt#; % diameter of rounded corners +fine#:=23/36pt#; % diameter of sharply rounded corners +thin_join#:=23/36pt#; % width of extrafine details +hair#:=27/36pt#; % lowercase hairline breadth +stem#:=27/36pt#; % lowercase stem breadth +curve#:=27/36pt#; % lowercase curve breadth +ess#:=27/36pt#; % breadth in middle of lowercase s +flare#:=29/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=30/36pt#; % diameter of dots +cap_hair#:=27/36pt#; % uppercase hairline breadth +cap_stem#:=27/36pt#; % uppercase stem breadth +cap_curve#:=27/36pt#; % uppercase curve breadth +cap_ess#:=27/36pt#; % breadth in middle of uppercase s +rule_thickness#:=25/36pt#; % thickness of lines in math symbols + +dish#:=0pt#; % amount erased at top or bottom of serifs +bracket#:=0pt#; % vertical distance from serif base to tangent +jut#:=0pt#; % protrusion of lowercase serifs +cap_jut#:=0pt#; % protrusion of uppercase serifs +beak_jut#:=0pt#; % horizontal protrusion of beak serifs +beak#:=1.5/36pt#; % vertical protrusion of beak serifs +vair#:=23/36pt#; % vertical diameter of hairlines +notch_cut#:=27/36pt#; % maximum breadth above or below notches +bar#:=23/36pt#; % lowercase bar thickness +slab#:=27/36pt#; % serif and arm thickness +cap_bar#:=27/36pt#; % uppercase bar thickness +cap_band#:=27/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=27/36pt#; % max breadth above/below uppercase notches +serif_drop#:=2/36pt#; % vertical drop of sloped serifs +stem_corr#:=0/36pt#; % for small refinements of stem breadth +vair_corr#:=0/36pt#; % for small refinements of hairline height +apex_corr#:=0/36pt#; % extra width at diagonal junctions + +o#:=7/36pt#; % amount of overshoot for curves +apex_o#:=0pt#; % amount of overshoot for diagonal junctions + +slant:=0; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=1; % factor applied to weights of heavy characters +math_spread:=.3; % extra openness of math symbols +superness:=.75; % parameter for superellipses +superpull:=0; % extra openness inside bowls +beak_darkness:=0; % fraction of triangle inside beak serifs +ligs:=2; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=true; % should we try hard not to be overweight? +serifs:=false; % should serifs and bulbs be attached? +monospace:=false; % should all characters have the same width? +variant_g:=true; % should an italic-style g be used? +low_asterisk:=false; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +generate roman % switch to the driver file diff --git a/systems/knuth/local/cm/cmssu30.mf b/systems/knuth/local/cm/cmssu30.mf new file mode 100644 index 0000000000..7288820cd2 --- /dev/null +++ b/systems/knuth/local/cm/cmssu30.mf @@ -0,0 +1,75 @@ +% Computer Modern Sans Serif UltraCondensed for C+T boards +if unknown cmbase: input cmbase fi + +font_identifier:="CMSSU"; font_size 30pt#; + +u#:=30/36pt#; % unit width +width_adj#:=20/36pt#; % width adjustment for certain characters +serif_fit#:=-12/36pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=-15/36pt#; % extra sidebar near uppercase serifs +letter_fit#:=0pt#; % extra space added to all sidebars + +body_height#:=750/36pt#; % height of tallest characters +asc_height#:=750/36pt#; % height of lowercase ascenders +cap_height#:=750/36pt#; % height of caps +fig_height#:=750/36pt#; % height of numerals +x_height#:=510/36pt#; % height of lowercase without ascenders +math_axis#:=.5cap_height#; % axis of symmetry for math symbols +bar_height#:=285/36pt#; % height of crossbar in lowercase e +comma_depth#:=120/36pt#; % depth of comma below baseline +desc_depth#:=180/36pt#; % depth of lowercase descenders + +crisp#:=23/36pt#; % diameter of serif corners +tiny#:=23/36pt#; % diameter of rounded corners +fine#:=23/36pt#; % diameter of sharply rounded corners +thin_join#:=46/36pt#; % width of extrafine details +hair#:=54/36pt#; % lowercase hairline breadth +stem#:=54/36pt#; % lowercase stem breadth +curve#:=54/36pt#; % lowercase curve breadth +ess#:=54/36pt#; % breadth in middle of lowercase s +flare#:=58/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=60/36pt#; % diameter of dots +cap_hair#:=54/36pt#; % uppercase hairline breadth +cap_stem#:=54/36pt#; % uppercase stem breadth +cap_curve#:=54/36pt#; % uppercase curve breadth +cap_ess#:=54/36pt#; % breadth in middle of uppercase s +rule_thickness#:=50/36pt#; % thickness of lines in math symbols + +dish#:=0pt#; % amount erased at top or bottom of serifs +bracket#:=0pt#; % vertical distance from serif base to tangent +jut#:=0pt#; % protrusion of lowercase serifs +cap_jut#:=0pt#; % protrusion of uppercase serifs +beak_jut#:=0pt#; % horizontal protrusion of beak serifs +beak#:=1.5/36pt#; % vertical protrusion of beak serifs +vair#:=50/36pt#; % vertical diameter of hairlines +notch_cut#:=54/36pt#; % maximum breadth above or below notches +bar#:=48/36pt#; % lowercase bar thickness +slab#:=54/36pt#; % serif and arm thickness +cap_bar#:=54/36pt#; % uppercase bar thickness +cap_band#:=54/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=54/36pt#; % max breadth above/below uppercase notches +serif_drop#:=2/36pt#; % vertical drop of sloped serifs +stem_corr#:=0/36pt#; % for small refinements of stem breadth +vair_corr#:=0/36pt#; % for small refinements of hairline height +apex_corr#:=0/36pt#; % extra width at diagonal junctions + +o#:=7/36pt#; % amount of overshoot for curves +apex_o#:=0pt#; % amount of overshoot for diagonal junctions + +slant:=0; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=1; % factor applied to weights of heavy characters +math_spread:=.3; % extra openness of math symbols +superness:=.75; % parameter for superellipses +superpull:=0; % extra openness inside bowls +beak_darkness:=0; % fraction of triangle inside beak serifs +ligs:=2; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=true; % should we try hard not to be overweight? +serifs:=false; % should serifs and bulbs be attached? +monospace:=false; % should all characters have the same width? +variant_g:=true; % should an italic-style g be used? +low_asterisk:=false; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +generate roman % switch to the driver file diff --git a/systems/knuth/local/cm/cmsytt10.mf b/systems/knuth/local/cm/cmsytt10.mf new file mode 100644 index 0000000000..1a28aefc6b --- /dev/null +++ b/systems/knuth/local/cm/cmsytt10.mf @@ -0,0 +1,97 @@ +% Computer Modern Math Symbols 10 point Typewriter +if unknown cmbase: input cmbase fi + +font_identifier:="CMSYTT"; font_size 10pt#; + +u#:=21/36pt#; % unit width +width_adj#:=0pt#; % width adjustment for certain characters +serif_fit#:=0pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=0pt#; % extra sidebar near uppercase serifs +letter_fit#:=0pt#; % extra space added to all sidebars + +body_height#:=250/36pt#; % height of tallest characters +asc_height#:=220/36pt#; % height of lowercase ascenders +cap_height#:=220/36pt#; % height of caps +fig_height#:=220/36pt#; % height of numerals +x_height#:=155/36pt#; % height of lowercase without ascenders +math_axis#:=110/36pt#; % axis of symmetry for math symbols +bar_height#:=79/36pt#; % height of crossbar in lowercase e +comma_depth#:=50/36pt#; % depth of comma below baseline +desc_depth#:=80/36pt#; % depth of lowercase descenders + +crisp#:=22/36pt#; % diameter of serif corners +tiny#:=22/36pt#; % diameter of rounded corners +fine#:=21/36pt#; % diameter of sharply rounded corners +thin_join#:=21/36pt#; % width of extrafine details +hair#:=25/36pt#; % lowercase hairline breadth +stem#:=25/36pt#; % lowercase stem breadth +curve#:=25/36pt#; % lowercase curve breadth +ess#:=22/36pt#; % breadth in middle of lowercase s +flare#:=32/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=36/36pt#; % diameter of dots +cap_hair#:=25/36pt#; % uppercase hairline breadth +cap_stem#:=25/36pt#; % uppercase stem breadth +cap_curve#:=25/36pt#; % uppercase curve breadth +cap_ess#:=25/36pt#; % breadth in middle of uppercase s +rule_thickness#:=25/36pt#; % thickness of lines in math symbols + +dish#:=0pt#; % amount erased at top or bottom of serifs +bracket#:=0pt#; % vertical distance from serif base to tangent +jut#:=34/36pt#; % protrusion of lowercase serifs +cap_jut#:=34/36pt#; % protrusion of uppercase serifs +beak_jut#:=0pt#; % horizontal protrusion of beak serifs +beak#:=34/36pt#; % vertical protrusion of beak serifs +vair#:=22/36pt#; % vertical diameter of hairlines +notch_cut#:=25/36pt#; % maximum breadth above or below notches +bar#:=22/36pt#; % lowercase bar thickness +slab#:=22/36pt#; % serif and arm thickness +cap_bar#:=22/36pt#; % uppercase bar thickness +cap_band#:=22/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=25/36pt#; % max breadth above/below uppercase notches +serif_drop#:=0pt#; % vertical drop of sloped serifs +stem_corr#:=0pt#; % for small refinements of stem breadth +vair_corr#:=0pt#; % for small refinements of hairline height +apex_corr#:=10/36pt#; % extra width at diagonal junctions + +o#:=4/36pt#; % amount of overshoot for curves +apex_o#:=3/36pt#; % amount of overshoot for diagonal junctions + +slant:=0; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=0.81; % factor applied to weights of heavy characters +math_spread:=-1; % extra openness of math symbols +superness:=1/sqrt2; % parameter for superellipses +superpull:=0; % extra openness inside bowls +beak_darkness:=0; % fraction of triangle inside beak serifs +ligs:=0; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=true; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=true; % should all characters have the same width? +variant_g:=false; % should an italic-style g be used? +low_asterisk:=true; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +% the following font parameters are explained in {\sl The \TeX book}, Appendix G +% I've copied them from cmsy10 (maybe a bad idea, but for today it's OK...) + +subs:=7/10; % subscripts to 10pt will normally be in 7pt type +rth#:=.4pt#; % assume that rules will come from cmex10 +fontdimen 8: % parameters $\sigma_8$ through $\sigma_{22}$ will now be listed + math_axis#+3.51rth#+54/36pt#+subs*desc_depth#, % num1 + math_axis#+1.51rth#+30/36pt#, % num2 + math_axis#+1.51rth#+48/36pt#, % num3 + -(math_axis#-3.51rth#-subs*fig_height#-124/36pt#), % denom1 + -(math_axis#-1.51rth#-subs*fig_height#-30/36pt#), % denom2 + 8.99pt#-subs*asc_height#, % sup1 + 8.49pt#-subs*asc_height#, % sup2 + 104/36pt#, % sup3 + 54/36pt#, % sub1 + -(8.49pt#-2subs*asc_height#-3.1rth#), % sub2 + subs*asc_height#-36/36pt#, % sup\_drop + 18/36pt#, % sub\_drop + 23.9pt#, % delim1 + 10.1pt#, % delim2 + math_axis#; % axis\_height + +generate mathsy % switch to the driver file diff --git a/systems/knuth/local/cm/cmtim.mf b/systems/knuth/local/cm/cmtim.mf new file mode 100644 index 0000000000..020b825d36 --- /dev/null +++ b/systems/knuth/local/cm/cmtim.mf @@ -0,0 +1,78 @@ +% crude approximation to Time Magazine font of 1980 +% based on cmr8 scaled 1050 but then twiddled + +if unknown cmbase: input cmbase fi + +font_identifier:="CMTIM"; font_size 9pt#; + +bpt#:=1.05pt#; +u#:=1.02*17/36bpt#; % unit width +width_adj#:=0bpt#; % width adjustment for certain characters +serif_fit#:=0bpt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=4.1/36bpt#; % extra sidebar near uppercase serifs +letter_fit#:=-1/36bpt#; % extra space added to all sidebars + +body_height#:=9/8*216/36bpt#; % height of tallest characters +asc_height#:=9/8*200/36bpt#; % height of lowercase ascenders +cap_height#:=9/8*196.8/36bpt#; % height of caps +fig_height#:=9/8*185.6/36bpt#; % height of numerals +x_height#:=8/7*124/36bpt#; % height of lowercase without ascenders +math_axis#:=9/8*72/36bpt#; % axis of symmetry for math symbols +bar_height#:=8/7*69.6/36bpt#; % height of crossbar in lowercase e +comma_depth#:=7/8*56/36bpt#; % depth of comma below baseline +desc_depth#:=7/8*56/36bpt#; % depth of lowercase descenders + +crisp#:=0bpt#; % diameter of serif corners +tiny#:=8/36bpt#; % diameter of rounded corners +fine#:=7/36bpt#; % diameter of sharply rounded corners +thin_join#:=7/36bpt#; % width of extrafine details +hair#:=9/36bpt#; % lowercase hairline breadth +stem#:=22/36bpt#; % lowercase stem breadth +curve#:=25.5/36bpt#; % lowercase curve breadth +ess#:=23/36bpt#; % breadth in middle of lowercase s +flare#:=27/36bpt#; % diameter of bulbs or breadth of terminals +dot_size#:=32/36bpt#; % diameter of dots +cap_hair#:=9.5/36bpt#; % uppercase hairline breadth +cap_stem#:=26.5/36bpt#; % uppercase stem breadth +cap_curve#:=30/36bpt#; % uppercase curve breadth +cap_ess#:=27/36bpt#; % breadth in middle of uppercase s +rule_thickness#:=.36bpt#; % thickness of lines in math symbols + +dish#:=1/36bpt#; % amount erased at top or bottom of serifs +bracket#:=16/36bpt#; % vertical distance from serif base to tangent +jut#:=22/36bpt#; % protrusion of lowercase serifs +cap_jut#:=29/36bpt#; % protrusion of uppercase serifs +beak_jut#:=8.4/36bpt#; % horizontal protrusion of beak serifs +beak#:=56/36bpt#; % vertical protrusion of beak serifs +vair#:=8/36bpt#; % vertical diameter of hairlines +notch_cut#:=8bpt#; % maximum breadth above or below notches +bar#:=9.5/36bpt#; % lowercase bar thickness +slab#:=9.5/36bpt#; % serif and arm thickness +cap_bar#:=9.5/36bpt#; % uppercase bar thickness +cap_band#:=9.5/36bpt#; % uppercase thickness above/below lobes +cap_notch_cut#:=8bpt#; % max breadth above/below uppercase notches +serif_drop#:=3.2/36bpt#; % vertical drop of sloped serifs +stem_corr#:=1/36bpt#; % for small refinements of stem breadth +vair_corr#:=1/36bpt#; % for small refinements of hairline height +apex_corr#:=0bpt#; % extra width at diagonal junctions + +o#:=6/36bpt#; % amount of overshoot for curves +apex_o#:=6/36bpt#; % amount of overshoot for diagonal junctions + +slant:=0; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=1; % factor applied to weights of heavy characters +math_spread:=.4; % extra openness of math symbols +superness:=1/sqrt2; % parameter for superellipses +superpull:=1/6; % extra openness inside bowls +beak_darkness:=11/30; % fraction of triangle inside beak serifs +ligs:=2; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=false; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=false; % should all characters have the same width? +variant_g:=false; % should an italic-style g be used? +low_asterisk:=false; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +generate roman % switch to the driver file diff --git a/systems/knuth/local/cm/cmvtti10.mf b/systems/knuth/local/cm/cmvtti10.mf new file mode 100644 index 0000000000..535f4d87b2 --- /dev/null +++ b/systems/knuth/local/cm/cmvtti10.mf @@ -0,0 +1,75 @@ +% Computer Modern Variable-Width Typewriter Text Italic for use with 10 point +if unknown cmbase: input cmbase fi + +font_identifier:="CMVTTI"; font_size 10pt#; + +u#:=21/36pt#; % unit width +width_adj#:=0pt#; % width adjustment for certain characters +serif_fit#:=0pt#; % extra sidebar near lowercase serifs +cap_serif_fit#:=0pt#; % extra sidebar near uppercase serifs +letter_fit#:=15/36pt#; % extra space added to all sidebars + +body_height#:=250/36pt#; % height of tallest characters +asc_height#:=220/36pt#; % height of lowercase ascenders +cap_height#:=220/36pt#; % height of caps +fig_height#:=220/36pt#; % height of numerals +x_height#:=155/36pt#; % height of lowercase without ascenders +math_axis#:=110/36pt#; % axis of symmetry for math symbols +bar_height#:=79/36pt#; % height of crossbar in lowercase e +comma_depth#:=50/36pt#; % depth of comma below baseline +desc_depth#:=80/36pt#; % depth of lowercase descenders + +crisp#:=22/36pt#; % diameter of serif corners +tiny#:=22/36pt#; % diameter of rounded corners +fine#:=21/36pt#; % diameter of sharply rounded corners +thin_join#:=21/36pt#; % width of extrafine details +hair#:=25/36pt#; % lowercase hairline breadth +stem#:=25/36pt#; % lowercase stem breadth +curve#:=25/36pt#; % lowercase curve breadth +ess#:=22/36pt#; % breadth in middle of lowercase s +flare#:=32/36pt#; % diameter of bulbs or breadth of terminals +dot_size#:=36/36pt#; % diameter of dots +cap_hair#:=25/36pt#; % uppercase hairline breadth +cap_stem#:=25/36pt#; % uppercase stem breadth +cap_curve#:=25/36pt#; % uppercase curve breadth +cap_ess#:=25/36pt#; % breadth in middle of uppercase s +rule_thickness#:=25/36pt#; % thickness of lines in math symbols + +dish#:=0pt#; % amount erased at top or bottom of serifs +bracket#:=0pt#; % vertical distance from serif base to tangent +jut#:=40/36pt#; % protrusion of lowercase serifs +cap_jut#:=34/36pt#; % protrusion of uppercase serifs +beak_jut#:=0pt#; % horizontal protrusion of beak serifs +beak#:=34/36pt#; % vertical protrusion of beak serifs +vair#:=22/36pt#; % vertical diameter of hairlines +notch_cut#:=25/36pt#; % maximum breadth above or below notches +bar#:=22/36pt#; % lowercase bar thickness +slab#:=22/36pt#; % serif and arm thickness +cap_bar#:=22/36pt#; % uppercase bar thickness +cap_band#:=22/36pt#; % uppercase thickness above/below lobes +cap_notch_cut#:=25/36pt#; % max breadth above/below uppercase notches +serif_drop#:=0pt#; % vertical drop of sloped serifs +stem_corr#:=0pt#; % for small refinements of stem breadth +vair_corr#:=1.5/36pt#; % for small refinements of hairline height +apex_corr#:=10/36pt#; % extra width at diagonal junctions + +o#:=4/36pt#; % amount of overshoot for curves +apex_o#:=3/36pt#; % amount of overshoot for diagonal junctions + +slant:=1/4; % tilt ratio $(\Delta x/\Delta y)$ +fudge:=0.81; % factor applied to weights of heavy characters +math_spread:=-1; % extra openness of math symbols +superness:=1/sqrt2; % parameter for superellipses +superpull:=0; % extra openness inside bowls +beak_darkness:=0; % fraction of triangle inside beak serifs +ligs:=2; % level of ligatures to be included + +square_dots:=false; % should dots be square? +hefty:=true; % should we try hard not to be overweight? +serifs:=true; % should serifs and bulbs be attached? +monospace:=false; % should all characters have the same width? +variant_g:=true; % should an italic-style g be used? +low_asterisk:=true; % should the asterisk be centered at the axis? +math_fitting:=false; % should math-mode spacing be used? + +generate textit % switch to the driver file diff --git a/systems/knuth/local/cm/diam12.mf b/systems/knuth/local/cm/diam12.mf new file mode 100644 index 0000000000..2f4494d8c3 --- /dev/null +++ b/systems/knuth/local/cm/diam12.mf @@ -0,0 +1,18 @@ +% make a solid diamond to use as a calligraphic-style bullet +if unknown cmbase: input cmbase fi % omit if CMMF can be assumed +mode_setup; + +def generate suffix t= enddef; +input cmr12; font_setup; + +cmchar "Solid diamond"; % cf Diamond operator in sym.mf +beginchar("d",9u#,v_center(7u#)); +italcorr math_axis#*slant; +adjust_fit(0,0); pickup rule.nib; +numeric a; a=(lft 3.5u)*sqrt(3.14159/2); % an attempt to match circle area +x4=x8=good.x .5w; center_on(x4); x2=w-x6=good.x(x4+a); +y2=y6=.5[y4,y8]=math_axis; y8=good.y(y2+a); +fill (rt z2)--(top z8)--(lft z6)--(bot z4)--cycle; % bowl +labels(2,4,6,8); endchar; + +end diff --git a/systems/knuth/local/cm/ebigop.mf b/systems/knuth/local/cm/ebigop.mf new file mode 100644 index 0000000000..05f3d808d3 --- /dev/null +++ b/systems/knuth/local/cm/ebigop.mf @@ -0,0 +1,912 @@ +% The Computer Modern Math-Extension family (by D. E. Knuth, 1979--1985) +% Special version for characters redesigned to blend with Euler + +% This is the driver file for EUEX fonts, before AMS screwed it up +font_coding_scheme:="euler substitutions only"; +mode_setup; font_setup; + +def t_ = transformed currenttransform enddef; + +def bulb(suffix $,$$,$$$) = + z$$$r=z$$r; +pair trueup; (z5+trueup)t_=z5+(0,y$$r-y$r); + path_.l:=z$l{x$$r-x$r,0}...{trueup}z$$l; +{{less_tense; + filldraw path_.l--z$$r{-trueup}...{x$r-x$$r,0}z$r--cycle}}; % link + path_.r:=z$$$l{-trueup}..z$$$r{trueup}; % near-circle + filldraw subpath(0,xpart(path_.r intersectiontimes path_.l)) of path_.r + --z$$r{trueup}..cycle; % bulb + enddef; + +% characters modified from BIGOP +charlist oct"110": oct"111"; % contour integral signs +charlist oct"122": oct"132"; % integral signs +charlist oct"120": oct"130"; % summation signs +charlist oct"121": oct"131"; % product signs +charlist oct"140": oct"141"; % coproduct signs + +% characters modified from BIGDEL (braces in different positions) +charlist oct"010": oct"012": oct"014": oct"016": oct"070"; % left braces +charlist oct"011": oct"013": oct"015": oct"017": oct"071"; % right braces +extensible oct"070": oct"070",oct"074",oct"072",oct"076"; % left brace +extensible oct"071": oct"071",oct"075",oct"073",oct"076"; % right brace +extensible oct"072": oct"070",0,oct"072",oct"076"; % sharp left parenthesis +extensible oct"073": oct"071",0,oct"073",oct"076"; % sharp right parenthesis +extensible oct"076": 0,0,0,oct"076"; % brace extension modules only +extensible oct"100": oct"070",0,oct"073",oct"076"; % left moustache +extensible oct"101": oct"071",0,oct"072",oct"076"; % right moustache +% the horizontal braces are included too +heavy_rule_thickness:=bold+dw; % this is the main change: big braces not so dark +heavy_rule_thickness#:=curve#+(curve#-stem#); + +% arrows (taken from SYMBOL, SYM, and ROMSS, with longer and thicker arrowheads) +bar:=rule_thickness; % this makes the arrowheads thicker +% the half arrows from ROMSS are moved to different font positions +% infinity (taken from SYMBOL, made heavier) + +cmchar "\textstyle integral sign"; +beginchar(oct"122",12u#,0,100/54dh#); +italcorr 0.5u#; % \TeX\ kerning between upper limit and lower limit +adjust_fit(-1u#,-1u#-ic#); pickup fine.nib; +pos1(dot_size,0); pos2(.75[hair,stem],0); pos3(vair,90); pos4(stem,180); +pos5(.4[stem,curve],180); pos5'(.4[stem,curve],0); z5'=z5; pos6(stem,0); +pos7(vair,-90); pos8(.75[hair,stem],-180); pos9(dot_size,-180); +rt x1r=hround(w-u); x9=w-x1; x7=w-x3=3u; +x5=.5[x4,x6]; x4-x6=1.2u; lft x5r=hround(.5w-.5curve); +top y3r=0; bot y7r=-d; y9-.5(.4[stem,curve])=vround(top y7l+.25(.4[stem,curve])); +y3-y1=y9-y7; y5=.5[y3,y7]=.5[y4,y6]; y4-y6=.6(y3-y7); +transform skewit; + z5 transformed skewit=z5; (z5+right) transformed skewit = z5+right; + z3 transformed skewit=z3-u*right; +skewit:=skewit transformed currenttransform; +save currenttransform; transform currenttransform; currenttransform:=skewit; +bulb(3,2,1); bulb(7,8,9); % bulbs +filldraw stroke z3e{left}...z4e{(z5e-z4e)xscaled 1.1} + ..tension atleast 1 and atleast .8..{z5-z4}z5e; % upper stem +filldraw stroke z5'e{z6-z5}..tension atleast.8 and atleast 1 + ..{(z6e-z5'e)xscaled 1.1}z6e...{left}z7e; % lower stem +penlabels(1,2,3,4,5,6,7,8,9); endchar; + +cmchar "\displaystyle integral sign"; +beginchar(oct"132",18u#,0,200/54dh#); +italcorr 2u#; % \TeX\ kerning between upper limit and lower limit +adjust_fit(-4u#,-4u#-ic#); pickup fine.nib; +numeric bulb_size, max_size; +bulb_size=hround(.8[stem,curve]); max_size=hround(bold+.2dw); +pos1(bulb_size,0); pos2(.75[hair,stem],0); pos3(vair,90); pos4(.4[stem,curve],180); +pos5(max_size,180); pos5'(max_size,0); z5'=z5; pos6(.4[stem,curve],0); +pos7(vair,-90); pos8(.75[hair,stem],-180); pos9(bulb_size,-180); +rt x1r=hround(w-u); x9=w-x1; x7=w-x3=3u; +x5=.5[x4,x6]; x4-x6=4.8u; lft x5r=hround(.5w-.5max_size); +top y3r=0; bot y7r=-d; +y9-.5bulb_size=vround(top y7l+.25bulb_size); y3-y1=y9-y7; +y5=.5[y3,y7]=.5[y4,y6]; y4-y6=.6(y3-y7); +transform skewit; + z5 transformed skewit=z5; (z5+right) transformed skewit = z5+right; + z3 transformed skewit=z3-4u*right; +skewit:=skewit transformed currenttransform; +save currenttransform; transform currenttransform; currenttransform:=skewit; +bulb(3,2,1); bulb(7,8,9); % bulbs +filldraw stroke z3e{left}...z4e{(z5e-z4e)xscaled 1.1} + ..tension atleast 1 and atleast .8..{z5-z4}z5e; % upper stem +filldraw stroke z5'e{z6-z5}..tension atleast.8 and atleast 1 + ..{(z6e-z5'e)xscaled 1.1}z6e...{left}z7e; % lower stem +penlabels(1,2,3,4,5,6,7,8,9); endchar; + +cmchar "\textstyle contour integral sign"; +beginchar(oct"110",12u#,0,100/54dh#); +italcorr 0.5u#; % \TeX\ kerning between upper limit and lower limit +adjust_fit(-u#,-u#-ic#); pickup fine.nib; +begingroup +pos1(dot_size,0); pos2(.75[hair,stem],0); pos3(vair,90); pos4(stem,180); +pos5(.4[stem,curve],180); pos5'(.4[stem,curve],0); z5'=z5; pos6(stem,0); +pos7(vair,-90); pos8(.75[hair,stem],-180); pos9(dot_size,-180); +rt x1r=hround(w-u); x9=w-x1; x7=w-x3=3u; +x5=.5[x4,x6]; x4-x6=1.2u; lft x5r=hround(.5w-.5(.4[stem,curve])); +top y3r=0; bot y7r=-d; y9-.5(.4[stem,curve])=vround(top y7l+.25(.4[stem,curve])); +y3-y1=y9-y7; y5=.5[y3,y7]=.5[y4,y6]; y4-y6=.6(y3-y7); +transform skewit; + z5 transformed skewit=z5; (z5+right) transformed skewit = z5+right; + z3 transformed skewit=z3-u*right; +skewit:=skewit transformed currenttransform; +save currenttransform; transform currenttransform; currenttransform:=skewit; +bulb(3,2,1); bulb(7,8,9); % bulbs +filldraw stroke z3e{left}...z4e{(z5e-z4e)xscaled 1.1} + ..tension atleast 1 and atleast .8..{z5-z4}z5e; % upper stem +filldraw stroke z5'e{z6-z5}..tension atleast.8 and atleast 1 + ..{(z6e-z5'e)xscaled 1.1}z6e...{left}z7e; % lower stem +endgroup; +pickup rule.nib; autorounded; +draw fullcircle scaled .5w shifted z5; % contour +penlabels(1,2,3,4,5,6,7,8,9); endchar; + +cmchar "\displaystyle contour integral sign"; +beginchar(oct"111",18u#,0,200/54dh#); +italcorr 2u#; % \TeX\ kerning between upper limit and lower limit +adjust_fit(-4u#,-4u#-ic#); pickup fine.nib; +begingroup +numeric bulb_size, max_size; +bulb_size=hround(.8[stem,curve]); max_size=hround(bold+.2dw); +pos1(bulb_size,0); pos2(.75[hair,stem],0); pos3(vair,90); pos4(.4[stem,curve],180); +pos5(max_size,180); pos5'(max_size,0); z5'=z5; pos6(.4[stem,curve],0); +pos7(vair,-90); pos8(.75[hair,stem],-180); pos9(bulb_size,-180); +rt x1r=hround(w-u); x9=w-x1; x7=w-x3=3u; +x5=.5[x4,x6]; x4-x6=4.8u; lft x5r=hround(.5w-.5max_size); +top y3r=0; bot y7r=-d; +y9-.5bulb_size=vround(top y7l+.25bulb_size); y3-y1=y9-y7; +y5=.5[y3,y7]=.5[y4,y6]; y4-y6=.6(y3-y7); +transform skewit; + z5 transformed skewit=z5; (z5+right) transformed skewit = z5+right; + z3 transformed skewit=z3-4u*right; +skewit:=skewit transformed currenttransform; +save currenttransform; transform currenttransform; currenttransform:=skewit; +bulb(3,2,1); bulb(7,8,9); % bulbs +filldraw stroke z3e{left}...z4e{(z5e-z4e)xscaled 1.1} + ..tension atleast 1 and atleast .8..{z5-z4}z5e; % upper stem +filldraw stroke z5'e{z6-z5}..tension atleast.8 and atleast 1 + ..{(z6e-z5'e)xscaled 1.1}z6e...{left}z7e; % lower stem +endgroup; +pickup rule.nib; autorounded; +draw fullcircle scaled .5w shifted z5; % contour +penlabels(1,2,3,4,5,6,7,8,9); endchar; + + +cmchar "\textstyle summation sign"; +beginchar(oct"120",19u#,0,10/6dh#); +adjust_fit(0,0); pickup tiny.nib; +numeric top_arm_thickness, bot_arm_thickness; +top_arm_thickness=Vround(.7[rule_thickness,bold]); +bot_arm_thickness=Vround(bold+dw); +lft x1l=hround 2.2u; x1l=x2l; lft x4l=hround u; x3l-x1l=4/11(w-2u)-1.2u; +top y1=0; bot y2=-top_arm_thickness-eps; bot y4=-d; y3=-.48d; +numeric alpha[]; alpha1=((x3l-x1l)++(y2-y3))/(y2-y3); +penpos1(alpha1*(curve-tiny),0); penpos2(alpha1*(curve-tiny),0); +penpos3(alpha1*(curve-tiny),0); +alpha2=diag_ratio(1,rule_thickness+dw-tiny,y3-y4,x3r-x4l); +penpos4(alpha2*(rule_thickness+dw-tiny),0); +z0=whatever[z2l,z3l]=z4l+whatever*(z3r-z4r); +filldraw z1l--z2l--z0--z4l--z4r--z3r--z2r--z1r--cycle; % diagonals +pickup crisp.nib; pos5(top_arm_thickness,90); pos6(hair,0); +top y5r=0; x5=x1; rt x6r=hround(w-3u); y6=good.y(y5l)-eps; +{{save serifs; boolean serifs; serifs:=false; +arm(5,6,a,.45,-.25u); % upper arm and beak +pos7(bot_arm_thickness,-90); pos8(hair,0); +bot y7r=-d; z7l=whatever[z4,z3]; x7r:=x4; x8=x6+1.5u; y8=good.y(y7l)+eps; +arm(7,8,b,.45,.25u);}}; % lower arm and beak +penlabels(0,1,2,3,4,5,6,7,8); endchar; + +cmchar "\displaystyle summation sign"; +beginchar(oct"130",26u#,0,14/6dh#); padded 1/6dh#; +adjust_fit(0,0); pickup tiny.nib; +numeric top_arm_thickness, bot_arm_thickness, thick_stem, thin_stem; +thick_stem=bold+4dw; thin_stem=rule_thickness+2dw; +top_arm_thickness=Vround(bold-.5dw); +bot_arm_thickness=Vround(bold+2.5dw); +lft x1l=hround 3u; x1l=x2l; lft x4l=hround u; x3l-x1l=4/11(w-2u)-2u; +top y1=0; bot y2=-top_arm_thickness-eps; bot y4=-d; y3=-.48d; +numeric alpha[]; alpha1=((x3l-x1l)++(y2-y3))/(y2-y3); +penpos1(alpha1*(thick_stem-tiny),0); penpos2(alpha1*(thick_stem-tiny),0); +penpos3(alpha1*(thick_stem-tiny),0); +alpha2=diag_ratio(1,thin_stem-tiny,y3-y4,x3r-x4l); +penpos4(alpha2*(thin_stem-tiny),0); +z0=whatever[z2l,z3l]=z4l+whatever*(z3r-z4r); +filldraw z1l--z2l--z0--z4l--z4r--z3r--z2r--z1r--cycle; % diagonals +pickup crisp.nib; pos5(top_arm_thickness,90); pos6(hair,0); +top y5r=0; x5=x1; rt x6r=hround(w-4u); y6=good.y(y5l)-eps; +{{save serifs; boolean serifs; serifs:=false; +arm(5,6,a,.45,-.25u); % upper arm and beak +pos7(bot_arm_thickness,-90); pos8(hair,0); +bot y7r=-d; z7l=whatever[z4,z3]; x7r:=x4; x8=x6+2.5u; y8=good.y(y7l)+eps; +arm(7,8,b,.45,.25u);}}; % lower arm and beak +penlabels(0,1,2,3,4,5,6,7,8); endchar; + +cmchar "\textstyle product sign"; +beginchar(oct"121",18.5u#,0,10/6dh#); +adjust_fit(.25u#,.25u#); pickup crisp.nib; +numeric heavy_stem,light_stem; +heavy_stem=hround(bold+dw); light_stem=rule_thickness; +pos1(heavy_stem,0);pos2(heavy_stem,0); pos1'(heavy_stem,0);pos2'(heavy_stem,0); +pos11(light_stem,90); pos12(light_stem,90); pos22(light_stem,90); +lft x11=hround u; x1l-x11=x2l-x12=x22-x2r=hround cap_jut; +x1=x1'=x2=x2'; +top y1=0; bot y2=-d; y11r=y1; y12l=y22l=y2; +y11l-y1'=y2'-y12r=1.2bracket; +filldraw z1r--z11r--serif_arc(11l,1'l)--reverse serif_arc(12r,2'l) + --z12l--z22l--serif_arc(22r,2'r)--cycle; % left stem and serifs +pos3(heavy_stem,0);pos4(heavy_stem,0); pos3'(heavy_stem,0);pos4'(heavy_stem,0); +pos13(light_stem,90); pos14(light_stem,90); pos24(light_stem,90); +x3=x3'=x4=x4'=w-x1; x13=x14=w-x11; x24=w-x22; +y3=y13r=y1; y3'=y1'; y4'=y2'; y4=y14l=y24l=y2; +filldraw z3l--z13r--serif_arc(13l,3'r)--reverse serif_arc(14r,4'r) + --z14l--z24l--serif_arc(24r,4'l)--cycle; % right stem and serifs +filldraw stroke z11e--z13e; % bar +penlabels(1,1',2,2',3,3',4,4',11,12,13,14,22,24); endchar; + +cmchar "\displaystyle product sign"; +beginchar(oct"131",25.4u#,0,14/6dh#); padded 1/6dh#; +adjust_fit(0,0); pickup crisp.nib; +numeric heavy_stem,light_stem; +heavy_stem=hround(bold+5dw); light_stem=Vround(rule_thickness+dw); +pos1(heavy_stem,0);pos2(heavy_stem,0); pos1'(heavy_stem,0);pos2'(heavy_stem,0); +pos11(light_stem,90); pos12(light_stem,90); pos22(light_stem,90); +lft x11=hround u; x1l-x11=x2l-x12=x22-x2r=hround 1.6cap_jut; +x1=x1'=x2=x2'; +top y1=0; bot y2=-d; y11r=y1; y12l=y22l=y2; +y11l-y1'=y2'-y12r=1.8bracket; +filldraw z1r--z11r--serif_arc(11l,1'l)--reverse serif_arc(12r,2'l) + --z12l--z22l--serif_arc(22r,2'r)--cycle; % left stem and serifs +pos3(heavy_stem,0);pos4(heavy_stem,0); pos3'(heavy_stem,0);pos4'(heavy_stem,0); +pos13(light_stem,90); pos14(light_stem,90); pos24(light_stem,90); +x3=x3'=x4=x4'=w-x1; x13=x14=w-x11; x24=w-x22; +y3=y13r=y1; y3'=y1'; y4'=y2'; y4=y14l=y24l=y2; +filldraw z3l--z13r--serif_arc(13l,3'r)--reverse serif_arc(14r,4'r) + --z14l--z24l--serif_arc(24r,4'l)--cycle; % right stem and serifs +filldraw stroke z11e--z13e; % bar +penlabels(1,1',2,2',3,3',4,4',11,12,13,14,22,24); endchar; + +cmchar "\textstyle coproduct sign"; +beginchar(oct"140",18.5u#,0,10/6dh#); +adjust_fit(.25u#,.25u#); pickup crisp.nib; +numeric heavy_stem,light_stem; +heavy_stem=hround(bold+dw); light_stem=rule_thickness; +pos1(heavy_stem,0);pos2(heavy_stem,0); pos1'(heavy_stem,0);pos2'(heavy_stem,0); +pos11(light_stem,-90); pos12(light_stem,-90); pos22(light_stem,-90); +lft x11=hround u; x1l-x11=x2l-x12=x22-x2r=hround cap_jut; +x1=x1'=x2=x2'; +bot y1=-d; top y2=0; y11r=y1; y12l=y22l=y2; +y1'-y11l=y12r-y2'=1.2bracket; +filldraw z1r--z11r--serif_arc(11l,1'l)--reverse serif_arc(12r,2'l) + --z12l--z22l--serif_arc(22r,2'r)--cycle; % left stem and serifs +pos3(heavy_stem,0);pos4(heavy_stem,0); pos3'(heavy_stem,0);pos4'(heavy_stem,0); +pos13(light_stem,-90); pos14(light_stem,-90); pos24(light_stem,-90); +x3=x3'=x4=x4'=w-x1; x13=x14=w-x11; x24=w-x22; +y3=y13r=y1; y3'=y1'; y4'=y2'; y4=y14l=y24l=y2; +filldraw z3l--z13r--serif_arc(13l,3'r)--reverse serif_arc(14r,4'r) + --z14l--z24l--serif_arc(24r,4'l)--cycle; % right stem and serifs +filldraw stroke z11e--z13e; % bar +penlabels(1,1',2,2',3,3',4,4',11,12,13,14,22,24); endchar; + +cmchar "\displaystyle coproduct sign"; +beginchar(oct"141",25.4u#,0,14/6dh#); padded 1/6dh#; +adjust_fit(0,0); pickup crisp.nib; +numeric heavy_stem,light_stem; +heavy_stem=hround(bold+5dw); light_stem=Vround(rule_thickness+dw); +pos1(heavy_stem,0);pos2(heavy_stem,0); pos1'(heavy_stem,0);pos2'(heavy_stem,0); +pos11(light_stem,-90); pos12(light_stem,-90); pos22(light_stem,-90); +lft x11=hround u; x1l-x11=x2l-x12=x22-x2r=hround 1.6cap_jut; +x1=x1'=x2=x2'; +bot y1=-d; top y2=0; y11r=y1; y12l=y22l=y2; +y1'-y11l=y12r-y2'=1.8bracket; +filldraw z1r--z11r--serif_arc(11l,1'l)--reverse serif_arc(12r,2'l) + --z12l--z22l--serif_arc(22r,2'r)--cycle; % left stem and serifs +pos3(heavy_stem,0);pos4(heavy_stem,0); pos3'(heavy_stem,0);pos4'(heavy_stem,0); +pos13(light_stem,-90); pos14(light_stem,-90); pos24(light_stem,-90); +x3=x3'=x4=x4'=w-x1; x13=x14=w-x11; x24=w-x22; +y3=y13r=y1; y3'=y1'; y4'=y2'; y4=y14l=y24l=y2; +filldraw z3l--z13r--serif_arc(13l,3'r)--reverse serif_arc(14r,4'r) + --z14l--z24l--serif_arc(24r,4'l)--cycle; % right stem and serifs +filldraw stroke z11e--z13e; % bar +penlabels(1,1',2,2',3,3',4,4',11,12,13,14,22,24); endchar; + +cmchar "\big left curly brace"; +beginchar(oct"010",9u#,rule_thickness#,2dh#-rule_thickness#); +adjust_fit(.75u#,.75u#); left_curly(hair,stem); endchar; + +cmchar "\Big left curly brace"; +beginchar(oct"012",10u#,rule_thickness#,3dh#-rule_thickness#); +adjust_fit(u#,u#); left_curly(rule_thickness,.3[stem,bold]); endchar; + +cmchar "\bigg left curly brace"; +beginchar(oct"014",11u#,rule_thickness#,4dh#-rule_thickness#); +adjust_fit(1.25u#,1.25u#); left_curly(rule_thickness+.2dw,.7[stem,bold]); endchar; + +cmchar "\Bigg left curly brace"; +beginchar(oct"016",11.5u#,rule_thickness#,5dh#-rule_thickness#); +adjust_fit(1.5u#,1.5u#); left_curly(rule_thickness+.4dw,bold); endchar; + +cmchar "Extensible left curly brace---top"; +beginchar(oct"070",12u#,0,1.5dh#); +adjust_fit(2u#,2u#); pickup fine.nib; +numeric min_breadth; min_breadth=hround(rule_thickness+.6dw); +pos1(min_breadth,0); pos1'(min_breadth,0); +pos2(heavy_rule_thickness,0); pos3(heavy_rule_thickness,0); +rt x1r=rt x1'r=hround(w-1.5u+.5min_breadth); +lft x2l=lft x3l=hround(.5w-.5heavy_rule_thickness); +top y1=h-1; y3=-d-eps; y2=.5[y1,y3]; y1-y1'=min_breadth-fine; +filldraw z1l{3(x2l-x1l),y2-y1}...z2l---z3l + --z3r---z2r...{3(x1r-x2r),y1'-y2}z1'r--z1r--cycle; % stroke +penlabels(1,2,3); endchar; + +cmchar "Extensible left curly brace---bottom"; +beginchar(oct"072",12u#,0,1.5dh#); +adjust_fit(2u#,2u#); pickup fine.nib; +numeric min_breadth; min_breadth=hround(rule_thickness+.6dw); +pos7(min_breadth,0); pos7'(min_breadth,0); +pos5(heavy_rule_thickness,0); pos6(heavy_rule_thickness,0); +rt x7r=rt x7'r=hround(w-1.5u+.5min_breadth); +lft x5l=lft x6l=hround(.5w-.5heavy_rule_thickness); +y5=h+eps; bot y7=1-d; y6=.5[y5,y7]; y7'-y7=min_breadth-fine; +filldraw z5l---z6l...{3(x7l-x6l),y7-y6}z7l + --z7r--z7'r{3(x6r-x7r),y6-y7'}...z6r---z5r--cycle; % stroke +penlabels(5,6,7); endchar; + +cmchar "Extensible left curly brace---middle"; +beginchar(oct"074",12u#,0,3dh#); +adjust_fit(2u#,2u#); pickup fine.nib; +numeric min_breadth; min_breadth=hround(rule_thickness+.6dw); +pos4(min_breadth,0); pos4'(min_breadth,0); +forsuffixes $=2,3,5,6: pos$(heavy_rule_thickness,0); endfor +lft x4l=lft x4'l=hround(1.5u-.5min_breadth); +x2=x3=x5=x6; lft x2l=hround(.5w-.5heavy_rule_thickness); +y2=h+eps; y6=-d-eps; .5[y4,y4']=.5[y2,y6]=.5[y3,y5]; +y3-y4=(y2-y6)/4; y4-y4'=min_breadth-fine; +filldraw z2l---z3l...{3(x4l-x3l),y4-y3}z4l + --z4'l{3(x5l-x4l),y5-y4'}...z5l---z6l--z6r---z5r + ...{3(x4r-x5r),.5[y4,y4']-y5}.5[z4r,z4'r]{3(x3r-x4r),y3-.5[y4,y4']} + ...z3r---z2r--cycle; % stroke +penlabels(2,3,4,5,6); endchar; + +cmchar "Extensible curly brace---extension module"; +beginchar(oct"076",12u#,0,.5dh#); +adjust_fit(2u#,2u#); pickup fine.nib; +pos2(heavy_rule_thickness,0); pos3(heavy_rule_thickness,0); +lft x2l=lft x3l=hround(.5w-.5heavy_rule_thickness); y2=h+eps; y3=-d-eps; +filldraw stroke z2e--z3e; % stem +penlabels(2,3); endchar; + +cmchar "\big right curly brace"; +beginchar(oct"011",9u#,rule_thickness#,2dh#-rule_thickness#); +adjust_fit(.75u#,.75u#); right_curly(hair,stem); endchar; + +cmchar "\Big right curly brace"; +beginchar(oct"013",10u#,rule_thickness#,3dh#-rule_thickness#); +adjust_fit(u#,u#); right_curly(rule_thickness,.3[stem,bold]); endchar; + +cmchar "\bigg right curly brace"; +beginchar(oct"015",11u#,rule_thickness#,4dh#-rule_thickness#); +adjust_fit(1.25u#,1.25u#); right_curly(rule_thickness+.2dw,.7[stem,bold]); endchar; + +cmchar "\Bigg right curly brace"; +beginchar(oct"017",11.5u#,rule_thickness#,5dh#-rule_thickness#); +adjust_fit(1.5u#,1.5u#); right_curly(rule_thickness+.4dw,bold); endchar; + +cmchar "Extensible right curly brace---top"; +beginchar(oct"071",12u#,0,1.5dh#); +adjust_fit(2u#,2u#); pickup fine.nib; +numeric min_breadth; min_breadth=hround(rule_thickness+.6dw); +pos1(min_breadth,0); pos1'(min_breadth,0); +pos2(heavy_rule_thickness,0); pos3(heavy_rule_thickness,0); +lft x1l=lft x1'l=hround(1.5u-.5min_breadth); +lft x2l=lft x3l=hround(.5w-.5heavy_rule_thickness); +top y1=h-1; y3=-d-eps; y2=.5[y1,y3]; y1-y1'=min_breadth-fine; +filldraw z1r{3(x2r-x1r),y2-y1}...z2r---z3r + --z3l---z2l...{3(x1l-x2l),y1'-y2}z1'l--z1l--cycle; % stroke +penlabels(1,2,3); endchar; + +cmchar "Extensible right curly brace---bottom"; +beginchar(oct"073",12u#,0,1.5dh#); +adjust_fit(2u#,2u#); pickup fine.nib; +numeric min_breadth; min_breadth=hround(rule_thickness+.6dw); +pos7(min_breadth,0); pos7'(min_breadth,0); +pos5(heavy_rule_thickness,0); pos6(heavy_rule_thickness,0); +lft x7l=lft x7'l=hround(1.5u-.5min_breadth); +lft x5l=lft x6l=hround(.5w-.5heavy_rule_thickness); +y5=h+eps; bot y7=1-d; y6=.5[y5,y7]; y7'-y7=min_breadth-fine; +filldraw z5r---z6r...{3(x7r-x6r),y7-y6}z7r + --z7l--z7'l{3(x6l-x7l),y6-y7'}...z6l---z5l--cycle; % stroke +penlabels(5,6,7); endchar; + +cmchar "Extensible right curly brace---middle"; +beginchar(oct"075",12u#,0,3dh#); +adjust_fit(2u#,2u#); pickup fine.nib; +numeric min_breadth; min_breadth=hround(rule_thickness+.6dw); +pos4(min_breadth,0); pos4'(min_breadth,0); +forsuffixes $=2,3,5,6: pos$(heavy_rule_thickness,0); endfor +rt x4r=rt x4'r=hround(w-1.5u+.5min_breadth); +x2=x3=x5=x6; lft x2l=hround(.5w-.5heavy_rule_thickness); +y2=h+eps; y6=-d-eps; .5[y4,y4']=.5[y2,y6]=.5[y3,y5]; +y3-y4=(y2-y6)/4; y4-y4'=min_breadth-fine; +filldraw z2r---z3r...{3(x4r-x3r),y4-y3}z4r + --z4'r{3(x5r-x4r),y5-y4'}...z5r---z6r--z6l---z5l + ...{3(x4l-x5l),.5[y4,y4']-y5}.5[z4l,z4'l]{3(x3l-x4l),y3-.5[y4,y4']} + ...z3l---z2l--cycle; % stroke +penlabels(2,3,4,5,6); endchar; + +cmchar "Horizontal curly brace tip---down and left"; +beginchar(oct"172",.75dh#,heavy_rule_thickness#,0); +adjust_fit(0,0); pickup fine.nib; +numeric min_breadth; min_breadth=vround(rule_thickness+.6dw); +pos1(min_breadth,90); pos1'(min_breadth,90); +pos2(heavy_rule_thickness,90); +bot y2l=0; bot y1l=bot y1'l=vround(y2-4.5u-.5min_breadth); +.5[x1,x1']=-eps; x2=w+shrink_fit+eps; x1'-x1=min_breadth-fine; +filldraw z1r{x2-x1,3(y2r-y1r)}...{right}z2r + --z2l{left}...{x1'-x2,3(y1-y2)}z1'l--z1l--cycle; % stroke +penlabels(1,2); endchar; + +cmchar "Horizontal curly brace tip---down and right"; +beginchar(oct"173",.75dh#,heavy_rule_thickness#,0); +adjust_fit(0,0); pickup fine.nib; +numeric min_breadth; min_breadth=vround(rule_thickness+.6dw); +pos1(min_breadth,90); pos1'(min_breadth,90); +pos2(heavy_rule_thickness,90); +bot y2l=0; bot y1l=bot y1'l=vround(y2-4.5u-.5min_breadth); +.5[x1,x1']=w+shrink_fit+eps; x2=-eps; x1-x1'=min_breadth-fine; +filldraw z1r{x2-x1,3(y2r-y1r)}...{left}z2r + --z2l{right}...{x1'-x2,3(y1-y2)}z1'l--z1l--cycle; % stroke +penlabels(1,2); endchar; + +cmchar "Horizontal curly brace tip---up and left"; +beginchar(oct"174",.75dh#,heavy_rule_thickness#,0); +adjust_fit(0,0); pickup fine.nib; +numeric min_breadth; min_breadth=vround(rule_thickness+.6dw); +pos1(min_breadth,90); pos1'(min_breadth,90); +pos2(heavy_rule_thickness,90); +bot y2l=0; top y1r=top y1'r=vround(y2+4.5u+.5min_breadth); +.5[x1,x1']=-eps; x2=w+shrink_fit+eps; x1'-x1=min_breadth-fine; +filldraw z1l{x2-x1,3(y2l-y1l)}...{right}z2l + --z2r{left}...{x1'-x2,3(y1-y2)}z1'r--z1r--cycle; % stroke +penlabels(1,2); endchar; + +cmchar "Horizontal curly brace tip---up and right"; +beginchar(oct"175",.75dh#,heavy_rule_thickness#,0); +adjust_fit(0,0); pickup fine.nib; +numeric min_breadth; min_breadth=vround(rule_thickness+.6dw); +pos1(min_breadth,90); pos1'(min_breadth,90); +pos2(heavy_rule_thickness,90); +bot y2l=0; top y1r=top y1'r=vround(y2+4.5u+.5min_breadth); +.5[x1,x1']=w+shrink_fit+eps; x2=-eps; x1-x1'=min_breadth-fine; +filldraw z1l{x2-x1,3(y2l-y1l)}...{left}z2l + --z2r{right}...{x1'-x2,3(y1-y2)}z1'r--z1r--cycle; % stroke +penlabels(1,2); endchar; + +cmchar "Leftward arrow"; +compute_spread(.45x_height#,.55x_height#); +beginchar(oct"040",18u#,v_center(spread#+rule_thickness#)); +adjust_fit(0,0); pickup crisp.nib; +pos1(rule_thickness,90); pos2(rule_thickness,90); pos3(bar,0); pos4(bar,0); +y0=y1=y2=math_axis; x1+.5rule_thickness=hround(w-u); lft x0=hround u; +y3-y0=y0-y4=.36asc_height+eps; x3=x4=x0+3u+eps; +pos5(bar,angle(z4-z0)); z5l=z0; pos6(bar,angle(z3-z0)); z6l=z0; +z9=.381966[.5[z3,z4],z0]; +numeric t; path p; p=z4r{z9-z4}..z6r; +t=xpart(p intersectiontimes((0,y2l)--(w,y2l))); x2=xpart point t of p; +filldraw z0..{z4-z9}z4l--subpath (0,t) of\\(z4r{z9-z4}..z6r) + --z2l---z1l..z1r---z2r--subpath (t,0) of\\(z3r{z9-z3}..z5r) + --z3l{z9-z3}..z0 & cycle; % arrowhead and stem +penlabels(0,1,2,3,4,5,6,9); endchar; + +cmchar "Rightward arrow"; +compute_spread(.45x_height#,.55x_height#); +beginchar(oct"041",18u#,v_center(spread#+rule_thickness#)); +adjust_fit(0,0); pickup crisp.nib; +pos1(rule_thickness,90); pos2(rule_thickness,90); pos3(bar,0); pos4(bar,0); +y0=y1=y2=math_axis; x1-.5rule_thickness=hround u; rt x0=hround(w-u); +y3-y0=y0-y4=.36asc_height+eps; x3=x4=x0-3u-eps; +pos5(bar,angle(z4-z0)); z5l=z0; pos6(bar,angle(z3-z0)); z6l=z0; +z9=.381966[.5[z3,z4],z0]; +numeric t; path p; p=z4l{z9-z4}..z6r; +t=xpart(p intersectiontimes((0,y2l)--(w,y2l))); x2=xpart point t of p; +filldraw z0..{z4-z9}z4r--subpath (0,t) of\\(z4l{z9-z4}..z6r) + --z2l---z1l..z1r---z2r--subpath (t,0) of\\(z3l{z9-z3}..z5r) + --z3r{z9-z3}..z0 & cycle; % arrowhead and stem +penlabels(0,1,2,3,4,5,6,9); endchar; + +cmchar "Left-and-right arrow"; +compute_spread(.45x_height#,.55x_height#); +beginchar(oct"044",18u#, + v_center(if monospace:.6asc_height#+fi spread#+rule_thickness#)); +adjust_fit(0,0); pickup crisp.nib; +pos1(rule_thickness,90); pos2(rule_thickness,90); pos3(bar,0); pos4(bar,0); +y0=y1=y2=math_axis if monospace:+vround.3asc_height fi; lft x0=hround u; +if monospace: x1+.5rule_thickness=hround(w-u) else: x1=.5w fi; +y3-y0=y0-y4=.36asc_height+eps; x3=x4=x0+3u+eps; +pos5(bar,angle(z4-z0)); z5l=z0; pos6(bar,angle(z3-z0)); z6l=z0; +z9=.381966[.5[z3,z4],z0]; +numeric t; path p; p=z4r{z9-z4}..z6r; +t=xpart(p intersectiontimes((0,y2l)--(w,y2l))); x2=xpart point t of p; +filldraw z0..{z4-z9}z4l--subpath (0,t) of\\(z4r{z9-z4}..z6r) + --z2l---z1l..z1r---z2r--subpath (t,0) of\\(z3r{z9-z3}..z5r) + --z3l{z9-z3}..z0 & cycle; % left arrowhead and stem +pos11(rule_thickness,90); pos12(rule_thickness,90); pos13(bar,0); pos14(bar,0); +y10=y11=y12=math_axis if monospace:-vround.3asc_height fi; +rt x10=hround(w-u); +if monospace: x11-.5rule_thickness=hround u else: x11=.5w fi; +y13-y10=y10-y14=.36asc_height+eps; x13=x14=x10-3u-eps; +pos15(bar,angle(z14-z10)); z15l=z10; pos16(bar,angle(z13-z10)); z16l=z10; +z19=.381966[.5[z13,z14],z10]; +numeric t; path p; p=z14l{z19-z14}..z16r; +t=xpart(p intersectiontimes((0,y12l)--(w,y12l))); x12=xpart point t of p; +filldraw z10..{z14-z19}z14r--subpath (0,t) of\\(z14l{z19-z14}..z16r) + --z12l---z11l..z11r---z12r--subpath (t,0) of\\(z13l{z19-z13}..z15r) + --z13r{z19-z13}..z10 & cycle; % right arrowhead and stem +penlabels(0,1,2,3,4,5,6,9,10,11,12,13,14,15,16,19); endchar; + +cmchar "Upward arrow"; +beginchar(oct"042",9u#,asc_height#,asc_depth#); +italcorr .76asc_height#*slant+.5crisp#-u#; +adjust_fit(0,0); pickup crisp.nib; +pos1(rule_thickness,0); pos2(rule_thickness,0); +pos3(bar,90); pos4(bar,90); +lft x1l=hround(.5w-.5rule_thickness); y1-.5rule_thickness=-d; +x0=x1=x2; top y0=h; x0-x3=x4-x0=4u+eps; +y3=y4=y0-.24asc_height-eps; +pos5(bar,angle(z4-z0)); z5l=z0; +pos6(bar,angle(z3-z0)); z6l=z0; +z9=.381966[.5[z3,z4],z0]; +numeric t; path p; p=z4l{z9-z4}..z6r; +t=xpart(p intersectiontimes((x2r,-d)--(x2r,h))); y2=ypart point t of p; +filldraw z0..{z4-z9}z4r--subpath (0,t) of\\(z4l{z9-z4}..z6r) + --z2r---z1r..z1l---z2l--subpath (t,0) of\\(z3l{z9-z3}..z5r) + --z3r{z9-z3}..z0 & cycle; % arrowhead and stem +penlabels(0,1,2,3,4,5,6,9); endchar; + +cmchar "Downward arrow"; +beginchar(oct"043",9u#,asc_height#,asc_depth#); +adjust_fit(0,0); pickup crisp.nib; +pos1(rule_thickness,0); pos2(rule_thickness,0); +pos3(bar,90); pos4(bar,90); +lft x1l=hround(.5w-.5rule_thickness); y1+.5rule_thickness=h; +x0=x1=x2; bot y0=-d; x0-x3=x4-x0=4u+eps; +y3=y4=y0+.24asc_height+eps; +pos5(bar,angle(z4-z0)); z5l=z0; +pos6(bar,angle(z3-z0)); z6l=z0; +z9=.381966[.5[z3,z4],z0]; +numeric t; path p; p=z4r{z9-z4}..z6r; +t=xpart(p intersectiontimes((x2r,-d)--(x2r,h))); y2=ypart point t of p; +filldraw z0..{z4-z9}z4l--subpath (0,t) of\\(z4r{z9-z4}..z6r) + --z2r---z1r..z1l---z2l--subpath (t,0) of\\(z3r{z9-z3}..z5r) + --z3l{z9-z3}..z0 & cycle; % arrowhead and stem +penlabels(0,1,2,3,4,5,6,9); endchar; + +cmchar "Up-and-down arrow"; +beginchar(oct"154",9u#,body_height#,paren_depth#); +adjust_fit(0,0); pickup crisp.nib; +pos1(rule_thickness,0); pos2(rule_thickness,0); +pos3(bar,90); pos4(bar,90); +lft x1l=hround(.5w-.5rule_thickness); y1=.5[-d,h]; +x0=x1=x2; bot y0=-d-o; x0-x3=x4-x0=4u+eps; +y3=y4=y0+.24asc_height+eps; +pos5(bar,angle(z4-z0)); z5l=z0; pos6(bar,angle(z3-z0)); z6l=z0; +z9=.381966[.5[z3,z4],z0]; +numeric t; path p; p=z4r{z9-z4}..z6r; +t=xpart(p intersectiontimes((x2r,-d)--(x2r,h))); y2=ypart point t of p; +filldraw z0..{z4-z9}z4l--subpath (0,t) of\\(z4r{z9-z4}..z6r) + --z2r---z1r..z1l---z2l--subpath (t,0) of\\(z3r{z9-z3}..z5r) + --z3l{z9-z3}..z0 & cycle; % lower arrowhead and stem +pos11(rule_thickness,0); pos12(rule_thickness,0); z11=z1; +pos13(bar,90); pos14(bar,90); +x10=x11=x12; top y10=h+o; x10-x13=x14-x10=4u+eps; +y13=y14=y10-.24asc_height-eps; +pos15(bar,angle(z14-z10)); z15l=z10; pos16(bar,angle(z13-z10)); z16l=z10; +z19=.381966[.5[z13,z14],z10]; +numeric t; path p; p=z14l{z19-z14}..z16r; +t=xpart(p intersectiontimes((x12r,-d)--(x12r,h))); y12=ypart point t of p; +filldraw z10..{z14-z19}z14r--subpath (0,t) of\\(z14l{z19-z14}..z16r) + --z12r---z11r..z11l---z12l--subpath (t,0) of\\(z13l{z19-z13}..z15r) + --z13r{z19-z13}..z10 & cycle; % upper arrowhead and stem +penlabels(0,1,2,3,4,5,6,9,10,11,12,13,14,15,16,19); endchar; + +cmchar "Leftward top half arrow"; +compute_spread(.45x_height#,.55x_height#); +beginchar(oct"030",18u#,v_center(spread#+rule_thickness#)); +adjust_fit(0,0); pickup crisp.nib; +pos1(rule_thickness,90); pos2(rule_thickness,90); pos3(bar,0); pos4(bar,0); +y0=y1=y2=math_axis; x1+.5rule_thickness=hround(w-u); lft x0=hround u; +y3-y0=y0-y4=.36asc_height+eps; x3=x4=x0+3u+eps; +pos5(bar,angle(z4-z0)); z5l=z0; pos6(bar,angle(z3-z0)); z6l=z0; +numeric t; path p; p=z4r..{2(x0-x4),y0-y4}z6r; +t=xpart(p intersectiontimes((0,y2l)--(w,y2l))); x2=xpart point t of p; +filldraw z0--(x0,y2l)---z1l..z1r---z2r + ..subpath (t,0) of\\(z3r..{2(x0-x3),y0-y3}z5r) + --z3l..{2(x0-x3),y0-y3}cycle; % arrowhead and stem +penlabels(0,1,2,3,4,5,6); endchar; + +cmchar "Leftward bottom half arrow"; +compute_spread(.45x_height#,.55x_height#); +beginchar(oct"031",18u#,v_center(spread#+rule_thickness#)); +adjust_fit(0,0); pickup crisp.nib; +pos1(rule_thickness,90); pos2(rule_thickness,90); pos3(bar,0); pos4(bar,0); +y0=y1=y2=math_axis; x1+.5rule_thickness=hround(w-u); lft x0=hround u; +y3-y0=y0-y4=.36asc_height+eps; x3=x4=x0+3u+eps; +pos5(bar,angle(z4-z0)); z5l=z0; pos6(bar,angle(z3-z0)); z6l=z0; +numeric t; path p; p=z4r..{2(x0-x4),y0-y4}z6r; +t=xpart(p intersectiontimes((0,y2l)--(w,y2l))); x2=xpart point t of p; +filldraw z0{2(x4-x0),y4-y0}..z4l + --subpath (0,t) of\\(z4r..{2(x0-x4),y0-y4}z6r) + ..z2l---z1l..z1r---(x0,y2r)--cycle; % arrowhead and stem +penlabels(0,1,2,3,4,5,6); endchar; + +cmchar "Rightward top half arrow"; +compute_spread(.45x_height#,.55x_height#); +beginchar(oct"032",18u#,v_center(spread#+rule_thickness#)); +adjust_fit(0,0); pickup crisp.nib; +pos1(rule_thickness,90); pos2(rule_thickness,90); pos3(bar,0); pos4(bar,0); +y0=y1=y2=math_axis; x1-.5rule_thickness=hround u; rt x0=hround(w-u); +y3-y0=y0-y4=.36asc_height+eps; x3=x4=x0-3u-eps; +pos5(bar,angle(z4-z0)); z5l=z0; pos6(bar,angle(z3-z0)); z6l=z0; +numeric t; path p; p=z4l..{2(x0-x4),y0-y4}z6r; +t=xpart(p intersectiontimes((0,y2l)--(w,y2l))); x2=xpart point t of p; +filldraw z0--(x0,y2l)---z1l..z1r---z2r + ..subpath (t,0) of\\(z3l..{2(x0-x3),y0-y3}z5r) + --z3r..{2(x0-x3),y0-y3}cycle; % arrowhead and stem +penlabels(0,1,2,3,4,5,6); endchar; + +cmchar "Rightward bottom half arrow"; +compute_spread(.45x_height#,.55x_height#); +beginchar(oct"033",18u#,v_center(spread#+rule_thickness#)); +adjust_fit(0,0); pickup crisp.nib; +pos1(rule_thickness,90); pos2(rule_thickness,90); pos3(bar,0); pos4(bar,0); +y0=y1=y2=math_axis; x1-.5rule_thickness=hround u; rt x0=hround(w-u); +y3-y0=y0-y4=.36asc_height+eps; x3=x4=x0-3u-eps; +pos5(bar,angle(z4-z0)); z5l=z0; pos6(bar,angle(z3-z0)); z6l=z0; +numeric t; path p; p=z4l..{2(x0-x4),y0-y4}z6r; +t=xpart(p intersectiontimes((0,y2l)--(w,y2l))); x2=xpart point t of p; +filldraw z0{2(x4-x0),y4-y0}..z4r + --subpath (0,t) of\\(z4l..{2(x0-x4),y0-y4}z6r) + ..z2l---z1l..z1r---(x0,y2r)--cycle; % arrowhead and stem +penlabels(0,1,2,3,4,5,6); endchar; + +cmchar "Northeast arrow"; +beginchar(oct"045",18u#,asc_height#,asc_depth#); +adjust_fit(0,0); pickup crisp.nib; +x1-.5rule_thickness=hround u; rt x0=hround(w-u); +y1-.5rule_thickness=-d; top y0=h; +numeric theta,delta; theta=angle(z0-z1); delta=3u++.24asc_height; +if abs(theta-45)<2.5: theta:=45; y1:=y0+x1-x0; fi % near-45$^\circ$ angle +pos1(rule_thickness,90+theta); pos2(rule_thickness,90+theta); +pos3(bar,theta); pos4(bar,theta); +z3-z0=(-3u,.36asc_height) rotated theta; +z4-z0=(-3u,-.36asc_height) rotated theta; +pos5(bar,-90); z5l=z0; pos6(bar,-180); z6l=z0; +z9=.381966[.5[z3,z4],z0]; +numeric t; path p; p=z4l{z9-z4}..z6r; +t=xpart(p intersectiontimes (z1l--(z1l+2(z0-z1)))); z2l=point t of p; +filldraw z0..{z4-z9}z4r--subpath (0,t) of\\(z4l{z9-z4}..z6r) + --z2l---z1l..z1r---z2r--subpath (t,0) of\\(z3l{z9-z3}..z5r) + --z3r{z9-z3}..z0 & cycle; % arrowhead and stem +penlabels(0,1,2,3,4,5,6,9); endchar; + +cmchar "Southeast arrow"; +beginchar(oct"046",18u#,asc_height#,asc_depth#); +adjust_fit(0,0); pickup crisp.nib; +x1-.5rule_thickness=hround u; rt x0=hround(w-u); +y1+.5rule_thickness=h; bot y0=-d; +numeric theta,delta; theta=angle(z0-z1); delta=3u++.24asc_height; +if abs(theta+45)<2.5: theta:=-45; y1:=y0+x0-x1; fi % near-45$^\circ$ angle +pos1(rule_thickness,90+theta); pos2(rule_thickness,90+theta); +pos3(bar,theta); pos4(bar,theta); +z3-z0=(-3u,.36asc_height) rotated theta; +z4-z0=(-3u,-.36asc_height) rotated theta; +pos5(bar,180); z5l=z0; pos6(bar,90); z6l=z0; +z9=.381966[.5[z3,z4],z0]; +numeric t; path p; p=z4l{z9-z4}..z6r; +t=xpart(p intersectiontimes (z1l--(z1l+2(z0-z1)))); z2l=point t of p; +filldraw z0..{z4-z9}z4r + --subpath (0,t) of\\(z4l{z9-z4}..z6r) + --z2l---z1l..z1r---z2r + --subpath (t,0) of\\(z3l{z9-z3}..z5r) + --z3r{z9-z3}..z0 & cycle; % arrowhead and stem +penlabels(0,1,2,3,4,5,6,9); endchar; + +cmchar "Northwest arrow"; +beginchar(oct"055",18u#,asc_height#,asc_depth#); +adjust_fit(0,0); pickup crisp.nib; +x1+.5rule_thickness=hround(w-u); lft x0=hround u; +y1-.5rule_thickness=-d; top y0=h; +numeric theta,delta; theta=angle(z1-z0); delta=3u++.24asc_height; +if abs(theta+45)<2.5: theta:=-45; y1:=y0+x0-x1; fi % near-45$^\circ$ angle +pos1(rule_thickness,-90+theta); pos2(rule_thickness,-90+theta); +pos3(bar,-180+theta); pos4(bar,-180+theta); +z4-z0=(3u,.36asc_height) rotated theta; +z3-z0=(3u,-.36asc_height) rotated theta; +pos5(bar,0); z5l=z0; pos6(bar,-90); z6l=z0; +z9=.381966[.5[z3,z4],z0]; +numeric t; path p; p=z4l{z9-z4}..z6r; +t=xpart(p intersectiontimes (z1l--(z1l+2(z0-z1)))); z2l=point t of p; +filldraw z0..{z4-z9}z4r--subpath (0,t) of\\(z4l{z9-z4}..z6r) + --z2l---z1l..z1r---z2r--subpath (t,0) of\\(z3l{z9-z3}..z5r) + --z3r{z9-z3}..z0 & cycle; % arrowhead and stem +penlabels(0,1,2,3,4,5,6,9); endchar; + +cmchar "Southwest arrow"; +beginchar(oct"056",18u#,asc_height#,asc_depth#); +adjust_fit(0,0); pickup crisp.nib; +x1+.5rule_thickness=hround(w-u); lft x0=hround u; +y1+.5rule_thickness=h; bot y0=-d; +numeric theta,delta; theta=angle(z1-z0); delta=3u++.24asc_height; +if abs(theta-45)<2.5: theta:=45; y1:=y0+x1-x0; fi % near-45$^\circ$ angle +pos1(rule_thickness,-90+theta); pos2(rule_thickness,-90+theta); +pos3(bar,-180+theta); pos4(bar,-180+theta); +z4-z0=(3u,.36asc_height) rotated theta; +z3-z0=(3u,-.36asc_height) rotated theta; +pos5(bar,90); z5l=z0; pos6(bar,0); z6l=z0; +z9=.381966[.5[z3,z4],z0]; +numeric t; path p; p=z4l{z9-z4}..z6r; +t=xpart(p intersectiontimes (z1l--(z1l+2(z0-z1)))); z2l=point t of p; +filldraw z0..{z4-z9}z4r + --subpath (0,t) of\\(z4l{z9-z4}..z6r) + --z2l---z1l..z1r---z2r + --subpath (t,0) of\\(z3l{z9-z3}..z5r) + --z3r{z9-z3}..z0 & cycle; % arrowhead and stem +penlabels(0,1,2,3,4,5,6,9); endchar; + +cmchar "Double leftward arrow"; +compute_spread(.45x_height#,.55x_height#); +beginchar(oct"050",18u#,v_center(spread#+rule_thickness#)); +adjust_fit(0,0); pickup rule.nib; +lft x7=hround u-eps; x8=x7; x1=x2=w-x7; +y1=y7; y2=y8; y1-y2=spread; .5[y1,y2]=math_axis; +draw z1--z7; draw z2--z8; % bars +pickup crisp.nib; lft x0=hround u-eps; y0=good.y math_axis; +pos3(rule_thickness,0); pos4(rule_thickness,0); +y3-y1=y2-y4=.36asc_height+eps; x3=x4=x0+6u+eps; +pos5(rule_thickness,angle(z4-z0)); z5l=z0; +pos6(rule_thickness,angle(z3-z0)); z6l=z0; +z9=.381966[.5[z3,z4],z0]; +erase filldraw z0..{z3-z9}z3--(0,y3) + --(0,y4)--z4{z9-z4}..z0 & cycle; % erase excess +numeric t; path p; p=z4r{z9-z4}..z6r; +t=xpart(p intersectiontimes((0,y0)--(w,y0))); +filldraw z0..{z4-z9}z4l--subpath (0,t) of\\(z4r{z9-z4}..z6r) + --subpath (t,0) of\\(z3r{z9-z3}..z5r)--z3l{z9-z3}..z0 & cycle; % arrowhead +penlabels(0,1,2,3,4,5,6,7,8,9); endchar; + +cmchar "Double rightward arrow"; +compute_spread(.45x_height#,.55x_height#); +beginchar(oct"051",18u#,v_center(spread#+rule_thickness#)); +adjust_fit(0,0); pickup rule.nib; +lft x1=hround u-eps; x2=x1; x7=x8=w-x1; +y1=y7; y2=y8; y1-y2=spread; .5[y1,y2]=math_axis; +draw z1--z7; draw z2--z8; % bars +pickup crisp.nib; rt x0=hround(w-u)+eps; y0=good.y math_axis; +pos3(rule_thickness,0); pos4(rule_thickness,0); +y3-y1=y2-y4=.36asc_height+eps; x3=x4=x0-6u-eps; +pos5(rule_thickness,angle(z4-z0)); z5l=z0; +pos6(rule_thickness,angle(z3-z0)); z6l=z0; +z9=.381966[.5[z3,z4],z0]; +erase filldraw z0..{z3-z9}z3--(w,y3) + --(w,y4)--z4{z9-z4}..z0 & cycle; % erase excess +numeric t; path p; p=z4l{z9-z4}..z6r; +t=xpart(p intersectiontimes((0,y0)--(w,y0))); +filldraw z0..{z4-z9}z4r--subpath (0,t) of\\(z4l{z9-z4}..z6r) + --subpath (t,0) of\\(z3l{z9-z3}..z5r)--z3r{z9-z3}..z0 & cycle; % arrowhead +penlabels(0,1,2,3,4,5,6,7,8,9); endchar; + +cmchar "Double upward arrow"; +beginchar(oct"052",12u#,asc_height#,asc_depth#); +adjust_fit(0,0); pickup rule.nib; +compute_spread(.45x_height#,.55x_height#); +bot y1=bot y2=-d-eps; top y7=h; y8=y7; +x1=x7; x2=x8; x1-x2=spread; .5[x1,x2]=crisp.lft hround(crisp.rt .5w); +draw z1--z7; draw z2--z8; % bars +pickup crisp.nib; top y0=h+eps; x0=good.x .5w; +pos3(rule_thickness,90); pos4(rule_thickness,90); +x2-x3=x4-x1=4u+eps; y3=y4=y0-.48asc_height-eps; +pos5(rule_thickness,angle(z4-z0)); z5l=z0; +pos6(rule_thickness,angle(z3-z0)); z6l=z0; +z9=.381966[.5[z3,z4],z0]; +erase filldraw z0..{z3-z9}z3--(x3,h) + --(x4,h)--z4{z9-z4}..z0 & cycle; % erase excess +numeric t; path p; p=z4l{z9-z4}..z6r; +t=xpart(p intersectiontimes((x0,-d)--(x0,h))); +filldraw z0..{z4-z9}z4r--subpath (0,t) of\\(z4l{z9-z4}..z6r) + --subpath (t,0) of\\(z3l{z9-z3}..z5r)--z3r{z9-z3}..z0 & cycle; % arrowhead +penlabels(0,1,2,3,4,5,6,7,8,9); endchar; + +cmchar "Double downward arrow"; +beginchar(oct"053",12u#,asc_height#,asc_depth#); +adjust_fit(0,0); pickup rule.nib; +compute_spread(.45x_height#,.55x_height#); +top y1=top y2=h+eps; bot y7=-d; y8=y7; +x1=x7; x2=x8; x1-x2=spread; .5[x1,x2]=crisp.lft hround(crisp.rt .5w); +draw z1--z7; draw z2--z8; % bars +pickup crisp.nib; bot y0=-d-eps; x0=good.x .5w; +pos3(rule_thickness,90); pos4(rule_thickness,90); +x2-x3=x4-x1=4u+eps; y3=y4=y0+.48asc_height-eps; +pos5(rule_thickness,angle(z4-z0)); z5l=z0; +pos6(rule_thickness,angle(z3-z0)); z6l=z0; +z9=.381966[.5[z3,z4],z0]; +erase filldraw z0..{z3-z9}z3--(x3,-d) + --(x4,-d)--z4{z9-z4}..z0 & cycle; % erase excess +numeric t; path p; p=z4r{z9-z4}..z6r; +t=xpart(p intersectiontimes((x0,-d)--(x0,h))); +filldraw z0..{z4-z9}z4l--subpath (0,t) of\\(z4r{z9-z4}..z6r) + --subpath (t,0) of\\(z3r{z9-z3}..z5r)--z3l{z9-z3}..z0 & cycle; % arrowhead +penlabels(0,1,2,3,4,5,6,7,8,9); endchar; + +cmchar "Double left-and-right arrow"; +compute_spread(.45x_height#,.55x_height#); +beginchar(oct"054",18u#,v_center(spread#+rule_thickness#)); +adjust_fit(if monospace: -u#,-u# else: 0,0 fi); pickup rule.nib; +lft x7=hround u-eps; x8=x7; x1=x2=w-x7; +y1=y7; y2=y8; y1-y2=spread; .5[y1,y2]=math_axis; +draw z1--z7; draw z2--z8; % bars +pickup crisp.nib; lft x0=hround u-o; y0=good.y math_axis; +pos3(rule_thickness,0); pos4(rule_thickness,0); +y3-y1=y2-y4=.36asc_height+eps; x3=x4=x0+5u+eps; +pos5(rule_thickness,angle(z4-z0)); z5l=z0; +pos6(rule_thickness,angle(z3-z0)); z6l=z0; +z9=.381966[.5[z3,z4],z0]; +erase filldraw z0..{z3-z9}z3--(0,y3) + --(0,y4)--z4{z9-z4}..z0 & cycle; % erase excess at left +numeric t; path p; p=z4r{z9-z4}..z6r; +t=xpart(p intersectiontimes((0,y0)--(w,y0))); +filldraw z0..{z4-z9}z4l--subpath (0,t) of\\(z4r{z9-z4}..z6r) + --subpath (t,0) of\\(z3r{z9-z3}..z5r) + --z3l{z9-z3}..z0 & cycle; % left arrowhead +rt x10=hround(w-u)+o; y10=good.y math_axis; +pos13(rule_thickness,0); pos14(rule_thickness,0); +y13=y3; y14=y4; x13=x14=x10-5u-eps; +pos15(rule_thickness,angle(z14-z10)); z15l=z10; +pos16(rule_thickness,angle(z13-z10)); z16l=z10; +z19=.381966[.5[z13,z14],z10]; +erase filldraw z10..{z13-z19}z13--(w,y13) + --(w,y14)--z14{z19-z14}..z10 & cycle; % erase excess at right +numeric t; path p; p=z14l{z19-z14}..z16r; +t=xpart(p intersectiontimes((0,y10)--(w,y10))); +filldraw z10..{z14-z19}z14r--subpath (0,t) of\\(z14l{z19-z14}..z16r) + --subpath (t,0) of\\(z13l{z19-z13}..z15r) + --z13r{z19-z13}..z10 & cycle; % right arrowhead +penlabels(0,1,2,3,4,5,6,7,8,9,10,13,14,15,16,19); endchar; + +cmchar "Double up-and-down arrow"; +beginchar(oct"155",12u#,body_height#,paren_depth#); +adjust_fit(0,0); pickup rule.nib; +compute_spread(.45x_height#,.55x_height#); +bot y1=bot y2=-d-eps; top y7=h; y8=y7; +x1=x7; x2=x8; x1-x2=spread; .5[x1,x2]=crisp.lft hround(crisp.rt .5w); +draw z1--z7; draw z2--z8; % bars +pickup crisp.nib; top y0=h+o; x0=good.x .5w; +pos3(rule_thickness,90); pos4(rule_thickness,90); +x2-x3=x4-x1=4u+eps; y3=y4=y0-.4asc_height-eps; +pos5(rule_thickness,angle(z4-z0)); z5l=z0; +pos6(rule_thickness,angle(z3-z0)); z6l=z0; +z9=.381966[.5[z3,z4],z0]; +erase filldraw z0..{z3-z9}z3--(x3,h) + --(x4,h)--z4{z9-z4}..z0 & cycle; % erase excess at top +numeric t; path p; p=z4l{z9-z4}..z6r; +t=xpart(p intersectiontimes((x0,-d)--(x0,h))); +filldraw z0..{z4-z9}z4r--subpath (0,t) of\\(z4l{z9-z4}..z6r) + --subpath (t,0) of\\(z3l{z9-z3}..z5r) + --z3r{z9-z3}..z0 & cycle; % top arrowhead +bot y10=-d-o; x10=good.x .5w; +pos13(rule_thickness,90); pos14(rule_thickness,90); +x13=x3; x14=x4; y13=y14=y10+.4asc_height-eps; +pos15(rule_thickness,angle(z14-z10)); z15l=z10; +pos16(rule_thickness,angle(z13-z10)); z16l=z10; +z19=.381966[.5[z13,z14],z10]; +erase filldraw z10..{z13-z19}z13--(x13,-d) + --(x14,-d)--z14{z19-z14}..z10 & cycle; % erase excess at bottom +numeric t; path p; p=z14r{z19-z14}..z16r; +t=xpart(p intersectiontimes((x10,-d)--(x10,h))); +filldraw z10..{z14-z19}z14l--subpath (0,t) of\\(z14r{z19-z14}..z16r) + --subpath (t,0) of\\(z13r{z19-z13}..z15r) + --z13l{z19-z13}..z10 & cycle; % bottom arrowhead +penlabels(0,1,2,3,4,5,6,7,8,9,13,14,15,16,19); endchar; + +cmchar "Infinity"; +beginchar(oct"061",18u#,x_height#,0); +italcorr .7x_height#*slant-.5u#; +adjust_fit(0,0); pickup fine.nib; +numeric theta,phi; +if monospace: phi=-theta=90; +else: phi=angle(4u,h); theta=angle(6u,-h); fi +pos1(.2[vair,curve],180); pos2(.6[vair,curve],90+.5theta); pos3(curve,90+theta); +pos4(curve,90+theta); pos5(.6[vair,curve],90+.5theta); +pos6(.2[vair,curve],180); pos7(.3[vair,curve],270+.5phi); +pos8(.35[vair,curve],270+phi); pos9(.3[vair,curve],270+.5phi); +lft x1r=w-rt x6l=hround u; x2=x9=.4[x1,x8]; x5=x7=.6[x8,x6]; +if monospace: x2l:=x2r; x5r:=x5l; x7r:=x7l; x9l:=x9r; fi +y1=y6=.5h; top y2r=top y7l=h+oo; bot y5l=bot y9r=-oo; +x8=.5[x3,x4]=.5w; y8=.5[y3,y4]=.5h; +y3-y4=h/3; z3-z4=whatever*dir theta; +filldraw stroke z1e{up}...z2e{right}...z3e---z4e...z5e{right} + ...z6e{up}...z7e{left}...{-dir phi}z8e...{left}z9e...z1e{up}; % bowls +penlabels(1,2,3,4,5,6,7,8,9); endchar; + +font_x_height x_height#; +font_quad 18u#+4letter_fit#; +% (The calling file should give the other math extension font parameters.) + +bye. diff --git a/systems/knuth/local/cm/gen.mf b/systems/knuth/local/cm/gen.mf new file mode 100644 index 0000000000..32a55c77a0 --- /dev/null +++ b/systems/knuth/local/cm/gen.mf @@ -0,0 +1,91 @@ +% characters for Jill's genealogy publications + +cmchar "Cross (death symbol)"; +beginchar("d",9u#,.65[x_height#,asc_height#],.1(asc_height#-x_height#)); +adjust_fit(0,0); pickup tiny.nib; light_stem=Vround .5[vair,stem]; +pos1(stem,0); pos2(.4[hair,stem],0); pos3(stem,0); +%pos4(stem,90); pos5(.5[vair,stem],90); pos6(stem,90); +pos4(light_stem,90); pos5(.5[vair,light_stem],90); pos6(light_stem,90); +x1=x2=x3=.5w; top y1=h; bot y3=-d; y2=y4r; +y4=y5=y6; y4l=good.y .6[-d,h]; x4=good.x u; x6=r-x4; x5=x2; +filldraw z1l...z2l{down}...z3l--z3r...z2r{up}...z1r--cycle; % vertical stroke +filldraw z4l...z5l...z6l--z6r...z5r...z4r--cycle; % horizontal stroke +penlabels(1,2,3,4,5,6); endchar; + +cmchar "Rings (marriage symbol)"; +beginchar("m",9u#,v_center(x_height#)); +adjust_fit(0,0); pickup tiny.nib; +numeric light_stem; light_stem=Vround .5[vair,stem]; +pos1(light_stem,90); pos3(light_stem,-90); +pos2(light_stem,180); pos4(.3[hair,light_stem],0); +x1=x3=.5[x2,x4]; lft x2r=hround(-u-.5light_stem); rt x4r=hround(.6w+.5stem); +%top y1r=vround(h+.5light_stem); y2=y4=.5[y1,y3]; +%bot y3r=vround(-d-.5light_stem); +top y1r=h; y2=y4=.5[y1,y3]; +bot y3r=-d; +pos5(light_stem,90); pos7(light_stem,-90); +pos6(.3[hair,light_stem],180); pos8(light_stem,0); +x5-x1=x6-x2=x7-x3=x8-x4; rt x8r=hround(w+u+.5light_stem); +y5-y1=y6-y2=y7-y3=y8-y4=0; +filldraw stroke pulled_arc.e(1,2)&pulled_arc.e(2,3)&pulled_arc.e(3,4) + &pulled_arc.e(4,1); % left ring +filldraw stroke pulled_arc.e(5,6)&pulled_arc.e(6,7)&pulled_arc.e(7,8) + &pulled_arc.e(8,5); % right ring +penlabels(1,2,3,4,5,6,7,8); endchar; + +cmchar "Five-pointed star (birth symbol)"; +beginchar("b",9u#,v_center(x_height#)); +adjust_fit(0,0); pickup tiny.nib; +numeric theta; theta=360/5; % degrees between points +pos0(curve,0); pos1(rule_thickness,90); x0=x1=good.x .5w; +top y1r=vround(math_axis+.5x_height+.5rule_thickness); +ypart(.5[z1,z0+(z1-z2) rotated 2theta])=math_axis; +pos2(curve,theta); pos3(rule_thickness,90+theta); +z2=z0; z3-z0=(z1-z0) rotated theta; +z4=whatever[z0l,z1r]=whatever[z2r,z3r]; +filldraw for n=0 upto 4: + z0+(z1r-z0)rotated(n*theta)--z0+(z4-z0)rotated(n*theta)--endfor + cycle; % star +penlabels(0,1,2,3,4); endchar; + +cmchar "Divided rings (divorce symbol)"; +beginchar("1",9u#,v_center(x_height#)); +adjust_fit(0,0); pickup tiny.nib; +numeric light_stem; light_stem=Vround .5[vair,stem]; +pos11(stem,0); pos12(.4[hair,stem],0); pos13(stem,0); +x11=x12=x13=.5w; top y11=round 1.3h; bot y13=round(-d-.3h); y12=.6[y13,y11]; +filldraw z11l...z12l{down}...z13l + --z13r...z12r{up}...z11r--cycle; % vertical stroke +pos1(light_stem,90); pos3(light_stem,-90); +pos2(light_stem,180); pos4(.3[hair,light_stem],0); +x1=x3=.5[x2,x4]; lft x2r=hround(-3u-.5light_stem); rt x4r=hround(.25w+.5stem); +top y1r=h; y2=y4=.5[y1,y3]; +bot y3r=-d; +pos5(light_stem,90); pos7(light_stem,-90); +pos6(.3[hair,light_stem],180); pos8(light_stem,0); +x5-x1=x6-x2=x7-x3=x8-x4; rt x8r=hround(w+3u+.5light_stem); +y5-y1=y6-y2=y7-y3=y8-y4=0; +filldraw stroke pulled_arc.e(1,2)&pulled_arc.e(2,3)&pulled_arc.e(3,4) + &pulled_arc.e(4,1); % left ring +filldraw stroke pulled_arc.e(5,6)&pulled_arc.e(6,7)&pulled_arc.e(7,8) + &pulled_arc.e(8,5); % right ring +penlabels(1,2,3,4,5,6,7,8,11,12,13); endchar; + +cmchar "Leaf"; +beginchar("l",18u#,asc_height#,0); +adjust_fit(0,0); pickup pencircle scaled .6rule_thickness; +z1=(0,0); z2=(w,h); +z3=.5[z1,z2]+.25((z2-z1)rotated 90); +z4=.5[z1,z2]+.25((z2-z1)rotated-90); +path p[]; p3=z1...z3{z2-z1}...z2; p4=z1...z4{z2-z1}...z2; +draw p3; % upper edge +draw p4; % lower edge +draw z1 -- z2; % stem +z5=1/4[z1,z2]; z6=.55[z1,z2]; +z35=p3 intersectionpoint (z5--(x5,2h)); +z36=p3 intersectionpoint (z6--(x6,2h)); +z45=p4 intersectionpoint (z5--(2w,y5)); +z46=p4 intersectionpoint (z6--(2w,y6)); +draw z35--z5--z45; % vein +draw z36--z6--z46; % vein +labels(1,2,3,4,5,6,35,36,45,46); endchar; diff --git a/systems/knuth/local/cm/gen10.mf b/systems/knuth/local/cm/gen10.mf new file mode 100644 index 0000000000..5f2db849bc --- /dev/null +++ b/systems/knuth/local/cm/gen10.mf @@ -0,0 +1,14 @@ +% 10-point genealogy font +if unknown cmbase: input cmbase fi % omit if CMMF can be assumed +mode_setup; + +def generate suffix t= enddef; +input cmr10; font_setup; + +font_identifier:="GEN"; +font_slant slant; font_x_height x_height#; +font_normal_space 6u#+2letter_fit#; +font_quad 18u#+4letter_fit#; + +input gen; +end diff --git a/systems/knuth/local/cm/gen8.mf b/systems/knuth/local/cm/gen8.mf new file mode 100644 index 0000000000..1e13f6dbe8 --- /dev/null +++ b/systems/knuth/local/cm/gen8.mf @@ -0,0 +1,13 @@ +% 8-point genealogy font +if unknown cmbase: input cmbase fi % omit if CMMF can be assumed +mode_setup; + +def generate suffix t= enddef; +input cmr8; font_setup; + +font_slant slant; font_x_height x_height#; +font_normal_space 6u#+2letter_fit#; +font_quad 18u#+4letter_fit#; + +input gen; +end diff --git a/systems/knuth/local/cm/gen9.mf b/systems/knuth/local/cm/gen9.mf new file mode 100644 index 0000000000..eb056926a0 --- /dev/null +++ b/systems/knuth/local/cm/gen9.mf @@ -0,0 +1,13 @@ +% 9-point genealogy font +if unknown cmbase: input cmbase fi % omit if CMMF can be assumed +mode_setup; + +def generate suffix t= enddef; +input cmr9; font_setup; + +font_slant slant; font_x_height x_height#; +font_normal_space 6u#+2letter_fit#; +font_quad 18u#+4letter_fit#; + +input gen; +end diff --git a/systems/knuth/local/cm/odigs.mf b/systems/knuth/local/cm/odigs.mf new file mode 100644 index 0000000000..2b65df8e30 --- /dev/null +++ b/systems/knuth/local/cm/odigs.mf @@ -0,0 +1,11 @@ +% Computer Modern Oldstyle Digits Only + +font_coding_scheme:="Numerals only"; +mode_setup; font_setup; + +font_slant slant; font_x_height x_height#; +font_quad 18u#+4letter_fit#; + +input olddig; % oldstyle numerals + +bye. diff --git a/systems/knuth/local/etc-sparc/Makefile b/systems/knuth/local/etc-sparc/Makefile new file mode 100644 index 0000000000..8570427641 --- /dev/null +++ b/systems/knuth/local/etc-sparc/Makefile @@ -0,0 +1,41 @@ +# Make executable files for this workstation, using the master TeX sources + +PFLAGS= -O -I.. -temp=. -g +CFLAGS= -O -I.. -g +PC= time pc + +all: vftovp vptovf + +%.p: %.ch + tangle ../../dist/etc/$*.web $*.ch + mv ../../dist/etc/$*.p . + +%.ch: ../../dist/etc/%.web + touch $*.ch + +%.o: %.p + ${PC} ${PFLAGS} -c $*.p + +access.o: access.c + +dvityext.o: dvityext.c + +access.c: + cp ../texware/access.c . + +dvityext.c: + cp ../texware/dvityext.c . + +vftovp: vftovp.o access.o dvityext.o + ${PC} ${PFLAGS} -o vftovp vftovp.o access.o dvityext.o + +vptovf: vptovf.o access.o + ${PC} ${PFLAGS} -o vptovf vptovf.o access.o + +dvityext.o: dvityext.c ../h00vars.h ../texpaths.h + +install: # doit make install "PROG=vftovp" + mv $(PROG) /usr/local/bin/$(PROG) + +clean: + rm -f *.p *.o *~ access.c dvityext.c ../../dist/etc/*.pool diff --git a/systems/knuth/local/etc-sparc/vftovp.ch b/systems/knuth/local/etc-sparc/vftovp.ch new file mode 100644 index 0000000000..7e1c67cc0b --- /dev/null +++ b/systems/knuth/local/etc-sparc/vftovp.ch @@ -0,0 +1,330 @@ +% Change file for the VFtoVP processor, for use on Berkeley UNIX systems. +% This file based on TFtoPL.ch and DVItype.ch by Pavel Curtis, Pavel@Cornell. + +% History: +% 12/11/89 (don) Initial version +% 3/23/90 (don) Fixed coredump problem when no args given +% 4/26/90 (don) Up to version 1.1 +% 9/6/90 (don) Up to version 1.2 + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [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 SunOS} +@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 SunOS' + {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; + @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +function testreadaccess(var fn:UNIX_file_name):boolean; external; +procedure setpaths; external; +function testaccess(accessmode:integer; filepath:integer): boolean; external; +@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:packed file of -128..127; {files that contain binary data} +@!vf_name:UNIX_file_name; +@!vf_byte:integer; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [10] Fix declaration of tfm_file; declare extra TFM-file variables +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!tfm_file:packed file of byte; +@y +@!tfm_file:packed file of -128..127; {files that contain binary data} +@!tfm_name:UNIX_file_name; +@!tfm_byte:integer; +@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: array[1..100] of char; +@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 + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [24] Fix reading of TFM bytes. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@<Read the whole \.{TFM} file@>= +read(tfm_file,tfm[0]); +if tfm[0]>127 then abort('The first byte of the input file exceeds 127!'); +@.The first byte...@> +if eof(tfm_file) then abort('The input file is only one byte long!'); +@.The input...one byte long@> +read(tfm_file,tfm[1]); lf:=tfm[0]*@'400+tfm[1]; +if lf=0 then + abort('The file claims to have length zero, but that''s impossible!'); +@.The file claims...@> +if 4*lf-1>tfm_size then abort('The file is bigger than I can handle!'); +@.The file is bigger...@> +for tfm_ptr:=2 to 4*lf-1 do + begin if eof(tfm_file) then + abort('The file has fewer bytes than it claims!'); +@.The file has fewer bytes...@> + read(tfm_file,tfm[tfm_ptr]); + end; +if not eof(tfm_file) then + begin print_ln('There''s some extra junk at the end of the TFM file,'); +@.There's some extra junk...@> + print_ln('but I''ll proceed as if it weren''t there.'); + end +@y +@d fget==begin get(tfm_file); + tfm_byte:=tfm_file^; + if tfm_byte<0 then tfm_byte:=tfm_byte+256; + end +@d fbyte==tfm_byte +@d read_sixteen(#)==begin #:=fbyte; + if #>127 then abort; + fget; #:=#*@'400+fbyte; + end +@d store_four_quarters(#)==begin fget; a:=fbyte; qw.b0:=qi(a); + fget; b:=fbyte; qw.b1:=qi(b); + fget; c:=fbyte; qw.b2:=qi(c); + fget; d:=fbyte; qw.b3:=qi(d); + #:=qw; + end + +@<Read the whole \.{TFM} file@>= + {Prime the pump} +tfm_byte:=tfm_file^; +if tfm_byte<0 then tfm_byte:=tfm_byte+256; + +tfm[0]:=fbyte; fget; +if tfm[0]>127 then abort('The first byte of the input file exceeds 127!'); +@.The first byte...@> +if eof(tfm_file) then abort('The input file is only one byte long!'); +@.The input...one byte long@> +tfm[1]:=fbyte; fget; lf:=tfm[0]*@'400+tfm[1]; +if lf=0 then + abort('The file claims to have length zero, but that''s impossible!'); +@.The file claims...@> +if 4*lf-1>tfm_size then abort('The file is bigger than I can handle!'); +@.The file is bigger...@> +for tfm_ptr:=2 to 4*lf-1 do + begin if eof(tfm_file) then + abort('The file has fewer bytes than it claims!'); +@.The file has fewer bytes...@> + tfm[tfm_ptr]:=fbyte; fget; + end; +if not eof(tfm_file) then + begin print_ln('There''s some extra junk at the end of the TFM file,'); +@.There's some extra junk...@> + print_ln('but I''ll proceed as if it weren''t there.'); + end + +@^system dependencies@>@^Changes for Berkeley {\mc UNIX}@> +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [31] Fix reading of VF bytes. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d read_vf(#)==read(vf_file,#) +@y +@d read_vf(#)==begin vf_byte:=vf_file^; + if vf_byte>=0 then #:=vf_byte@+else #:=vf_byte+256; + get(vf_file); + end +@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:packed array[1..name_length] of char; + {external name} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [38] Fix read_tfm_word to read bytes properly +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d read_tfm(#)==if eof(tfm_file) then #:=0@+else read(tfm_file,#) +@y +@d read_tfm(#)==if eof(tfm_file) then #:=0 + else begin tfm_byte:=tfm_file^; + if tfm_byte>=0 then #:=tfm_byte@+else #:=tfm_byte+256; + get(tfm_file); + end +@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' +@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-sparc/vptovf.ch b/systems/knuth/local/etc-sparc/vptovf.ch new file mode 100644 index 0000000000..27d87eb6ad --- /dev/null +++ b/systems/knuth/local/etc-sparc/vptovf.ch @@ -0,0 +1,142 @@ +% Change file for the VPtoVF processor, for use on Berkeley UNIX systems. +% This file based on PLtoTF.ch by Pavel Curtis, Pavel@Cornell. + +% History: +% 12/14/89 (don) Initial version +% 4/26/90 (don) Up to version 1.1 +% 9/6/90 (don) Up to version 1.2 +% 3/25/91 (don) Up to version 1.3 +% 3/6/95 (don) Up to version 1.4 +% 8/8/98 (don) Up to version 1.5 + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [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 SunOS} +@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 SunOS' + {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@>@/ +function testreadaccess(var fn:UNIX_file_name):boolean; external; +@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 -128..127; +@!tmp : 0..255; +@!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 + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [156] Change TFM-byte output to fix ranges +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d out(#)==write(tfm_file,#) +@y +@d out(#)==begin + tmp := #; + if tmp > 127 then + write(tfm_file, tmp - 256) + else + write(tfm_file, tmp) + end +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [175] Change VF-byte output to fix ranges +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d vout(#)==write(vf_file,#) +@y +@d vout(#)==begin + tmp := #; + if tmp > 127 then + write(vf_file, tmp - 256) + else + write(vf_file, tmp) + end +@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/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} diff --git a/systems/knuth/local/h00vars.h b/systems/knuth/local/h00vars.h new file mode 100644 index 0000000000..288205b459 --- /dev/null +++ b/systems/knuth/local/h00vars.h @@ -0,0 +1,143 @@ +/* Header file for C programs that supplement the Pascal code */ +/* Copyright (c) 1979 Regents of the University of California */ + +/* sccsid[] = "@(#)h00vars.h 1.11 5/8/84"; */ +/* THIS VERSION COMES BACK FROM SUN AND ALLEGEDLY MATCHES OUR CURRENT + COMPILER 8/4/84 */ + +#include <stdio.h> +/* #include "whoami.h" --- no, don't bother; it's empty --- don (8/7/89) */ + +#define PXPFILE "pmon.out" +#define BITSPERBYTE 8 +#define BITSPERLONG (BITSPERBYTE * sizeof(long)) +#define LG2BITSBYTE 03 +#define MSKBITSBYTE 07 +#define LG2BITSLONG 05 +#define MSKBITSLONG 037 +#define HZ 60 +#define MAXLVL 20 +#define MAXERRS 75 +#define NAMSIZ 76 +#define MAXFILES 32 +#define PREDEF 2 +#ifdef ADDR32 +#define STDLVL ((struct iorec *)(0x7ffffff1)) +#define GLVL ((struct iorec *)(0x7ffffff0)) +#endif ADDR32 +#ifdef ADDR16 +#define STDLVL ((struct iorec *)(0xfff1)) +#define GLVL ((struct iorec *)(0xfff0)) +#endif ADDR16 +#define FILNIL ((struct iorec *)(0)) +#define INPUT ((struct iorec *)(&input)) +#define OUTPUT ((struct iorec *)(&output)) +#define ERR ((struct iorec *)(&_err)) +typedef enum {FALSE, TRUE} bool; +#define MAXINT 2147483647 +#define MININT -2147483648 + + +/* + * runtime display structure + */ +struct display { + char *ap; + char *fp; +}; + +/* + * formal routine structure + */ +struct formalrtn { + long (*fentryaddr)(); /* formal entry point */ + long fbn; /* block number of function */ + struct display fdisp[ MAXLVL ]; /* saved at first passing */ +}; + +/* + * program variables + */ +extern struct display _disply[MAXLVL];/* runtime display */ +extern int _argc; /* number of passed args */ +extern char **_argv; /* values of passed args */ +extern long _stlim; /* statement limit */ +extern long _stcnt; /* statement count */ +extern long _seed; /* random number seed */ +extern char *_maxptr; /* maximum valid pointer */ +extern char *_minptr; /* minimum valid pointer */ +extern long _pcpcount[]; /* pxp buffer */ + +/* + * file structures + */ +struct iorechd { + char *fileptr; /* ptr to file window */ + long lcount; /* number of lines printed */ + long llimit; /* maximum number of text lines */ + FILE *fbuf; /* FILE ptr */ + struct iorec *fchain; /* chain to next file */ + struct iorec *flev; /* ptr to associated file variable */ + char *pfname; /* ptr to name of file */ + short funit; /* file status flags */ + unsigned short fblk; /* index into active file table */ + long fsize; /* size of elements in the file */ + char fname[NAMSIZ]; /* name of associated UNIX file */ +}; + +struct iorec { + char *fileptr; /* ptr to file window */ + long lcount; /* number of lines printed */ + long llimit; /* maximum number of text lines */ + FILE *fbuf; /* FILE ptr */ + struct iorec *fchain; /* chain to next file */ + struct iorec *flev; /* ptr to associated file variable */ + char *pfname; /* ptr to name of file */ + short funit; /* file status flags */ + unsigned short fblk; /* index into active file table */ + long fsize; /* size of elements in the file */ + char fname[NAMSIZ]; /* name of associated UNIX file */ + char buf[BUFSIZ]; /* I/O buffer */ + char window[1]; /* file window element */ +}; + +/* + * unit flags + */ +#define SPEOLN 0x100 /* 1 => pseudo EOLN char read at EOF */ +#define FDEF 0x080 /* 1 => reserved file name */ +#define FTEXT 0x040 /* 1 => text file, process EOLN */ +#define FWRITE 0x020 /* 1 => open for writing */ +#define FREAD 0x010 /* 1 => open for reading */ +#define TEMP 0x008 /* 1 => temporary file */ +#define SYNC 0x004 /* 1 => window is out of sync */ +#define EOLN 0x002 /* 1 => at end of line */ +#define EOFF 0x001 /* 1 => at end of file */ + +/* + * file routines + */ +extern struct iorec *GETNAME(); +extern char *MKTEMP(); +extern char *PALLOC(); + +/* + * file record variables + */ +extern struct iorechd _fchain; /* head of active file chain */ +extern struct iorec *_actfile[]; /* table of active files */ +extern long _filefre; /* last used entry in _actfile */ + +/* + * standard files + */ +extern struct iorechd input; +extern struct iorechd output; +extern struct iorechd _err; + +/* + * seek pointer struct for TELL, SEEK extensions + */ +struct seekptr { + long cnt; +}; diff --git a/systems/knuth/local/lib/3list-small.tex b/systems/knuth/local/lib/3list-small.tex new file mode 100644 index 0000000000..d5dd720eb1 --- /dev/null +++ b/systems/knuth/local/lib/3list-small.tex @@ -0,0 +1,71 @@ +% Makes a 3-column landscape listing of one or more files +% Typical usage: +% tex 3list-small *.c \\end + +\def\grabfile#1 {\setbox0=\lastbox\endgraf\doit{#1}} +\everypar{\grabfile} + +\font\filenamefont= cmtt8 scaled\magstep3 +\font\headlinefont= cmr8 +\font\listingfont= cmtex8 at 7pt +\font\eoffont= cmti8 + +\def\today{\ifcase\month\or + January\or February\or March\or April\or May\or June\or + July\or August\or September\or October\or November\or December\fi + \space\number\day, \number\year} +\newcount\m \newcount\n +\n=\time \divide\n 60 \m=-\n \multiply\m 60 \advance\m \time +\def\hours{\twodigits\n\twodigits\m} +\def\twodigits#1{\ifnum #1<10 0\fi \number#1} + +\newlinechar=`@ +\message{@\today\space at \hours} + +\baselineskip=8pt +\medskipamount=3pt minus 1pt +\raggedbottom +\nopagenumbers + +\chardef\other=12 +\def\doit#1{\message{@Listing #1@} + \begingroup \everypar{} \frenchspacing + \headline{\ifright \headlinefont \hfill Page \folio + \else\hbox to2.5in{\filenamefont#1\quad + \headlinefont \today\ at \hours\hskip-3in\hss}\hfill \fi} + \def\do##1{\catcode`##1=\other}\dospecials + \catcode127=\other \catcode9=\other \catcode12=\other + \parindent 0pt \parfillskip=0pt plus 1fil minus .8in + \everypar{\hangindent 1in} \rightskip=0pt plus 2in + \def\par{\ifvmode\penalty-50\medskip\else\endgraf\fi} + \listingfont \obeylines \obeyspaces \global\pageno=1 + \input #1 {\eoffont(end of\/ file)}\endgraf\vfill\eject + \ifright\null\vfill\eject\fi\endgroup} +{\obeyspaces\global\let =\ } +\catcode`\_=\other % allow _ in file names + +\hsize=3truein +\vsize=7truein +\hoffset=-.5truein +\voffset=-.2truein +\newif\ifright \newif\ifmid +\newbox\lefthalf \newbox\midhalf +\output{\ifright + \shipout\hbox{\hbox to3.5in{\box\lefthalf\hss}% + \hbox to3.5in{\box\midhalf\hss}% + \vbox{\makeheadline\pagebody\makefootline}} + \advancepageno\global\rightfalse + \else\ifmid\global\setbox\midhalf\vbox{\pagebody\makefootline} + \global\midfalse\global\righttrue + \else\global\setbox\lefthalf\vbox{\makeheadline\pagebody\makefootline} + \global\midtrue\fi\fi} + +\special{landscape} + +% A tab (^^I) prints as lowercase gamma. +% Character ^^M could be made visible, with a bit of work; +% at present, it's indistinguishable from newline (^^J). + +% You can get up to 63 characters on a line without an overfull box. +% (But lines with more than 59 characters may overlap with the next column, +% or be clipped off in the rightmost column.) diff --git a/systems/knuth/local/lib/3list.tex b/systems/knuth/local/lib/3list.tex new file mode 100644 index 0000000000..64c21c339c --- /dev/null +++ b/systems/knuth/local/lib/3list.tex @@ -0,0 +1,71 @@ +% Makes a 3-column landscape listing of one or more files +% Typical usage: +% tex 3list *.c \\end + +\def\grabfile#1 {\setbox0=\lastbox\endgraf\doit{#1}} +\everypar{\grabfile} + +\font\filenamefont= cmtt8 scaled\magstep3 +\font\headlinefont= cmr8 +\font\listingfont= cmtex8 +\font\eoffont= cmti8 + +\def\today{\ifcase\month\or + January\or February\or March\or April\or May\or June\or + July\or August\or September\or October\or November\or December\fi + \space\number\day, \number\year} +\newcount\m \newcount\n +\n=\time \divide\n 60 \m=-\n \multiply\m 60 \advance\m \time +\def\hours{\twodigits\n\twodigits\m} +\def\twodigits#1{\ifnum #1<10 0\fi \number#1} + +\newlinechar=`@ +\message{@\today\space at \hours} + +\baselineskip=9pt +\medskipamount=4pt minus 1pt +\raggedbottom +\nopagenumbers + +\chardef\other=12 +\def\doit#1{\message{@Listing #1@} + \begingroup \everypar{} \frenchspacing + \headline{\ifright \headlinefont \hfill Page \folio + \else\hbox to2.5in{\filenamefont#1\quad + \headlinefont \today\ at \hours\hskip-3in\hss}\hfill \fi} + \def\do##1{\catcode`##1=\other}\dospecials + \catcode127=\other \catcode9=\other \catcode12=\other + \parindent 0pt \parfillskip=0pt plus 1fil minus .8in + \everypar{\hangindent 1in} \rightskip=0pt plus 2in + \def\par{\ifvmode\penalty-50\medskip\else\endgraf\fi} + \listingfont \obeylines \obeyspaces \global\pageno=1 + \input #1 {\eoffont(end of\/ file)}\endgraf\vfill\eject + \ifright\null\vfill\eject\fi\endgroup} +{\obeyspaces\global\let =\ } +\catcode`\_=\other % allow _ in file names + +\hsize=3truein +\vsize=7truein +\hoffset=-.5truein +\voffset=-.2truein +\newif\ifright \newif\ifmid +\newbox\lefthalf \newbox\midhalf +\output{\ifright + \shipout\hbox{\hbox to3.5in{\box\lefthalf\hss}% + \hbox to3.5in{\box\midhalf\hss}% + \vbox{\makeheadline\pagebody\makefootline}} + \advancepageno\global\rightfalse + \else\ifmid\global\setbox\midhalf\vbox{\pagebody\makefootline} + \global\midfalse\global\righttrue + \else\global\setbox\lefthalf\vbox{\makeheadline\pagebody\makefootline} + \global\midtrue\fi\fi} + +\special{landscape} + +% A tab (^^I) prints as lowercase gamma. +% Character ^^M could be made visible, with a bit of work; +% at present, it's indistinguishable from newline (^^J). + +% You can get up to 63 characters on a line without an overfull box. +% (But lines with more than 59 characters may overlap with the next column, +% or be clipped off in the rightmost column.) diff --git a/systems/knuth/local/lib/6list.tex b/systems/knuth/local/lib/6list.tex new file mode 100644 index 0000000000..5d59194ffe --- /dev/null +++ b/systems/knuth/local/lib/6list.tex @@ -0,0 +1,75 @@ +% Makes a 6-column landscape listing of one or more files with narrow lines +% Typical usage: +% tex 6list foo \\end +% and then use gv to print the result (my dvips has trouble with landscape) + +\def\grabfile#1 {\setbox0=\lastbox\endgraf\doit{#1}} +\everypar{\grabfile} + +\font\filenamefont= cmtt8 scaled\magstep3 +\font\headlinefont= cmr8 +\font\listingfont= cmtex8 +\font\eoffont= cmti8 + +\def\today{\ifcase\month\or + January\or February\or March\or April\or May\or June\or + July\or August\or September\or October\or November\or December\fi + \space\number\day, \number\year} +\newcount\m \newcount\n +\n=\time \divide\n 60 \m=-\n \multiply\m 60 \advance\m \time +\def\hours{\twodigits\n\twodigits\m} +\def\twodigits#1{\ifnum #1<10 0\fi \number#1} + +\newlinechar=`@ +\message{@\today\space at \hours} + +\baselineskip=9pt +\medskipamount=4pt minus 1pt +\raggedbottom +\nopagenumbers + +\chardef\other=12 +\def\doit#1{\message{@Listing #1@} + \begingroup \everypar{} \frenchspacing + \headline{\hbox to1.25in{\filenamefont#1\quad + \headlinefont \today\ at \hours\hskip3in Page \folio\hss}\hfill} + \def\do##1{\catcode`##1=\other}\dospecials + \catcode127=\other \catcode9=\other \catcode12=\other + \parindent 0pt \parfillskip=0pt plus 1fil minus .8in + \everypar{\hangindent 1in} \rightskip=0pt plus 2in + \def\par{\ifvmode\penalty-50\medskip\else\endgraf\fi} + \listingfont \obeylines \obeyspaces \global\pageno=1 + \input #1 {\eoffont(end of\/ file)}\endgraf\vfill\eject + \ifright\null\vfill\eject\fi\endgroup} +{\obeyspaces\global\let =\ } +\catcode`\_=\other % allow _ in file names + +\hsize=1.65truein +\vsize=7truein +\hoffset=-.5truein +\voffset=-.2truein +\newif\ifright +\newcount\boxnum \boxnum=0 +\output{\ifright\else\ifcase\boxnum + \global\setbox0=\vbox{\makeheadline\pagebody\makefootline}\global\boxnum=1\or + \global\setbox1=\vbox{\pagebody\makefootline}\global\boxnum=2\or + \global\setbox2=\vbox{\pagebody\makefootline}\global\boxnum=3\or + \global\setbox3=\vbox{\pagebody\makefootline}\global\boxnum=4\or + \global\setbox4=\vbox{\pagebody\makefootline}\global\boxnum=5\or + \shipout\hbox{\hbox to1.7truein{\box0\hss}% + \hbox to1.7truein{\box1\hss}% + \hbox to1.7truein{\box2\hss}% + \hbox to1.7truein{\box3\hss}% + \hbox to1.7truein{\box4\hss}% + \vbox{\pagebody\makefootline}} + \advancepageno\global\boxnum=0\fi\fi} + +\special{landscape} + +% A tab (^^I) prints as lowercase gamma. +% Character ^^M could be made visible, with a bit of work; +% at present, it's indistinguishable from newline (^^J). + +% You can get up to 63 characters on a line without an overfull box. +% (But lines with more than 59 characters may overlap with the next column, +% or be clipped off in the rightmost column.) diff --git a/systems/knuth/local/lib/8list.tex b/systems/knuth/local/lib/8list.tex new file mode 100644 index 0000000000..b25b5b7d0f --- /dev/null +++ b/systems/knuth/local/lib/8list.tex @@ -0,0 +1,79 @@ +% Makes a 8-column landscape listing of one or more files with narrow lines +% Typical usage: +% tex 8list foo \\end +% and then use gv to print the result (my dvips has trouble with landscape) + +\def\grabfile#1 {\setbox0=\lastbox\endgraf\doit{#1}} +\everypar{\grabfile} + +\font\filenamefont= cmtt8 scaled\magstep3 +\font\headlinefont= cmr8 +\font\listingfont= cmtex8 +\font\eoffont= cmti8 + +\def\today{\ifcase\month\or + January\or February\or March\or April\or May\or June\or + July\or August\or September\or October\or November\or December\fi + \space\number\day, \number\year} +\newcount\m \newcount\n +\n=\time \divide\n 60 \m=-\n \multiply\m 60 \advance\m \time +\def\hours{\twodigits\n\twodigits\m} +\def\twodigits#1{\ifnum #1<10 0\fi \number#1} + +\newlinechar=`@ +\message{@\today\space at \hours} + +\baselineskip=9pt +\medskipamount=4pt minus 1pt +\raggedbottom +\nopagenumbers + +\chardef\other=12 +\def\doit#1{\message{@Listing #1@} + \begingroup \everypar{} \frenchspacing + \headline{\hbox to1.25in{\filenamefont#1\quad + \headlinefont \today\ at \hours\hskip3in Page \folio\hss}\hfill} + \def\do##1{\catcode`##1=\other}\dospecials + \catcode127=\other \catcode9=\other \catcode12=\other + \parindent 0pt \parfillskip=0pt plus 1fil minus .8in + \everypar{\hangindent 1in} \rightskip=0pt plus 2in + \def\par{\ifvmode\penalty-50\medskip\else\endgraf\fi} + \listingfont \obeylines \obeyspaces \global\pageno=1 + \input #1 {\eoffont(end of\/ file)}\endgraf\vfill\eject + \ifright\null\vfill\eject\fi\endgroup} +{\obeyspaces\global\let =\ } +\catcode`\_=\other % allow _ in file names + +\hsize=1.25truein +\vsize=7truein +\hoffset=-.5truein +\voffset=-.2truein +\newif\ifright +\newcount\boxnum \boxnum=0 +\output{\ifright\else\ifcase\boxnum + \global\setbox0=\vbox{\makeheadline\pagebody\makefootline}\global\boxnum=1\or + \global\setbox1=\vbox{\pagebody\makefootline}\global\boxnum=2\or + \global\setbox2=\vbox{\pagebody\makefootline}\global\boxnum=3\or + \global\setbox3=\vbox{\pagebody\makefootline}\global\boxnum=4\or + \global\setbox4=\vbox{\pagebody\makefootline}\global\boxnum=5\or + \global\setbox5=\vbox{\pagebody\makefootline}\global\boxnum=6\or + \global\setbox6=\vbox{\pagebody\makefootline}\global\boxnum=7\or + \shipout\hbox{\hbox to1.3truein{\box0\hss}% + \hbox to1.3truein{\box1\hss}% + \hbox to1.3truein{\box2\hss}% + \hbox to1.3truein{\box3\hss}% + \hbox to1.3truein{\box4\hss}% + \hbox to1.3truein{\box5\hss}% + \hbox to1.3truein{\box6\hss}% + \vbox{\pagebody\makefootline}} + \advancepageno\global\boxnum=0\fi\fi} + +\special{landscape} + +% A tab (^^I) prints as lowercase gamma. +% Character ^^M could be made visible, with a bit of work; +% at present, it's indistinguishable from newline (^^J). + +% You can get up to 63 characters on a line without an overfull box. +% (But lines with more than 59 characters may overlap with the next column, +% or be clipped off in the rightmost column.) diff --git a/systems/knuth/local/lib/amsmodes.mf b/systems/knuth/local/lib/amsmodes.mf new file mode 100644 index 0000000000..5bbd2cd380 --- /dev/null +++ b/systems/knuth/local/lib/amsmodes.mf @@ -0,0 +1,286 @@ +% AMSMODES.MF +% This file can be loaded after PLAIN.MF. +% It introduces conventions that were commonly used at WAITS and +% may still be commonly used at AMS. +% (I combined two files on AMS's public directory --- don.) +base_version:=base_version&"/AMS"; + +% We make the following modification of "mode_def" from PLAIN in order +% to accommodate modes not preloaded in MF. Even though mode had been +% set dependently on the command line (as with mode=talaris), when +% mode_def came along to define "talaris" the assignment operator +% (:=) wiped out that dependency and left mode hanging and undefined +% when mode_setup was called. We simply add a test to see whether +% "mode" has been set to the mode being defined. + +% Furthermore, if mode was set to a mode which was preloaded and +% that mode was re-defined at run-time, the value of mode would +% only pick up the old definition. So, for the other case, +% that the mode being defined already has a numeric realization, +% we avoid redefining that mode's (behind-the-scenes) value. + +% We also add the following macros to enable conditional "and" +% and "or". See The METAFONTbook, pp.288--289. + +def cand(text q) = startif true q else: false fi enddef; +def cor(text q) = startif true true else: q fi enddef; +tertiarydef p startif true = if p: enddef; + +def mode_def suffix $ = + if known($) cand + (numeric $ cand + ($<number_of_modes cand + (mode_name[$] = (str $ & "_")))): + else: if known(mode-$) cand (unknown mode): mode:= fi + $:=incr number_of_modes; + mode_name[$]:=str$ & "_"; + fi + expandafter quote def scantokens mode_name[$] enddef; + +% Say "boise_proof" on the command line, to get proofmode on boise +def boise_proof = lcode_:=" /"; + extra_setup:=extra_setup&"grayfont grbois;" enddef; + +screen_rows:=400; screen_cols:=480; + +% Here are conventions for local output devices: + +mode_def dover = % dover mode: for the Xerox Dover + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=0; % no, don't show titles in the log + pixels_per_inch:=384; + blacker:=1.2; % make pens somewhat blacker + fillin:=0; % no compensation for fillin + o_correction:=.6; % but don't overshoot as much + enddef; + +mode_def imagen = % imagen mode: for the Imagen 8/300 (Canon engine) + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=0; % no, don't show titles in the log + pixels_per_inch:=300; + blacker:=0; % Canon engine is black enough + fillin:=.2; % and it tends to fill in diagonals + o_correction:=.6; % + enddef; + +mode_def qms = % qms mode: for the QMS (Xerox engine) + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=0; % no, don't show titles in the log + pixels_per_inch:=300; + blacker:=.75; % (this value is conjectural) + fillin:=0; % (ditto) + o_correction:=.5; % (ditto) + enddef; + +mode_def aps = % aps mode: for the Autologic APS-Micro5 + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=1; % yes, show titles online + pixels_per_inch:=722.909; % that's roughly 10 per pt + blacker:=.2; % make pens a teeny bit blacker + fillin:=.2; % but compensate for diagonal fillin + o_correction:=1; % and keep the full overshoot + enddef; + +mode_def linotronic = % for the Linotronic + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=1; % yes, show titles online + pixels_per_inch:=1270; % high resolution mode + blacker:=.2; % make pens a teeny bit blacker (aps value) + fillin:=.2; % but compensate for diagonal fillin (aps value) + o_correction:=1; % and keep the full overshoot (aps value) + enddef; + +mode_def halflinotronic = % for the Linotronic + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=1; % yes, show titles online + pixels_per_inch:=635; % high resolution mode + blacker:=.2; % make pens a teeny bit blacker (aps value) + fillin:=.2; % but compensate for diagonal fillin (aps value) + o_correction:=1; % and keep the full overshoot (aps value) + enddef; + +mode_def crs = % crs mode: for the Alphatype CRS + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=1; % yes, show titles online + begingroup interim warningcheck:=0; % (we need to go past 4096) + pixels_per_inch:=4000+4000/3 endgroup; % HIGH res + blacker:=4; % make pens a lot blacker + fillin:=0; % but don't compensate for fillin + o_correction:=1; % and keep the full overshoot + enddef; + +mode_def boise = % boise mode: for the HP 2680A + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=0; % no, don't show titles in the log + pixels_per_inch:=180; + blacker:=.55; % make pens a bit blacker + fillin:=.1; % and compensate for diagonal fillin + o_correction:=.3; % but don't overshoot much + enddef; + +mode_def DD = % DD mode: for the DataDisc (usually with mag=magstep 2=1.44) + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=0; % no, don't show titles in the log + pixels_per_inch:=70; % really lowres + blacker:=0; % don't make the pens any blacker + fillin:=0; % and don't compensate for fillin + o_correction:=.2; % but suppress most overshoots + enddef; + +mode_def canon = % canon mode: for the old Imagen (Canon LBP10) + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=0; % no, don't show titles in the log + pixels_per_inch:=240; + blacker:=.2; % make pens a wee bit blacker + fillin:=.2; % and compensate for fillin + o_correction:=.4; % but don't overshoot as much + enddef; + +mode_def newDD = % newDD mode: for DataDisc with special aspect ratio + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=0; % no, don't show titles in the log + pixels_per_inch:=70; % really lowres + blacker:=0; % don't make the pens any blacker + fillin:=0; % and don't compensate for fillin + o_correction:=.2; % but suppress most overshoots + aspect_ratio:=4/3; % this is the new feature... + enddef; + +mode_def cg = % cg mode: for the Compugraphic 8600 + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=1; % yes, show titles online + pixels_per_inch:=1301.5; % a bit less than 20 per pt + blacker:=.2; % make pens a teeny bit blacker + fillin:=.2; % but compensate for diagonal fillin + o_correction:=1; % and keep the full overshoot + aspect_ratio:=1569/1301.5; % strange, no? + enddef; + +mode_def epson = % Epson + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=0; % no, don't show titles in the log + pixels_per_inch:=240; % lowres + blacker:=0; % don't make the pens any blacker + fillin:=0; % and don't compensate for fillin + o_correction:=.2; % but suppress most overshoots + aspect_ratio:=9/10; % 216 dots/inch vertical + enddef; + +mode_def pcscreen = % pcscreen mode: for screen fonts (118dpi) + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=0; % no, don't show titles in the log + pixels_per_inch:=118; + blacker:=0; % don't make pens any blacker + fillin:=0; % and don't compensate for diagonal fillin + o_correction:=0; % don't overshoot (corrected -- they had 1 -- don) + enddef; + +mode_def epsonlq = % epsonlq mode: for the Epson LQ and Toshiba + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=0; % no, don't show titles in the log + pixels_per_inch:=180; + blacker:=0; % don't make pens any blacker + fillin:=0; % and don't compensate for diagonal fillin + o_correction:=.3; % but don't overshoot much + enddef; + +mode_def epsonx = % Epson 240dpi + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=0; % no, don't show titles in the log + pixels_per_inch:=240; % lowres + blacker:=0; % don't make the pens any blacker + fillin:=0; % and don't compensate for fillin + o_correction:=.2; % but suppress most overshoots + aspect_ratio:=9/10; % 216 dots/inch vertical + enddef; + +mode_def laser = % laser mode: for the Apple LaserWriter or Canon 300dpi + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=0; % no, don't show titles in the log + pixels_per_inch:=300; + blacker:=0; % Canon engine is black enough + fillin:=.2; % and it tends to fill in diagonals + o_correction:=.6; % + enddef; + +mode_def fourc = % for 400dpi printers + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=0; % no, don't show titles in the log + pixels_per_inch:=400; + blacker:=0; % engine is black enough + fillin:=.2; % and it tends to fill in diagonals + o_correction:=.6; % + enddef; + +% macintosh mode: for screen fonts (72dpi) & imagewriter (144dpi) +mode_def macintosh = + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=0; % no, don't show titles in the log + pixels_per_inch:=72; + blacker:=0; % Don't blacken + fillin:=0; % + o_correction:=0; % (corrected -- they had 1 -- don) + enddef; + +mode_def notimagewriter = % notimagewriter mode: to get 129pk for screen + % Largest resolution which guarantees at least one point size less + % than imagewriter size. + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=0; % no, don't show titles in the log + pixels_per_inch:=129; + blacker:=0; % Don't blacken + fillin:=0; % + o_correction:=0; % (corrected -- they had 1 -- don) + enddef; + +localfont:=imagen; + +% Finally, here are macros for Xerox-world font info: + +def font_family expr s = % string s names the font family, e.g., "CMR" + headerbyte 49: BCPL_string(s,20); + special "identifier "&s enddef; +def coding_scheme expr s = % string s names the scheme, e.g. "TEX TEXT" + headerbyte 9: BCPL_string(s,40); + special "codingscheme "&s enddef; +def font_face_byte expr x = % integer x gives the family member number, + headerbyte 72: x; % which should be between 0 and 255 + special "fontfacebyte"; numspecial x enddef; + +def BCPL_string(expr s,n)= % string s becomes an n-byte BCPL string + for l:=if length(s)>=n: n-1 else: length(s) fi: l + for k:=1 upto l: , substring (k-1,k) of s endfor + for k:=l+2 upto n: , 0 endfor endfor enddef; + +Xerox_world:=1; % users can say `if known Xerox_world:...fi' + +inner end; +def bye= + if fontmaking>0: font_family font_identifier_; + coding_scheme font_coding_scheme_; + font_face_byte max(0,254-round 2designsize); fi + tracingstats:=1; % at least for now we want this + end + enddef; + +outer bye,end; diff --git a/systems/knuth/local/lib/amsppt.sty b/systems/knuth/local/lib/amsppt.sty new file mode 100644 index 0000000000..68e030688b --- /dev/null +++ b/systems/knuth/local/lib/amsppt.sty @@ -0,0 +1,1133 @@ +%% This is file `amsppt.sty' generated from `amsppt.doc' +%% on 22-JAN-1992 by the docstrip.ams utility (1.2). +%% +%% @texfile{ +%% filename="amsppt.sty", +\def\filename{amsppt.sty} +%% version="2.1a", +\def\fileversion{2.1a} +%% date="22-JAN-1992", +\def\filedate{22-JAN-1992} +%% filetype="AMS-TeX: documentstyle", +%% copyright="Copyright (C) American Mathematical Society, +%% all rights reserved. Copying of this file is +%% authorized only if either: +%% (1) you make absolutely no changes to your copy +%% including name; OR +%% (2) if you do make changes, you first rename it to some +%% other name.", +%% author="American Mathematical Society", +%% address="American Mathematical Society, +%% Technical Support Group, +%% P. O. Box 6248, +%% Providence, RI 02940, +%% USA", +%% telephone="401-455-4080 or (in the USA) 800-321-4AMS", +%% email="Internet: Tech-Support@Math.AMS.com", +%% codetable="ISO/ASCII", +%% checksumtype="line count", +%% checksum="1133", +%% keywords="amstex, ams-tex, tex", +%% abstract="This file is a documentstyle for use with +%% AMS-TeX 2.1. It exists in two forms: amsppt.doc, which +%% is the full form containing all technical documentation, +%% and amsppt.sty, which is identical except that all lines +%% beginning with a single percent sign are removed, to +%% make the file more rapid-loading when processed by +%% TeX." +%% } +\expandafter\ifx\csname amsppt.sty\endcsname\endinput + \expandafter\def\csname amsppt.sty\endcsname{2.1 (1-JUL-1991)}\fi +\xdef\fileversiontest{\fileversion\space(\filedate)} +\expandafter\ifx\csname\filename\endcsname\fileversiontest + \message{[already loaded]}\endinput\fi +\expandafter\ifx\csname\filename\endcsname\relax % file not yet loaded + \else\errmessage{Discrepancy in `\filename' file versions: + version \csname\filename\endcsname\space already loaded, trying + now to load version \fileversiontest}\fi +\expandafter\xdef\csname\filename\endcsname{% + \catcode`\noexpand\@=\the\catcode`\@ + \expandafter\gdef\csname\filename\endcsname{% + \fileversion\space(\filedate)}} +\catcode`\@=11 +\message{version \fileversion\space(\filedate):} +\expandafter\ifx\csname styname\endcsname\relax + \def\styname{AMSPPT}\def\styversion{2.1a} +\fi +\message{Loading utility definitions,} +\def\identity@#1{#1} +\def\nofrills@@#1{% + \DN@{#1}% + \ifx\next\nofrills \let\frills@\eat@ + \expandafter\expandafter\expandafter\next@\expandafter\eat@ + \else \let\frills@\identity@\expandafter\next@\fi} +\def\nofrillscheck#1{\def\nofrills@{\nofrills@@{#1}}% + \futurelet\next\nofrills@} +\Invalid@\usualspace +\def\addto#1#2{\csname \expandafter\eat@\string#1@\endcsname + \expandafter{\the\csname \expandafter\eat@\string#1@\endcsname#2}} +\newdimen\bigsize@ +\def\big@#1#2{{\hbox{$\left#2\vcenter to#1\bigsize@{}% + \right.\nulldelimiterspace\z@\m@th$}}} +\def\big{\big@\@ne} +\def\Big{\big@{1.5}} +\def\bigg{\big@\tw@} +\def\Bigg{\big@{2.5}} +\def\raggedcenter@{\leftskip\z@ plus.4\hsize \rightskip\leftskip + \parfillskip\z@ \parindent\z@ \spaceskip.3333em \xspaceskip.5em + \pretolerance9999\tolerance9999 \exhyphenpenalty\@M + \hyphenpenalty\@M \let\\\linebreak} +\def\uppercasetext@#1{% + {\spaceskip1.3\fontdimen2\the\font plus1.3\fontdimen3\the\font + \def\ss{SS}\let\i=I\let\j=J\let\ae\AE\let\oe\OE + \let\o\O\let\aa\AA\let\l\L + \skipmath@#1$\skipmath@$}} +\def\skipmath@#1$#2${\uppercase{#1}% + \ifx\skipmath@#2\else$#2$\expandafter\skipmath@\fi} +\def\add@missing#1{\expandafter\ifx\envir@end#1% + \Err@{You seem to have a missing or misspelled + \expandafter\string\envir@end ...}% + \envir@end +\fi} +\newtoks\revert@ +\def\envir@stack#1{\toks@\expandafter{\envir@end}% + \edef\next@{\def\noexpand\envir@end{\the\toks@}% + \revert@{\the\revert@}}% + \revert@\expandafter{\next@}% + \def\envir@end{#1}} +\begingroup +\catcode`\ =11 +\gdef\revert@envir#1{\expandafter\ifx\envir@end#1% +\the\revert@% +\else\ifx\envir@end\enddocument \Err@{Extra \string#1}% +\else\expandafter\add@missing\envir@end\revert@envir#1% +\fi\fi} +\xdef\enddocument {\string\enddocument}% +\global\let\envir@end\enddocument %%%%%% don't remove the final space! +\endgroup\relax +\def\first@#1#2\end{#1} +\def\true@{TT} +\def\false@{TF} +\begingroup \catcode`\-=3 +\long\gdef\notempty#1{% + \expandafter\ifx\first@#1-\end-\empty \false@\else \true@\fi} +\endgroup +\message{more fonts,} +\font@\tensmc=cmcsc10 +\font@\sevenex=cmex7 +%% non-AMSfonts substitute for previous line: +%%\font@\sevenex=cmex10 at 7pt +\font@\sevenit=cmti7 +\font@\eightrm=cmr8 % preloaded in plain.tex +\font@\sixrm=cmr6 % preloaded in plain.tex +\font@\eighti=cmmi8 \skewchar\eighti='177 % preloaded +\font@\sixi=cmmi6 \skewchar\sixi='177 % preloaded +\font@\eightsy=cmsy8 \skewchar\eightsy='60 % preloaded +\font@\sixsy=cmsy6 \skewchar\sixsy='60 % preloaded +\font@\eightex=cmex8 +%% non-AMSfonts substitute for previous line: +%%\font@\eightex=cmex10 at 8pt +\font@\eightbf=cmbx8 % preloaded in plain.tex +\font@\sixbf=cmbx6 % preloaded in plain.tex +\font@\eightit=cmti8 % preloaded in plain.tex +\font@\eightsl=cmsl8 % preloaded in plain.tex +\font@\eightsmc=cmcsc8 +%% non-AMSfonts substitute for previous line: +%%\font@\eightsmc=cmcsc10 at 8pt +\font@\eighttt=cmtt8 % preloaded in plain.tex +%% Nine-point fonts are not needed but are included here, commented +%% out, to make it easier for a user to add them if they are needed. +%%\font@\ninerm=cmr9 +%%\font@\ninei=cmmi9 \skewchar\ninei='177 +%%\font@\ninesy=cmsy9 \skewchar\ninesy='60 +%%\font@\nineex=cmex9 +%%%%\font@\nineex=cmex10 at9pt % non-AMSfonts substitute +%%\font@\ninebf=cmbx9 +%%\font@\nineit=cmti9 +%%\font@\ninesl=cmsl9 +%%\font@\ninesmc=cmcsc9 +%% +%%\font@\ninemsa=msam9 +%%\font@\ninemsb=msbm9 +%%\font@\nineeufm=eufm9 +%% To use amsppt.sty without AMSFonts, comment out the following +%% two lines (and refer to the lines above that begin with double +%% percent signs); to load extra math symbols only on demand (with +%% \newsymbol) comment out the second line. +\loadeufm \loadmsam \loadmsbm +\message{symbol names}\UseAMSsymbols\message{,} +\newtoks\tenpoint@ +\def\tenpoint{\normalbaselineskip12\p@ + \abovedisplayskip12\p@ plus3\p@ minus9\p@ + \belowdisplayskip\abovedisplayskip + \abovedisplayshortskip\z@ plus3\p@ + \belowdisplayshortskip7\p@ plus3\p@ minus4\p@ + \textonlyfont@\rm\tenrm \textonlyfont@\it\tenit + \textonlyfont@\sl\tensl \textonlyfont@\bf\tenbf + \textonlyfont@\smc\tensmc \textonlyfont@\tt\tentt + \ifsyntax@ \def\big##1{{\hbox{$\left##1\right.$}}}% + \let\Big\big \let\bigg\big \let\Bigg\big + \else + \textfont\z@\tenrm \scriptfont\z@\sevenrm + \scriptscriptfont\z@\fiverm + \textfont\@ne\teni \scriptfont\@ne\seveni + \scriptscriptfont\@ne\fivei + \textfont\tw@\tensy \scriptfont\tw@\sevensy + \scriptscriptfont\tw@\fivesy + \textfont\thr@@\tenex \scriptfont\thr@@\sevenex + \scriptscriptfont\thr@@\sevenex + \textfont\itfam\tenit \scriptfont\itfam\sevenit + \scriptscriptfont\itfam\sevenit + \textfont\bffam\tenbf \scriptfont\bffam\sevenbf + \scriptscriptfont\bffam\fivebf + \setbox\strutbox\hbox{\vrule height8.5\p@ depth3.5\p@ width\z@}% + \setbox\strutbox@\hbox{\lower.5\normallineskiplimit\vbox{% + \kern-\normallineskiplimit\copy\strutbox}}% + \setbox\z@\vbox{\hbox{$($}\kern\z@}\bigsize@1.2\ht\z@ + \fi + \normalbaselines\rm\dotsspace@1.5mu\ex@.2326ex\jot3\ex@ + \the\tenpoint@} +\newtoks\eightpoint@ +\def\eightpoint{\normalbaselineskip10\p@ + \abovedisplayskip10\p@ plus2.4\p@ minus7.2\p@ + \belowdisplayskip\abovedisplayskip + \abovedisplayshortskip\z@ plus2.4\p@ + \belowdisplayshortskip5.6\p@ plus2.4\p@ minus3.2\p@ + \textonlyfont@\rm\eightrm \textonlyfont@\it\eightit + \textonlyfont@\sl\eightsl \textonlyfont@\bf\eightbf + \textonlyfont@\smc\eightsmc \textonlyfont@\tt\eighttt + \ifsyntax@\def\big##1{{\hbox{$\left##1\right.$}}}% + \let\Big\big \let\bigg\big \let\Bigg\big + \else + \textfont\z@\eightrm \scriptfont\z@\sixrm + \scriptscriptfont\z@\fiverm + \textfont\@ne\eighti \scriptfont\@ne\sixi + \scriptscriptfont\@ne\fivei + \textfont\tw@\eightsy \scriptfont\tw@\sixsy + \scriptscriptfont\tw@\fivesy + \textfont\thr@@\eightex \scriptfont\thr@@\sevenex + \scriptscriptfont\thr@@\sevenex + \textfont\itfam\eightit \scriptfont\itfam\sevenit + \scriptscriptfont\itfam\sevenit + \textfont\bffam\eightbf \scriptfont\bffam\sixbf + \scriptscriptfont\bffam\fivebf + \setbox\strutbox\hbox{\vrule height7\p@ depth3\p@ width\z@}% + \setbox\strutbox@\hbox{\raise.5\normallineskiplimit\vbox{% + \kern-\normallineskiplimit\copy\strutbox}}% + \setbox\z@\vbox{\hbox{$($}\kern\z@}\bigsize@1.2\ht\z@ + \fi + \normalbaselines\eightrm\dotsspace@1.5mu\ex@.2326ex\jot3\ex@ + \the\eightpoint@} +\message{page dimension settings,} +\parindent1pc +\newdimen\normalparindent \normalparindent\parindent +\normallineskiplimit\p@ +\newdimen\indenti \indenti=2pc +\def\pageheight#1{\vsize#1\relax} +\def\pagewidth#1{\hsize#1% + \captionwidth@\hsize \advance\captionwidth@-2\indenti} +\pagewidth{30pc} \pageheight{47pc} +\let\magnification=\mag +\message{top matter,} +\def\topmatter{% + \ifx\undefined\msafam + \else\font@\eightmsa=msam8 \font@\sixmsa=msam6 + \ifsyntax@\else \addto\tenpoint{\textfont\msafam\tenmsa + \scriptfont\msafam\sevenmsa \scriptscriptfont\msafam\fivemsa}% + \addto\eightpoint{\textfont\msafam\eightmsa + \scriptfont\msafam\sixmsa \scriptscriptfont\msafam\fivemsa}% + \fi + \fi + \ifx\undefined\msbfam + \else\font@\eightmsb=msbm8 \font@\sixmsb=msbm6 + \ifsyntax@\else \addto\tenpoint{\textfont\msbfam\tenmsb + \scriptfont\msbfam\sevenmsb \scriptscriptfont\msbfam\fivemsb}% + \addto\eightpoint{\textfont\msbfam\eightmsb + \scriptfont\msbfam\sixmsb \scriptscriptfont\msbfam\fivemsb}% + \fi + \fi + \ifx\undefined\eufmfam + \else \font@\eighteufm=eufm8 \font@\sixeufm=eufm6 + \ifsyntax@\else \addto\tenpoint{\textfont\eufmfam\teneufm + \scriptfont\eufmfam\seveneufm + \scriptscriptfont\eufmfam\fiveeufm}% + \addto\eightpoint{\textfont\eufmfam\eighteufm + \scriptfont\eufmfam\sixeufm + \scriptscriptfont\eufmfam\fiveeufm}% + \fi + \fi + \ifx\undefined\eufbfam + \else \font@\eighteufb=eufb8 \font@\sixeufb=eufb6 + \ifsyntax@\else \addto\tenpoint{\textfont\eufbfam\teneufb + \scriptfont\eufbfam\seveneufb + \scriptscriptfont\eufbfam\fiveeufb}% + \addto\eightpoint{\textfont\eufbfam\eighteufb + \scriptfont\eufbfam\sixeufb + \scriptscriptfont\eufbfam\fiveeufb}% + \fi + \fi + \ifx\undefined\eusmfam + \else \font@\eighteusm=eusm8 \font@\sixeusm=eusm6 + \ifsyntax@\else \addto\tenpoint{\textfont\eusmfam\teneusm + \scriptfont\eusmfam\seveneusm + \scriptscriptfont\eusmfam\fiveeusm}% + \addto\eightpoint{\textfont\eusmfam\eighteusm + \scriptfont\eusmfam\sixeusm + \scriptscriptfont\eusmfam\fiveeusm}% + \fi + \fi + \ifx\undefined\eusbfam + \else \font@\eighteusb=eusb8 \font@\sixeusb=eusb6 + \ifsyntax@\else \addto\tenpoint{\textfont\eusbfam\teneusb + \scriptfont\eusbfam\seveneusb + \scriptscriptfont\eusbfam\fiveeusb}% + \addto\eightpoint{\textfont\eusbfam\eighteusb + \scriptfont\eusbfam\sixeusb + \scriptscriptfont\eusbfam\fiveeusb}% + \fi + \fi + \ifx\undefined\eurmfam + \else \font@\eighteurm=eurm8 \font@\sixeurm=eurm6 + \ifsyntax@\else \addto\tenpoint{\textfont\eurmfam\teneurm + \scriptfont\eurmfam\seveneurm + \scriptscriptfont\eurmfam\fiveeurm}% + \addto\eightpoint{\textfont\eurmfam\eighteurm + \scriptfont\eurmfam\sixeurm + \scriptscriptfont\eurmfam\fiveeurm}% + \fi + \fi + \ifx\undefined\eurbfam + \else \font@\eighteurb=eurb8 \font@\sixeurb=eurb6 + \ifsyntax@\else \addto\tenpoint{\textfont\eurbfam\teneurb + \scriptfont\eurbfam\seveneurb + \scriptscriptfont\eurbfam\fiveeurb}% + \addto\eightpoint{\textfont\eurbfam\eighteurb + \scriptfont\eurbfam\sixeurb + \scriptscriptfont\eurbfam\fiveeurb}% + \fi + \fi + \ifx\undefined\cmmibfam + \else \font@\eightcmmib=cmmib8 \font@\sixcmmib=cmmib6 + \ifsyntax@\else \addto\tenpoint{\textfont\cmmibfam\tencmmib + \scriptfont\cmmibfam\sevencmmib + \scriptscriptfont\cmmibfam\fivecmmib}% + \addto\eightpoint{\textfont\cmmibfam\eightcmmib + \scriptfont\cmmibfam\sixcmmib + \scriptscriptfont\cmmibfam\fivecmmib}% + \fi + \fi + \ifx\undefined\cmbsyfam + \else \font@\eightcmbsy=cmbsy8 \font@\sixcmbsy=cmbsy6 + \ifsyntax@\else \addto\tenpoint{\textfont\cmbsyfam\tencmbsy + \scriptfont\cmbsyfam\sevencmbsy + \scriptscriptfont\cmbsyfam\fivecmbsy}% + \addto\eightpoint{\textfont\cmbsyfam\eightcmbsy + \scriptfont\cmbsyfam\sixcmbsy + \scriptscriptfont\cmbsyfam\fivecmbsy}% + \fi + \fi + \let\topmatter\relax} +\def\chapterno@{\uppercase\expandafter{\romannumeral\chaptercount@}} +\newcount\chaptercount@ +\def\chapter{\let\savedef@\chapter + \def\chapter##1{\let\chapter\savedef@ + \leavevmode\hskip-\leftskip + \rlap{\vbox to\z@{\vss\centerline{\eightpoint + \frills@{CHAPTER\space\afterassignment\chapterno@ + \global\chaptercount@=}% + ##1\unskip}\baselineskip2pc\null}}\hskip\leftskip}% + \nofrillscheck\chapter} +\newbox\titlebox@ +\def\title{\let\savedef@\title + \def\title##1\endtitle{\let\title\savedef@ + \global\setbox\titlebox@\vtop{\tenpoint\bf + \raggedcenter@ + \baselineskip1.3\baselineskip + \frills@\uppercasetext@{##1}\endgraf}% + \ifmonograph@ \edef\next{\the\leftheadtoks}% + \ifx\next\empty + \leftheadtext{##1}\fi + \fi + \edef\next{\the\rightheadtoks}\ifx\next\empty \rightheadtext{##1}\fi + }% + \nofrillscheck\title} +\newbox\authorbox@ +\def\author#1\endauthor{\global\setbox\authorbox@ + \vbox{\tenpoint\smc\raggedcenter@ + #1\endgraf}\relaxnext@ \edef\next{\the\leftheadtoks}% + \ifx\next\empty\leftheadtext{#1}\fi} +\newbox\affilbox@ +\def\affil#1\endaffil{\global\setbox\affilbox@ + \vbox{\tenpoint\raggedcenter@#1\endgraf}} +\newcount\addresscount@ +\addresscount@\z@ +\def\address#1\endaddress{\global\advance\addresscount@\@ne + \expandafter\gdef\csname address\number\addresscount@\endcsname + {\nobreak\vskip12\p@ minus6\p@\indent\eightpoint\smc#1\par}} +\def\curraddr{\let\savedef@\curraddr + \def\curraddr##1\endcurraddr{\let\curraddr\savedef@ + \toks@\expandafter\expandafter\expandafter{% + \csname address\number\addresscount@\endcsname}% + \toks@@{##1}% + \expandafter\xdef\csname address\number\addresscount@\endcsname + {\the\toks@\endgraf\noexpand\nobreak + \indent{\noexpand\rm + \frills@{{\noexpand\it Current address\noexpand\/}:\space}% + \def\noexpand\usualspace{\space}\the\toks@@\unskip}}}% + \nofrillscheck\curraddr} +\def\email{\let\savedef@\email + \def\email##1\endemail{\let\email\savedef@ + \toks@{\def\usualspace{{\it\enspace}}\endgraf\indent\eightpoint}% + \toks@@{##1\par}% + \expandafter\xdef\csname email\number\addresscount@\endcsname + {\the\toks@\frills@{{\noexpand\it E-mail address\noexpand\/}:% + \noexpand\enspace}\the\toks@@}}% + \nofrillscheck\email} +\def\thedate@{} +\def\date#1\enddate{\gdef\thedate@{\tenpoint#1\unskip}} +\def\thethanks@{} +\def\thanks#1\endthanks{% + \ifx\thethanks@\empty \gdef\thethanks@{\eightpoint#1}% + \else + \expandafter\gdef\expandafter\thethanks@\expandafter{% + \thethanks@\endgraf#1}% + \fi} +\def\thekeywords@{} +\def\keywords{\let\savedef@\keywords + \def\keywords##1\endkeywords{\let\keywords\savedef@ + \toks@{\def\usualspace{{\it\enspace}}\eightpoint}% + \toks@@{##1\unskip.}% + \edef\thekeywords@{\the\toks@\frills@{{\noexpand\it + Key words and phrases.\noexpand\enspace}}\the\toks@@}}% + \nofrillscheck\keywords} +\def\thesubjclass@{} +\def\subjclass{\let\savedef@\subjclass + \def\subjclass##1\endsubjclass{\let\subjclass\savedef@ + \toks@{\def\usualspace{{\rm\enspace}}\eightpoint}% + \toks@@{##1\unskip.}% + \edef\thesubjclass@{\the\toks@ + \frills@{{\noexpand\rm1991 {\noexpand\it Mathematics Subject + Classification}.\noexpand\enspace}}% + \the\toks@@}}% + \nofrillscheck\subjclass} +\newbox\abstractbox@ +\def\abstract{\let\savedef@\abstract + \def\abstract{\let\abstract\savedef@ + \setbox\abstractbox@\vbox\bgroup\noindent$$\vbox\bgroup + \def\envir@end{\endabstract}\advance\hsize-2\indenti + \def\usualspace{\enspace}\eightpoint \noindent + \frills@{{\smc Abstract.\enspace}}}% + \nofrillscheck\abstract} +\def\endabstract{\par\unskip\egroup$$\egroup} +\def\widestnumber{\begingroup \let\head\relax\let\subhead\relax + \let\subsubhead\relax \expandafter\endgroup\setwidest@} +\def\setwidest@#1#2{% + \ifx#1\head\setbox\tocheadbox@\hbox{#2.\enspace}% + \else\ifx#1\subhead\setbox\tocsubheadbox@\hbox{#2.\enspace}% + \else\ifx#1\subsubhead\setbox\tocsubheadbox@\hbox{#2.\enspace}% + \else\ifx#1\key\refstyle A% + \setboxz@h{\refsfont@\keyformat{#2}}% + \refindentwd\wd\z@ + \else\ifx#1\no\refstyle C% + \setboxz@h{\refsfont@\keyformat{#2}}% + \refindentwd\wd\z@ + \else\ifx#1\page\setbox\z@\hbox{\quad\bf#2}% + \pagenumwd\wd\z@ + \else\ifx#1\item + \edef\next@{\the\revert@\rosteritemwd\the\rosteritemwd\relax + \revert@{\the\revert@}}% + \revert@\expandafter{\next@}% + \setboxz@h{(#2)}\rosteritemwd\wdz@ + \else\message{\string\widestnumber\space not defined for this + option (\string#1)}% +\fi\fi\fi\fi\fi\fi\fi} +\newif\ifmonograph@ +\def\Monograph{\monograph@true \let\headmark\rightheadtext + \let\varindent@\indent \def\headfont@{\bf}\def\proclaimheadfont@{\smc}% + \def\remarkheadfont@{\smc}} +\let\varindent@\noindent +\newbox\tocheadbox@ \newbox\tocsubheadbox@ +\newbox\tocbox@ +\newdimen\pagenumwd +\def\toc{\toc@{Contents}} +\def\newtocdefs{% + \def \title##1\endtitle + {\penaltyandskip@\z@\smallskipamount + \hangindent\wd\tocheadbox@\noindent{\bf##1}}% + \def \chapter##1{% + Chapter \uppercase\expandafter{% + \romannumeral##1.\unskip}\enspace}% + \def \specialhead##1\endspecialhead + {\par\hangindent\wd\tocheadbox@ \noindent##1\par}% + \def \head##1 ##2\endhead + {\par\hangindent\wd\tocheadbox@ \noindent + \if\notempty{##1}\hbox to\wd\tocheadbox@{\hfil##1\enspace}\fi + ##2\par}% + \def \subhead##1 ##2\endsubhead + {\par\vskip-\parskip {\normalbaselines + \advance\leftskip\wd\tocheadbox@ + \hangindent\wd\tocsubheadbox@ \noindent + \if\notempty{##1}% + \hbox to\wd\tocsubheadbox@{##1\unskip\hfil}\fi + ##2\par}}% + \def \subsubhead##1 ##2\endsubsubhead + {\par\vskip-\parskip {\normalbaselines + \advance\leftskip\wd\tocheadbox@ + \hangindent\wd\tocsubheadbox@ \noindent + \if\notempty{##1}% + \hbox to\wd\tocsubheadbox@{##1\unskip\hfil}\fi + ##2\par}}} +\def\toc@#1{\relaxnext@ + \DN@{\ifx\next\nofrills\DN@\nofrills{\nextii@}% + \else\DN@{\nextii@{{#1}}}\fi + \next@}% + \DNii@##1{% +\ifmonograph@\bgroup\else\setbox\tocbox@\vbox\bgroup + \centerline{\headfont@\ignorespaces##1\unskip}\nobreak + \vskip\belowheadskip \fi + \def\page####1% + {\unskip\penalty\z@\null\hfil + \rlap{\hbox to\pagenumwd{\quad\hfil####1}}% + \hfilneg\penalty\@M}% + \setbox\tocheadbox@\hbox{0.\enspace}% + \setbox\tocsubheadbox@\hbox{0.0.\enspace}% + \leftskip\indenti \rightskip\leftskip + \setboxz@h{\bf\quad000}\pagenumwd\wd\z@ + \advance\rightskip\pagenumwd + \newtocdefs + }% + \FN@\next@} +\def\endtoc{\par\egroup} +\let\pretitle\relax +\let\preauthor\relax +\let\preaffil\relax +\let\predate\relax +\let\preabstract\relax +\let\prepaper\relax +\def\dedicatory #1\enddedicatory{\def\preabstract{{\medskip + \eightpoint\it \raggedcenter@#1\endgraf}}} +\def\thetranslator@{} +\def\translator{% + \let\savedef@\translator + \def\translator##1\endtranslator{\let\translator\savedef@ + \edef\thetranslator@{\noexpand\nobreak\noexpand\medskip + \noexpand\line{\noexpand\eightpoint\hfil + \frills@{Translated by \uppercase}{##1}\qquad\qquad}% + \noexpand\nobreak}}% + \nofrillscheck\translator} +\outer\def\endtopmatter{\add@missing\endabstract + \edef\next{\the\leftheadtoks}\ifx\next\empty + \expandafter\leftheadtext\expandafter{\the\rightheadtoks}\fi + \ifmonograph@\else + \ifx\thesubjclass@\empty\else \makefootnote@{}{\thesubjclass@}\fi + \ifx\thekeywords@\empty\else \makefootnote@{}{\thekeywords@}\fi + \ifx\thethanks@\empty\else \makefootnote@{}{\thethanks@}\fi + \fi + \pretitle + \begingroup % to localize variant topskip + \ifmonograph@ \topskip7pc \else \topskip4pc \fi + \box\titlebox@ + \endgroup + \preauthor + \ifvoid\authorbox@\else \vskip2.5pcplus1pc\unvbox\authorbox@\fi + \preaffil + \ifvoid\affilbox@\else \vskip1pcplus.5pc\unvbox\affilbox@\fi + \predate + \ifx\thedate@\empty\else + \vskip1pcplus.5pc\line{\hfil\thedate@\hfil}\fi + \preabstract + \ifvoid\abstractbox@\else + \vskip1.5pcplus.5pc\unvbox\abstractbox@ \fi + \ifvoid\tocbox@\else\vskip1.5pcplus.5pc\unvbox\tocbox@\fi + \prepaper + \vskip2pcplus1pc\relax +} +\def\document{\let\fontlist@\relax\let\alloclist@\relax + \tenpoint} +\message{section heads,} +\newskip\aboveheadskip \aboveheadskip\bigskipamount +\newdimen\belowheadskip \belowheadskip6\p@ +\def\headfont@{\smc} +\def\penaltyandskip@#1#2{\par\skip@#2\relax + \ifdim\lastskip<\skip@\relax\removelastskip + \ifnum#1=\z@\else\penalty@#1\relax\fi\vskip\skip@ + \else\ifnum#1=\z@\else\penalty@#1\relax\fi\fi} +\def\nobreak{\penalty\@M + \ifvmode\gdef\penalty@{\global\let\penalty@\penalty\count@@@}% + \everypar{\global\let\penalty@\penalty\everypar{}}\fi} +\let\penalty@\penalty +\def\heading#1\endheading{\head#1\endhead} +\def\subheading{\DN@{\ifx\next\nofrills + \expandafter\subheading@ + \else \expandafter\subheading@\expandafter\empty + \fi}% + \FN@\next@ +} +\def\subheading@#1#2{\subhead#1#2\endsubhead} +\def\specialheadfont@{\bf} +\outer\def\specialhead{% + \add@missing\endroster \add@missing\enddefinition + \add@missing\enddemo \add@missing\endexample + \add@missing\endproclaim + \penaltyandskip@{-200}\aboveheadskip + \begingroup\interlinepenalty\@M\rightskip\z@ plus\hsize + \let\\\linebreak + \specialheadfont@\noindent} +\def\endspecialhead{\par\endgroup\nobreak\vskip\belowheadskip} +\outer\def\head#1\endhead{% + \add@missing\endroster \add@missing\enddefinition + \add@missing\enddemo \add@missing\endexample + \add@missing\endproclaim + \penaltyandskip@{-200}\aboveheadskip + {\headfont@\raggedcenter@\interlinepenalty\@M + #1\endgraf}\headmark{#1}% + \nobreak + \vskip\belowheadskip} +\let\headmark\eat@ +\def\restoredef@#1{\relax\let#1\savedef@\let\savedef@\relax} +\newskip\subheadskip \subheadskip\medskipamount +\def\subheadfont@{\bf} +\outer\def\subhead{% + \add@missing\endroster \add@missing\enddefinition + \add@missing\enddemo \add@missing\endexample + \add@missing\endproclaim + \let\savedef@\subhead \let\subhead\relax + \def\subhead##1\endsubhead{\restoredef@\subhead + \penaltyandskip@{-100}\subheadskip + \varindent@{\def\usualspace{{\subheadfont@\enspace}}% + \subheadfont@\ignorespaces##1\unskip\frills@{.\enspace}}% + \ignorespaces}% + \nofrillscheck\subhead} +\outer\def\subsubhead{% + \add@missing\endroster \add@missing\enddefinition + \add@missing\enddemo + \add@missing\endexample \add@missing\endproclaim + \let\savedef@\subsubhead \let\subsubhead\relax + \def\subsubhead##1\endsubsubhead{\restoredef@\subsubhead + \penaltyandskip@{-50}\medskipamount + {\def\usualspace{\/{\it\enspace}}% + \it##1\unskip\frills@{.\enspace}}}% + \nofrillscheck\subsubhead} +\message{theorems/proofs/definitions/remarks,} +\def\proclaimheadfont@{\bf} +\outer\def\proclaim{% + \let\savedef@\proclaim \let\proclaim\relax + \add@missing\endroster \add@missing\enddefinition + \add@missing\endproclaim \envir@stack\endproclaim + \def\proclaim##1{\restoredef@\proclaim + \penaltyandskip@{-100}\medskipamount\varindent@ + \def\usualspace{{\proclaimheadfont@\enspace}}\proclaimheadfont@ + \ignorespaces##1\unskip\frills@{.\enspace}% + \sl\ignorespaces}% + \nofrillscheck\proclaim} +\def\endproclaim{\revert@envir\endproclaim \par\rm + \penaltyandskip@{55}\medskipamount} +\def\remarkheadfont@{\it} +\def\remark{\let\savedef@\remark \let\remark\relax + \add@missing\endroster \add@missing\endproclaim + \envir@stack\endremark + \def\remark##1{\restoredef@\remark + \penaltyandskip@\z@\medskipamount + {\def\usualspace{{\remarkheadfont@\enspace}}% + \varindent@\remarkheadfont@\ignorespaces##1\unskip% + \frills@{.\enspace}}\rm + \ignorespaces}\nofrillscheck\remark} +\def\endremark{\par\revert@envir\endremark} +\ifx\undefined\square + \def\square{\vrule width.6em height.5em depth.1em\relax}\fi +\def\qed{\ifhmode\unskip\nobreak\fi\quad + \ifmmode\square\else$\m@th\square$\fi} +\def\demo{\DN@{\ifx\next\nofrills + \DN@####1####2{\remark####1{####2}\envir@stack\enddemo + \ignorespaces}% + \else + \DN@####1{\remark{####1}\envir@stack\enddemo\ignorespaces}% + \fi + \next@}% +\FN@\next@} + +\def\enddemo{\par\revert@envir\enddemo \endremark\medskip} +\def\definition{\let\savedef@\definition \let\definition\relax + \add@missing\endproclaim \add@missing\endroster + \add@missing\enddefinition \envir@stack\enddefinition + \def\definition##1{\restoredef@\definition + \penaltyandskip@{-100}\medskipamount + {\def\usualspace{{\proclaimheadfont@\enspace}}% + \varindent@\proclaimheadfont@\ignorespaces##1\unskip + \frills@{.\proclaimheadfont@\enspace}}% + \rm \ignorespaces}% + \nofrillscheck\definition} +\def\enddefinition{\revert@envir\enddefinition + \par\medskip} +\def\example{\DN@{\ifx\next\nofrills + \DN@####1####2{\definition####1{####2}\envir@stack\endexample + \ignorespaces}% + \else + \DN@####1{\definition{####1}\envir@stack\endexample\ignorespaces}% + \fi + \next@}% +\FN@\next@} +\def\endexample{\revert@envir\endexample \enddefinition } +\message{rosters,} +\newdimen\rosteritemwd +\rosteritemwd16pt % approximately the width of (iii) in 10 point text +\newcount\rostercount@ +\newif\iffirstitem@ +\let\plainitem@\item +\newtoks\everypartoks@ +\def\par@{\everypartoks@\expandafter{\the\everypar}\everypar{}} +\def\leftskip@{} +\def\roster{% + \envir@stack\endroster + \edef\leftskip@{\leftskip\the\leftskip}% + \relaxnext@ + \rostercount@\z@% Initialize \rostercount@ to 0. + \def\item{\FN@\rosteritem@}% \item, now redefined, has + \DN@{\ifx\next\runinitem\let\next@\nextii@\else + \let\next@\nextiii@\fi\next@}% + \DNii@\runinitem% If \runinitem occurs, \nextii@ must kill it off. + {\unskip% This unskips any space before the original \roster. + \DN@{\ifx\next[\let\next@\nextii@\else + \ifx\next"\let\next@\nextiii@\else\let\next@\nextiv@\fi\fi\next@}% + \DNii@[####1]{\rostercount@####1\relax + \enspace\therosteritem{\number\rostercount@}~\ignorespaces}% + \def\nextiii@"####1"{\enspace{\rm####1}~\ignorespaces}% + \def\nextiv@{\enspace\therosteritem1\rostercount@\@ne~}% + \par@\firstitem@false% Before doing any of this we still change + \FN@\next@}% End of definition of \nextii@\runinitem. + \def\nextiii@{\par\par@% End the present paragraph, change \everypar + \penalty\@m\smallskip\vskip-\parskip + \firstitem@true} + \FN@\next@} +\def\rosteritem@{\iffirstitem@\firstitem@false + \else\par\vskip-\parskip\fi + \leftskip\rosteritemwd \advance\leftskip\normalparindent + \advance\leftskip.5em \noindent + \DNii@[##1]{\rostercount@##1\relax\itembox@}% + \def\nextiii@"##1"{\def\therosteritem@{\rm##1}\itembox@}% + \def\nextiv@{\advance\rostercount@\@ne\itembox@}% + \def\therosteritem@{\therosteritem{\number\rostercount@}}% + \ifx\next[\let\next@\nextii@\else\ifx\next"\let\next@\nextiii@\else + \let\next@\nextiv@\fi\fi\next@} +\def\itembox@{\llap{\hbox to\rosteritemwd{\hss + \kern\z@ % kern to thwart \unskip in \rom + \therosteritem@}\enspace}\ignorespaces} +\def\therosteritem#1{\rom{(\ignorespaces#1\unskip)}} +\newif\ifnextRunin@ +\def\endroster{\relaxnext@ + \revert@envir\endroster % restore \envir@end + \par\leftskip@% End the paragraph, and restore the \leftskip. + \global\rosteritemwd16\p@ % restore default value + \penalty-50 \vskip-\parskip\smallskip% Add a good break and + \DN@{\ifx\next\Runinitem\let\next@\relax + \else\nextRunin@false\let\item\plainitem@% Otherwise, set + \ifx\next\par% moreover, if \endroster is followed by \par, + \DN@\par{\everypar\expandafter{\the\everypartoks@}}% + \else% but if the \endroster isn't followed by a new paragraph, + \DN@{\noindent\everypar\expandafter{\the\everypartoks@}}% + \fi\fi\next@}% + \FN@\next@} +\newcount\rosterhangafter@ +\def\Runinitem#1\roster\runinitem{\relaxnext@ + \envir@stack\endroster + \rostercount@\z@ + \def\item{\FN@\rosteritem@}% + \def\runinitem@{#1}% + \DN@{\ifx\next[\let\next\nextii@\else\ifx\next"\let\next\nextiii@ + \else\let\next\nextiv@\fi\fi\next}% + \DNii@[##1]{\rostercount@##1\relax + \def\item@{\therosteritem{\number\rostercount@}}\nextv@}% + \def\nextiii@"##1"{\def\item@{{\rm##1}}\nextv@}% + \def\nextiv@{\advance\rostercount@\@ne + \def\item@{\therosteritem{\number\rostercount@}}\nextv@}% + \def\nextv@{\setbox\z@\vbox + {\ifnextRunin@\noindent\fi + \runinitem@\unskip\enspace\item@~\par + \global\rosterhangafter@\prevgraf}% + \firstitem@false% Set \firstitem@false for future \item's. + \ifnextRunin@\else\par\fi + \hangafter\rosterhangafter@\hangindent3\normalparindent + \ifnextRunin@\noindent\fi + \runinitem@\unskip\enspace% Put in all the stored stuff + \item@~\ifnextRunin@\else\par@\fi% and the \item@, and + \nextRunin@true\ignorespaces}%% Here's where we set \nextRunin@true. + \FN@\next@} +\message{footnotes,} +\def\footmarkform@#1{$\m@th^{#1}$} +\let\thefootnotemark\footmarkform@ +\def\makefootnote@#1#2{\insert\footins + {\interlinepenalty\interfootnotelinepenalty + \eightpoint\splittopskip\ht\strutbox\splitmaxdepth\dp\strutbox + \floatingpenalty\@MM\leftskip\z@\rightskip\z@ + \spaceskip\z@\xspaceskip\z@ + \leavevmode{#1}\footstrut\ignorespaces#2\unskip\lower\dp\strutbox + \vbox to\dp\strutbox{}}} +\newcount\footmarkcount@ +\footmarkcount@\z@ +\def\footnotemark{\let\@sf\empty\relaxnext@ + \ifhmode\edef\@sf{\spacefactor\the\spacefactor}\/\fi + \DN@{\ifx[\next\let\next@\nextii@\else + \ifx"\next\let\next@\nextiii@\else + \let\next@\nextiv@\fi\fi\next@}% + \DNii@[##1]{\footmarkform@{##1}\@sf}% + \def\nextiii@"##1"{{##1}\@sf}% + \def\nextiv@{\iffirstchoice@\global\advance\footmarkcount@\@ne\fi + \footmarkform@{\number\footmarkcount@}\@sf}% + \FN@\next@} +\def\footnotetext{\relaxnext@ + \DN@{\ifx[\next\let\next@\nextii@\else + \ifx"\next\let\next@\nextiii@\else + \let\next@\nextiv@\fi\fi\next@}% + \DNii@[##1]##2{\makefootnote@{\footmarkform@{##1}}{##2}}% + \def\nextiii@"##1"##2{\makefootnote@{##1}{##2}}% + \def\nextiv@##1{\makefootnote@{\footmarkform@% + {\number\footmarkcount@}}{##1}}% + \FN@\next@} +\def\footnote{\let\@sf\empty\relaxnext@ + \ifhmode\edef\@sf{\spacefactor\the\spacefactor}\/\fi + \DN@{\ifx[\next\let\next@\nextii@\else + \ifx"\next\let\next@\nextiii@\else + \let\next@\nextiv@\fi\fi\next@}% + \DNii@[##1]##2{\footnotemark[##1]\footnotetext[##1]{##2}}% + \def\nextiii@"##1"##2{\footnotemark"##1"\footnotetext"##1"{##2}}% + \def\nextiv@##1{\footnotemark\footnotetext{##1}}% + \FN@\next@} +\def\adjustfootnotemark#1{\advance\footmarkcount@#1\relax} +\def\footnoterule{\kern-3\p@ + \hrule width5pc\kern 2.6\p@}% the \hrule is .4pt high +\message{figures and captions,} +\def\captionfont@{\smc} +\def\topcaption#1#2\endcaption{% + {\dimen@\hsize \advance\dimen@-\captionwidth@ + \rm\raggedcenter@ \advance\leftskip.5\dimen@ \rightskip\leftskip + {\captionfont@#1}% + \if\notempty{#2}.\enspace\ignorespaces#2\fi + \endgraf}\nobreak\bigskip} +\def\botcaption#1#2\endcaption{% + \nobreak\bigskip + \setboxz@h{\captionfont@#1\if\notempty{#2}.\enspace\rm#2\fi}% + {\dimen@\hsize \advance\dimen@-\captionwidth@ + \leftskip.5\dimen@ \rightskip\leftskip + \noindent \ifdim\wdz@>\captionwidth@ + \else\hfil\fi + {\captionfont@#1}% + \if\notempty{#2}.\enspace\rm#2\fi\endgraf}} +\def\@ins{\par\begingroup\def\vspace##1{\vskip##1\relax}% + \def\captionwidth##1{\captionwidth@##1\relax}% + \setbox\z@\vbox\bgroup} % start a \vbox +\message{miscellaneous,} +\def\block{\RIfMIfI@\nondmatherr@\block\fi + \else\ifvmode\noindent$$\predisplaysize\hsize + \else$$\fi + \def\endblock{\par\egroup$$}\fi + \vbox\bgroup\advance\hsize-2\indenti\noindent} +\def\endblock{\par\egroup} +\def\cite#1{\rom{[{\citefont@\m@th#1}]}} +\def\citefont@{\rm} +\def\rom#1{\leavevmode\skip@\lastskip\unskip\/% + \ifdim\skip@=\z@\else\hskip\skip@\fi{\rm#1}} +\message{references,} +\def\refsfont@{\eightpoint} +\newdimen\refindentwd +\setboxz@h{\refsfont@ 00.\enspace} +\refindentwd\wdz@ +\outer\def\Refs{\add@missing\endroster \add@missing\endproclaim + \let\savedef@\Refs \let\Refs\relax % because of \outer-ness + \def\Refs##1{\restoredef@\Refs + \if\notempty{##1}\penaltyandskip@{-200}\aboveheadskip + \begingroup \raggedcenter@\headfont@ + \ignorespaces##1\endgraf\endgroup + \penaltyandskip@\@M\belowheadskip + \fi + \begingroup\def\envir@end{\endRefs}\refsfont@\sfcode`\.\@m + }% + \nofrillscheck{\csname Refs\expandafter\endcsname + \frills@{{References}}}} +\def\endRefs{\par % This will check for a missing \endref, also + \endgroup} +\newif\ifbook@ \newif\ifprocpaper@ +\def\nofrills{% + \expandafter\ifx\envir@end\endref + \let\do\relax + \xdef\nofrills@list{\nofrills@list\do\curbox}% + \else\errmessage{\Invalid@@ \string\nofrills}% + \fi}% +\def\defaultreftexts{\gdef\edtext{ed.}\gdef\pagestext{pp.}% + \gdef\voltext{vol.}\gdef\issuetext{no.}} +\defaultreftexts +\def\ref{\par + \begingroup \def\envir@end{\endref}% + \noindent\hangindent\refindentwd + \def\par{\add@missing\endref}% + \global\let\nofrills@list\empty + \refbreaks + \procpaper@false \book@false + \def\curbox{\z@}\setbox\z@\vbox\bgroup +} +\let\keyhook@\empty +\def\endref{% + \setbox\tw@\box\thr@@ + \makerefbox?\thr@@{\endgraf\egroup}% + \endref@ + \endgraf + \endgroup + \keyhook@ + \global\let\keyhook@\empty % \global to conserve save stack +} +\def\key{\gdef\key{\makerefbox\key\keybox@\empty}\key} \newbox\keybox@ +\def\no{\gdef\no{\makerefbox\no\keybox@\empty}% + \gdef\keyhook@{\refstyle C}\no} +\def\by{\makerefbox\by\bybox@\empty} \newbox\bybox@ +\let\manyby\by % for backward compatibility +\def\bysame{\by\hbox to3em{\hrulefill}\thinspace\kern\z@} +\def\paper{\makerefbox\paper\paperbox@\it} \newbox\paperbox@ +\def\paperinfo{\makerefbox\paperinfo\paperinfobox@\empty}% + \newbox\paperinfobox@ +\def\jour{\makerefbox\jour\jourbox@ + {\aftergroup\book@false \aftergroup\procpaper@false}} \newbox\jourbox@ +\def\issue{\makerefbox\issue\issuebox@\empty} \newbox\issuebox@ +\def\yr{\makerefbox\yr\yrbox@\empty} \newbox\yrbox@ +\def\pages{\makerefbox\pages\pagesbox@\empty} \newbox\pagesbox@ +\def\page{\gdef\pagestext{p.}\makerefbox\page\pagesbox@\empty} +\def\ed{\makerefbox\ed\edbox@\empty} \newbox\edbox@ +\def\eds{\gdef\edtext{eds.}\makerefbox\eds\edbox@\empty} +\def\book{\makerefbox\book\bookbox@ + {\it\aftergroup\book@true \aftergroup\procpaper@false}} + \newbox\bookbox@ +\def\bookinfo{\makerefbox\bookinfo\bookinfobox@\empty}% + \newbox\bookinfobox@ +\def\publ{\makerefbox\publ\publbox@\empty} \newbox\publbox@ +\def\publaddr{\makerefbox\publaddr\publaddrbox@\empty}% + \newbox\publaddrbox@ +\def\inbook{\makerefbox\inbook\bookbox@ + {\aftergroup\procpaper@true \aftergroup\book@false}} +\def\procinfo{\makerefbox\procinfo\procinfobox@\empty}% + \newbox\procinfobox@ +\def\finalinfo{\makerefbox\finalinfo\finalinfobox@\empty}% + \newbox\finalinfobox@ +\def\miscnote{\makerefbox\miscnote\miscnotebox@\empty}% + \newbox\miscnotebox@ +\def\toappear{\miscnote to appear} +\def\lang{\makerefbox\lang\langbox@\empty} \newbox\langbox@ +\newbox\morerefbox@ +\def\vol{\makerefbox\vol\volbox@{\ifbook@ \else + \ifprocpaper@\else\bf\fi\fi}} +\newbox\volbox@ +\newbox\holdoverbox +\def\makerefbox#1#2#3{\endgraf + \setbox\z@\lastbox + \global\setbox\@ne\hbox{\unhbox\holdoverbox + \ifvoid\z@\else\unhbox\z@\unskip\unskip\unpenalty\fi}% + \egroup + \setbox\curbox\box\ifdim\wd\@ne>\z@ \@ne \else\voidb@x\fi + \ifvoid#2\else\Err@{Redundant \string#1; duplicate use, or + mutually exclusive information already given}\fi + \def\curbox{#2}\setbox\curbox\vbox\bgroup \hsize\maxdimen \noindent + #3} +\def\refbreaks{% + \def\refconcat##1{\setbox\z@\lastbox \setbox\holdoverbox\hbox{% + \unhbox\holdoverbox \unhbox\z@\unskip\unskip\unpenalty##1}}% + \def\holdover##1{% + \RIfM@ + \penalty-\@M\null + \hfil$\clubpenalty\z@\widowpenalty\z@\interlinepenalty\z@ + \offinterlineskip\endgraf + \setbox\z@\lastbox\unskip \unpenalty + \refconcat{##1}% + \noindent + $\hfil\penalty-\@M + \else + \endgraf\refconcat{##1}\noindent + \fi}% + \def\break{\holdover{\penalty-\@M}}% + \let\vadjust@\vadjust + \def\vadjust##1{\holdover{\vadjust@{##1}}}% + \def\newpage{\vadjust{\vfill\break}}% +} +\def\refstyle#1{\uppercase{% + \if#1A\relax \def\keyformat##1{[##1]\enspace\hfil}% + \else\if#1B\relax + \def\keyformat##1{\aftergroup\kern + \aftergroup-\aftergroup\refindentwd}% + \refindentwd\parindent + \else\if#1C\relax + \def\keyformat##1{\hfil##1.\enspace}% + \fi\fi\fi}% end of \uppercase +} +\refstyle{A} +\def\finalpunct{\ifnum\lastkern=\m@ne\unkern\else.\fi + \refquotes@\refbreak@}% +\def\continuepunct#1#2#3#4{}% +\def\endref@{% + \keyhook@ + \def\nofrillscheck##1{% + \def\do####1{\ifx##1####1\let\frills@\eat@\fi}% + \let\frills@\identity@ \nofrills@list}% + \ifvoid\bybox@ + \ifvoid\edbox@ + \else\setbox\bybox@\hbox{\unhbox\edbox@\breakcheck + \nofrillscheck\edbox@\frills@{\space(\edtext)}\refbreak@}\fi + \fi + \ifvoid\keybox@\else\hbox to\refindentwd{% + \keyformat{\unhbox\keybox@}}\fi + \commaunbox@\morerefbox@ + \ppunbox@\empty\empty\bybox@\empty + \ifbook@ % Case 1: \book etc. + \commaunbox@\bookbox@ \commaunbox@\bookinfobox@ + \ppunbox@\empty{ (}\procinfobox@)% + \ppunbox@,{ vol.~}\volbox@\empty + \ppunbox@\empty{ (}\edbox@{, \edtext)}% + \commaunbox@\publbox@ \commaunbox@\publaddrbox@ + \commaunbox@\yrbox@ + \ppunbox@,{ \pagestext~}\pagesbox@\empty + \else + \commaunbox@\paperbox@ \commaunbox@\paperinfobox@ + \ifprocpaper@ % Case 2: \paper ... \inbook + \commaunbox@\bookbox@ + \ppunbox@\empty{ (}\procinfobox@)% + \ppunbox@\empty{ (}\edbox@{, \edtext)}% + \commaunbox@\bookinfobox@ + \ppunbox@,{ \voltext~}\volbox@\empty + \commaunbox@\publbox@ \commaunbox@\publaddrbox@ + \commaunbox@\yrbox@ + \ppunbox@,{ \pagestext~}\pagesbox@\empty + \else % Case 3: \paper ... \jour + \commaunbox@\jourbox@ + \ppunbox@\empty{ }\volbox@\empty + \ppunbox@\empty{ (}\yrbox@)% + \ppunbox@,{ \issuetext~}\issuebox@\empty + \commaunbox@\publbox@ \commaunbox@\publaddrbox@ + \commaunbox@\pagesbox@ + \fi + \fi + \commaunbox@\finalinfobox@ + \ppunbox@\empty{ (}\miscnotebox@)% + \finalpunct\ppunbox@\empty{ (}\langbox@)% + \defaultreftexts +} +\def\punct@#1{#1} +\def\ppunbox@#1#2#3#4{\ifvoid#3\else + \ifnum\lastkern=\m@ne\unkern\let\punct@\eat@\fi + \nofrillscheck#3% + \punct@{#1}\refquotes@\refbreak@ + \let\punct@\identity@ + \frills@{#2\eat@}\space + \unhbox#3\breakcheck + \frills@{#4\eat@}{\kern\m@ne sp}\fi} +\def\commaunbox@#1{\ppunbox@,\space{#1}\empty} +\def\breakcheck{\edef\refbreak@{\ifnum\lastpenalty=\z@\else + \penalty\the\lastpenalty\relax\fi}\unpenalty} +\def\endquotes{\def\refquotes@{''\let\refquotes@\empty}} +\let\refquotes@\empty +\let\refbreak@\empty +\def\moreref{% + \setbox\tw@\box\thr@@ + \makerefbox?\thr@@{\endgraf\egroup}% + \let\savedef@\finalpunct \let\finalpunct\empty + \endref@ + \def\punct@##1##2{##2;}% + \global\let\nofrills@list\empty % global, to conserve save stack + \let\finalpunct\savedef@ + \def\curbox{\morerefbox@}% + \setbox\morerefbox@\vbox\bgroup \hsize\maxdimen \noindent +} +\def\transl{\moreref} +\message{end of document,} +\outer\def\enddocument{\par% \par will do a runaway check for \endref + \add@missing\endRefs + \add@missing\endroster \add@missing\endproclaim + \add@missing\enddefinition + \add@missing\enddemo \add@missing\endremark \add@missing\endexample + \ifmonograph@ % do nothing + \else + \nobreak + \thetranslator@ + \count@\z@ \loop\ifnum\count@<\addresscount@\advance\count@\@ne + \csname address\number\count@\endcsname + \csname email\number\count@\endcsname + \repeat +\fi + \vfill\supereject\end} +\message{output routine,} +\def\folio{{\foliofont@\ifnum\pageno<\z@ \romannumeral-\pageno + \else\number\pageno \fi}} +\def\foliofont@{\eightrm} +\def\headlinefont@{\eightpoint} +\def\leftheadline{\rlap{\folio}\hfill \iftrue\topmark\fi \hfill} +\def\rightheadline{\hfill \expandafter\iffalse\botmark\fi + \hfill \llap{\folio}} +\newtoks\leftheadtoks +\newtoks\rightheadtoks +\def\leftheadtext{\let\savedef@\leftheadtext + \def\leftheadtext##1{\let\leftheadtext\savedef@ + \leftheadtoks\expandafter{\frills@\uppercasetext@{##1}}% + \mark{\the\leftheadtoks\noexpand\else\the\rightheadtoks} + \ifsyntax@\setboxz@h{\def\\{\unskip\space\ignorespaces}% + \headlinefont@##1}\fi}% + \nofrillscheck\leftheadtext} +\def\rightheadtext{\let\savedef@\rightheadtext + \def\rightheadtext##1{\let\rightheadtext\savedef@ + \rightheadtoks\expandafter{\frills@\uppercasetext@{##1}}% + \mark{\the\leftheadtoks\noexpand\else\the\rightheadtoks}% + \ifsyntax@\setboxz@h{\def\\{\unskip\space\ignorespaces}% + \headlinefont@##1}\fi}% + \nofrillscheck\rightheadtext} +\headline={\def\chapter#1{\chapterno@. }% + \def\\{\unskip\space\ignorespaces}\headlinefont@ + \ifodd\pageno \rightheadline \else \leftheadline\fi} +\def\NoRunningHeads{\global\runheads@false\global\let\headmark\eat@} +\def\NoPageNumbers{\gdef\folio{}} +\def\logo@{\baselineskip2pc \hbox to\hsize{\hfil\eightpoint Typeset by + \AmSTeX}} +\newif\iffirstpage@ \firstpage@true +\newif\ifrunheads@ \runheads@true +\output={\output@} +\def\output@{\shipout\vbox{% + \iffirstpage@ \global\firstpage@false + \pagebody \logo@ \makefootline% + \else \ifrunheads@ \makeheadline \pagebody + \else \pagebody \makefootline \fi + \fi}% + \advancepageno \ifnum\outputpenalty>-\@MM\else\dosupereject\fi} +\message{hyphenation exceptions (U.S. English)} +\hyphenation{acad-e-my acad-e-mies af-ter-thought anom-aly anom-alies +an-ti-deriv-a-tive an-tin-o-my an-tin-o-mies apoth-e-o-ses +apoth-e-o-sis ap-pen-dix ar-che-typ-al as-sign-a-ble as-sist-ant-ship +as-ymp-tot-ic asyn-chro-nous at-trib-uted at-trib-ut-able bank-rupt +bank-rupt-cy bi-dif-fer-en-tial blue-print busier busiest +cat-a-stroph-ic cat-a-stroph-i-cally con-gress cross-hatched data-base +de-fin-i-tive de-riv-a-tive dis-trib-ute dri-ver dri-vers eco-nom-ics +econ-o-mist elit-ist equi-vari-ant ex-quis-ite ex-tra-or-di-nary +flow-chart for-mi-da-ble forth-right friv-o-lous ge-o-des-ic +ge-o-det-ic geo-met-ric griev-ance griev-ous griev-ous-ly +hexa-dec-i-mal ho-lo-no-my ho-mo-thetic ideals idio-syn-crasy +in-fin-ite-ly in-fin-i-tes-i-mal ir-rev-o-ca-ble key-stroke +lam-en-ta-ble light-weight mal-a-prop-ism man-u-script mar-gin-al +meta-bol-ic me-tab-o-lism meta-lan-guage me-trop-o-lis +met-ro-pol-i-tan mi-nut-est mol-e-cule mono-chrome mono-pole +mo-nop-oly mono-spline mo-not-o-nous mul-ti-fac-eted mul-ti-plic-able +non-euclid-ean non-iso-mor-phic non-smooth par-a-digm par-a-bol-ic +pa-rab-o-loid pa-ram-e-trize para-mount pen-ta-gon phe-nom-e-non +post-script pre-am-ble pro-ce-dur-al pro-hib-i-tive pro-hib-i-tive-ly +pseu-do-dif-fer-en-tial pseu-do-fi-nite pseu-do-nym qua-drat-ic +quad-ra-ture qua-si-smooth qua-si-sta-tion-ary qua-si-tri-an-gu-lar +quin-tes-sence quin-tes-sen-tial re-arrange-ment rec-tan-gle +ret-ri-bu-tion retro-fit retro-fit-ted right-eous right-eous-ness +ro-bot ro-bot-ics sched-ul-ing se-mes-ter semi-def-i-nite +semi-ho-mo-thet-ic set-up se-vere-ly side-step sov-er-eign spe-cious +spher-oid spher-oid-al star-tling star-tling-ly sta-tis-tics +sto-chas-tic straight-est strange-ness strat-a-gem strong-hold +sum-ma-ble symp-to-matic syn-chro-nous topo-graph-i-cal tra-vers-a-ble +tra-ver-sal tra-ver-sals treach-ery turn-around un-at-tached +un-err-ing-ly white-space wide-spread wing-spread wretch-ed +wretch-ed-ly Brown-ian Eng-lish Euler-ian Feb-ru-ary Gauss-ian +Grothen-dieck Hamil-ton-ian Her-mit-ian Jan-u-ary Japan-ese Kor-te-weg +Le-gendre Lip-schitz Lip-schitz-ian Mar-kov-ian Noe-ther-ian +No-vem-ber Rie-mann-ian Schwarz-schild Sep-tem-ber} +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\tenpoint +\W@{} +\csname amsppt.sty\endcsname +\endinput +%% +%% End of file `amsppt.sty'. diff --git a/systems/knuth/local/lib/amssym.def b/systems/knuth/local/lib/amssym.def new file mode 100644 index 0000000000..563047d0ba --- /dev/null +++ b/systems/knuth/local/lib/amssym.def @@ -0,0 +1,108 @@ +%% @texfile{ +%% filename="amssym.def", +%% version="2.1", +%% date="5-APR-1991", +%% filetype="TeX: option", +%% copyright="Copyright (C) American Mathematical Society, +%% all rights reserved. Copying of this file is +%% authorized only if either: +%% (1) you make absolutely no changes to your copy +%% including name; OR +%% (2) if you do make changes, you first rename it to some +%% other name.", +%% author="American Mathematical Society", +%% address="American Mathematical Society, +%% Technical Support Group, +%% P. O. Box 6248, +%% Providence, RI 02940, +%% USA", +%% telephone="401-455-4080 or (in the USA) 800-321-4AMS", +%% email="Internet: Tech-Support@Math.AMS.com", +%% codetable="ISO/ASCII", +%% checksumtype="line count", +%% checksum="108", +%% keywords="amsfonts, tex", +%% abstract="This file contains definitions that perform the same +%% functions as similar ones in AMS-TeX, so that the file +%% AMSSYM.TEX can be used outside of AMS-TeX. Instructions +%% for using this file and the AMS symbol fonts are +%% included in the AMSFonts 2.0 User's Guide." +%% } +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +\expandafter\ifx\csname amssym.def\endcsname\relax \else\endinput\fi +% +% Store the catcode of the @ in the csname so that it can be restored later. +\expandafter\edef\csname amssym.def\endcsname{% + \catcode`\noexpand\@=\the\catcode`\@\space} +% Set the catcode to 11 for use in private control sequence names. +\catcode`\@=11 +% +% Include all definitions related to the fonts msam, msbm and eufm, so that +% when this file is used by itself, the results with respect to those fonts +% are equivalent to what they would have been using AMS-TeX. +% Most symbols in fonts msam and msbm are defined using \newsymbol; +% however, a few symbols that replace composites defined in plain must be +% defined with \mathchardef. + +\def\undefine#1{\let#1\undefined} +\def\newsymbol#1#2#3#4#5{\let\next@\relax + \ifnum#2=\@ne\let\next@\msafam@\else + \ifnum#2=\tw@\let\next@\msbfam@\fi\fi + \mathchardef#1="#3\next@#4#5} +\def\mathhexbox@#1#2#3{\relax + \ifmmode\mathpalette{}{\m@th\mathchar"#1#2#3}% + \else\leavevmode\hbox{$\m@th\mathchar"#1#2#3$}\fi} +\def\hexnumber@#1{\ifcase#1 0\or 1\or 2\or 3\or 4\or 5\or 6\or 7\or 8\or + 9\or A\or B\or C\or D\or E\or F\fi} + +\font\tenmsa=msam10 +\font\sevenmsa=msam7 +\font\fivemsa=msam5 +\newfam\msafam +\textfont\msafam=\tenmsa +\scriptfont\msafam=\sevenmsa +\scriptscriptfont\msafam=\fivemsa +\edef\msafam@{\hexnumber@\msafam} +\mathchardef\dabar@"0\msafam@39 +\def\dashrightarrow{\mathrel{\dabar@\dabar@\mathchar"0\msafam@4B}} +\def\dashleftarrow{\mathrel{\mathchar"0\msafam@4C\dabar@\dabar@}} +\let\dasharrow\dashrightarrow +\def\ulcorner{\delimiter"4\msafam@70\msafam@70 } +\def\urcorner{\delimiter"5\msafam@71\msafam@71 } +\def\llcorner{\delimiter"4\msafam@78\msafam@78 } +\def\lrcorner{\delimiter"5\msafam@79\msafam@79 } +\def\yen{{\mathhexbox@\msafam@55 }} +\def\checkmark{{\mathhexbox@\msafam@58 }} +\def\circledR{{\mathhexbox@\msafam@72 }} +\def\maltese{{\mathhexbox@\msafam@7A }} + +\font\tenmsb=msbm10 +\font\sevenmsb=msbm7 +\font\fivemsb=msbm5 +\newfam\msbfam +\textfont\msbfam=\tenmsb +\scriptfont\msbfam=\sevenmsb +\scriptscriptfont\msbfam=\fivemsb +\edef\msbfam@{\hexnumber@\msbfam} +\def\Bbb#1{{\fam\msbfam\relax#1}} +\def\widehat#1{\setbox\z@\hbox{$\m@th#1$}% + \ifdim\wd\z@>\tw@ em\mathaccent"0\msbfam@5B{#1}% + \else\mathaccent"0362{#1}\fi} +\def\widetilde#1{\setbox\z@\hbox{$\m@th#1$}% + \ifdim\wd\z@>\tw@ em\mathaccent"0\msbfam@5D{#1}% + \else\mathaccent"0365{#1}\fi} +\font\teneufm=eufm10 +\font\seveneufm=eufm7 +\font\fiveeufm=eufm5 +\newfam\eufmfam +\textfont\eufmfam=\teneufm +\scriptfont\eufmfam=\seveneufm +\scriptscriptfont\eufmfam=\fiveeufm +\def\frak#1{{\fam\eufmfam\relax#1}} +\let\goth\frak + +% Restore the catcode value for @ that was previously saved. +\csname amssym.def\endcsname + +\endinput diff --git a/systems/knuth/local/lib/amssym.tex b/systems/knuth/local/lib/amssym.tex new file mode 100644 index 0000000000..3212baa5cd --- /dev/null +++ b/systems/knuth/local/lib/amssym.tex @@ -0,0 +1,279 @@ +%% @texfile{ +%% filename="amssym.tex", +%% version="2.1", +%% date="31-MAY-1991", +%% filetype="TeX: option", +%% copyright="Copyright (C) American Mathematical Society, +%% all rights reserved. Copying of this file is +%% authorized only if either: +%% (1) you make absolutely no changes to your copy +%% including name; OR +%% (2) if you do make changes, you first rename it to some +%% other name.", +%% author="American Mathematical Society", +%% address="American Mathematical Society, +%% Technical Support Group, +%% P. O. Box 6248, +%% Providence, RI 02940, +%% USA", +%% telephone="401-455-4080 or (in the USA) 800-321-4AMS", +%% email="Internet: Tech-Support@Math.AMS.com", +%% codetable="ISO/ASCII", +%% checksumtype="line count", +%% checksum="277", +%% keywords="amsfonts, tex, amstex", +%% abstract="This file defines names for all the math symbols in +%% the math symbol fonts of the AMSFonts package (MSAM and +%% MSBM). If this file is not used by way of the AMS-TeX +%% \UseAMSsymbols command, it must be used in conjunction +%% with AMSSYM.DEF, which provides a definition of the +%% \newsymbol and \undefine commands. For more details, +%% refer to the AMSFonts User's Guide." +%% } +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +% Save the current value of the @-sign catcode so that it can be restored +% afterwards. This allows us to call amssym.tex either within an AMS-TeX +% document style file or by itself, in addition to providing a means +% of testing whether the file has been previously loaded. We want to +% avoid inputting this file twice because when AMSTeX is being used +% \newsymbol will give an error message if used to define a control +% sequence name that is already defined. + +% If the csname is not equal to \relax, we assume this file has already +% been loaded and \endinput immediately. +\expandafter\ifx\csname pre amssym.tex at\endcsname\relax \else \endinput\fi +% Otherwise we store the catcode of the @ in the csname. +\expandafter\chardef\csname pre amssym.tex at\endcsname=\the\catcode`\@ +% Set the catcode to 11 for use in private control sequence names. +\catcode`\@=11 +\ifx\undefined\newsymbol \else \begingroup\def\input#1 {\endgroup}\fi +\input amssym.def \relax +% Most symbols in fonts msam and msbm are defined using \newsymbol. A few +% that are delimiters or otherwise require special treatment have already +% been defined as soon as the fonts were loaded. Finally, a few symbols +% that replace composites defined in plain must be undefined first. +\newsymbol\boxdot 1200 +\newsymbol\boxplus 1201 +\newsymbol\boxtimes 1202 +\newsymbol\square 1003 +\newsymbol\blacksquare 1004 +\newsymbol\centerdot 1205 +\newsymbol\lozenge 1006 +\newsymbol\blacklozenge 1007 +\newsymbol\circlearrowright 1308 +\newsymbol\circlearrowleft 1309 +\undefine\rightleftharpoons +\newsymbol\rightleftharpoons 130A +\newsymbol\leftrightharpoons 130B +\newsymbol\boxminus 120C +\newsymbol\Vdash 130D +\newsymbol\Vvdash 130E +\newsymbol\vDash 130F +\newsymbol\twoheadrightarrow 1310 +\newsymbol\twoheadleftarrow 1311 +\newsymbol\leftleftarrows 1312 +\newsymbol\rightrightarrows 1313 +\newsymbol\upuparrows 1314 +\newsymbol\downdownarrows 1315 +\newsymbol\upharpoonright 1316 + \let\restriction\upharpoonright +\newsymbol\downharpoonright 1317 +\newsymbol\upharpoonleft 1318 +\newsymbol\downharpoonleft 1319 +\newsymbol\rightarrowtail 131A +\newsymbol\leftarrowtail 131B +\newsymbol\leftrightarrows 131C +\newsymbol\rightleftarrows 131D +\newsymbol\Lsh 131E +\newsymbol\Rsh 131F +\newsymbol\rightsquigarrow 1320 +\newsymbol\leftrightsquigarrow 1321 +\newsymbol\looparrowleft 1322 +\newsymbol\looparrowright 1323 +\newsymbol\circeq 1324 +\newsymbol\succsim 1325 +\newsymbol\gtrsim 1326 +\newsymbol\gtrapprox 1327 +\newsymbol\multimap 1328 +\newsymbol\therefore 1329 +\newsymbol\because 132A +\newsymbol\doteqdot 132B + \let\Doteq\doteqdot +\newsymbol\triangleq 132C +\newsymbol\precsim 132D +\newsymbol\lesssim 132E +\newsymbol\lessapprox 132F +\newsymbol\eqslantless 1330 +\newsymbol\eqslantgtr 1331 +\newsymbol\curlyeqprec 1332 +\newsymbol\curlyeqsucc 1333 +\newsymbol\preccurlyeq 1334 +\newsymbol\leqq 1335 +\newsymbol\leqslant 1336 +\newsymbol\lessgtr 1337 +\newsymbol\backprime 1038 +\newsymbol\risingdotseq 133A +\newsymbol\fallingdotseq 133B +\newsymbol\succcurlyeq 133C +\newsymbol\geqq 133D +\newsymbol\geqslant 133E +\newsymbol\gtrless 133F +\newsymbol\sqsubset 1340 +\newsymbol\sqsupset 1341 +\newsymbol\vartriangleright 1342 +\newsymbol\vartriangleleft 1343 +\newsymbol\trianglerighteq 1344 +\newsymbol\trianglelefteq 1345 +\newsymbol\bigstar 1046 +\newsymbol\between 1347 +\newsymbol\blacktriangledown 1048 +\newsymbol\blacktriangleright 1349 +\newsymbol\blacktriangleleft 134A +\newsymbol\vartriangle 134D +\newsymbol\blacktriangle 104E +\newsymbol\triangledown 104F +\newsymbol\eqcirc 1350 +\newsymbol\lesseqgtr 1351 +\newsymbol\gtreqless 1352 +\newsymbol\lesseqqgtr 1353 +\newsymbol\gtreqqless 1354 +\newsymbol\Rrightarrow 1356 +\newsymbol\Lleftarrow 1357 +\newsymbol\veebar 1259 +\newsymbol\barwedge 125A +\newsymbol\doublebarwedge 125B +\undefine\angle +\newsymbol\angle 105C +\newsymbol\measuredangle 105D +\newsymbol\sphericalangle 105E +\newsymbol\varpropto 135F +\newsymbol\smallsmile 1360 +\newsymbol\smallfrown 1361 +\newsymbol\Subset 1362 +\newsymbol\Supset 1363 +\newsymbol\Cup 1264 + \let\doublecup\Cup +\newsymbol\Cap 1265 + \let\doublecap\Cap +\newsymbol\curlywedge 1266 +\newsymbol\curlyvee 1267 +\newsymbol\leftthreetimes 1268 +\newsymbol\rightthreetimes 1269 +\newsymbol\subseteqq 136A +\newsymbol\supseteqq 136B +\newsymbol\bumpeq 136C +\newsymbol\Bumpeq 136D +\newsymbol\lll 136E + \let\llless\lll +\newsymbol\ggg 136F + \let\gggtr\ggg +\newsymbol\circledS 1073 +\newsymbol\pitchfork 1374 +\newsymbol\dotplus 1275 +\newsymbol\backsim 1376 +\newsymbol\backsimeq 1377 +\newsymbol\complement 107B +\newsymbol\intercal 127C +\newsymbol\circledcirc 127D +\newsymbol\circledast 127E +\newsymbol\circleddash 127F +\newsymbol\lvertneqq 2300 +\newsymbol\gvertneqq 2301 +\newsymbol\nleq 2302 +\newsymbol\ngeq 2303 +\newsymbol\nless 2304 +\newsymbol\ngtr 2305 +\newsymbol\nprec 2306 +\newsymbol\nsucc 2307 +\newsymbol\lneqq 2308 +\newsymbol\gneqq 2309 +\newsymbol\nleqslant 230A +\newsymbol\ngeqslant 230B +\newsymbol\lneq 230C +\newsymbol\gneq 230D +\newsymbol\npreceq 230E +\newsymbol\nsucceq 230F +\newsymbol\precnsim 2310 +\newsymbol\succnsim 2311 +\newsymbol\lnsim 2312 +\newsymbol\gnsim 2313 +\newsymbol\nleqq 2314 +\newsymbol\ngeqq 2315 +\newsymbol\precneqq 2316 +\newsymbol\succneqq 2317 +\newsymbol\precnapprox 2318 +\newsymbol\succnapprox 2319 +\newsymbol\lnapprox 231A +\newsymbol\gnapprox 231B +\newsymbol\nsim 231C +\newsymbol\ncong 231D +\newsymbol\diagup 231E +\newsymbol\diagdown 231F +\newsymbol\varsubsetneq 2320 +\newsymbol\varsupsetneq 2321 +\newsymbol\nsubseteqq 2322 +\newsymbol\nsupseteqq 2323 +\newsymbol\subsetneqq 2324 +\newsymbol\supsetneqq 2325 +\newsymbol\varsubsetneqq 2326 +\newsymbol\varsupsetneqq 2327 +\newsymbol\subsetneq 2328 +\newsymbol\supsetneq 2329 +\newsymbol\nsubseteq 232A +\newsymbol\nsupseteq 232B +\newsymbol\nparallel 232C +\newsymbol\nmid 232D +\newsymbol\nshortmid 232E +\newsymbol\nshortparallel 232F +\newsymbol\nvdash 2330 +\newsymbol\nVdash 2331 +\newsymbol\nvDash 2332 +\newsymbol\nVDash 2333 +\newsymbol\ntrianglerighteq 2334 +\newsymbol\ntrianglelefteq 2335 +\newsymbol\ntriangleleft 2336 +\newsymbol\ntriangleright 2337 +\newsymbol\nleftarrow 2338 +\newsymbol\nrightarrow 2339 +\newsymbol\nLeftarrow 233A +\newsymbol\nRightarrow 233B +\newsymbol\nLeftrightarrow 233C +\newsymbol\nleftrightarrow 233D +\newsymbol\divideontimes 223E +\newsymbol\varnothing 203F +\newsymbol\nexists 2040 +\newsymbol\Finv 2060 +\newsymbol\Game 2061 +\newsymbol\mho 2066 +\newsymbol\eth 2067 +\newsymbol\eqsim 2368 +\newsymbol\beth 2069 +\newsymbol\gimel 206A +\newsymbol\daleth 206B +\newsymbol\lessdot 236C +\newsymbol\gtrdot 236D +\newsymbol\ltimes 226E +\newsymbol\rtimes 226F +\newsymbol\shortmid 2370 +\newsymbol\shortparallel 2371 +\newsymbol\smallsetminus 2272 +\newsymbol\thicksim 2373 +\newsymbol\thickapprox 2374 +\newsymbol\approxeq 2375 +\newsymbol\succapprox 2376 +\newsymbol\precapprox 2377 +\newsymbol\curvearrowleft 2378 +\newsymbol\curvearrowright 2379 +\newsymbol\digamma 207A +\newsymbol\varkappa 207B +\newsymbol\Bbbk 207C +\newsymbol\hslash 207D +\undefine\hbar +\newsymbol\hbar 207E +\newsymbol\backepsilon 237F +% Restore the catcode value for @ that was previously saved. +\catcode`\@=\csname pre amssym.tex at\endcsname + +\endinput diff --git a/systems/knuth/local/lib/amstex.tex b/systems/knuth/local/lib/amstex.tex new file mode 100644 index 0000000000..96502696d6 --- /dev/null +++ b/systems/knuth/local/lib/amstex.tex @@ -0,0 +1,1797 @@ +%% @texfile{ +%% filename="amstex.tex", +%% version="2.1", +%% date="5-APR-1991", +%% filetype="AMS-TeX: documentstyle", +%% copyright="Copyright (C) American Mathematical Society, +%% all rights reserved. Copying of this file is +%% authorized only if either: +%% (1) you make absolutely no changes to your copy +%% including name; OR +%% (2) if you do make changes, you first rename it to some +%% other name.", +%% author="American Mathematical Society", +%% address="American Mathematical Society, +%% Technical Support Group, +%% P. O. Box 6248, +%% Providence, RI 02940, +%% USA", +%% telephone="401-455-4080 or (in the USA) 800-321-4AMS", +%% email="Internet: Tech-Support@Math.AMS.com", +%% codetable="ISO/ASCII", +%% checksumtype="line count", +%% checksum="1797", +%% keywords="amstex, ams-tex, tex", +%% abstract="This file contains the AMS-TeX Version 2.1 macro +%% package. It is intended to be used in conjunction with +%% plain TeX. The macros defined herein are chiefly oriented +%% to the construction of mathematical formulas, both display +%% and nondisplay, using AMS conventions for fonts, spacing, +%% and other details." +%% } +\def\fmtname{AmS-TeX} +\let\plainfmtversion\fmtversion +\def\fmtversion{2.1} +\catcode`\@=11 +\ifx\amstexloaded@\relax\catcode`\@=\active + \endinput\else\let\amstexloaded@\relax\fi +\newlinechar=`\^^J +\def\W@{\immediate\write\sixt@@n} +\def\CR@{\W@{^^J\fmtname - Version \fmtversion^^J% +COPYRIGHT 1985, 1990, 1991 - AMERICAN MATHEMATICAL SOCIETY^^J% +Use of this macro package is not restricted provided^^J% +each use is acknowledged upon publication.^^J}} +\CR@ \everyjob{\CR@} +\message{Loading definitions for} +\message{misc utility macros,} +\toksdef\toks@@=2 +\long\def\rightappend@#1\to#2{\toks@{\\{#1}}\toks@@ + =\expandafter{#2}\xdef#2{\the\toks@@\the\toks@}\toks@{}\toks@@{}} +\def\alloclist@{} +\newif\ifalloc@ +\def\showallocations{{\def\\{\immediate\write\m@ne}\alloclist@}\alloc@true} +\def\alloc@#1#2#3#4#5{\global\advance\count1#1by\@ne + \ch@ck#1#4#2\allocationnumber=\count1#1 + \global#3#5=\allocationnumber + \edef\next@{\string#5=\string#2\the\allocationnumber}% + \expandafter\rightappend@\next@\to\alloclist@} +\newcount\count@@ +\newcount\count@@@ +\def\FN@{\futurelet\next} +\def\DN@{\def\next@} +\def\DNii@{\def\nextii@} +\def\RIfM@{\relax\ifmmode} +\def\RIfMIfI@{\relax\ifmmode\ifinner} +\def\setboxz@h{\setbox\z@\hbox} +\def\wdz@{\wd\z@} +\def\boxz@{\box\z@} +\def\setbox@ne{\setbox\@ne} +\def\wd@ne{\wd\@ne} +\def\iterate{\body\expandafter\iterate\else\fi} +\def\err@#1{\errmessage{AmS-TeX error: #1}} +\newhelp\defaulthelp@{Sorry, I already gave what help I could...^^J +Maybe you should try asking a human?^^J +An error might have occurred before I noticed any problems.^^J +``If all else fails, read the instructions.''} +\def\Err@{\errhelp\defaulthelp@\err@} +\def\eat@#1{} +\def\in@#1#2{\def\in@@##1#1##2##3\in@@{\ifx\in@##2\in@false\else\in@true\fi}% + \in@@#2#1\in@\in@@} +\newif\ifin@ +\def\space@.{\futurelet\space@\relax} +\space@. % +\newhelp\athelp@ +{Only certain combinations beginning with @ make sense to me.^^J +Perhaps you wanted \string\@\space for a printed @?^^J +I've ignored the character or group after @.} +{\catcode`\~=\active % just in case + \lccode`\~=`\@ \lowercase{\gdef~{\FN@\at@}}} +\def\at@{\let\next@\at@@ + \ifcat\noexpand\next a\else\ifcat\noexpand\next0\else + \ifcat\noexpand\next\relax\else + \let\next\at@@@\fi\fi\fi + \next@} +\def\at@@#1{\expandafter + \ifx\csname\space @\string#1\endcsname\relax + \expandafter\at@@@ \else + \csname\space @\string#1\expandafter\endcsname\fi} +\def\at@@@#1{\errhelp\athelp@ \err@{\Invalid@@ @}}%% +\def\atdef@#1{\expandafter\def\csname\space @\string#1\endcsname}%% +\newhelp\defahelp@{If you typed \string\define\space cs instead of +\string\define\string\cs\space^^J +I've substituted an inaccessible control sequence so that your^^J +definition will be completed without mixing me up too badly.^^J +If you typed \string\define{\string\cs} the inaccessible control sequence^^J +was defined to be \string\cs, and the rest of your^^J +definition appears as input.} +\newhelp\defbhelp@{I've ignored your definition, because it might^^J +conflict with other uses that are important to me.} +\def\define{\FN@\define@} +\def\define@{\ifcat\noexpand\next\relax + \expandafter\define@@\else\errhelp\defahelp@ %1 + \err@{\string\define\space must be followed by a control + sequence}\expandafter\def\expandafter\nextii@\fi} %2 +\def\undefined@@@@@@@@@@{} +\def\preloaded@@@@@@@@@@{} +\def\next@@@@@@@@@@{} +\def\define@@#1{\ifx#1\relax\errhelp\defbhelp@ %1 + \err@{\string#1\space is already defined}\DN@{\DNii@}\else + \expandafter\ifx\csname\expandafter\eat@\string %2 + #1@@@@@@@@@@\endcsname\undefined@@@@@@@@@@\errhelp\defbhelp@ + \err@{\string#1\space can't be defined}\DN@{\DNii@}\else + \expandafter\ifx\csname\expandafter\eat@\string#1\endcsname\relax %3 + \global\let#1\undefined\DN@{\def#1}\else\errhelp\defbhelp@ + \err@{\string#1\space is already defined}\DN@{\DNii@}\fi + \fi\fi\next@} +\let\redefine\def +\def\predefine#1#2{\let#1#2} +\def\undefine#1{\let#1\undefined} +\message{page layout,} +\newdimen\captionwidth@ +\captionwidth@\hsize +\advance\captionwidth@-1.5in +\def\pagewidth#1{\hsize#1\relax + \captionwidth@\hsize\advance\captionwidth@-1.5in} +\def\pageheight#1{\vsize#1\relax} +\def\hcorrection#1{\advance\hoffset#1\relax} +\def\vcorrection#1{\advance\voffset#1\relax} +\message{accents/punctuation,} +\def\tie{\unskip\nobreak\ } +\let\graveaccent\` +\let\acuteaccent\' +\let\tildeaccent\~ +\let\hataccent\^ +\let\underscore\_ +\let\B\= +\let\D\. +\let\ic@\/ +\def\/{\unskip\ic@} +\def\textfonti{\the\textfont\@ne} +\def\t#1#2{{\edef\next@{\the\font}\textfonti\accent"7F \next@#1#2}} +\def~{\unskip\nobreak\ \ignorespaces} +\def\.{.\spacefactor\@m} +\atdef@;{\leavevmode\null;} +\atdef@:{\leavevmode\null:} +\atdef@?{\leavevmode\null?} +\edef\@{\string @} +\def\relaxnext@{\let\next\relax} +\atdef@-{\relaxnext@\leavevmode + \DN@{\ifx\next-\DN@-{\FN@\nextii@}\else + \DN@{\leavevmode\hbox{-}}\fi\next@}% + \DNii@{\ifx\next-\DN@-{\leavevmode\hbox{---}}\else + \DN@{\leavevmode\hbox{--}}\fi\next@}% + \FN@\next@} +\def\srdr@{\kern.16667em} +\def\drsr@{\kern.02778em} +\def\sldl@{\drsr@} +\def\dlsl@{\srdr@} +\atdef@"{\unskip\relaxnext@ + \DN@{\ifx\next\space@\DN@. {\FN@\nextii@}\else + \DN@.{\FN@\nextii@}\fi\next@.}% + \DNii@{\ifx\next`\DN@`{\FN@\nextiii@}\else + \ifx\next\lq\DN@\lq{\FN@\nextiii@}\else + \DN@####1{\FN@\nextiv@}\fi\fi\next@}% + \def\nextiii@{\ifx\next`\DN@`{\sldl@``}\else\ifx\next\lq + \DN@\lq{\sldl@``}\else\DN@{\dlsl@`}\fi\fi\next@}% + \def\nextiv@{\ifx\next'\DN@'{\srdr@''}\else + \ifx\next\rq\DN@\rq{\srdr@''}\else\DN@{\drsr@'}\fi\fi\next@}% + \FN@\next@} +\def\flushpar{\par\noindent} +\def\textfontii{\the\textfont\tw@} +\def\lbrace@{\delimiter"4266308 } +\def\rbrace@{\delimiter"5267309 } +\def\{{\RIfM@\lbrace@\else{\textfontii f}\spacefactor\@m\fi} +\def\}{\RIfM@\rbrace@\else + \let\@sf\empty\ifhmode\edef\@sf{\spacefactor\the\spacefactor}\fi + {\textfontii g}\@sf\relax\fi} +\let\lbrace\{ +\let\rbrace\} +\def\AmSTeX{{\textfontii A\kern-.1667em% + \lower.5ex\hbox{M}\kern-.125emS}-\TeX} +\message{line and page breaks,} +\def\vmodeerr@#1{\Err@{\string#1\space not allowed between paragraphs}} +\def\mathmodeerr@#1{\Err@{\string#1\space not allowed in math mode}} +\def\linebreak{\RIfM@\mathmodeerr@\linebreak\else + \ifhmode\unskip\unkern\break\else\vmodeerr@\linebreak\fi\fi} +\def\slash{\unskip/\penalty\exhyphenpenalty} +\newskip\saveskip@ +\def\allowlinebreak{\RIfM@\mathmodeerr@\allowlinebreak\else + \ifhmode\saveskip@\lastskip\unskip + \allowbreak\ifdim\saveskip@>\z@\hskip\saveskip@\fi + \else\vmodeerr@\allowlinebreak\fi\fi} +\def\nolinebreak{\RIfM@\mathmodeerr@\nolinebreak\else + \ifhmode\saveskip@\lastskip\unskip + \nobreak\ifdim\saveskip@>\z@\hskip\saveskip@\fi + \else\vmodeerr@\nolinebreak\fi\fi} +\def\newline{\relaxnext@ + \DN@{\RIfM@\expandafter\mathmodeerr@\expandafter\newline\else + \ifhmode\ifx\next\par\else + \expandafter\unskip\expandafter\null\expandafter\hfill\expandafter\break\fi + \else + \expandafter\vmodeerr@\expandafter\newline\fi\fi}% + \FN@\next@} +\def\dmatherr@#1{\Err@{\string#1\space not allowed in display math mode}} +\def\nondmatherr@#1{\Err@{\string#1\space not allowed in non-display math + mode}} +\def\onlydmatherr@#1{\Err@{\string#1\space allowed only in display math mode}} +\def\nonmatherr@#1{\Err@{\string#1\space allowed only in math mode}} +\def\mathbreak{\RIfMIfI@\break\else + \dmatherr@\mathbreak\fi\else\nonmatherr@\mathbreak\fi} +\def\nomathbreak{\RIfMIfI@\nobreak\else + \dmatherr@\nomathbreak\fi\else\nonmatherr@\nomathbreak\fi} +\def\allowmathbreak{\RIfMIfI@\allowbreak\else + \dmatherr@\allowmathbreak\fi\else\nonmatherr@\allowmathbreak\fi} +\def\pagebreak{\RIfM@ + \ifinner\nondmatherr@\pagebreak\else\postdisplaypenalty-\@M\fi + \else\ifvmode\removelastskip\break\else\vadjust{\break}\fi\fi} +\def\nopagebreak{\RIfM@ + \ifinner\nondmatherr@\nopagebreak\else\postdisplaypenalty\@M\fi + \else\ifvmode\nobreak\else\vadjust{\nobreak}\fi\fi} +\def\nonvmodeerr@#1{\Err@{\string#1\space not allowed within a paragraph + or in math}} +\def\vnonvmode@#1#2{\relaxnext@\DNii@{\ifx\next\par\DN@{#1}\else + \DN@{#2}\fi\next@}% + \ifvmode\DN@{#1}\else + \DN@{\FN@\nextii@}\fi\next@} +\def\newpage{\vnonvmode@{\vfill\break}{\nonvmodeerr@\newpage}} +\def\smallpagebreak{\vnonvmode@\smallbreak{\nonvmodeerr@\smallpagebreak}} +\def\medpagebreak{\vnonvmode@\medbreak{\nonvmodeerr@\medpagebreak}} +\def\bigpagebreak{\vnonvmode@\bigbreak{\nonvmodeerr@\bigpagebreak}} +\def\NoBlackBoxes{\global\overfullrule\z@} +\def\BlackBoxes{\global\overfullrule5\p@} +\def\Invalid@#1{\def#1{\Err@{\Invalid@@\string#1}}} +\def\Invalid@@{Invalid use of } +\message{figures,} +\Invalid@\caption +\Invalid@\captionwidth +\newdimen\smallcaptionwidth@ +\def\topspace{\mid@false\ins@} +\def\midspace{\mid@true\ins@} +\newif\ifmid@ +\def\captionfont@{} +\def\ins@#1{\relaxnext@\allowbreak + \smallcaptionwidth@\captionwidth@\gdef\thespace@{#1}% + \DN@{\ifx\next\space@\DN@. {\FN@\nextii@}\else + \DN@.{\FN@\nextii@}\fi\next@.}% + \DNii@{\ifx\next\caption\DN@\caption{\FN@\nextiii@}% + \else\let\next@\nextiv@\fi\next@}% + \def\nextiv@{\vnonvmode@ + {\ifmid@\expandafter\midinsert\else\expandafter\topinsert\fi + \vbox to\thespace@{}\endinsert} + {\ifmid@\nonvmodeerr@\midspace\else\nonvmodeerr@\topspace\fi}}% + \def\nextiii@{\ifx\next\captionwidth\expandafter\nextv@ + \else\expandafter\nextvi@\fi}% + \def\nextv@\captionwidth##1##2{\smallcaptionwidth@##1\relax\nextvi@{##2}}% + \def\nextvi@##1{\def\thecaption@{\captionfont@##1}% + \DN@{\ifx\next\space@\DN@. {\FN@\nextvii@}\else + \DN@.{\FN@\nextvii@}\fi\next@.}% + \FN@\next@}% + \def\nextvii@{\vnonvmode@ + {\ifmid@\expandafter\midinsert\else + \expandafter\topinsert\fi\vbox to\thespace@{}\nobreak\smallskip + \setboxz@h{\noindent\ignorespaces\thecaption@\unskip}% + \ifdim\wdz@>\smallcaptionwidth@\centerline{\vbox{\hsize\smallcaptionwidth@ + \noindent\ignorespaces\thecaption@\unskip}}% + \else\centerline{\boxz@}\fi\endinsert} + {\ifmid@\nonvmodeerr@\midspace + \else\nonvmodeerr@\topspace\fi}}% + \FN@\next@} +\message{comments,} +\def\newcodes@{\catcode`\\12\catcode`\{12\catcode`\}12\catcode`\#12% + \catcode`\%12\relax} +\def\oldcodes@{\catcode`\\0\catcode`\{1\catcode`\}2\catcode`\#6% + \catcode`\%14\relax} +\def\comment{\newcodes@\endlinechar=10 \comment@} +{\lccode`\0=`\\ +\lowercase{\gdef\comment@#1^^J{\comment@@#10endcomment\comment@@@}% +\gdef\comment@@#10endcomment{\FN@\comment@@@}% +\gdef\comment@@@#1\comment@@@{\ifx\next\comment@@@\let\next\comment@ + \else\def\next{\oldcodes@\endlinechar=`\^^M\relax}% + \fi\next}}} +\def\pr@m@s{\ifx'\next\DN@##1{\prim@s}\else\let\next@\egroup\fi\next@} +\def\prime{{\null\prime@\null}} +\mathchardef\prime@="0230 +\let\dsize\displaystyle +\let\tsize\textstyle +\let\ssize\scriptstyle +\let\sssize\scriptscriptstyle +\message{math spacing,} +\def\,{\RIfM@\mskip\thinmuskip\relax\else\kern.16667em\fi} +\def\!{\RIfM@\mskip-\thinmuskip\relax\else\kern-.16667em\fi} +\let\thinspace\, +\let\negthinspace\! +\def\medspace{\RIfM@\mskip\medmuskip\relax\else\kern.222222em\fi} +\def\negmedspace{\RIfM@\mskip-\medmuskip\relax\else\kern-.222222em\fi} +\def\thickspace{\RIfM@\mskip\thickmuskip\relax\else\kern.27777em\fi} +\let\;\thickspace +\def\negthickspace{\RIfM@\mskip-\thickmuskip\relax\else + \kern-.27777em\fi} +\atdef@,{\RIfM@\mskip.1\thinmuskip\else\leavevmode\null,\fi} +\atdef@!{\RIfM@\mskip-.1\thinmuskip\else\leavevmode\null!\fi} +\atdef@.{\RIfM@&&\else\leavevmode.\spacefactor3000 \fi} +\def\and{\DOTSB\;\mathchar"3026 \;} +\def\implies{\DOTSB\;\Longrightarrow\;} +\def\impliedby{\DOTSB\;\Longleftarrow\;} +\message{fractions,} +\def\frac#1#2{{#1\over#2}} +\def\dfrac#1#2{{\displaystyle{#1\over#2}}} +\def\tfrac#1#2{{\textstyle{#1\over#2}}} +\newdimen\ex@ +\ex@.2326ex +\Invalid@\thickness +\def\thickfrac{\relaxnext@ + \DN@{\ifx\next\thickness\let\next@\nextii@\else + \DN@{\nextii@\thickness1}\fi\next@}% + \DNii@\thickness##1##2##3{{##2\above##1\ex@##3}}% + \FN@\next@} +\def\fracwithdelims#1#2#3#4{{#3\overwithdelims#1#2#4}} +\def\thickfracwithdelims#1#2{\relaxnext@\def\ldelim@{#1}\def\rdelim@{#2}% + \DN@{\ifx\next\thickness\let\next@\nextii@\else + \DN@{\nextii@\thickness1}\fi\next@}% + \DNii@\thickness##1##2##3{{##2\abovewithdelims + \ldelim@\rdelim@##1\ex@##3}}% + \FN@\next@} +\def\binom#1#2{{#1\choose#2}} +\def\dbinom#1#2{{\displaystyle{#1\choose#2}}} +\def\tbinom#1#2{{\textstyle{#1\choose#2}}} +\def\:{\nobreak\hskip.1111em\mathpunct{}\nonscript\mkern-\thinmuskip{:}\hskip + .3333emplus.0555em\relax} +\def\snug{\unskip\kern-\mathsurround} +\message{smash commands,} +\def\topsmash{\top@true\bot@false\smash@} +\def\botsmash{\top@false\bot@true\smash@} +\newif\iftop@ +\newif\ifbot@ +\def\smash{\top@true\bot@true\smash@} +\def\smash@{\RIfM@\expandafter\mathpalette\expandafter\mathsm@sh\else + \expandafter\makesm@sh\fi} +\def\finsm@sh{\iftop@\ht\z@\z@\fi\ifbot@\dp\z@\z@\fi\leavevmode\boxz@} +\message{large operator symbols,} +\def\LimitsOnSums{\global\let\slimits@\displaylimits} +\def\NoLimitsOnSums{\global\let\slimits@\nolimits} +\LimitsOnSums +\mathchardef\coprod@="1360 \def\coprod{\DOTSB\coprod@\slimits@} +\mathchardef\bigvee@="1357 \def\bigvee{\DOTSB\bigvee@\slimits@} +\mathchardef\bigwedge@="1356 \def\bigwedge{\DOTSB\bigwedge@\slimits@} +\mathchardef\biguplus@="1355 \def\biguplus{\DOTSB\biguplus@\slimits@} +\mathchardef\bigcap@="1354 \def\bigcap{\DOTSB\bigcap@\slimits@} +\mathchardef\bigcup@="1353 \def\bigcup{\DOTSB\bigcup@\slimits@} +\mathchardef\prod@="1351 \def\prod{\DOTSB\prod@\slimits@} +\mathchardef\sum@="1350 \def\sum{\DOTSB\sum@\slimits@} +\mathchardef\bigotimes@="134E \def\bigotimes{\DOTSB\bigotimes@\slimits@} +\mathchardef\bigoplus@="134C \def\bigoplus{\DOTSB\bigoplus@\slimits@} +\mathchardef\bigodot@="134A \def\bigodot{\DOTSB\bigodot@\slimits@} +\mathchardef\bigsqcup@="1346 \def\bigsqcup{\DOTSB\bigsqcup@\slimits@} +\message{integrals,} +\def\LimitsOnInts{\global\let\ilimits@\displaylimits} +\def\NoLimitsOnInts{\global\let\ilimits@\nolimits} +\NoLimitsOnInts +\def\int{\DOTSI\intop\ilimits@} +\def\oint{\DOTSI\ointop\ilimits@} +\def\intic@{\mathchoice{\hskip.5em}{\hskip.4em}{\hskip.4em}{\hskip.4em}} +\def\negintic@{\mathchoice + {\hskip-.5em}{\hskip-.4em}{\hskip-.4em}{\hskip-.4em}} +\def\intkern@{\mathchoice{\!\!\!}{\!\!}{\!\!}{\!\!}} +\def\intdots@{\mathchoice{\plaincdots@} + {{\cdotp}\mkern1.5mu{\cdotp}\mkern1.5mu{\cdotp}} + {{\cdotp}\mkern1mu{\cdotp}\mkern1mu{\cdotp}} + {{\cdotp}\mkern1mu{\cdotp}\mkern1mu{\cdotp}}} +\newcount\intno@ +\def\iint{\DOTSI\intno@\tw@\FN@\ints@} +\def\iiint{\DOTSI\intno@\thr@@\FN@\ints@} +\def\iiiint{\DOTSI\intno@4 \FN@\ints@} +\def\idotsint{\DOTSI\intno@\z@\FN@\ints@} +\def\ints@{\findlimits@\ints@@} +\newif\iflimtoken@ +\newif\iflimits@ +\def\findlimits@{\limtoken@true\ifx\next\limits\limits@true + \else\ifx\next\nolimits\limits@false\else + \limtoken@false\ifx\ilimits@\nolimits\limits@false\else + \ifinner\limits@false\else\limits@true\fi\fi\fi\fi} +\def\multint@{\int\ifnum\intno@=\z@\intdots@ %1 + \else\intkern@\fi %2 + \ifnum\intno@>\tw@\int\intkern@\fi %3 + \ifnum\intno@>\thr@@\int\intkern@\fi %4 + \int} %5 +\def\multintlimits@{\intop\ifnum\intno@=\z@\intdots@\else\intkern@\fi + \ifnum\intno@>\tw@\intop\intkern@\fi + \ifnum\intno@>\thr@@\intop\intkern@\fi\intop} +\def\ints@@{\iflimtoken@ %1 + \def\ints@@@{\iflimits@\negintic@\mathop{\intic@\multintlimits@}\limits %2 + \else\multint@\nolimits\fi %3 + \eat@} %4 + \else %5 + \def\ints@@@{\iflimits@\negintic@ + \mathop{\intic@\multintlimits@}\limits\else + \multint@\nolimits\fi}\fi\ints@@@} +\def\LimitsOnNames{\global\let\nlimits@\displaylimits} +\def\NoLimitsOnNames{\global\let\nlimits@\nolimits@} +\LimitsOnNames +\def\nolimits@{\relaxnext@ + \DN@{\ifx\next\limits\DN@\limits{\nolimits}\else + \let\next@\nolimits\fi\next@}% + \FN@\next@} +\message{operator names,} +\def\newmcodes@{\mathcode`\'"27\mathcode`\*"2A\mathcode`\."613A% + \mathcode`\-"2D\mathcode`\/"2F\mathcode`\:"603A } +\def\operatorname#1{\mathop{\newmcodes@\kern\z@\fam\z@#1}\nolimits@} +\def\operatornamewithlimits#1{\mathop{\newmcodes@\kern\z@\fam\z@#1}\nlimits@} +\def\qopname@#1{\mathop{\fam\z@#1}\nolimits@} +\def\qopnamewl@#1{\mathop{\fam\z@#1}\nlimits@} +\def\arccos{\qopname@{arccos}} +\def\arcsin{\qopname@{arcsin}} +\def\arctan{\qopname@{arctan}} +\def\arg{\qopname@{arg}} +\def\cos{\qopname@{cos}} +\def\cosh{\qopname@{cosh}} +\def\cot{\qopname@{cot}} +\def\coth{\qopname@{coth}} +\def\csc{\qopname@{csc}} +\def\deg{\qopname@{deg}} +\def\det{\qopnamewl@{det}} +\def\dim{\qopname@{dim}} +\def\exp{\qopname@{exp}} +\def\gcd{\qopnamewl@{gcd}} +\def\hom{\qopname@{hom}} +\def\inf{\qopnamewl@{inf}} +\def\injlim{\qopnamewl@{inj\,lim}} +\def\ker{\qopname@{ker}} +\def\lg{\qopname@{lg}} +\def\lim{\qopnamewl@{lim}} +\def\liminf{\qopnamewl@{lim\,inf}} +\def\limsup{\qopnamewl@{lim\,sup}} +\def\ln{\qopname@{ln}} +\def\log{\qopname@{log}} +\def\max{\qopnamewl@{max}} +\def\min{\qopnamewl@{min}} +\def\Pr{\qopnamewl@{Pr}} +\def\projlim{\qopnamewl@{proj\,lim}} +\def\sec{\qopname@{sec}} +\def\sin{\qopname@{sin}} +\def\sinh{\qopname@{sinh}} +\def\sup{\qopnamewl@{sup}} +\def\tan{\qopname@{tan}} +\def\tanh{\qopname@{tanh}} +\def\varinjlim{\mathop{\vtop{\ialign{##\crcr + \hfil\rm lim\hfil\crcr\noalign{\nointerlineskip}\rightarrowfill\crcr + \noalign{\nointerlineskip\kern-\ex@}\crcr}}}} +\def\varprojlim{\mathop{\vtop{\ialign{##\crcr + \hfil\rm lim\hfil\crcr\noalign{\nointerlineskip}\leftarrowfill\crcr + \noalign{\nointerlineskip\kern-\ex@}\crcr}}}} +\def\varliminf{\mathop{\underline{\vrule height\z@ depth.2exwidth\z@ + \hbox{\rm lim}}}} +\def\varlimsup{\mathop{\overline{\hbox{\rm lim}}}} +\newdimen\buffer@ +\buffer@\fontdimen13 \tenex +\newdimen\buffer +\buffer\buffer@ +\def\ChangeBuffer#1{\fontdimen13 \tenex#1\relax + \global\buffer\fontdimen13 \tenex} +\def\ResetBuffer{\fontdimen13 \tenex\buffer@\global\buffer\buffer@} +\def\shave#1{\mathop{\hbox{$\m@th\fontdimen13 \tenex\z@ %1 + \displaystyle{#1}$}}\fontdimen13 \tenex\buffer} +\def\topshave#1{\mathop{\topsmash{\displaystyle{#1}}\vphantom{\shave{#1}}}} +\def\botshave#1{\mathop{\botsmash{\displaystyle{#1}}\vphantom{\shave{#1}}}} +\message{multilevel sub/superscripts,} +\Invalid@\\ +\def\Let@{\relax\iffalse{\fi\let\\=\cr\iffalse}\fi} +\Invalid@\vspace +\def\vspace@{\def\vspace##1{\crcr\noalign{\vskip##1\relax}}} +\def\multilimits@{\bgroup\vspace@\Let@ + \baselineskip\fontdimen10 \scriptfont\tw@ + \advance\baselineskip\fontdimen12 \scriptfont\tw@ + \lineskip\thr@@\fontdimen8 \scriptfont\thr@@ + \lineskiplimit\lineskip + \vbox\bgroup\ialign\bgroup\hfil$\m@th\scriptstyle{##}$\hfil\crcr} +\def\Sb{_\multilimits@} +\def\endSb{\crcr\egroup\egroup\egroup} +\def\Sp{^\multilimits@} +\let\endSp\endSb +\def\spreadlines#1{\RIfMIfI@\onlydmatherr@\spreadlines\else + \openup#1\relax\fi\else\onlydmatherr@\spreadlines\fi} +\def\Mathstrut@{\copy\Mathstrutbox@} +\newbox\Mathstrutbox@ +\setbox\Mathstrutbox@\null +\setboxz@h{$\m@th($} +\ht\Mathstrutbox@\ht\z@ +\dp\Mathstrutbox@\dp\z@ +\message{matrices,} +\newdimen\spreadmlines@ +\def\spreadmatrixlines#1{\RIfMIfI@ + \onlydmatherr@\spreadmatrixlines\else + \spreadmlines@#1\relax\fi\else\onlydmatherr@\spreadmatrixlines\fi} +\def\matrix{\null\,\vcenter\bgroup\Let@\vspace@ + \normalbaselines\openup\spreadmlines@\ialign + \bgroup\hfil$\m@th##$\hfil&&\quad\hfil$\m@th##$\hfil\crcr + \Mathstrut@\crcr\noalign{\kern-\baselineskip}} +\def\endmatrix{\crcr\Mathstrut@\crcr\noalign{\kern-\baselineskip}\egroup + \egroup\,} +\def\format{\crcr\egroup\iffalse{\fi\ifnum`}=0 \fi\format@} +\newtoks\hashtoks@ +\hashtoks@{#} +\def\format@#1\\{\def\preamble@{#1}% + \def\l{$\m@th\the\hashtoks@$\hfil}% + \def\c{\hfil$\m@th\the\hashtoks@$\hfil}% + \def\r{\hfil$\m@th\the\hashtoks@$}% + \edef\preamble@@{\preamble@}\ifnum`{=0 \fi\iffalse}\fi + \ialign\bgroup\span\preamble@@\crcr} +\def\smallmatrix{\null\,\vcenter\bgroup\vspace@\Let@ + \baselineskip9\ex@\lineskip\ex@ + \ialign\bgroup\hfil$\m@th\scriptstyle{##}$\hfil&&\thickspace\hfil + $\m@th\scriptstyle{##}$\hfil\crcr} +\def\endsmallmatrix{\crcr\egroup\egroup\,} +\def\pmatrix{\left(\matrix} +\def\endpmatrix{\endmatrix\right)} +\def\bmatrix{\left[\matrix} +\def\endbmatrix{\endmatrix\right]} +\def\vmatrix{\left|\matrix} +\def\endvmatrix{\endmatrix\right|} +\def\Vmatrix{\left\|\matrix} +\def\endVmatrix{\endmatrix\right\|} +\def\hdots{\mathinner{\ldotp\ldotp\ldotp}} +\newmuskip\dotsspace@ +\dotsspace@1.5mu +\def\strip@#1 {#1} +\def\spacehdots#1\for#2{\multispan{#2}\xleaders + \hbox{$\m@th\mkern\strip@#1 \dotsspace@.\mkern\strip@#1 \dotsspace@$}\hfill} +\def\hdotsfor#1{\spacehdots\@ne\for{#1}} +\def\multispan@#1{\omit\mscount#1\unskip\loop\ifnum\mscount>\@ne\sp@n\repeat} +\def\spaceinnerhdots#1\for#2\after#3{\multispan@{\strip@#2 }#3\xleaders + \hbox{$\m@th\mkern\strip@#1 \dotsspace@.\mkern\strip@#1 \dotsspace@$}\hfill} +\def\innerhdotsfor#1\after#2{\spaceinnerhdots\@ne\for#1\after{#2}} +\def\cases{\bgroup\spreadmlines@\jot\left\{\,\matrix\format\l&\quad\l\\} +\def\endcases{\endmatrix\right.\egroup} +\message{multiline displays,} +\newif\ifinany@ +\newif\ifinalign@ +\newif\ifingather@ +\def\strut@{\copy\strutbox@} +\newbox\strutbox@ +\setbox\strutbox@\hbox{\vrule height8\p@ depth3\p@ width\z@} +\def\topaligned{\null\,\vtop\aligned@} +\def\botaligned{\null\,\vbox\aligned@} +\def\aligned{\null\,\vcenter\aligned@} +\def\aligned@{\bgroup\vspace@\Let@ + \ifinany@\else\openup\jot\fi\ialign + \bgroup\hfil\strut@$\m@th\displaystyle{##}$& + $\m@th\displaystyle{{}##}$\hfil\crcr} +\def\endaligned{\crcr\egroup\egroup} +\let\endtopaligned\endaligned +\let\endbotaligned\endaligned +\def\alignedat#1{\null\,\vcenter\bgroup\doat@{#1}\vspace@\Let@ + \ifinany@\else\openup\jot\fi\ialign\bgroup\span\preamble@@\crcr} +\newcount\atcount@ +\def\doat@#1{\toks@{\hfil\strut@$\m@th + \displaystyle{\the\hashtoks@}$&$\m@th\displaystyle + {{}\the\hashtoks@}$\hfil}% %1 + \atcount@#1\relax\advance\atcount@\m@ne %2 + \loop\ifnum\atcount@>\z@\toks@=\expandafter{\the\toks@&\hfil$\m@th + \displaystyle{\the\hashtoks@}$&$\m@th + \displaystyle{{}\the\hashtoks@}$\hfil}\advance + \atcount@\m@ne\repeat %3 + \xdef\preamble@{\the\toks@}\xdef\preamble@@{\preamble@}} +\let\endalignedat\endaligned +\def\gathered{\null\,\vcenter\bgroup\vspace@\Let@ + \ifinany@\else\openup\jot\fi\ialign + \bgroup\hfil\strut@$\m@th\displaystyle{##}$\hfil\crcr} +\def\endgathered{\crcr\egroup\egroup} +\newif\iftagsleft@ +\def\TagsOnLeft{\global\tagsleft@true} +\def\TagsOnRight{\global\tagsleft@false} +\TagsOnLeft +\newif\ifmathtags@ +\def\TagsAsMath{\global\mathtags@true} +\def\TagsAsText{\global\mathtags@false} +\TagsAsText +\def\tagform@#1{\hbox{\rm(\ignorespaces#1\unskip)}} +\def\thetag{\leavevmode\tagform@} +\def\tag#1$${\iftagsleft@\leqno\else\eqno\fi %1 + \maketag@#1\maketag@ %2 + $$} %3 +\def\maketag@{\FN@\maketag@@} +\def\maketag@@{\ifx\next"\expandafter\maketag@@@\else\expandafter\maketag@@@@ + \fi} +\def\maketag@@@"#1"#2\maketag@{\hbox{\rm#1}} %1 +\def\maketag@@@@#1\maketag@{\ifmathtags@\tagform@{$\m@th#1$}\else + \tagform@{#1}\fi} +\interdisplaylinepenalty\@M +\def\allowdisplaybreaks{\RIfMIfI@ + \onlydmatherr@\allowdisplaybreaks\else + \interdisplaylinepenalty\z@\fi\else\onlydmatherr@\allowdisplaybreaks\fi} +\Invalid@\allowdisplaybreak +\Invalid@\displaybreak +\Invalid@\intertext +\def\allowdisplaybreak@{\def\allowdisplaybreak{\crcr\noalign{\allowbreak}}} +\def\displaybreak@{\def\displaybreak{\crcr\noalign{\break}}} +\def\intertext@{\def\intertext##1{\crcr\noalign{% + \penalty\postdisplaypenalty \vskip\belowdisplayskip + \vbox{\normalbaselines\noindent##1}% + \penalty\predisplaypenalty \vskip\abovedisplayskip}}} +\newskip\centering@ +\centering@\z@ plus\@m\p@ +\def\align{\relax\ifingather@\DN@{\csname align (in + \string\gather)\endcsname}\else + \ifmmode\ifinner\DN@{\onlydmatherr@\align}\else + \let\next@\align@\fi + \else\DN@{\onlydmatherr@\align}\fi\fi\next@} +\newhelp\andhelp@ +{An extra & here is so disastrous that you should probably exit^^J +and fix things up.} +\newif\iftag@ +\newcount\and@ +\def\align@{\inalign@true\inany@true + \vspace@\allowdisplaybreak@\displaybreak@\intertext@ + \def\tag{\global\tag@true\ifnum\and@=\z@\DN@{&&}\else + \DN@{&}\fi\next@}% + \iftagsleft@\DN@{\csname align \endcsname}\else + \DN@{\csname align \space\endcsname}\fi\next@} +\def\Tag@{\iftag@\else\errhelp\andhelp@\err@{Extra & on this line}\fi} +\newdimen\lwidth@ +\newdimen\rwidth@ +\newdimen\maxlwidth@ +\newdimen\maxrwidth@ +\newdimen\totwidth@ +\def\measure@#1\endalign{\lwidth@\z@\rwidth@\z@\maxlwidth@\z@\maxrwidth@\z@ + \global\and@\z@ %1 + \setbox@ne\vbox %2 + {\everycr{\noalign{\global\tag@false\global\and@\z@}}\Let@ %3 + \halign{\setboxz@h{$\m@th\displaystyle{\@lign##}$}% %4 + \global\lwidth@\wdz@ %5 + \ifdim\lwidth@>\maxlwidth@\global\maxlwidth@\lwidth@\fi %6 + \global\advance\and@\@ne %7 + &\setboxz@h{$\m@th\displaystyle{{}\@lign##}$}\global\rwidth@\wdz@ %8 + \ifdim\rwidth@>\maxrwidth@\global\maxrwidth@\rwidth@\fi %9 + \global\advance\and@\@ne %10 + &\Tag@ + \eat@{##}\crcr#1\crcr}}% %11 + \totwidth@\maxlwidth@\advance\totwidth@\maxrwidth@} %12 +\def\displ@y@{\global\dt@ptrue\openup\jot + \everycr{\noalign{\global\tag@false\global\and@\z@\ifdt@p\global\dt@pfalse + \vskip-\lineskiplimit\vskip\normallineskiplimit\else + \penalty\interdisplaylinepenalty\fi}}} +\def\black@#1{\noalign{\ifdim#1>\displaywidth + \dimen@\prevdepth\nointerlineskip %1 + \vskip-\ht\strutbox@\vskip-\dp\strutbox@ %2 + \vbox{\noindent\hbox to#1{\strut@\hfill}}% %3 + \prevdepth\dimen@ %4 + \fi}} +\expandafter\def\csname align \space\endcsname#1\endalign + {\measure@#1\endalign\global\and@\z@ %1 + \ifingather@\everycr{\noalign{\global\and@\z@}}\else\displ@y@\fi %2 + \Let@\tabskip\centering@ %3 + \halign to\displaywidth + {\hfil\strut@\setboxz@h{$\m@th\displaystyle{\@lign##}$}% %4 + \global\lwidth@\wdz@\boxz@\global\advance\and@\@ne %5 + \tabskip\z@skip %6 + &\setboxz@h{$\m@th\displaystyle{{}\@lign##}$}% %7 + \global\rwidth@\wdz@\boxz@\hfill\global\advance\and@\@ne %8 + \tabskip\centering@ %9 + &\setboxz@h{\@lign\strut@\maketag@##\maketag@}% %10 + \dimen@\displaywidth\advance\dimen@-\totwidth@ + \divide\dimen@\tw@\advance\dimen@\maxrwidth@\advance\dimen@-\rwidth@ %11 + \ifdim\dimen@<\tw@\wdz@\llap{\vtop{\normalbaselines\null\boxz@}}% %12 + \else\llap{\boxz@}\fi %13 + \tabskip\z@skip %14 + \crcr#1\crcr %15 + \black@\totwidth@}} %16 +\newdimen\lineht@ +\expandafter\def\csname align \endcsname#1\endalign{\measure@#1\endalign + \global\and@\z@ + \ifdim\totwidth@>\displaywidth\let\displaywidth@\totwidth@\else + \let\displaywidth@\displaywidth\fi %1 + \ifingather@\everycr{\noalign{\global\and@\z@}}\else\displ@y@\fi + \Let@\tabskip\centering@\halign to\displaywidth + {\hfil\strut@\setboxz@h{$\m@th\displaystyle{\@lign##}$}% + \global\lwidth@\wdz@\global\lineht@\ht\z@ %2 + \boxz@\global\advance\and@\@ne + \tabskip\z@skip&\setboxz@h{$\m@th\displaystyle{{}\@lign##}$}% + \global\rwidth@\wdz@\ifdim\ht\z@>\lineht@\global\lineht@\ht\z@\fi %3 + \boxz@\hfil\global\advance\and@\@ne + \tabskip\centering@&\kern-\displaywidth@ %4 + \setboxz@h{\@lign\strut@\maketag@##\maketag@}% + \dimen@\displaywidth\advance\dimen@-\totwidth@ + \divide\dimen@\tw@\advance\dimen@\maxlwidth@\advance\dimen@-\lwidth@ + \ifdim\dimen@<\tw@\wdz@ + \rlap{\vbox{\normalbaselines\boxz@\vbox to\lineht@{}}}\else + \rlap{\boxz@}\fi + \tabskip\displaywidth@\crcr#1\crcr\black@\totwidth@}} +\expandafter\def\csname align (in \string\gather)\endcsname + #1\endalign{\vcenter{\align@#1\endalign}} +\Invalid@\endalign +\newif\ifxat@ +\def\alignat{\RIfMIfI@\DN@{\onlydmatherr@\alignat}\else + \DN@{\csname alignat \endcsname}\fi\else + \DN@{\onlydmatherr@\alignat}\fi\next@} +\newif\ifmeasuring@ +\newbox\savealignat@ +\expandafter\def\csname alignat \endcsname#1#2\endalignat %1 + {\inany@true\xat@false + \def\tag{\global\tag@true\count@#1\relax\multiply\count@\tw@ + \xdef\tag@{}\loop\ifnum\count@>\and@\xdef\tag@{&\tag@}\advance\count@\m@ne + \repeat\tag@}% + \vspace@\allowdisplaybreak@\displaybreak@\intertext@ + \displ@y@\measuring@true %2 + \setbox\savealignat@\hbox{$\m@th\displaystyle\Let@ + \attag@{#1}% %3 + \vbox{\halign{\span\preamble@@\crcr#2\crcr}}$}% + \measuring@false %4 + \Let@\attag@{#1}% %5 + \tabskip\centering@\halign to\displaywidth + {\span\preamble@@\crcr#2\crcr %6 + \black@{\wd\savealignat@}}} %7 +\Invalid@\endalignat +\def\xalignat{\RIfMIfI@ + \DN@{\onlydmatherr@\xalignat}\else + \DN@{\csname xalignat \endcsname}\fi\else + \DN@{\onlydmatherr@\xalignat}\fi\next@} +\expandafter\def\csname xalignat \endcsname#1#2\endxalignat + {\inany@true\xat@true + \def\tag{\global\tag@true\def\tag@{}\count@#1\relax\multiply\count@\tw@ + \loop\ifnum\count@>\and@\xdef\tag@{&\tag@}\advance\count@\m@ne\repeat\tag@}% + \vspace@\allowdisplaybreak@\displaybreak@\intertext@ + \displ@y@\measuring@true\setbox\savealignat@\hbox{$\m@th\displaystyle\Let@ + \attag@{#1}\vbox{\halign{\span\preamble@@\crcr#2\crcr}}$}% + \measuring@false\Let@ + \attag@{#1}\tabskip\centering@\halign to\displaywidth + {\span\preamble@@\crcr#2\crcr\black@{\wd\savealignat@}}} +\def\attag@#1{\let\Maketag@\maketag@\let\TAG@\Tag@ %1 + \let\Tag@=0\let\maketag@=0% %2 + \ifmeasuring@\def\llap@##1{\setboxz@h{##1}\hbox to\tw@\wdz@{}}% + \def\rlap@##1{\setboxz@h{##1}\hbox to\tw@\wdz@{}}\else + \let\llap@\llap\let\rlap@\rlap\fi %3 + \toks@{\hfil\strut@$\m@th\displaystyle{\@lign\the\hashtoks@}$\tabskip\z@skip + \global\advance\and@\@ne&$\m@th\displaystyle{{}\@lign\the\hashtoks@}$\hfil + \ifxat@\tabskip\centering@\fi\global\advance\and@\@ne}% %4 + \iftagsleft@ + \toks@@{\tabskip\centering@&\Tag@\kern-\displaywidth + \rlap@{\@lign\maketag@\the\hashtoks@\maketag@}% + \global\advance\and@\@ne\tabskip\displaywidth}\else + \toks@@{\tabskip\centering@&\Tag@\llap@{\@lign\maketag@ + \the\hashtoks@\maketag@}\global\advance\and@\@ne\tabskip\z@skip}\fi %5 + \atcount@#1\relax\advance\atcount@\m@ne + \loop\ifnum\atcount@>\z@ + \toks@=\expandafter{\the\toks@&\hfil$\m@th\displaystyle{\@lign + \the\hashtoks@}$\global\advance\and@\@ne + \tabskip\z@skip&$\m@th\displaystyle{{}\@lign\the\hashtoks@}$\hfil\ifxat@ + \tabskip\centering@\fi\global\advance\and@\@ne}\advance\atcount@\m@ne + \repeat %6 + \xdef\preamble@{\the\toks@\the\toks@@}% %7 + \xdef\preamble@@{\preamble@}% %8 + \let\maketag@\Maketag@\let\Tag@\TAG@} %9 +\Invalid@\endxalignat +\def\xxalignat{\RIfMIfI@ + \DN@{\onlydmatherr@\xxalignat}\else\DN@{\csname xxalignat + \endcsname}\fi\else + \DN@{\onlydmatherr@\xxalignat}\fi\next@} +\expandafter\def\csname xxalignat \endcsname#1#2\endxxalignat{\inany@true + \vspace@\allowdisplaybreak@\displaybreak@\intertext@ + \displ@y\setbox\savealignat@\hbox{$\m@th\displaystyle\Let@ + \xxattag@{#1}\vbox{\halign{\span\preamble@@\crcr#2\crcr}}$}% + \Let@\xxattag@{#1}\tabskip\z@skip\halign to\displaywidth + {\span\preamble@@\crcr#2\crcr\black@{\wd\savealignat@}}} +\def\xxattag@#1{\toks@{\tabskip\z@skip\hfil\strut@ + $\m@th\displaystyle{\the\hashtoks@}$&% + $\m@th\displaystyle{{}\the\hashtoks@}$\hfil\tabskip\centering@&}% + \atcount@#1\relax\advance\atcount@\m@ne\loop\ifnum\atcount@>\z@ + \toks@=\expandafter{\the\toks@&\hfil$\m@th\displaystyle{\the\hashtoks@}$% + \tabskip\z@skip&$\m@th\displaystyle{{}\the\hashtoks@}$\hfil + \tabskip\centering@}\advance\atcount@\m@ne\repeat + \xdef\preamble@{\the\toks@\tabskip\z@skip}\xdef\preamble@@{\preamble@}} +\Invalid@\endxxalignat +\newdimen\gwidth@ +\newdimen\gmaxwidth@ +\def\gmeasure@#1\endgather{\gwidth@\z@\gmaxwidth@\z@\setbox@ne\vbox{\Let@ + \halign{\setboxz@h{$\m@th\displaystyle{##}$}\global\gwidth@\wdz@ + \ifdim\gwidth@>\gmaxwidth@\global\gmaxwidth@\gwidth@\fi + &\eat@{##}\crcr#1\crcr}}} +\def\gather{\RIfMIfI@\DN@{\onlydmatherr@\gather}\else + \ingather@true\inany@true\def\tag{&}% + \vspace@\allowdisplaybreak@\displaybreak@\intertext@ + \displ@y\Let@ + \iftagsleft@\DN@{\csname gather \endcsname}\else + \DN@{\csname gather \space\endcsname}\fi\fi + \else\DN@{\onlydmatherr@\gather}\fi\next@} +\expandafter\def\csname gather \space\endcsname#1\endgather + {\gmeasure@#1\endgather\tabskip\centering@ + \halign to\displaywidth{\hfil\strut@\setboxz@h{$\m@th\displaystyle{##}$}% + \global\gwidth@\wdz@\boxz@\hfil& + \setboxz@h{\strut@{\maketag@##\maketag@}}% + \dimen@\displaywidth\advance\dimen@-\gwidth@ + \ifdim\dimen@>\tw@\wdz@\llap{\boxz@}\else + \llap{\vtop{\normalbaselines\null\boxz@}}\fi + \tabskip\z@skip\crcr#1\crcr\black@\gmaxwidth@}} +\newdimen\glineht@ +\expandafter\def\csname gather \endcsname#1\endgather{\gmeasure@#1\endgather + \ifdim\gmaxwidth@>\displaywidth\let\gdisplaywidth@\gmaxwidth@\else + \let\gdisplaywidth@\displaywidth\fi\tabskip\centering@\halign to\displaywidth + {\hfil\strut@\setboxz@h{$\m@th\displaystyle{##}$}% + \global\gwidth@\wdz@\global\glineht@\ht\z@\boxz@\hfil&\kern-\gdisplaywidth@ + \setboxz@h{\strut@{\maketag@##\maketag@}}% + \dimen@\displaywidth\advance\dimen@-\gwidth@ + \ifdim\dimen@>\tw@\wdz@\rlap{\boxz@}\else + \rlap{\vbox{\normalbaselines\boxz@\vbox to\glineht@{}}}\fi + \tabskip\gdisplaywidth@\crcr#1\crcr\black@\gmaxwidth@}} +\newif\ifctagsplit@ +\def\CenteredTagsOnSplits{\global\ctagsplit@true} +\def\TopOrBottomTagsOnSplits{\global\ctagsplit@false} +\TopOrBottomTagsOnSplits +\def\split{\relax\ifinany@\let\next@\insplit@\else + \ifmmode\ifinner\def\next@{\onlydmatherr@\split}\else + \let\next@\outsplit@\fi\else + \def\next@{\onlydmatherr@\split}\fi\fi\next@} +\def\insplit@{\global\setbox\z@\vbox\bgroup\vspace@\Let@\ialign\bgroup + \hfil\strut@$\m@th\displaystyle{##}$&$\m@th\displaystyle{{}##}$\hfill\crcr} +\def\endsplit{\crcr\egroup\egroup\iftagsleft@\expandafter\lendsplit@\else + \expandafter\rendsplit@\fi} +\def\rendsplit@{\global\setbox9 \vbox + {\unvcopy\z@\global\setbox8 \lastbox\unskip}% %1 + \setbox@ne\hbox{\unhcopy8 \unskip\global\setbox\tw@\lastbox + \unskip\global\setbox\thr@@\lastbox}% %2 + \global\setbox7 \hbox{\unhbox\tw@\unskip}% %3 + \ifinalign@\ifctagsplit@ %4 + \gdef\split@{\hbox to\wd\thr@@{}& + \vcenter{\vbox{\moveleft\wd\thr@@\boxz@}}}% %5 + \else\gdef\split@{&\vbox{\moveleft\wd\thr@@\box9}\crcr + \box\thr@@&\box7}\fi %6 + \else %7 + \ifctagsplit@\gdef\split@{\vcenter{\boxz@}}\else + \gdef\split@{\box9\crcr\hbox{\box\thr@@\box7}}\fi + \fi + \split@} %8 +\def\lendsplit@{\global\setbox9\vtop{\unvcopy\z@}% %1 + \setbox@ne\vbox{\unvcopy\z@\global\setbox8\lastbox}% %2 + \setbox@ne\hbox{\unhcopy8\unskip\setbox\tw@\lastbox + \unskip\global\setbox\thr@@\lastbox}% %3 + \ifinalign@\ifctagsplit@ %4 + \gdef\split@{\hbox to\wd\thr@@{}& + \vcenter{\vbox{\moveleft\wd\thr@@\box9}}}% %5 + \else %6 + \gdef\split@{\hbox to\wd\thr@@{}&\vbox{\moveleft\wd\thr@@\box9}}\fi + \else + \ifctagsplit@\gdef\split@{\vcenter{\box9}}\else + \gdef\split@{\box9}\fi + \fi\split@} +\def\outsplit@#1$${\align\insplit@#1\endalign$$} +\newdimen\multlinegap@ +\multlinegap@1em +\newdimen\multlinetaggap@ +\multlinetaggap@1em +\def\MultlineGap#1{\global\multlinegap@#1\relax} +\def\multlinegap#1{\RIfMIfI@\onlydmatherr@\multlinegap\else + \multlinegap@#1\relax\fi\else\onlydmatherr@\multlinegap\fi} +\def\nomultlinegap{\multlinegap{\z@}} +\def\multline{\RIfMIfI@ + \DN@{\onlydmatherr@\multline}\else + \DN@{\multline@}\fi\else + \DN@{\onlydmatherr@\multline}\fi\next@} +\newif\iftagin@ +\def\tagin@#1{\tagin@false\in@\tag{#1}\ifin@\tagin@true\fi} +\def\multline@#1$${\inany@true\vspace@\allowdisplaybreak@\displaybreak@ + \tagin@{#1}\iftagsleft@\DN@{\multline@l#1$$}\else + \DN@{\multline@r#1$$}\fi\next@} +\newdimen\mwidth@ +\def\rmmeasure@#1\endmultline{% + \def\shoveleft##1{##1}\def\shoveright##1{##1}% %1 + \setbox@ne\vbox{\Let@\halign{\setboxz@h + {$\m@th\@lign\displaystyle{}##$}\global\mwidth@\wdz@ + \crcr#1\crcr}}} +\newdimen\mlineht@ +\newif\ifzerocr@ +\newif\ifonecr@ +\def\lmmeasure@#1\endmultline{\global\zerocr@true\global\onecr@false + \everycr{\noalign{\ifonecr@\global\onecr@false\fi + \ifzerocr@\global\zerocr@false\global\onecr@true\fi}}% %1 + \def\shoveleft##1{##1}\def\shoveright##1{##1}% + \setbox@ne\vbox{\Let@\halign{\setboxz@h + {$\m@th\@lign\displaystyle{}##$}\ifonecr@\global\mwidth@\wdz@ + \global\mlineht@\ht\z@\fi\crcr#1\crcr}}} +\newbox\mtagbox@ +\newdimen\ltwidth@ +\newdimen\rtwidth@ +\def\multline@l#1$${\iftagin@\DN@{\lmultline@@#1$$}\else + \DN@{\setbox\mtagbox@\null\ltwidth@\z@\rtwidth@\z@ + \lmultline@@@#1$$}\fi\next@} +\def\lmultline@@#1\endmultline\tag#2$${% + \setbox\mtagbox@\hbox{\maketag@#2\maketag@}% %1 + \lmmeasure@#1\endmultline\dimen@\mwidth@\advance\dimen@\wd\mtagbox@ + \advance\dimen@\multlinetaggap@ %2 + \ifdim\dimen@>\displaywidth\ltwidth@\z@\else\ltwidth@\wd\mtagbox@\fi %3 + \lmultline@@@#1\endmultline$$} +\def\lmultline@@@{\displ@y + \def\shoveright##1{##1\hfilneg\hskip\multlinegap@}% + \def\shoveleft##1{\setboxz@h{$\m@th\displaystyle{}##1$}% + \setbox@ne\hbox{$\m@th\displaystyle##1$}% + \hfilneg + \iftagin@ + \ifdim\ltwidth@>\z@\hskip\ltwidth@\hskip\multlinetaggap@\fi + \else\hskip\multlinegap@\fi\hskip.5\wd@ne\hskip-.5\wdz@##1}% %1 + \halign\bgroup\Let@\hbox to\displaywidth + {\strut@$\m@th\displaystyle\hfil{}##\hfil$}\crcr + \hfilneg %2 + \iftagin@ %3 + \ifdim\ltwidth@>\z@ %4 + \box\mtagbox@\hskip\multlinetaggap@ %5 + \else + \rlap{\vbox{\normalbaselines\hbox{\strut@\box\mtagbox@}% + \vbox to\mlineht@{}}}\fi %6 + \else\hskip\multlinegap@\fi} %7 +\def\multline@r#1$${\iftagin@\DN@{\rmultline@@#1$$}\else + \DN@{\setbox\mtagbox@\null\ltwidth@\z@\rtwidth@\z@ + \rmultline@@@#1$$}\fi\next@} +\def\rmultline@@#1\endmultline\tag#2$${\ltwidth@\z@ + \setbox\mtagbox@\hbox{\maketag@#2\maketag@}% + \rmmeasure@#1\endmultline\dimen@\mwidth@\advance\dimen@\wd\mtagbox@ + \advance\dimen@\multlinetaggap@ + \ifdim\dimen@>\displaywidth\rtwidth@\z@\else\rtwidth@\wd\mtagbox@\fi + \rmultline@@@#1\endmultline$$} +\def\rmultline@@@{\displ@y + \def\shoveright##1{##1\hfilneg\iftagin@\ifdim\rtwidth@>\z@ + \hskip\rtwidth@\hskip\multlinetaggap@\fi\else\hskip\multlinegap@\fi}% + \def\shoveleft##1{\setboxz@h{$\m@th\displaystyle{}##1$}% + \setbox@ne\hbox{$\m@th\displaystyle##1$}% + \hfilneg\hskip\multlinegap@\hskip.5\wd@ne\hskip-.5\wdz@##1}% + \halign\bgroup\Let@\hbox to\displaywidth + {\strut@$\m@th\displaystyle\hfil{}##\hfil$}\crcr + \hfilneg\hskip\multlinegap@} +\def\endmultline{\iftagsleft@\expandafter\lendmultline@\else + \expandafter\rendmultline@\fi} +\def\lendmultline@{\hfilneg\hskip\multlinegap@\crcr\egroup} +\def\rendmultline@{\iftagin@ %1 + \ifdim\rtwidth@>\z@ %2 + \hskip\multlinetaggap@\box\mtagbox@ %3 + \else\llap{\vtop{\normalbaselines\null\hbox{\strut@\box\mtagbox@}}}\fi %4 + \else\hskip\multlinegap@\fi %5 + \hfilneg\crcr\egroup} +\def\bmod{\mskip-\medmuskip\mkern5mu\mathbin{\fam\z@ mod}\penalty900 + \mkern5mu\mskip-\medmuskip} +\def\pmod#1{\allowbreak\ifinner\mkern8mu\else\mkern18mu\fi + ({\fam\z@ mod}\,\,#1)} +\def\pod#1{\allowbreak\ifinner\mkern8mu\else\mkern18mu\fi(#1)} +\def\mod#1{\allowbreak\ifinner\mkern12mu\else\mkern18mu\fi{\fam\z@ mod}\,\,#1} +\message{continued fractions,} +\newcount\cfraccount@ +\def\cfrac{\bgroup\bgroup\advance\cfraccount@\@ne\strut + \iffalse{\fi\def\\{\over\displaystyle}\iffalse}\fi} +\def\lcfrac{\bgroup\bgroup\advance\cfraccount@\@ne\strut + \iffalse{\fi\def\\{\hfill\over\displaystyle}\iffalse}\fi} +\def\rcfrac{\bgroup\bgroup\advance\cfraccount@\@ne\strut\hfill + \iffalse{\fi\def\\{\over\displaystyle}\iffalse}\fi} +\def\gloop@#1\repeat{\gdef\body{#1}\iterate} +\def\endcfrac{\gloop@\ifnum\cfraccount@>\z@\global\advance\cfraccount@\m@ne + \egroup\hskip-\nulldelimiterspace\egroup\repeat} +\message{compound symbols,} +\def\binrel@#1{\setboxz@h{\thinmuskip0mu + \medmuskip\m@ne mu\thickmuskip\@ne mu$#1\m@th$}% + \setbox@ne\hbox{\thinmuskip0mu\medmuskip\m@ne mu\thickmuskip + \@ne mu${}#1{}\m@th$}% + \setbox\tw@\hbox{\hskip\wd@ne\hskip-\wdz@}} +\def\overset#1\to#2{\binrel@{#2}\ifdim\wd\tw@<\z@ + \mathbin{\mathop{\kern\z@#2}\limits^{#1}}\else\ifdim\wd\tw@>\z@ + \mathrel{\mathop{\kern\z@#2}\limits^{#1}}\else + {\mathop{\kern\z@#2}\limits^{#1}}{}\fi\fi} +\def\underset#1\to#2{\binrel@{#2}\ifdim\wd\tw@<\z@ + \mathbin{\mathop{\kern\z@#2}\limits_{#1}}\else\ifdim\wd\tw@>\z@ + \mathrel{\mathop{\kern\z@#2}\limits_{#1}}\else + {\mathop{\kern\z@#2}\limits_{#1}}{}\fi\fi} +\def\oversetbrace#1\to#2{\overbrace{#2}^{#1}} +\def\undersetbrace#1\to#2{\underbrace{#2}_{#1}} +\def\sideset#1\and#2\to#3{% + \setbox@ne\hbox{$\dsize{\vphantom{#3}}#1{#3}\m@th$}% + \setbox\tw@\hbox{$\dsize{#3}#2\m@th$}% + \hskip\wd@ne\hskip-\wd\tw@\mathop{\hskip\wd\tw@\hskip-\wd@ne + {\vphantom{#3}}#1{#3}#2}} +\def\rightarrowfill@#1{\setboxz@h{$#1-\m@th$}\ht\z@\z@ + $#1\m@th\copy\z@\mkern-6mu\cleaders + \hbox{$#1\mkern-2mu\box\z@\mkern-2mu$}\hfill + \mkern-6mu\mathord\rightarrow$} +\def\leftarrowfill@#1{\setboxz@h{$#1-\m@th$}\ht\z@\z@ + $#1\m@th\mathord\leftarrow\mkern-6mu\cleaders + \hbox{$#1\mkern-2mu\copy\z@\mkern-2mu$}\hfill + \mkern-6mu\box\z@$} +\def\leftrightarrowfill@#1{\setboxz@h{$#1-\m@th$}\ht\z@\z@ + $#1\m@th\mathord\leftarrow\mkern-6mu\cleaders + \hbox{$#1\mkern-2mu\box\z@\mkern-2mu$}\hfill + \mkern-6mu\mathord\rightarrow$} +\def\overrightarrow{\mathpalette\overrightarrow@} +\def\overrightarrow@#1#2{\vbox{\ialign{##\crcr\rightarrowfill@#1\crcr + \noalign{\kern-\ex@\nointerlineskip}$\m@th\hfil#1#2\hfil$\crcr}}} +\let\overarrow\overrightarrow +\def\overleftarrow{\mathpalette\overleftarrow@} +\def\overleftarrow@#1#2{\vbox{\ialign{##\crcr\leftarrowfill@#1\crcr + \noalign{\kern-\ex@\nointerlineskip}$\m@th\hfil#1#2\hfil$\crcr}}} +\def\overleftrightarrow{\mathpalette\overleftrightarrow@} +\def\overleftrightarrow@#1#2{\vbox{\ialign{##\crcr\leftrightarrowfill@#1\crcr + \noalign{\kern-\ex@\nointerlineskip}$\m@th\hfil#1#2\hfil$\crcr}}} +\def\underrightarrow{\mathpalette\underrightarrow@} +\def\underrightarrow@#1#2{\vtop{\ialign{##\crcr$\m@th\hfil#1#2\hfil$\crcr + \noalign{\nointerlineskip}\rightarrowfill@#1\crcr}}} +\let\underarrow\underrightarrow +\def\underleftarrow{\mathpalette\underleftarrow@} +\def\underleftarrow@#1#2{\vtop{\ialign{##\crcr$\m@th\hfil#1#2\hfil$\crcr + \noalign{\nointerlineskip}\leftarrowfill@#1\crcr}}} +\def\underleftrightarrow{\mathpalette\underleftrightarrow@} +\def\underleftrightarrow@#1#2{\vtop{\ialign{##\crcr$\m@th\hfil#1#2\hfil$\crcr + \noalign{\nointerlineskip}\leftrightarrowfill@#1\crcr}}} +\message{various kinds of dots,} +\let\DOTSI\relax +\let\DOTSB\relax +\let\DOTSX\relax +\newif\ifmath@ +{\uccode`7=`\\ \uccode`8=`m \uccode`9=`a \uccode`0=`t \uccode`!=`h + \uppercase{\gdef\math@#1#2#3#4#5#6\math@{\global\math@false\ifx 7#1\ifx 8#2% + \ifx 9#3\ifx 0#4\ifx !#5\xdef\meaning@{#6}\global\math@true\fi\fi\fi\fi\fi}}} +\newif\ifmathch@ +{\uccode`7=`c \uccode`8=`h \uccode`9=`\" + \uppercase{\gdef\mathch@#1#2#3#4#5#6\mathch@{\global\mathch@false + \ifx 7#1\ifx 8#2\ifx 9#5\global\mathch@true\xdef\meaning@{9#6}\fi\fi\fi}}} +\newcount\classnum@ +\def\getmathch@#1.#2\getmathch@{\classnum@#1 \divide\classnum@4096 + \ifcase\number\classnum@\or\or\gdef\thedots@{\dotsb@}\or + \gdef\thedots@{\dotsb@}\fi} +\newif\ifmathbin@ +{\uccode`4=`b \uccode`5=`i \uccode`6=`n + \uppercase{\gdef\mathbin@#1#2#3{\relaxnext@ + \DNii@##1\mathbin@{\ifx\space@\next\global\mathbin@true\fi}% + \global\mathbin@false\DN@##1\mathbin@{}% + \ifx 4#1\ifx 5#2\ifx 6#3\DN@{\FN@\nextii@}\fi\fi\fi\next@}}} +\newif\ifmathrel@ +{\uccode`4=`r \uccode`5=`e \uccode`6=`l + \uppercase{\gdef\mathrel@#1#2#3{\relaxnext@ + \DNii@##1\mathrel@{\ifx\space@\next\global\mathrel@true\fi}% + \global\mathrel@false\DN@##1\mathrel@{}% + \ifx 4#1\ifx 5#2\ifx 6#3\DN@{\FN@\nextii@}\fi\fi\fi\next@}}} +\newif\ifmacro@ +{\uccode`5=`m \uccode`6=`a \uccode`7=`c + \uppercase{\gdef\macro@#1#2#3#4\macro@{\global\macro@false + \ifx 5#1\ifx 6#2\ifx 7#3\global\macro@true + \xdef\meaning@{\macro@@#4\macro@@}\fi\fi\fi}}} +\def\macro@@#1->#2\macro@@{#2} +\newif\ifDOTS@ +\newcount\DOTSCASE@ +{\uccode`6=`\\ \uccode`7=`D \uccode`8=`O \uccode`9=`T \uccode`0=`S + \uppercase{\gdef\DOTS@#1#2#3#4#5{\global\DOTS@false\DN@##1\DOTS@{}% + \ifx 6#1\ifx 7#2\ifx 8#3\ifx 9#4\ifx 0#5\let\next@\DOTS@@\fi\fi\fi\fi\fi + \next@}}} +{\uccode`3=`B \uccode`4=`I \uccode`5=`X + \uppercase{\gdef\DOTS@@#1{\relaxnext@ + \DNii@##1\DOTS@{\ifx\space@\next\global\DOTS@true\fi}% + \DN@{\FN@\nextii@}% + \ifx 3#1\global\DOTSCASE@\z@\else + \ifx 4#1\global\DOTSCASE@\@ne\else + \ifx 5#1\global\DOTSCASE@\tw@\else\DN@##1\DOTS@{}% + \fi\fi\fi\next@}}} +\newif\ifnot@ +{\uccode`5=`\\ \uccode`6=`n \uccode`7=`o \uccode`8=`t + \uppercase{\gdef\not@#1#2#3#4{\relaxnext@ + \DNii@##1\not@{\ifx\space@\next\global\not@true\fi}% + \global\not@false\DN@##1\not@{}% + \ifx 5#1\ifx 6#2\ifx 7#3\ifx 8#4\DN@{\FN@\nextii@}\fi\fi\fi + \fi\next@}}} +\newif\ifkeybin@ +\def\keybin@{\keybin@true + \ifx\next+\else\ifx\next=\else\ifx\next<\else\ifx\next>\else\ifx\next-\else + \ifx\next*\else\ifx\next:\else\keybin@false\fi\fi\fi\fi\fi\fi\fi} +\def\dots{\RIfM@\expandafter\mdots@\else\expandafter\tdots@\fi} +\def\tdots@{\unskip\relaxnext@ + \DN@{$\m@th\mathinner{\ldotp\ldotp\ldotp}\, + \ifx\next,\,$\else\ifx\next.\,$\else\ifx\next;\,$\else\ifx\next:\,$\else + \ifx\next?\,$\else\ifx\next!\,$\else$ \fi\fi\fi\fi\fi\fi}% + \ \FN@\next@} +\def\mdots@{\FN@\mdots@@} +\def\mdots@@{\gdef\thedots@{\dotso@}% %1 + \ifx\next\boldkey\gdef\thedots@\boldkey{\boldkeydots@}\else %2 + \ifx\next\boldsymbol\gdef\thedots@\boldsymbol{\boldsymboldots@}\else %3 + \ifx,\next\gdef\thedots@{\dotsc}% %4 + \else\ifx\not\next\gdef\thedots@{\dotsb@}% %5 + \else\keybin@ + \ifkeybin@\gdef\thedots@{\dotsb@}% %6 + \else\xdef\meaning@{\meaning\next..........}\xdef\meaning@@{\meaning@}% %7 + \expandafter\math@\meaning@\math@ + \ifmath@ + \expandafter\mathch@\meaning@\mathch@ + \ifmathch@\expandafter\getmathch@\meaning@\getmathch@\fi %8 + \else\expandafter\macro@\meaning@@\macro@ %9 + \ifmacro@ %10 + \expandafter\not@\meaning@\not@\ifnot@\gdef\thedots@{\dotsb@}% %11 + \else\expandafter\DOTS@\meaning@\DOTS@ + \ifDOTS@ + \ifcase\number\DOTSCASE@\gdef\thedots@{\dotsb@}% + \or\gdef\thedots@{\dotsi}\else\fi %12 + \else\expandafter\math@\meaning@\math@ %13 + \ifmath@\expandafter\mathbin@\meaning@\mathbin@ + \ifmathbin@\gdef\thedots@{\dotsb@}% %14 + \else\expandafter\mathrel@\meaning@\mathrel@ + \ifmathrel@\gdef\thedots@{\dotsb@}% %15 + \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi + \thedots@} +\def\plainldots@{\mathinner{\ldotp\ldotp\ldotp}} +\def\plaincdots@{\mathinner{\cdotp\cdotp\cdotp}} +\def\dotsi{\!\plaincdots@} +\let\dotsb@\plaincdots@ +\newif\ifextra@ +\newif\ifrightdelim@ +\def\rightdelim@{\global\rightdelim@true %1 + \ifx\next)\else %2 + \ifx\next]\else + \ifx\next\rbrack\else + \ifx\next\}\else + \ifx\next\rbrace\else + \ifx\next\rangle\else + \ifx\next\rceil\else + \ifx\next\rfloor\else + \ifx\next\rgroup\else + \ifx\next\rmoustache\else + \ifx\next\right\else + \ifx\next\bigr\else + \ifx\next\biggr\else + \ifx\next\Bigr\else %3 + \ifx\next\Biggr\else\global\rightdelim@false + \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi} +\def\extra@{% + \global\extra@false\rightdelim@\ifrightdelim@\global\extra@true %1 + \else\ifx\next$\global\extra@true %2 + \else\xdef\meaning@{\meaning\next..........}% %3 + \expandafter\macro@\meaning@\macro@\ifmacro@ %4 + \expandafter\DOTS@\meaning@\DOTS@ + \ifDOTS@ + \ifnum\DOTSCASE@=\tw@\global\extra@true %5 + \fi\fi\fi\fi\fi} +\newif\ifbold@ +\def\dotso@{\relaxnext@ + \ifbold@ + \let\next\delayed@ + \DNii@{\extra@\plainldots@\ifextra@\,\fi}% + \else + \DNii@{\DN@{\extra@\plainldots@\ifextra@\,\fi}\FN@\next@}% + \fi + \nextii@} +\def\extrap@#1{% + \ifx\next,\DN@{#1\,}\else + \ifx\next;\DN@{#1\,}\else + \ifx\next.\DN@{#1\,}\else\extra@ + \ifextra@\DN@{#1\,}\else + \let\next@#1\fi\fi\fi\fi\next@} +\def\ldots{\DN@{\extrap@\plainldots@}% + \FN@\next@} +\def\cdots{\DN@{\extrap@\plaincdots@}% + \FN@\next@} +\let\dotso\ldots +\let\dotsb\cdots +\let\dotsm\dotsb +\def\dotsc{\relaxnext@ + \DN@{\ifx\next;\plainldots@\,\else + \ifx\next.\plainldots@\,\else\extra@\plainldots@ + \ifextra@\,\fi\fi\fi}% + \FN@\next@} +\def\cdot{\mathchar"2201 } +\def\longrightarrow{\DOTSB\relbar\joinrel\rightarrow} +\def\Longrightarrow{\DOTSB\Relbar\joinrel\Rightarrow} +\def\longleftarrow{\DOTSB\leftarrow\joinrel\relbar} +\def\Longleftarrow{\DOTSB\Leftarrow\joinrel\Relbar} +\def\longleftrightarrow{\DOTSB\leftarrow\joinrel\rightarrow} +\def\Longleftrightarrow{\DOTSB\Leftarrow\joinrel\Rightarrow} +\def\mapsto{\DOTSB\mapstochar\rightarrow} +\def\longmapsto{\DOTSB\mapstochar\longrightarrow} +\def\hookrightarrow{\DOTSB\lhook\joinrel\rightarrow} +\def\hookleftarrow{\DOTSB\leftarrow\joinrel\rhook} +\def\doteq{\DOTSB\buildrel\textstyle.\over=} +\def\iff{\DOTSB\;\Longleftrightarrow\;} +\message{special superscripts,} +\def\dddot#1{{\mathop{#1}\limits^{\vbox to-1.4\ex@{\kern-\tw@\ex@ + \hbox{\rm...}\vss}}}} +\def\ddddot#1{{\mathop{#1}\limits^{\vbox to-1.4\ex@{\kern-\tw@\ex@ + \hbox{\rm....}\vss}}}} +\def\sphat{^{\mathchoice{}{}% + {\,\,\botsmash{\hbox{\lower4\ex@\hbox{$\m@th\widehat{\null}$}}}}% + {\,\botsmash{\hbox{\lower3\ex@\hbox{$\m@th\hat{\null}$}}}}}} +\def\spcheck{^\vee} +\def\sptilde{^\sim} +\def\spacute{^{\!\botsmash{\hbox{\lower\@ne ex\hbox{\'{}}}}}} +\def\spgrave{^{\mathchoice{}{}{}{\!}% + \botsmash{\hbox{\lower\@ne ex\hbox{\`{}}}}}} +\def\spdot{^{\hbox{\raise\ex@\hbox{\rm.}}}} +\def\spddot{^{\hbox{\raise\ex@\hbox{\rm..}}}} +\def\spdddot{^{\hbox{\raise\ex@\hbox{\rm...}}}} +\def\spddddot{^{\hbox{\raise\ex@\hbox{\rm....}}}} +\def\spbreve{^{\!\botsmash{\hbox{\lower4\ex@\hbox{\u{}}}}}} +\def\spbar{^-} +\def\spvec{^\rightarrow} +\message{\string\text,} +\def\textonlyfont@#1#2{\def#1{\RIfM@ + \Err@{Use \string#1\space only in text}\else#2\fi}} +\textonlyfont@\rm\tenrm +\textonlyfont@\it\tenit +\textonlyfont@\sl\tensl +\textonlyfont@\bf\tenbf +\def\oldnos#1{\RIfM@{\mathcode`\,="013B \fam\@ne#1}\else + \leavevmode\hbox{$\m@th\mathcode`\,="013B \fam\@ne#1$}\fi} +\def\text{\RIfM@\expandafter\text@\else\expandafter\text@@\fi} +\def\text@@#1{\leavevmode\hbox{#1}} +\def\mathhexbox@#1#2#3{\text{$\m@th\mathchar"#1#2#3$}} +\def\dag{{\mathhexbox@279}} +\def\ddag{{\mathhexbox@27A}} +\def\S{{\mathhexbox@278}} +\def\P{{\mathhexbox@27B}} +\newif\iffirstchoice@ +\firstchoice@true +\def\text@#1{\mathchoice + {\hbox{\everymath{\displaystyle}\def\textfonti{\the\textfont\@ne}% + \def\textfontii{\the\textfont\tw@}\textdef@@ T#1}} + {\hbox{\firstchoice@false + \everymath{\textstyle}\def\textfonti{\the\textfont\@ne}% + \def\textfontii{\the\textfont\tw@}\textdef@@ T#1}} + {\hbox{\firstchoice@false + \everymath{\scriptstyle}\def\textfonti{\the\scriptfont\@ne}% + \def\textfontii{\the\scriptfont\tw@}\textdef@@ S\rm#1}} + {\hbox{\firstchoice@false + \everymath{\scriptscriptstyle}\def\textfonti + {\the\scriptscriptfont\@ne}% + \def\textfontii{\the\scriptscriptfont\tw@}\textdef@@ s\rm#1}}} +\def\textdef@@#1{\textdef@#1\rm\textdef@#1\bf\textdef@#1\sl\textdef@#1\it} +\def\rmfam{0} +\def\textdef@#1#2{% + \DN@{\csname\expandafter\eat@\string#2fam\endcsname}% + \if S#1\edef#2{\the\scriptfont\next@\relax}% + \else\if s#1\edef#2{\the\scriptscriptfont\next@\relax}% + \else\edef#2{\the\textfont\next@\relax}\fi\fi} +\scriptfont\itfam\tenit \scriptscriptfont\itfam\tenit +\scriptfont\slfam\tensl \scriptscriptfont\slfam\tensl +\newif\iftopfolded@ +\newif\ifbotfolded@ +\def\topfoldedtext{\topfolded@true\botfolded@false\foldedtext@} +\def\botfoldedtext{\botfolded@true\topfolded@false\foldedtext@} +\def\foldedtext{\topfolded@false\botfolded@false\foldedtext@} +\Invalid@\foldedwidth +\def\foldedtext@{\relaxnext@ + \DN@{\ifx\next\foldedwidth\let\next@\nextii@\else + \DN@{\nextii@\foldedwidth{.3\hsize}}\fi\next@}% + \DNii@\foldedwidth##1##2{\setbox\z@\vbox + {\normalbaselines\hsize##1\relax + \tolerance1600 \noindent\ignorespaces##2}\ifbotfolded@\boxz@\else + \iftopfolded@\vtop{\unvbox\z@}\else\vcenter{\boxz@}\fi\fi}% + \FN@\next@} +\message{math font commands,} +\def\bold{\RIfM@\expandafter\bold@\else + \expandafter\nonmatherr@\expandafter\bold\fi} +\def\bold@#1{{\bold@@{#1}}} +\def\bold@@#1{\fam\bffam\relax#1} +\def\slanted{\RIfM@\expandafter\slanted@\else + \expandafter\nonmatherr@\expandafter\slanted\fi} +\def\slanted@#1{{\slanted@@{#1}}} +\def\slanted@@#1{\fam\slfam\relax#1} +\def\roman{\RIfM@\expandafter\roman@\else + \expandafter\nonmatherr@\expandafter\roman\fi} +\def\roman@#1{{\roman@@{#1}}} +\def\roman@@#1{\fam\rmfam\relax#1} +\def\italic{\RIfM@\expandafter\italic@\else + \expandafter\nonmatherr@\expandafter\italic\fi} +\def\italic@#1{{\italic@@{#1}}} +\def\italic@@#1{\fam\itfam\relax#1} +\def\Cal{\RIfM@\expandafter\Cal@\else + \expandafter\nonmatherr@\expandafter\Cal\fi} +\def\Cal@#1{{\Cal@@{#1}}} +\def\Cal@@#1{\noaccents@\fam\tw@#1} +\mathchardef\Gamma="0000 +\mathchardef\Delta="0001 +\mathchardef\Theta="0002 +\mathchardef\Lambda="0003 +\mathchardef\Xi="0004 +\mathchardef\Pi="0005 +\mathchardef\Sigma="0006 +\mathchardef\Upsilon="0007 +\mathchardef\Phi="0008 +\mathchardef\Psi="0009 +\mathchardef\Omega="000A +\mathchardef\varGamma="0100 +\mathchardef\varDelta="0101 +\mathchardef\varTheta="0102 +\mathchardef\varLambda="0103 +\mathchardef\varXi="0104 +\mathchardef\varPi="0105 +\mathchardef\varSigma="0106 +\mathchardef\varUpsilon="0107 +\mathchardef\varPhi="0108 +\mathchardef\varPsi="0109 +\mathchardef\varOmega="010A +\let\alloc@@\alloc@ +\def\hexnumber@#1{\ifcase#1 0\or 1\or 2\or 3\or 4\or 5\or 6\or 7\or 8\or + 9\or A\or B\or C\or D\or E\or F\fi} +\def\loadmsam{% + \font@\tenmsa=msam10 + \font@\sevenmsa=msam7 + \font@\fivemsa=msam5 + \alloc@@8\fam\chardef\sixt@@n\msafam + \textfont\msafam=\tenmsa + \scriptfont\msafam=\sevenmsa + \scriptscriptfont\msafam=\fivemsa + \edef\next{\hexnumber@\msafam}% + \mathchardef\dabar@"0\next39 + \edef\dashrightarrow{\mathrel{\dabar@\dabar@\mathchar"0\next4B}}% + \edef\dashleftarrow{\mathrel{\mathchar"0\next4C\dabar@\dabar@}}% + \let\dasharrow\dashrightarrow + \edef\ulcorner{\delimiter"4\next70\next70 }% + \edef\urcorner{\delimiter"5\next71\next71 }% + \edef\llcorner{\delimiter"4\next78\next78 }% + \edef\lrcorner{\delimiter"5\next79\next79 }% + \edef\yen{{\noexpand\mathhexbox@\next55}}% + \edef\checkmark{{\noexpand\mathhexbox@\next58}}% + \edef\circledR{{\noexpand\mathhexbox@\next72}}% + \edef\maltese{{\noexpand\mathhexbox@\next7A}}% + \global\let\loadmsam\empty}% +\def\loadmsbm{% + \font@\tenmsb=msbm10 \font@\sevenmsb=msbm7 \font@\fivemsb=msbm5 + \alloc@@8\fam\chardef\sixt@@n\msbfam + \textfont\msbfam=\tenmsb + \scriptfont\msbfam=\sevenmsb \scriptscriptfont\msbfam=\fivemsb + \global\let\loadmsbm\empty + } +\def\widehat#1{\ifx\undefined\msbfam \DN@{362}% + \else \setboxz@h{$\m@th#1$}% + \edef\next@{\ifdim\wdz@>\tw@ em% + \hexnumber@\msbfam 5B% + \else 362\fi}\fi + \mathaccent"0\next@{#1}} +\def\widetilde#1{\ifx\undefined\msbfam \DN@{365}% + \else \setboxz@h{$\m@th#1$}% + \edef\next@{\ifdim\wdz@>\tw@ em% + \hexnumber@\msbfam 5D% + \else 365\fi}\fi + \mathaccent"0\next@{#1}} +\message{\string\newsymbol,} +\def\newsymbol#1#2#3#4#5{\define#1{}% + \count@#2\relax \advance\count@\m@ne % to push case 0 to the \else clause + \ifcase\count@ + \ifx\undefined\msafam\loadmsam\fi \let\next@\msafam + \or \ifx\undefined\msbfam\loadmsbm\fi \let\next@\msbfam + \else \Err@{\Invalid@@\string\newsymbol}\let\next@\tw@\fi + \mathchardef#1="#3\hexnumber@\next@#4#5\space} +\def\UseAMSsymbols{\loadmsam\loadmsbm \input amssym.tex } +\def\Bbb{\RIfM@\expandafter\Bbb@\else + \expandafter\nonmatherr@\expandafter\Bbb\fi} +\def\Bbb@#1{{\Bbb@@{#1}}} +\def\Bbb@@#1{\noaccents@\fam\msbfam\relax#1} +\message{bold Greek and bold symbols,} +\def\loadbold{% + \font@\tencmmib=cmmib10 \font@\sevencmmib=cmmib7 \font@\fivecmmib=cmmib5 + \skewchar\tencmmib'177 \skewchar\sevencmmib'177 \skewchar\fivecmmib'177 + \alloc@@8\fam\chardef\sixt@@n\cmmibfam + \textfont\cmmibfam\tencmmib + \scriptfont\cmmibfam\sevencmmib \scriptscriptfont\cmmibfam\fivecmmib + \font@\tencmbsy=cmbsy10 \font@\sevencmbsy=cmbsy7 \font@\fivecmbsy=cmbsy5 + \skewchar\tencmbsy'60 \skewchar\sevencmbsy'60 \skewchar\fivecmbsy'60 + \alloc@@8\fam\chardef\sixt@@n\cmbsyfam + \textfont\cmbsyfam\tencmbsy + \scriptfont\cmbsyfam\sevencmbsy \scriptscriptfont\cmbsyfam\fivecmbsy + \let\loadbold\empty +} +\def\boldnotloaded#1{\Err@{\ifcase#1\or First\else Second\fi + bold symbol font not loaded}} +\def\mathchari@#1#2#3{\ifx\undefined\cmmibfam + \boldnotloaded@\@ne + \else\mathchar"#1\hexnumber@\cmmibfam#2#3\space \fi} +\def\mathcharii@#1#2#3{\ifx\undefined\cmbsyfam + \boldnotloaded\tw@ + \else \mathchar"#1\hexnumber@\cmbsyfam#2#3\space\fi} +\edef\bffam@{\hexnumber@\bffam} +\def\boldkey#1{\ifcat\noexpand#1A% + \ifx\undefined\cmmibfam \boldnotloaded\@ne + \else {\fam\cmmibfam#1}\fi + \else + \ifx#1!\mathchar"5\bffam@21 \else + \ifx#1(\mathchar"4\bffam@28 \else\ifx#1)\mathchar"5\bffam@29 \else + \ifx#1+\mathchar"2\bffam@2B \else\ifx#1:\mathchar"3\bffam@3A \else + \ifx#1;\mathchar"6\bffam@3B \else\ifx#1=\mathchar"3\bffam@3D \else + \ifx#1?\mathchar"5\bffam@3F \else\ifx#1[\mathchar"4\bffam@5B \else + \ifx#1]\mathchar"5\bffam@5D \else + \ifx#1,\mathchari@63B \else + \ifx#1-\mathcharii@200 \else + \ifx#1.\mathchari@03A \else + \ifx#1/\mathchari@03D \else + \ifx#1<\mathchari@33C \else + \ifx#1>\mathchari@33E \else + \ifx#1*\mathcharii@203 \else + \ifx#1|\mathcharii@06A \else + \ifx#10\bold0\else\ifx#11\bold1\else\ifx#12\bold2\else\ifx#13\bold3\else + \ifx#14\bold4\else\ifx#15\bold5\else\ifx#16\bold6\else\ifx#17\bold7\else + \ifx#18\bold8\else\ifx#19\bold9\else + \Err@{\string\boldkey\space can't be used with #1}% + \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi + \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi} +\def\boldsymbol#1{% + \DN@{\Err@{You can't use \string\boldsymbol\space with \string#1}#1}% + \ifcat\noexpand#1A% + \let\next@\relax + \ifx\undefined\cmmibfam \boldnotloaded\@ne + \else {\fam\cmmibfam#1}\fi + \else + \xdef\meaning@{\meaning#1.........}% + \expandafter\math@\meaning@\math@ + \ifmath@ + \expandafter\mathch@\meaning@\mathch@ + \ifmathch@ + \expandafter\boldsymbol@@\meaning@\boldsymbol@@ + \fi + \else + \expandafter\macro@\meaning@\macro@ + \expandafter\delim@\meaning@\delim@ + \ifdelim@ + \expandafter\delim@@\meaning@\delim@@ + \else + \boldsymbol@{#1}% + \fi + \fi + \fi + \next@} +\def\mathhexboxii@#1#2{\ifx\undefined\cmbsyfam + \boldnotloaded\tw@ + \else \mathhexbox@{\hexnumber@\cmbsyfam}{#1}{#2}\fi} +\def\boldsymbol@#1{\let\next@\relax\let\next#1% + \ifx\next\cdot\mathcharii@201 \else + \ifx\next\prime{{\null\mathcharii@030 \null}}\else + \ifx\next\lbrack\mathchar"4\bffam@5B \else + \ifx\next\rbrack\mathchar"5\bffam@5D \else + \ifx\next\{\mathcharii@466 \else + \ifx\next\lbrace\mathcharii@466 \else + \ifx\next\}\mathcharii@567 \else + \ifx\next\rbrace\mathcharii@567 \else + \ifx\next\surd{{\mathcharii@170}}\else + \ifx\next\S{{\mathhexboxii@78}}\else + \ifx\next\P{{\mathhexboxii@7B}}\else + \ifx\next\dag{{\mathhexboxii@79}}\else + \ifx\next\ddag{{\mathhexboxii@7A}}\else + \DN@{\Err@{You can't use \string\boldsymbol\space with \string#1}#1}% + \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi} +\def\boldsymbol@@#1.#2\boldsymbol@@{\classnum@#1 \count@@@\classnum@ %1 + \divide\classnum@4096 \count@\classnum@ %2 + \multiply\count@4096 \advance\count@@@-\count@ \count@@\count@@@ %3 + \divide\count@@@\@cclvi \count@\count@@ %4 + \multiply\count@@@\@cclvi \advance\count@@-\count@@@ %5 + \divide\count@@@\@cclvi %6 + \multiply\classnum@4096 \advance\classnum@\count@@ %7 + \ifnum\count@@@=\z@ %8 + \count@"\bffam@ \multiply\count@\@cclvi + \advance\classnum@\count@ + \DN@{\mathchar\number\classnum@}% + \else + \ifnum\count@@@=\@ne %9 + \ifx\undefined\cmmibfam \DN@{\boldnotloaded\@ne}% + \else \count@\cmmibfam \multiply\count@\@cclvi + \advance\classnum@\count@ + \DN@{\mathchar\number\classnum@}\fi + \else + \ifnum\count@@@=\tw@ %10 + \ifx\undefined\cmbsyfam + \DN@{\boldnotloaded\tw@}% + \else + \count@\cmbsyfam \multiply\count@\@cclvi + \advance\classnum@\count@ + \DN@{\mathchar\number\classnum@}% + \fi + \fi + \fi +\fi} +\newif\ifdelim@ +\newcount\delimcount@ +{\uccode`6=`\\ \uccode`7=`d \uccode`8=`e \uccode`9=`l + \uppercase{\gdef\delim@#1#2#3#4#5\delim@ + {\delim@false\ifx 6#1\ifx 7#2\ifx 8#3\ifx 9#4\delim@true + \xdef\meaning@{#5}\fi\fi\fi\fi}}} +\def\delim@@#1"#2#3#4#5#6\delim@@{\if#32% +\let\next@\relax + \ifx\undefined\cmbsyfam \boldnotloaded\@ne + \else \mathcharii@#2#4#5\space \fi\fi} +\def\vert{\delimiter"026A30C } +\def\Vert{\delimiter"026B30D } +\let\|\Vert +\def\backslash{\delimiter"026E30F } +\def\boldkeydots@#1{\bold@true\let\next=#1\let\delayed@=#1\mdots@@ + \boldkey#1\bold@false} % = required! +\def\boldsymboldots@#1{\bold@true\let\next#1\let\delayed@#1\mdots@@ + \boldsymbol#1\bold@false} +\message{Euler fonts,} +\def\loadeufm{\loadmathfont{eufm}} +\def\loadeufb{\loadmathfont{eufb}} +\def\loadeusm{\loadmathfont{eusm}} +\def\loadeusb{\loadmathfont{eusb}} +\def\loadeurm{\loadmathfont{eurm}} +\def\loadeurb{\loadmathfont{eurb}} +\def\frak{\mathfont@\frak} +\def\frakfam{\eufmfam} +\let\goth\frak +\def\loadmathfont#1{% + \expandafter\font@\csname ten#1\endcsname=#110 + \expandafter\font@\csname seven#1\endcsname=#17 + \expandafter\font@\csname five#1\endcsname=#15 + \edef\next{\noexpand\alloc@@8\fam\chardef\sixt@@n + \expandafter\noexpand\csname#1fam\endcsname}% + \next + \textfont\csname#1fam\endcsname \csname ten#1\endcsname + \scriptfont\csname#1fam\endcsname \csname seven#1\endcsname + \scriptscriptfont\csname#1fam\endcsname \csname five#1\endcsname + \expandafter\def\csname #1\expandafter\endcsname\expandafter{% + \expandafter\mathfont@\csname#1\endcsname}% + \expandafter\gdef\csname load#1\endcsname{}% +} +\def\mathfont@#1{\RIfM@\expandafter\mathfont@@\expandafter#1\else + \expandafter\nonmatherr@\expandafter#1\fi} +\def\mathfont@@#1#2{{\mathfont@@@#1{#2}}} +\def\mathfont@@@#1#2{\noaccents@ + \fam\csname\expandafter\eat@\string#1fam\endcsname + \relax#2} +\message{math accents,} +\def\accentclass@{7} +\def\noaccents@{\def\accentclass@{0}} +\def\makeacc@#1#2{\def#1{\mathaccent"\accentclass@#2 }} +\makeacc@\hat{05E} +\makeacc@\check{014} +\makeacc@\tilde{07E} +\makeacc@\acute{013} +\makeacc@\grave{012} +\makeacc@\dot{05F} +\makeacc@\ddot{07F} +\makeacc@\breve{015} +\makeacc@\bar{016} +\def\vec{\mathaccent"017E } +\newcount\skewcharcount@ +\newcount\familycount@ +\def\theskewchar@{\familycount@\@ne + \global\skewcharcount@\the\skewchar\textfont\@ne %1 + \ifnum\fam>\m@ne\ifnum\fam<16 + \global\familycount@\the\fam\relax + \global\skewcharcount@\the\skewchar\textfont\the\fam\relax\fi\fi %2 + \ifnum\skewcharcount@>\m@ne + \ifnum\skewcharcount@<128 + \multiply\familycount@256 + \global\advance\skewcharcount@\familycount@ + \global\advance\skewcharcount@28672 + \mathchar\skewcharcount@\else + \global\skewcharcount@\m@ne\fi\else + \global\skewcharcount@\m@ne\fi} %3 +\newcount\pointcount@ +\def\getpoints@#1.#2\getpoints@{\pointcount@#1 } +\newdimen\accentdimen@ +\newcount\accentmu@ +\def\dimentomu@{\multiply\accentdimen@ 100 + \expandafter\getpoints@\the\accentdimen@\getpoints@ + \multiply\pointcount@18 + \divide\pointcount@\@m + \global\accentmu@\pointcount@} +\def\Makeacc@#1#2{\def#1{\RIfM@\DN@{\mathaccent@ + {"\accentclass@#2 }}\else\DN@{\nonmatherr@{#1}}\fi\next@}} +\def\unbracefonts@{\let\Cal@\Cal@@\let\roman@\roman@@\let\bold@\bold@@ + \let\slanted@\slanted@@} +\def\mathaccent@#1#2{\ifnum\fam=\m@ne\xdef\thefam@{1}\else + \xdef\thefam@{\the\fam}\fi %1 + \accentdimen@\z@ %2 + \setboxz@h{\unbracefonts@$\m@th\fam\thefam@\relax#2$}% %3 + \ifdim\accentdimen@=\z@\DN@{\mathaccent#1{#2}}% %4 + \setbox@ne\hbox{\unbracefonts@$\m@th\fam\thefam@\relax#2\theskewchar@$}% %5a + \setbox\tw@\hbox{$\m@th\ifnum\skewcharcount@=\m@ne\else + \mathchar\skewcharcount@\fi$}% %5b + \global\accentdimen@\wd@ne\global\advance\accentdimen@-\wdz@ + \global\advance\accentdimen@-\wd\tw@ %5c + \global\multiply\accentdimen@\tw@ + \dimentomu@\global\advance\accentmu@\@ne %5d + \else\DN@{{\mathaccent#1{#2\mkern\accentmu@ mu}% + \mkern-\accentmu@ mu}{}}\fi %6 + \next@}\Makeacc@\Hat{05E} +\Makeacc@\Check{014} +\Makeacc@\Tilde{07E} +\Makeacc@\Acute{013} +\Makeacc@\Grave{012} +\Makeacc@\Dot{05F} +\Makeacc@\Ddot{07F} +\Makeacc@\Breve{015} +\Makeacc@\Bar{016} +\def\Vec{\RIfM@\DN@{\mathaccent@{"017E }}\else + \DN@{\nonmatherr@\Vec}\fi\next@} +\def\accentedsymbol#1#2{\csname newbox\expandafter\endcsname + \csname\expandafter\eat@\string#1@box\endcsname + \expandafter\setbox\csname\expandafter\eat@ + \string#1@box\endcsname\hbox{$\m@th#2$}\define + #1{\copy\csname\expandafter\eat@\string#1@box\endcsname{}}} +\message{roots,} +\def\sqrt#1{\radical"270370 {#1}} +\let\underline@\underline +\let\overline@\overline +\def\underline#1{\underline@{#1}} +\def\overline#1{\overline@{#1}} +\Invalid@\leftroot +\Invalid@\uproot +\newcount\uproot@ +\newcount\leftroot@ +\def\root{\relaxnext@ + \DN@{\ifx\next\uproot\let\next@\nextii@\else + \ifx\next\leftroot\let\next@\nextiii@\else + \let\next@\plainroot@\fi\fi\next@}% + \DNii@\uproot##1{\uproot@##1\relax\FN@\nextiv@}% + \def\nextiv@{\ifx\next\space@\DN@. {\FN@\nextv@}\else + \DN@.{\FN@\nextv@}\fi\next@.}% + \def\nextv@{\ifx\next\leftroot\let\next@\nextvi@\else + \let\next@\plainroot@\fi\next@}% + \def\nextvi@\leftroot##1{\leftroot@##1\relax\plainroot@}% + \def\nextiii@\leftroot##1{\leftroot@##1\relax\FN@\nextvii@}% + \def\nextvii@{\ifx\next\space@ + \DN@. {\FN@\nextviii@}\else + \DN@.{\FN@\nextviii@}\fi\next@.}% + \def\nextviii@{\ifx\next\uproot\let\next@\nextix@\else + \let\next@\plainroot@\fi\next@}% + \def\nextix@\uproot##1{\uproot@##1\relax\plainroot@}% + \bgroup\uproot@\z@\leftroot@\z@\FN@\next@} +\def\plainroot@#1\of#2{\setbox\rootbox\hbox{$\m@th\scriptscriptstyle{#1}$}% + \mathchoice{\r@@t\displaystyle{#2}}{\r@@t\textstyle{#2}} + {\r@@t\scriptstyle{#2}}{\r@@t\scriptscriptstyle{#2}}\egroup} +\def\r@@t#1#2{\setboxz@h{$\m@th#1\sqrt{#2}$}% + \dimen@\ht\z@\advance\dimen@-\dp\z@ + \setbox@ne\hbox{$\m@th#1\mskip\uproot@ mu$}\advance\dimen@ 1.667\wd@ne + \mkern-\leftroot@ mu\mkern5mu\raise.6\dimen@\copy\rootbox + \mkern-10mu\mkern\leftroot@ mu\boxz@} +\def\boxed#1{\setboxz@h{$\m@th\displaystyle{#1}$}\dimen@.4\ex@ + \advance\dimen@3\ex@\advance\dimen@\dp\z@ + \hbox{\lower\dimen@\hbox{% + \vbox{\hrule height.4\ex@ + \hbox{\vrule width.4\ex@\hskip3\ex@\vbox{\vskip3\ex@\boxz@\vskip3\ex@}% + \hskip3\ex@\vrule width.4\ex@}\hrule height.4\ex@}% + }}} +\message{commutative diagrams,} +\let\ampersand@\relax +\newdimen\minaw@ +\minaw@11.11128\ex@ +\newdimen\minCDaw@ +\minCDaw@2.5pc +\def\minCDarrowwidth#1{\RIfMIfI@\onlydmatherr@\minCDarrowwidth + \else\minCDaw@#1\relax\fi\else\onlydmatherr@\minCDarrowwidth\fi} +\newif\ifCD@ +\def\CD{\bgroup\vspace@\relax\iffalse{\fi\let\ampersand@&\iffalse}\fi + \CD@true\vcenter\bgroup\Let@\tabskip\z@skip\baselineskip20\ex@ + \lineskip3\ex@\lineskiplimit3\ex@\halign\bgroup + &\hfill$\m@th##$\hfill\crcr} +\def\endCD{\crcr\egroup\egroup\egroup} +\newdimen\bigaw@ +\atdef@>#1>#2>{\ampersand@ %1 + \setboxz@h{$\m@th\ssize\;{#1}\;\;$}% %2 + \setbox@ne\hbox{$\m@th\ssize\;{#2}\;\;$}% %3 + \setbox\tw@\hbox{$\m@th#2$}% %4 + \ifCD@\global\bigaw@\minCDaw@\else\global\bigaw@\minaw@\fi %5 + \ifdim\wdz@>\bigaw@\global\bigaw@\wdz@\fi + \ifdim\wd@ne>\bigaw@\global\bigaw@\wd@ne\fi %6 + \ifCD@\enskip\fi %7 + \ifdim\wd\tw@>\z@ + \mathrel{\mathop{\hbox to\bigaw@{\rightarrowfill@\displaystyle}}% + \limits^{#1}_{#2}}% %8 + \else\mathrel{\mathop{\hbox to\bigaw@{\rightarrowfill@\displaystyle}}% + \limits^{#1}}\fi %9 + \ifCD@\enskip\fi %10 + \ampersand@} %11 +\atdef@<#1<#2<{\ampersand@\setboxz@h{$\m@th\ssize\;\;{#1}\;$}% + \setbox@ne\hbox{$\m@th\ssize\;\;{#2}\;$}\setbox\tw@\hbox{$\m@th#2$}% + \ifCD@\global\bigaw@\minCDaw@\else\global\bigaw@\minaw@\fi + \ifdim\wdz@>\bigaw@\global\bigaw@\wdz@\fi + \ifdim\wd@ne>\bigaw@\global\bigaw@\wd@ne\fi + \ifCD@\enskip\fi + \ifdim\wd\tw@>\z@ + \mathrel{\mathop{\hbox to\bigaw@{\leftarrowfill@\displaystyle}}% + \limits^{#1}_{#2}}\else + \mathrel{\mathop{\hbox to\bigaw@{\leftarrowfill@\displaystyle}}% + \limits^{#1}}\fi + \ifCD@\enskip\fi\ampersand@} +\begingroup + \catcode`\~=\active \lccode`\~=`\@ + \lowercase{% + \global\atdef@)#1)#2){~>#1>#2>} + \global\atdef@(#1(#2({~<#1<#2<}} +\endgroup +\atdef@ A#1A#2A{\llap{$\m@th\vcenter{\hbox + {$\ssize#1$}}$}\Big\uparrow\rlap{$\m@th\vcenter{\hbox{$\ssize#2$}}$}&&} +\atdef@ V#1V#2V{\llap{$\m@th\vcenter{\hbox + {$\ssize#1$}}$}\Big\downarrow\rlap{$\m@th\vcenter{\hbox{$\ssize#2$}}$}&&} +\atdef@={&\enskip\mathrel + {\vbox{\hrule width\minCDaw@\vskip3\ex@\hrule width + \minCDaw@}}\enskip&} +\atdef@|{\Big\Vert&&} +\atdef@\vert{\Big\Vert&&} +\def\pretend#1\haswidth#2{\setboxz@h{$\m@th\scriptstyle{#2}$}\hbox + to\wdz@{\hfill$\m@th\scriptstyle{#1}$\hfill}} +\message{poor man's bold,} +\def\pmb{\RIfM@\expandafter\mathpalette\expandafter\pmb@\else + \expandafter\pmb@@\fi} +\def\pmb@@#1{\leavevmode\setboxz@h{#1}% + \dimen@-\wdz@ + \kern-.5\ex@\copy\z@ + \kern\dimen@\kern.25\ex@\raise.4\ex@\copy\z@ + \kern\dimen@\kern.25\ex@\box\z@ +} +\def\binrel@@#1{\ifdim\wd2<\z@\mathbin{#1}\else\ifdim\wd\tw@>\z@ + \mathrel{#1}\else{#1}\fi\fi} +\newdimen\pmbraise@ +% Note: because of the use of \mathpalette, if \pmb@ is +% applied to a single math italic character (or a single +% character from some other slanted math font), the italic +% correction will be added. This will cause subscripts +% to fall too far away from the character in some +% cases, e.g., $\pmb{T}_1$ or $\pmb{\Cal T}_1$. +\def\pmb@#1#2{\setbox\thr@@\hbox{$\m@th#1{#2}$}% + \setbox4\hbox{$\m@th#1\mkern.5mu$}\pmbraise@\wd4\relax + \binrel@{#2}% + \dimen@-\wd\thr@@ + \binrel@@{% + \mkern-.8mu\copy\thr@@ + \kern\dimen@\mkern.4mu\raise\pmbraise@\copy\thr@@ + \kern\dimen@\mkern.4mu\box\thr@@ +}} +\def\documentstyle#1{\W@{}\input #1.sty\relax} +\message{syntax check,} +\font\dummyft@=dummy +\fontdimen1 \dummyft@=\z@ +\fontdimen2 \dummyft@=\z@ +\fontdimen3 \dummyft@=\z@ +\fontdimen4 \dummyft@=\z@ +\fontdimen5 \dummyft@=\z@ +\fontdimen6 \dummyft@=\z@ +\fontdimen7 \dummyft@=\z@ +\fontdimen8 \dummyft@=\z@ +\fontdimen9 \dummyft@=\z@ +\fontdimen10 \dummyft@=\z@ +\fontdimen11 \dummyft@=\z@ +\fontdimen12 \dummyft@=\z@ +\fontdimen13 \dummyft@=\z@ +\fontdimen14 \dummyft@=\z@ +\fontdimen15 \dummyft@=\z@ +\fontdimen16 \dummyft@=\z@ +\fontdimen17 \dummyft@=\z@ +\fontdimen18 \dummyft@=\z@ +\fontdimen19 \dummyft@=\z@ +\fontdimen20 \dummyft@=\z@ +\fontdimen21 \dummyft@=\z@ +\fontdimen22 \dummyft@=\z@ +\def\fontlist@{\\{\tenrm}\\{\sevenrm}\\{\fiverm}\\{\teni}\\{\seveni}% + \\{\fivei}\\{\tensy}\\{\sevensy}\\{\fivesy}\\{\tenex}\\{\tenbf}\\{\sevenbf}% + \\{\fivebf}\\{\tensl}\\{\tenit}} +\def\font@#1=#2 {\rightappend@#1\to\fontlist@\font#1=#2 } +\def\dodummy@{{\def\\##1{\global\let##1\dummyft@}\fontlist@}} +\def\nopages@{\output{\setbox\z@\box\@cclv \deadcycles\z@}% + \alloc@5\toks\toksdef\@cclvi\output} +\let\galleys\nopages@ +\newif\ifsyntax@ +\newcount\countxviii@ +\def\syntax{\syntax@true\dodummy@\countxviii@\count18 + \loop\ifnum\countxviii@>\m@ne\textfont\countxviii@=\dummyft@ + \scriptfont\countxviii@=\dummyft@\scriptscriptfont\countxviii@=\dummyft@ + \advance\countxviii@\m@ne\repeat %1 + \dummyft@\tracinglostchars\z@\nopages@\frenchspacing\hbadness\@M} +\def\first@#1#2\end{#1} +\def\printoptions{\W@{Do you want S(yntax check), + G(alleys) or P(ages)?}% + \message{Type S, G or P, followed by <return>: }% + \begingroup % to localize the following change to \endlinechar: + \endlinechar\m@ne % to prevent a space or \par in \ans@ from ^^M + \read\m@ne to\ans@ +% Define \ans@ to uppercase itself, and default to P if the user +% just pressed <return>. + \edef\ans@{\uppercase{\def\noexpand\ans@{% + \expandafter\first@\ans@ P\end}}}% +% Cast the new definition of \ans@ outside the group + \expandafter\endgroup\ans@ + \if\ans@ P% fine, no action needs to be taken + \else \if\ans@ S\syntax + \else \if\ans@ G\galleys + \else\message{? Unknown option: \ans@; using the `pages' option.}% + \fi\fi\fi} +\def\alloc@#1#2#3#4#5{\global\advance\count1#1by\@ne + \ch@ck#1#4#2\allocationnumber=\count1#1 + \global#3#5=\allocationnumber + \ifalloc@\wlog{\string#5=\string#2\the\allocationnumber}\fi} +\def\document{\def\alloclist@{}\def\fontlist@{}} +\let\enddocument\bye +\let\plainproclaim\proclaim +\let\plainfootnote\footnote +\let\proclaim\undefined +\let\footnote\undefined +\let\=\undefined +\let\>\undefined +\let\cal\undefined +\let\mit\undefined +\let\oldstyle\undefined +\catcode`\@=\active +\message{... finished} +\endinput diff --git a/systems/knuth/local/lib/bigwlist.tex b/systems/knuth/local/lib/bigwlist.tex new file mode 100644 index 0000000000..8d780a2692 --- /dev/null +++ b/systems/knuth/local/lib/bigwlist.tex @@ -0,0 +1,54 @@ +% Makes a landscape listing of one or more files with wide lines +% Typical usage: +% tex list *.c \\end + +\magnification=\magstep2 +\hsize=9truein +\vsize=6.5truein +\special{landscape} + +\def\grabfile#1 {\setbox0=\lastbox\endgraf\doit{#1}} +\everypar{\grabfile} + +\font\filenamefont= cmtt8 scaled\magstep3 +\font\headlinefont= cmr8 +\font\listingfont= cmtex8 +\font\eoffont= cmti8 + +\def\today{\ifcase\month\or + January\or February\or March\or April\or May\or June\or + July\or August\or September\or October\or November\or December\fi + \space\number\day, \number\year} +\newcount\m \newcount\n +\n=\time \divide\n 60 \m=-\n \multiply\m 60 \advance\m \time +\def\hours{\twodigits\n\twodigits\m} +\def\twodigits#1{\ifnum #1<10 0\fi \number#1} + +\newlinechar=`@ +\message{@\today\space at \hours} + +\baselineskip=9pt +\medskipamount=4pt minus 1pt +\raggedbottom +\nopagenumbers + +\chardef\other=12 +\def\doit#1{\message{@Listing #1@} + \begingroup \everypar{} \frenchspacing + \headline{\filenamefont#1\quad\headlinefont \today\ at \hours + \hfill Page \folio} + \def\do##1{\catcode`##1=\other}\dospecials + \catcode127=\other \catcode9=\other \catcode12=\other + \parindent 0pt \parfillskip=0pt plus 1fil minus 1in + \everypar{\hangindent 1in} \rightskip=0pt plus 2in + \def\par{\ifvmode\penalty-500\medskip\else\endgraf\fi} + \listingfont \obeylines \obeyspaces \global\pageno=1 + \input #1 {\eoffont(end of\/ file)}\endgraf\vfill\eject\endgroup} +{\obeyspaces\global\let =\ } +\catcode`\_=\other % allow _ in file names + +% A tab (^^I) prints as lowercase gamma. +% Character ^^M could be made visible, with a bit of work; +% at present, it's indistinguishable from newline (^^J). + +% You can get up to 170 characters on a line without an overfull box. diff --git a/systems/knuth/local/lib/black.mf b/systems/knuth/local/lib/black.mf new file mode 100644 index 0000000000..dfbdd1765f --- /dev/null +++ b/systems/knuth/local/lib/black.mf @@ -0,0 +1,2 @@ +%input blackimagen % the `standard' black font is for imagen (300dpi) +input blacklj % now it's for LaserJet 4 (600dpi) diff --git a/systems/knuth/local/lib/blackaps.mf b/systems/knuth/local/lib/blackaps.mf new file mode 100644 index 0000000000..b3ea772032 --- /dev/null +++ b/systems/knuth/local/lib/blackaps.mf @@ -0,0 +1,10 @@ +% Black font for APS with proofsheet resolution approx 90 pixels per inch +% (Used with output of GF2DVI for the METAFONTbook illustrations) + +if mode<>aps: errmessage "This file is for aps only"; fi + +font_identifier "BLACKAPS"; +picture pix_picture; pix_wd := pix_ht := 8; +pix_picture := unitpixel scaled 8; + +input grayf diff --git a/systems/knuth/local/lib/blackdvi.tex b/systems/knuth/local/lib/blackdvi.tex new file mode 100644 index 0000000000..fc1539a33e --- /dev/null +++ b/systems/knuth/local/lib/blackdvi.tex @@ -0,0 +1,96 @@ +% This is BLACKDVI.STY and BLACKDVI.TEX in text format, as of March 5, +% 1992, written by Jim Hafner, HAFNER@ALMADEN, or hafner@almaden.ibm.com. +% This file turns all color commands defined by COLORDVI.STY or COLORDVI.TEX +% into no-ops and so can be used to get B/W printing without having to +% ferret out all the color macros. +% +% For example, just use +% \documentstyle[blackdvi]{foils} +% in place of +% \documentstyle[colordvi]{foils} +% It should be compatible with any other COLOR*.STY file (e.g., +% COLORPS.STY) intended for use with a non-PostScript driver. +% +% This file can be used anywhere COLORDVI.STY or COLORDVI.TEX is used. In +% particular, It can be used in any flavor of LaTeX (e.g. LaTeX, +% FoilTeX, AMS-LaTeX) by adding the keyword "blackdvi" to the options in +% the \documentstyle command (e.g., "\documentstyle[blackdvi]{foils}") or +% \input in any flavor of TeX (e.g. Plain TeX, eplain, AMS-TeX or any of +% the above LaTeX flavors) with the command "\input blackdvi". +% +% Here is the background command +\def\background#1{}% +\def\newColor #1 {\expandafter\def\csname text#1\endcsname{}% + \expandafter\def\csname #1\endcsname##1{}}% +% +\def\textColor#1{} +\def\Color#1#2{#2} + +\newColor GreenYellow +\newColor Yellow +\newColor Goldenrod +\newColor Dandelion +\newColor Apricot +\newColor Peach +\newColor Melon +\newColor YellowOrange +\newColor Orange +\newColor BurntOrange +\newColor Bittersweet +\newColor RedOrange +\newColor Mahogany +\newColor Maroon +\newColor BrickRed +\newColor Red +\newColor OrangeRed +\newColor RubineRed +\newColor WildStrawberry +\newColor Salmon +\newColor CarnationPink +\newColor Magenta +\newColor VioletRed +\newColor Rhodamine +\newColor Mulberry +\newColor RedViolet +\newColor Fuchsia +\newColor Lavender +\newColor Thistle +\newColor Orchid +\newColor DarkOrchid +\newColor Purple +\newColor Plum +\newColor Violet +\newColor RoyalPurple +\newColor BlueViolet +\newColor Periwinkle +\newColor CadetBlue +\newColor CornflowerBlue +\newColor MidnightBlue +\newColor NavyBlue +\newColor RoyalBlue +\newColor Blue +\newColor Cerulean +\newColor Cyan +\newColor ProcessBlue +\newColor SkyBlue +\newColor Turquoise +\newColor TealBlue +\newColor Aquamarine +\newColor BlueGreen +\newColor Emerald +\newColor JungleGreen +\newColor SeaGreen +\newColor Green +\newColor ForestGreen +\newColor PineGreen +\newColor LimeGreen +\newColor YellowGreen +\newColor SpringGreen +\newColor OliveGreen +\newColor RawSienna +\newColor Sepia +\newColor Brown +\newColor Tan +\newColor Gray +\newColor Black +\newColor White diff --git a/systems/knuth/local/lib/blackimagen.mf b/systems/knuth/local/lib/blackimagen.mf new file mode 100644 index 0000000000..6171bdbbaa --- /dev/null +++ b/systems/knuth/local/lib/blackimagen.mf @@ -0,0 +1,9 @@ +% Black font for Imagen with proofsheet resolution 75 pixels per inch + +if mode<>imagen: errmessage "This file is for imagen only"; fi + +font_identifier "BLACKIMAGEN"; +picture pix_picture; pix_wd := pix_ht := 4; +pix_picture := unitpixel scaled 4; + +input grayf diff --git a/systems/knuth/local/lib/blacklino.mf b/systems/knuth/local/lib/blacklino.mf new file mode 100644 index 0000000000..6bc06c4111 --- /dev/null +++ b/systems/knuth/local/lib/blacklino.mf @@ -0,0 +1,10 @@ +% Black font for LINO with proofsheet resolution approx 90 pixels per inch +% (Used with output of GF2DVI for the METAFONTbook illustrations) + +if mode<>linohi: errmessage "This file is for linotronic only"; fi + +font_identifier "BLACKLINO"; +picture pix_picture; pix_wd := pix_ht := 14; +pix_picture := unitpixel scaled 14; + +input grayf diff --git a/systems/knuth/local/lib/blacklj.mf b/systems/knuth/local/lib/blacklj.mf new file mode 100644 index 0000000000..a1808c8a6c --- /dev/null +++ b/systems/knuth/local/lib/blacklj.mf @@ -0,0 +1,9 @@ +% Black font for LJ with proofsheet resolution 75 pixels per inch. + +if mode<>ljfour: errmessage "This file is for ljfour only"; fi + +font_identifier "BLACKLJ"; +picture pix_picture; pix_wd := pix_ht := 8; +pix_picture := unitpixel scaled 8; + +input grayf diff --git a/systems/knuth/local/lib/colordvi.tex b/systems/knuth/local/lib/colordvi.tex new file mode 100644 index 0000000000..5b65e0ccc8 --- /dev/null +++ b/systems/knuth/local/lib/colordvi.tex @@ -0,0 +1,139 @@ +% This is COLORDVI.TEX and COLORDVI.STY in text format, as of +% March 5, 1992, written by Jim Hafner, HAFNER@ALMADEN, or +% hafner@almaden.ibm.com. Modified by Tomas Rokicki to be a +% bit smaller and easier to add to. +% +% This style file can be used to get color in TeX, LaTeX or more +% importantly, FoilTeX as an optional style file. It is generic in +% that the color parameters are determined by the driver's header files. +% +% It can be used with any driver which knows how to process the keywords +% in the \special commands. Currently, only versions of dvips greater +% than 5.478 (dvips is the DVI->PostScript driver by Tom Rokicki) and +% TeXview on the NeXT interpret these specials. +% +% This file can be used in any flavor of LaTeX (e.g. LaTeX, FoilTeX, +% AMS-LaTeX) by adding the keyword "colordvi" to the options in the +% \documentstyle command (e.g., "\documentstyle[colordvi]{foils}") or \input +% in any flavor of TeX (e.g. Plain TeX, eplain, AMS-TeX or any of the +% above LaTeX flavors) with the command "\input colordvi". +% +% The actual parameters for each color are determined by the color.pro +% header file prepended to the output file by dvips. They can be +% overrriden by a user-supplied header, called by either the -h option +% or the ``h'' flag in a printer configuration file, or in the .dvipsrc +% (or its analogue on other systems). +% +% Most of the color names and their matches were based on the +% most recent (at time of writing) Crayola Crayon box of 64 colors. +% +% There are 68 predefined colors. At the end of this file is a +% listing of the color names and their approximate PANTONE color +% match. This is for reference purposes only. +% +% The first macro lets the user specify the background color for the +% document. It sets the background color for the current page and all +% succeeding pages, unless changed by another command of this type. To +% change the background color back to the default, issue +% \background{White} +% +\def\background#1{\special{background #1}} +% +% There are two types of text color commands. The first is in the form +% \ColorName (note the uppercase for the color name). +% +% It is called a local color command since it takes one argument +% enclosed in brackets. It writes the contents of its argument in the +% selected color. This should be used for local or nested color +% changes, since it restores the original color state when it completes. +% The second type of color command is in the form +% \textColorName +% This uses the same naming convention as before. It is called a global +% color command since it takes no arguments and simply sets the color at +% this point. No previous color information is saved. IF YOU USE THIS +% INTERNAL TO ANY LOCAL COLOR COMMAND, THE NESTING HISTORY IS LOST. +% +% Here are the global color changers, with color codes defined; +% these are used to define the small region colors. +% +% This first is for user defined color. The argument #1 is for a "CMYK" +% quadruple of intensity values between 0 and 1. (CMYK stands for Cyan, +% Magenta, Yellow and Black.) E.g., \textColor{.2 .3 .4 .1} +% +\def\textColor#1{\special{color cmyk #1}} +% +\def\newColor #1 {\expandafter\def\csname text#1\endcsname{\special + {color #1}}\expandafter\def\csname #1\endcsname##1{\special + {color push #1}##1\special{color pop}}}% +\def\Color#1#2{\special{color push cmyk #1}#2\special{color pop}} +% +% Here are the color names and their PANTONE match (approximately) +% +\newColor GreenYellow % GreenYellow Approximate PANTONE 388 +\newColor Yellow % Yellow Approximate PANTONE YELLOW +\newColor Goldenrod % Goldenrod Approximate PANTONE 109 +\newColor Dandelion % Dandelion Approximate PANTONE 123 +\newColor Apricot % Apricot Approximate PANTONE 1565 +\newColor Peach % Peach Approximate PANTONE 164 +\newColor Melon % Melon Approximate PANTONE 177 +\newColor YellowOrange % YellowOrange Approximate PANTONE 130 +\newColor Orange % Orange Approximate PANTONE ORANGE-021 +\newColor BurntOrange % BurntOrange Approximate PANTONE 388 +\newColor Bittersweet % Bittersweet Approximate PANTONE 167 +\newColor RedOrange % RedOrange Approximate PANTONE 179 +\newColor Mahogany % Mahogany Approximate PANTONE 484 +\newColor Maroon % Maroon Approximate PANTONE 201 +\newColor BrickRed % BrickRed Approximate PANTONE 1805 +\newColor Red % Red VERY-Approx PANTONE RED +\newColor OrangeRed % OrangeRed No PANTONE match +\newColor RubineRed % RubineRed Approximate PANTONE RUBINE-RED +\newColor WildStrawberry % WildStrawberry Approximate PANTONE 206 +\newColor Salmon % Salmon Approximate PANTONE 183 +\newColor CarnationPink % CarnationPink Approximate PANTONE 218 +\newColor Magenta % Magenta Approximate PANTONE PROCESS-MAGENTA +\newColor VioletRed % VioletRed Approximate PANTONE 219 +\newColor Rhodamine % Rhodamine Approximate PANTONE RHODAMINE-RED +\newColor Mulberry % Mulberry Approximate PANTONE 241 +\newColor RedViolet % RedViolet Approximate PANTONE 234 +\newColor Fuchsia % Fuchsia Approximate PANTONE 248 +\newColor Lavender % Lavender Approximate PANTONE 223 +\newColor Thistle % Thistle Approximate PANTONE 245 +\newColor Orchid % Orchid Approximate PANTONE 252 +\newColor DarkOrchid % DarkOrchid No PANTONE match +\newColor Purple % Purple Approximate PANTONE PURPLE +\newColor Plum % Plum VERY-Approx PANTONE 518 +\newColor Violet % Violet Approximate PANTONE VIOLET +\newColor RoyalPurple % RoyalPurple Approximate PANTONE 267 +\newColor BlueViolet % BlueViolet Approximate PANTONE 2755 +\newColor Periwinkle % Periwinkle Approximate PANTONE 2715 +\newColor CadetBlue % CadetBlue Approximate PANTONE (534+535)/2 +\newColor CornflowerBlue % CornflowerBlue Approximate PANTONE 292 +\newColor MidnightBlue % MidnightBlue Approximate PANTONE 302 +\newColor NavyBlue % NavyBlue Approximate PANTONE 293 +\newColor RoyalBlue % RoyalBlue No PANTONE match +\newColor Blue % Blue Approximate PANTONE BLUE-072 +\newColor Cerulean % Cerulean Approximate PANTONE 3005 +\newColor Cyan % Cyan Approximate PANTONE PROCESS-CYAN +\newColor ProcessBlue % ProcessBlue Approximate PANTONE PROCESS-BLUE +\newColor SkyBlue % SkyBlue Approximate PANTONE 2985 +\newColor Turquoise % Turquoise Approximate PANTONE (312+313)/2 +\newColor TealBlue % TealBlue Approximate PANTONE 3145 +\newColor Aquamarine % Aquamarine Approximate PANTONE 3135 +\newColor BlueGreen % BlueGreen Approximate PANTONE 320 +\newColor Emerald % Emerald No PANTONE match +\newColor JungleGreen % JungleGreen Approximate PANTONE 328 +\newColor SeaGreen % SeaGreen Approximate PANTONE 3268 +\newColor Green % Green VERY-Approx PANTONE GREEN +\newColor ForestGreen % ForestGreen Approximate PANTONE 349 +\newColor PineGreen % PineGreen Approximate PANTONE 323 +\newColor LimeGreen % LimeGreen No PANTONE match +\newColor YellowGreen % YellowGreen Approximate PANTONE 375 +\newColor SpringGreen % SpringGreen Approximate PANTONE 381 +\newColor OliveGreen % OliveGreen Approximate PANTONE 582 +\newColor RawSienna % RawSienna Approximate PANTONE 154 +\newColor Sepia % Sepia Approximate PANTONE 161 +\newColor Brown % Brown Approximate PANTONE 1615 +\newColor Tan % Tan No PANTONE match +\newColor Gray % Gray Approximate PANTONE COOL-GRAY-8 +\newColor Black % Black Approximate PANTONE PROCESS-BLACK +\newColor White % White No PANTONE match diff --git a/systems/knuth/local/lib/ctwimac.tex b/systems/knuth/local/lib/ctwimac.tex new file mode 100644 index 0000000000..eddd6af352 --- /dev/null +++ b/systems/knuth/local/lib/ctwimac.tex @@ -0,0 +1,476 @@ +% standard macros for CWEB listings (in addition to plain.tex) +% Version 3.6 --- May 2000 +% modified for pages produced by CTWILL +% further modified for page size of the MMIXware book +\ifx\documentstyle\undefined\else\endinput\fi % LaTeX will use other macros +\xdef\fmtversion{\fmtversion+CTWILL3.6+LNCS} + +\let\:=\. % preserve a way to get the dot accent + % (all other accents will still work as usual) + +\newdimen\em \em=10pt % this "em" will not change with font size +\parskip 0pt plus .1pt % almost no stretch between paragraphs +\parindent 1\em % for paragraphs and for the first line of C text + +\newif\ifsorted +\newread\sreffile +\newwrite\reffile +\ifx\norefs\def\else + \openin\sreffile=\jobname.sref + \ifeof\sreffile \immediate\openout\reffile=\jobname.ref \sortedfalse + \message{This is the first pass!} + \else \sortedtrue \message{This is the second pass!} \fi +\fi + +\font\ninerm=cmr9 +\let\mc=\ninerm % medium caps +\def\CEE/{{\mc C\spacefactor1000}} +\def\UNIX/{{\mc U\kern-.05emNIX\spacefactor1000}} +\def\TEX/{\TeX} +\def\CPLUSPLUS/{{\mc C\PP\spacefactor1000}} +\def\Cee{\CEE/} % for backward compatibility +\def\9#1{} +\font\eightrm=cmr8 +\font\sixrm=cmr6 +\font\ninei=cmmi9 +\font\eighti=cmmi8 +\font\sixi=cmmi6 +\skewchar\ninei='177 \skewchar\eighti='177 \skewchar\sixi='177 +\font\ninesy=cmsy9 +\font\eightsy=cmsy8 +\font\sixsy=cmsy6 +\skewchar\ninesy='60 \skewchar\eightsy='60 \skewchar\sixsy='60 +\font\ninebf=cmbx9 +\font\eightbf=cmbx8 +\font\sixbf=cmbx6 +\font\ninett=cmtt9 +\font\eighttt=cmtt8 +\hyphenchar\ninett=-1 \hyphenchar\eighttt=-1 +\font\ninesl=cmsl9 +\font\eightsl=cmsl8 +\font\nineit=cmti9 +\font\eightit=cmti8 +\font\tentex=cmtex10 +\font\ninetex=cmtex9 % TeX extended character set (used in strings) +\font\eighttex=cmtex8 +\fontdimen7\tentex=0pt % no double space after sentences +\fontdimen7\ninetex=0pt +\fontdimen7\eighttex=0pt + +\newif\iftenpoint +\def\tenpoint{\tenpointtrue + \def\rm{\fam0\tenrm}% + \textfont0=\tenrm \scriptfont0=\sevenrm \scriptscriptfont0=\fiverm + \textfont1=\teni \scriptfont1=\seveni \scriptscriptfont1=\fivei + \textfont2=\tensy \scriptfont2=\sevensy \scriptscriptfont2=\fivesy + \textfont3=\tenex \scriptfont3=\tenex \scriptscriptfont3=\tenex + \def\it{\fam\itfam\tenit}% + \textfont\itfam=\tenit + \def\sl{\fam\slfam\tensl}% + \textfont\slfam=\tensl + \def\bf{\fam\bffam\tenbf}% + \textfont\bffam=\tenbf \scriptfont\bffam=\sevenbf + \scriptscriptfont\bffam=\fivebf + \def\tt{\fam\ttfam\tentt}% + \textfont\ttfam=\tentt + \def\ttx{\tentex}% + \normalbaselineskip=12pt + \let\cmntfont=\tenrm + \let\mc=\ninerm + \let\sc=\eightrm + \let\big=\tenbig + \setbox\strutbox=\hbox{\vrule height8pt depth3pt width 0pt}% + \normalbaselines\rm} + +\def\ninepoint{\tenpointfalse + \def\rm{\fam0\ninerm}% + \textfont0=\ninerm \scriptfont0=\sixrm \scriptscriptfont0=\fiverm + \textfont1=\ninei \scriptfont1=\sixi \scriptscriptfont1=\fivei + \textfont2=\ninesy \scriptfont2=\sixsy \scriptscriptfont2=\fivesy + \textfont3=\tenex \scriptfont3=\tenex \scriptscriptfont3=\tenex + \def\it{\fam\itfam\nineit}% + \textfont\itfam=\nineit + \def\sl{\fam\slfam\ninesl}% + \textfont\slfam=\ninesl + \def\bf{\fam\bffam\ninebf}% + \textfont\bffam=\ninebf \scriptfont\bffam=\sixbf + \scriptscriptfont\bffam=\fivebf + \def\tt{\fam\ttfam\ninett}% + \textfont\ttfam=\ninett + \def\ttx{\ninetex}% + \normalbaselineskip=11pt + \let\cmntfont=\ninerm + \let\mc=\eightrm + \let\sc=\sevenrm + \let\big=\ninebig + \setbox\strutbox=\hbox{\vrule height8pt depth3pt width 0pt}% + \normalbaselines\rm} + +\def\eightpoint{% + \def\rm{\fam0\eightrm}% + \textfont0=\eightrm \scriptfont0=\sixrm \scriptscriptfont0=\fiverm + \textfont1=\eighti \scriptfont1=\sixi \scriptscriptfont1=\fivei + \textfont2=\eightsy \scriptfont2=\sixsy \scriptscriptfont2=\fivesy + \textfont3=\tenex \scriptfont3=\tenex \scriptscriptfont3=\tenex + \def\it{\fam\itfam\eightit}% + \textfont\itfam=\eightit + \def\sl{\fam\slfam\eightsl}% + \textfont\slfam=\eightsl + \def\bf{\fam\bffam\eightbf}% + \textfont\bffam=\eightbf \scriptfont\bffam=\sixbf + \scriptscriptfont\bffam=\fivebf + \def\tt{\fam\ttfam\eighttt}% + \textfont\ttfam=\eighttt + \def\ttx{\eighttex}% + \normalbaselineskip=9pt + \let\cmntfont=\eightrm + \let\mc=\sevenrm + \let\sc=\sixrm + \let\big=\eightbig + \setbox\strutbox=\hbox{\vrule height7pt depth2pt width 0pt}% + \normalbaselines\rm} + +\tenpoint +\def\tenbig#1{{\hbox{$\left#1\vbox to8.5pt{}\right.\nulldelimiterspace=0pt$}}} +\def\ninebig#1{{\hbox{$\textfont0=\tenrm\textfont2=\tensy + \left#1\vbox to7.25pt{}\right.\nulldelimiterspace=0pt$}}} +\def\eightbig#1{{\hbox{$\textfont0=\ninerm\textfont2=\ninesy + \left#1\vbox to6.5pt{}\right.\nulldelimiterspace=0pt$}}} + +%\font\tenss=cmss10 \let\cmntfont\tenss % alternative comment font +\font\titlefont=cmr7 scaled\magstep4 % title on the contents page +\font\ttitlefont=cmtt10 scaled\magstep2 % typewriter type in title + +\def\\#1{\leavevmode\hbox{\it#1\/\kern.05em}} % italic type for identifiers +\def\|#1{\leavevmode\hbox{$#1$}} % one-letter identifiers look better this way +\def\{\leavevmode\hbox{\bf + \def\_{\kern.04em\vbox{\hrule width.3em height .6pt}\kern.08em}% + #1\/\kern.05em}} % boldface type for reserved words +\def\.#1{\leavevmode\hbox{\ttx % typewriter type for strings + \let\\=\BS % backslash in a string + \let\{=\LB % left brace in a string + \let\}=\RB % right brace in a string + \let\~=\TL % tilde in a string + \let\ =\SP % space in a string + \let\_=\UL % underline in a string + \let\&=\AM % ampersand in a string + \let\^=\CF % circumflex in a string + #1\kern.05em}} +\def\){{\tentex\kern-.05em}\discretionary{\hbox{\tentex\BS}}{}{}} +\def\AT{@} % at sign for control text (not needed in versions >= 2.9) +\def\ATL{\par\noindent\bgroup\catcode`\_=12 \postATL} % print @l in limbo +\def\postATL#1 #2 {\bf letter \\{\uppercase{\char"#1}} + tangles as \tentex "#2"\egroup\par} +\def\noATL#1 #2 {} +\def\noatl{\let\ATL=\noATL} % suppress output from @l +\def\ATH{\X\kern-.5em:Preprocessor definitions\X} +\let\PB=\relax % hook for program brackets |...| in TeX part or section name + +\chardef\AM=`\& % ampersand character in a string +\chardef\BS=`\\ % backslash in a string +\chardef\LB=`\{ % left brace in a string +\chardef\RB=`\} % right brace in a string +\def\SP{{\tt\char`\ }} % (visible) space in a string +\chardef\TL=`\~ % tilde in a string +\chardef\UL=`\_ % underline character in a string +\chardef\CF=`\^ % circumflex character in a string + +\newbox\PPbox % symbol for ++ +\setbox\PPbox=\hbox{\kern.5pt\raise1pt\hbox{\sevenrm+\kern-1pt+}\kern.5pt} +\def\PP{\copy\PPbox} +\newbox\MMbox \setbox\MMbox=\hbox{\kern.5pt\raise1pt\hbox{\sevensy\char0 + \kern-1pt\char0}\kern.5pt} +\def\MM{\copy\MMbox} +\newbox\MGbox % symbol for -> +\setbox\MGbox=\hbox{\kern-2pt\lower3pt\hbox{\teni\char'176}\kern1pt} +\def\MG{\copy\MGbox} +\def\MRL#1{\mathrel{\let\K==#1}} +\let\GG=\gg +\let\LL=\ll +\let\NULL=\Lambda +\mathchardef\AND="2026 % bitwise and; also \& (unary operator) +\let\OR=\mid % bitwise or +\let\XOR=\oplus % bitwise exclusive or +\def\CM{{\sim}} % bitwise complement +\newbox\MODbox \setbox\MODbox=\hbox{\eightrm\%} +\def\MOD{\mathbin{\copy\MODbox}} +\def\DC{\kern.1em{::}\kern.1em} % symbol for :: +\def\PA{\mathbin{.*}} % symbol for .* +\def\MGA{\mathbin{\MG*}} % symbol for ->* +\def\this{\&{this}} + +\newbox\bak \setbox\bak=\hbox to -1\em{} % backspace one em +\newbox\bakk\setbox\bakk=\hbox to -2\em{} % backspace two ems + +\newcount\ind % current indentation in ems +\def\1{\global\advance\ind by1\hangindent\ind\em} % indent one more notch +\def\2{\global\advance\ind by-1} % indent one less notch +\def\3#1{\hfil\penalty#10\hfilneg} % optional break within a statement +\def\4{\copy\bak} % backspace one notch +\def\5{\hfil\penalty-1\hfilneg\kern2.5\em\copy\bakk\ignorespaces}% optional break +\def\6{\ifmmode\else\par % forced break + \hangindent\ind\em\noindent\kern\ind\em\copy\bakk\ignorespaces\fi} +\def\7{\Y\6} % forced break and a little extra space +\def\8{\hskip-\ind em\hskip 2\em} % no indentation + +\newcount\gdepth % depth of current major group, plus one +\newtoks\gtitle % title of current major group +\newskip\intersecskip \intersecskip=12pt minus 3pt % space between sections +\let\yskip=\smallskip +\def\?{\mathrel?} +\def\note#1#2.{\par\penalty5000 + \Y\noindent{\hangindent2\em\baselineskip10pt\eightrm#1~#2.\par}} +\def\lapstar{\rlap{*}} +\def\stsec{\tenpoint\rightskip=0pt % get out of C mode (cf. \B) + \sfcode`;=1500 \pretolerance 200 \hyphenpenalty 50 \exhyphenpenalty 50 + \noindent\strut{\bf\secno.\quad}} +\def\startsection{\titletrue + \line{\smash{\titlefont\title}\quad\hrulefill}\bigskip + \let\startsection=\stsec\stsec} +\def\defin#1{\global\advance\ind by 2 \1\&{#1 } } % begin `define' or `format' +\def\A{\note{See also section}} % xref for doubly defined section name +\def\As{\note{See also sections}} % xref for multiply defined section name +\def\B{\iftenpoint\ninepoint\fi + \rightskip=0pt plus 100pt minus 10pt % go into C mode + \sfcode`;=3000 + \pretolerance 10000 + \hyphenpenalty 9999 % so strings can be broken (discretionary \ is inserted) + \exhyphenpenalty 10000 + \global\ind=2 \1\ \unskip} +\def\C#1{\5\5\quad$/\ast\,${\cmntfont #1}$\,\ast/$} +\let\SHC\C % "// short comments" treated like "/* ordinary comments */" +%\def\C#1{\5\5\quad$\triangleright\,${\cmntfont#1}$\,\triangleleft$} +%\def\SHC#1{\5\5\quad$\diamond\,${\cmntfont#1}} +\def\D{\defin{\#define}} % macro definition +\let\E=\equiv % equivalence sign +\def\ET{ and~} % conjunction between two section numbers +\def\ETs{, and~} % conjunction between the last two of several section numbers +\def\F{\defin{format}} % format definition +\let\G=\ge % greater than or equal sign +% \H is long Hungarian umlaut accent +\let\I=\ne % unequal sign +\def\J{\.{@\&}} % TANGLE's join operation +\let\K== % assignment operator +%\let\K=\leftarrow % "honest" alternative to standard assignment operator +% \L is Polish letter suppressed-L +\outer\def\M#1{\def\secno{#1}\startsection\ignorespaces} +\outer\def\N{\ifvoid\partialpage\lefttrue + \else\ifdim\ht\partialpage<\pageht \leftfalse\else\lefttrue\fi\fi\NNN} +\outer\def\NN{\ifvoid\partialpage\leftfalse + \else\ifdim\ht\partialpage<\pageht \lefttrue\else\leftfalse\fi\fi\NNN} +\outer\def\NNN#1#2#3.{\gdepth=#1\gtitle={#3}\def\secno{#2}% starred section + \ifleft \flushout + \gdef\rlhead{\let\i=I\uppercase{\ignorespaces#3}} % running left headline + \global\let\rrhead=\rlhead % running right headline + \else\global\setbox\partialpage=\vbox{ + \vbox to\pageht{\unvbox\partialpage\vfill}\break} + \gdef\rrhead{\let\i=I\uppercase{\ignorespaces#3}} + \fi + \message{*\secno} % progress report + \startsection{\bf\ignorespaces#3.\quad}\ignorespaces} +% \O is Scandinavian letter O-with-slash +% \P is paragraph sign +\def\Q{\note{This code is cited in section}} % xref for mention of a section +\def\Qs{\note{This code is cited in sections}} % xref for mentions of a section +\let\R=\lnot % logical not +% \S is section sign +\def\T#1{\leavevmode % octal, hex or decimal constant + \hbox{$\def\?{\kern.2em}% + \def\$##1{\egroup_{\,\rm##1}\bgroup}% suffix to constant + \def\_{\cdot 10^{\aftergroup}}% power of ten (via dirty trick) + \let\~=\oct \let\^=\hex {#1}$}} +\def\U{\note{This code is used in section}} % xref for use of a section +\def\Us{\note{This code is used in sections}} % xref for uses of a section +\let\V=\lor % logical or +\let\W=\land % logical and +\def\X#1:#2\X{\ifmmode\gdef\XX{\null$\null}\else\gdef\XX{}\fi % section name + \XX$\langle\,${\let\I=\ne#2\sevenrm\kern.5em#1}$\,\rangle$\XX} +\def\Y{\par\yskip} +\let\Z=\le +\let\ZZ=\let % now you can \write the control sequence \ZZ +\let\*=* + +%\def\oct{\hbox{\rm\char'23\kern-.2em\it\aftergroup\?\aftergroup}} % WEB style +%\def\hex{\hbox{\rm\char"7D\tt\aftergroup}} % WEB style +\def\oct{\hbox{$^\circ$\kern-.1em\it\aftergroup\?\aftergroup}}% CWEB style +\def\hex{\hbox{$^{\scriptscriptstyle\#}$\tt\aftergroup}} % CWEB style +\def\vb#1{\leavevmode\hbox{\kern2pt\vrule\vtop{\vbox{\hrule + \hbox{\strut\kern2pt\.{#1}\kern2pt}} + \hrule}\vrule\kern2pt}} % verbatim string + +\def\TeX{{\ifmmode\it\fi + \leavevmode\hbox{T\kern-.1667em\lower.424ex\hbox{E}\hskip-.125em X}}} +\def\,{\relax\ifmmode\mskip\thinmuskip\else\thinspace\fi} + +% now here's the mini-index formatting control +\newcount\nrefs % total number of references in partial page +\newcount\baseno % smallest section number in partial page +\toksdef\prefs=199 % references to previous sections in current program +\toksdef\frefs=220 % references to future sections in current program +\toksdef\erefs=221 % references to sections in another program +% \count and \toks registers 200--219 are also used to keep track of refs +\catcode`\@=11 +\newcount\@n \newcount\@m \newcount\@p +\newdimen\pageht \pageht=19cm +\newdimen\pagewd \pagewd=13cm +\newdimen\colwd \colwd=\pagewd + \advance\colwd by -2pc \divide\colwd by 3 % for three columns +\newdimen\fullpageht \fullpageht=\pageht \advance\fullpageht by 4pc +\newdimen\pagethresh \pagethresh=2\pageht +\newdimen\nsize \newdimen\msize +\newskip\intersecskip \intersecskip=8pt plus 2pt minus 3pt +\newbox\partialpage +\newbox\newsec +\newtoks\newrefs +\newtoks\ttoks +\newdimen\ninept \ninept=9pt +\newif\iftitle \newif\ifleft + +\def\flushout{\ifvoid\partialpage\else + \setbox0=\vsplit\partialpage to \pageht + \shipout\vbox{ + \vbox to 3pc{\leftheadline\vfill} + \nointerlineskip\box0} + \global\advance\pageno 1 + \global\let\[=\makeinref \global\let\]=\makeoutref + \ifsorted \let\readin=\readln \readrefs + \else \immediate\write\reffile{!\the\pageno}\let\readin=\readrefs \fi + \setbox0=\vbox{\eightpoint \hsize=\colwd + \rightskip=0pt plus 100pt minus 10pt + \pretolerance 10000 + \hyphenpenalty 10000 \exhyphenpenalty 10000 + \noindent\vbox to1pt{}\par % 1pt = \topskip - \ninept + \readin} + \shipout\vbox to\fullpageht{ + \vbox to 3pc{\rightheadline\vfill} + \unvbox\partialpage + \vfill + \ifdim\ht0>1pt \kern11pt\hrule \hbox{% + \nsize=\ht0 \advance\nsize-\topskip + \divide\nsize by 3 \divide\nsize by\ninept + \multiply\nsize by\ninept \advance\nsize\topskip + \vsplit0 to\nsize \kern1pc + \msize=\ht0 \advance\msize-\topskip + \divide\msize by 2 \divide\msize by\ninept + \multiply\msize by\ninept \advance\msize\topskip + \vbox to\nsize{\vsplit0 to\msize\vss}\kern1pc + \vbox to\nsize{\box0\vss}} \fi} + \global\advance\pageno 1 \global\let\rlhead=\rrhead\fi + {\globaldefs=1 + \@n=199 \loop \ifnum\@n<222 \toks\@n={} \count\@n=0 \advance\@n 1 \repeat + \nrefs=0 + \baseno=\secno}} +\def\leftheadline{\hbox to\pagewd{\vbox to10pt{}% + \iftitle\global\titlefalse\else\ninerm\title:\enspace \eightsl\rlhead\fi + \hfil\eightrm\folio}} +\def\rightheadline{\hbox to\pagewd{\vbox to10pt{}% + \eightrm\folio\hfil\ninerm\title:\enspace \eightsl\rrhead\/}} + +\def\mini{\begingroup \obeylines \globaldefs=1 \newrefs=\bgroup} +\def\FI{\@n=\secno \advance\@n-\baseno \advance\@n 200 + \advance\nrefs-\count\@n \@n=\nrefs + \let\[=\countnewref \let\]=\cn \the\newrefs \endgroup + \nobreak\null\nobreak\vskip-\baselineskip\penalty-500\vfil\eject} +\def\twillout{\setbox\newsec=\vbox{\unvbox255} + \ifnum\@n=0 \nsize=0pt + \else \nsize=3pt \multiply\nsize\@n \advance\nsize 1.25pc \fi + \ifvoid\partialpage\else\advance\nsize 5pt \advance\nsize\ht\partialpage\fi + \advance\nsize\ht\newsec + \message{\the\nsize} % show the page break decision amount + \ifbr \global\brfalse \flushout \message{/\secno}\fi + \ifdim\nsize>\pagethresh \flushout \message{\secno}\fi + \addtopartialpage} +\def\addtopartialpage{\globaldefs=1 + \let\[=\addnewref \let\]=\addneweref \the\newrefs + \setbox\partialpage=\ifvoid\partialpage \box\newsec + \else \vbox{\unvbox\partialpage \vfilneg + \vskip\intersecskip \unvbox\newsec}\fi} +\def\shortpage{\par\vskip-2\baselineskip + \null\vfill\penalty-5000\message{(shortpage)}} +\newif\ifbr +\def\forcebr{\global\brtrue} + +\def\countnewref #1 {\ifnum#1<\baseno \let\next\cn + \else\ifnum#1>\secno \let\next\cn \else\let\next\flushref\fi\fi\next#1 } +\def\cn #1 #2 {\begintest{#1 #2}\cnr\endtest} + +% here's a tricky way to present \cnr with a csname unexpanded inside: +\def\begintest#1{\def\TEST{#1}\expandafter\expandafter\expandafter} +\def\endtest{\csname\expandafter\gobb\meaning\TEST\endcsname} +\expandafter\def\expandafter\gobb\meaning\empty{} + +{\obeylines\gdef\cnr#1#2 + {\ifx#1\relax \advance\@n 1 \fi}} +{\obeylines\gdef\flushref#1 + {}} +\def\addnewref #1 {\ifnum#1<\baseno \let\next\an \@n=199 + \else\ifnum#1>\secno \let\next\an \@n=#1 \advance\@n-\baseno + \advance\@n200 \ifnum\@n>219 \@n=220 \fi + \else\let\next\flushref\fi\fi\next#1 } +\def\an#1 #2 {\begintest{#1 #2}\anr\endtest\[#1 #2 } +\def\addneweref#1 #2 {\@n=221 \begintest{#1 #2}\anr\endtest\]#1 #2 } +{\obeylines\gdef\anr#1#2 + {\ifx#1\relax \advance\nrefs1 \advance\count\@n 1 % + \def#1{#2 + }\toks\@n=\expandafter{\the\toks\@n\lmda#1}\fi}} +\ifsorted \def\lmda#1{\global\let#1\relax} +\else \def\lmda#1{#1\global\let#1\relax} \fi +{\obeylines\gdef\makeinref#1 #2 #3 + {\ifsorted\else\ttoks={\[#1 #2 #3}\immediate\write\reffile{+ \the\ttoks}\fi % + \hangindent=1em \noindent #2\miniform#3, \S#1.\par}} +{\obeylines\gdef\makeoutref#1 #2 #3 + {\ifsorted\else\ttoks={\]#1 #2 #3}\immediate\write\reffile{+ \the\ttoks}\fi % + \hangindent=1em \noindent #2\miniform#3, \extref#1.\par}} +\def\miniform{\futurelet\next\miniforma} +\def\miniforma{\ifx\next\zip + \else\if=\noexpand\next \let\next\gobbleq + \else\let\next\colon\fi\fi\next} +\def\zip{} +\def\gobbleq={\,=\,} +\def\colon{: } +\def\extref{\futurelet\next\extrefa} +\def\extrefa{\if"\next\let\next\gobblest\else\let\next\cite\fi\next} +\def\gobblest"#1"{{\ttx#1}} +\def\cite#1#2.{{\sc#1}\,\S#2.} +\def\uninitialized{???} + +\def\readrefs{\the\prefs \@m=\secno \advance\@m-\baseno \advance\@m200 + {\def\lmda##1{\global\let##1\relax}\@p=200 + \loop\ifnum\@p<\@m \the\toks\@p \advance\@p 1 \repeat} + \loop\ifnum\@m<222 \the\toks\@m \advance\@m 1 \repeat} +\def\readln{\read\sreffile to\next \expandafter\next\newline \readin} +{\obeylines\gdef\newline{\unskip\noexpand + }} +\def\donewithpage#1 {\let\readin=\relax} +\catcode`\@=12 + +\hsize=\pagewd \vsize=\maxdimen \output={\twillout} + +\def\inx{\flushout\end} +\def\fin{\parfillskip 0pt plus 1fil + \let\topsecno=\nullsec + \message{Section names:} + \def\note##1##2.{\quad{\eightrm##1~##2.}} + \def\Q{\note{Cited in section}} % crossref for mention of a section + \def\Qs{\note{Cited in sections}} % crossref for mentions of a section + \def\U{\note{Used in section}} % crossref for use of a section + \def\Us{\note{Used in sections}} % crossref for uses of a section + \def\I{\par\hangindent 2em}\let\*=* + \readsections} +\def\readsections{\input \jobname.sscn} +\def\datethis{} + +% To produce only a subset of pages, put the page numbers on separate +% lines in a file called pages.tex +\let\Shipout=\shipout +\newread\pages \newcount\nextpage \openin\pages=pages +\def\getnextpage{\ifeof\pages\else + {\endlinechar=-1\read\pages to\next + \ifx\next\empty % in this case we should have eof now + \else\global\nextpage=\next\fi}\fi} +\ifeof\pages\else\message{OK, I'll ship only the requested pages!} + \getnextpage\fi +\def\shipout{\ifeof\pages\let\next=\Shipout + \else\ifnum\pageno=\nextpage\getnextpage\let\next=\Shipout + \else\let\next=\Tosspage\fi\fi \next} +\newbox\garbage \def\Tosspage{\deadcycles=0\setbox\garbage=} diff --git a/systems/knuth/local/lib/cwebmac.tex b/systems/knuth/local/lib/cwebmac.tex new file mode 100644 index 0000000000..8890b63b4d --- /dev/null +++ b/systems/knuth/local/lib/cwebmac.tex @@ -0,0 +1,545 @@ +% standard macros for CWEB listings (in addition to plain.tex) +% Version 3.67 --- July 2006 +\ifx\renewenvironment\undefined\else\endinput\fi % LaTeX will use other macros +\xdef\fmtversion{\fmtversion+CWEB3.67} +\chardef\cwebversion=3 \chardef\cwebrevision=67 +\newif\ifpdf +\ifx\pdf+\pdftrue\fi +% Uncomment the following line if you want PDF goodies to be the default +%\ifx\pdf-\else\pdftrue\fi +\def\pdflinkcolor{0 0 1} % the RGB values for hyperlink color +\newif\ifpdftex +\ifx\pdfoutput\undefined \pdftexfalse \else\ifnum\pdfoutput=0 \pdftexfalse +\else \pdftextrue \pdfoutput=1 \input pdfcolor \let\setcolor\pdfsetcolor \fi\fi +\newif\ifacro \ifpdf\acrotrue\fi \ifpdftex\acrotrue\fi + +\let\:=\. % preserve a way to get the dot accent + % (all other accents will still work as usual) + +\parskip 0pt % no stretch between paragraphs +\parindent 1em % for paragraphs and for the first line of C text + +\font\ninerm=cmr9 +\let\mc=\ninerm % medium caps +\def\CEE/{{\mc C\spacefactor1000}} +\def\UNIX/{{\mc U\kern-.05emNIX\spacefactor1000}} +\def\TEX/{\TeX} +\def\CPLUSPLUS/{{\mc C\PP\spacefactor1000}} +\def\Cee{\CEE/} % for backward compatibility +\def\9#1{} + % with this definition of \9 you can say @:sort key}{TeX code@> + % to alphabetize an index entry by the sort key but format with the TeX code +\font\eightrm=cmr8 +\let\sc=\eightrm % for smallish caps (NOT a caps-and-small-caps font) +\let\mainfont=\tenrm +\let\cmntfont\tenrm +%\font\tenss=cmss10 \let\cmntfont\tenss % alternative comment font +\font\titlefont=cmr7 scaled\magstep4 % title on the contents page +\font\ttitlefont=cmtt10 scaled\magstep2 % typewriter type in title +\font\tentex=cmtex10 % TeX extended character set (used in strings) +\fontdimen7\tentex=0pt % no double space after sentences + +\def\\#1{\leavevmode\hbox{\it#1\/\kern.05em}} % italic type for identifiers +\def\|#1{\leavevmode\hbox{$#1$}} % one-letter identifiers look better this way +\def\{\leavevmode\hbox{\bf + \def\_{\kern.04em\vbox{\hrule width.3em height .6pt}\kern.08em}% + #1\/\kern.05em}} % boldface type for reserved words +\def\.#1{\leavevmode\hbox{\tentex % typewriter type for strings + \let\\=\BS % backslash in a string + \let\{=\LB % left brace in a string + \let\}=\RB % right brace in a string + \let\~=\TL % tilde in a string + \let\ =\SP % space in a string + \let\_=\UL % underline in a string + \let\&=\AM % ampersand in a string + \let\^=\CF % circumflex in a string + #1\kern.05em}} +\def\){{\tentex\kern-.05em}\discretionary{\hbox{\tentex\BS}}{}{}} +\def\AT{@} % at sign for control text (not needed in versions >= 2.9) +\def\ATL{\par\noindent\bgroup\catcode`\_=12 \postATL} % print @l in limbo +\def\postATL#1 #2 {\bf letter \\{\uppercase{\char"#1}} + tangles as \tentex "#2"\egroup\par} +\def\noATL#1 #2 {} +\def\noatl{\let\ATL=\noATL} % suppress output from @l +\def\ATH{{\acrofalse\X\kern-.5em:Preprocessor definitions\X}} +\let\PB=\relax % hook for program brackets |...| in TeX part or section name + +\chardef\AM=`\& % ampersand character in a string +\chardef\BS=`\\ % backslash in a string +\chardef\LB=`\{ % left brace in a string +\chardef\RB=`\} % right brace in a string +\def\SP{{\tt\char`\ }} % (visible) space in a string +\chardef\TL=`\~ % tilde in a string +\chardef\UL=`\_ % underline character in a string +\chardef\CF=`\^ % circumflex character in a string + +\newbox\PPbox % symbol for ++ +\setbox\PPbox=\hbox{\kern.5pt\raise1pt\hbox{\sevenrm+\kern-1pt+}\kern.5pt} +\def\PP{\copy\PPbox} +\newbox\MMbox \setbox\MMbox=\hbox{\kern.5pt\raise1pt\hbox{\sevensy\char0 + \kern-1pt\char0}\kern.5pt} +\def\MM{\copy\MMbox} +\newbox\MGbox % symbol for -> +\setbox\MGbox=\hbox{\kern-2pt\lower3pt\hbox{\teni\char'176}\kern1pt} +\def\MG{\copy\MGbox} +\def\MRL#1{\mathrel{\let\K==#1}} +%\def\MRL#1{\KK#1}\def\KK#1#2{\buildrel\;#1\over{#2}} +\let\GG=\gg +\let\LL=\ll +\let\NULL=\Lambda +\mathchardef\AND="2026 % bitwise and; also \& (unary operator) +\let\OR=\mid % bitwise or +\let\XOR=\oplus % bitwise exclusive or +\def\CM{{\sim}} % bitwise complement +\newbox\MODbox \setbox\MODbox=\hbox{\eightrm\%} +\def\MOD{\mathbin{\copy\MODbox}} +\def\DC{\kern.1em{::}\kern.1em} % symbol for :: +\def\PA{\mathbin{.*}} % symbol for .* +\def\MGA{\mathbin{\MG*}} % symbol for ->* +\def\this{\&{this}} + +\newbox\bak \setbox\bak=\hbox to -1em{} % backspace one em +\newbox\bakk\setbox\bakk=\hbox to -2em{} % backspace two ems + +\newcount\ind % current indentation in ems +\def\1{\global\advance\ind by1\hangindent\ind em} % indent one more notch +\def\2{\global\advance\ind by-1} % indent one less notch +\def\3#1{\hfil\penalty#10\hfilneg} % optional break within a statement +\def\4{\copy\bak} % backspace one notch +\def\5{\hfil\penalty-1\hfilneg\kern2.5em\copy\bakk\ignorespaces}% optional break +\def\6{\ifmmode\else\par % forced break + \hangindent\ind em\noindent\kern\ind em\copy\bakk\ignorespaces\fi} +\def\7{\Y\6} % forced break and a little extra space +\def\8{\hskip-\ind em\hskip 2em} % no indentation + +\newcount\gdepth % depth of current major group, plus one +\newcount\secpagedepth +\secpagedepth=3 % page breaks will occur for depths -1, 0, and 1 +\newtoks\gtitle % title of current major group +\newskip\intersecskip \intersecskip=12pt minus 3pt % space between sections +\let\yskip=\smallskip +\def\?{\mathrel?} +\def\note#1#2.{\Y\noindent{\hangindent2em% + \baselineskip10pt\eightrm#1~\ifacro{\pdfnote#2.}\else#2\fi.\par}} + +\newtoks\toksA \newtoks\toksB \newtoks\toksC \newtoks\toksD +\newtoks\toksE \newtoks\toksF \newtoks\usersanitizer +\newcount\countA \countA=0 \newcount\countB \countB=0 +\newcount\countC \countC=0 +\newif\iftokprocessed \newif\ifTnum \newif\ifinstr +{\def\\{\global\let\spacechar= }\\ } + +\ifacro % The following are pdf macros +\def\thewidth{\the\wd0 \space} +\def\theheight{\the\ht\strutbox\space} +\def\thedepth{\the\dp\strutbox\space} +\ifpdftex + \ifx\pdfannotlink\undefined\let\pdfannotlink\pdfstartlink\fi% for pdfTeX 0.14 + \def\pdflink#1#2{\hbox{\pdfannotlink height\ht\strutbox depth\dp\strutbox + attr{/Border [0 0 0]} goto num #1 \BlueGreen #1\Black\pdfendlink}} +\else\def\pdflink#1#2{\setbox0=\hbox{\special{pdf: bc [ \pdflinkcolor ]}{#1}% + \special{pdf: ec}}\special{pdf: ann width \thewidth height \theheight + depth \thedepth << /Type /Annot /Subtype /Link + /Border [0 0 0] /A << /S /GoTo /D (#2) >> >>}\box0\relax}\fi +\def\pdfnote#1.{\setbox0=\hbox{\toksA={#1.}\toksB={}\maketoks}\the\toksA} +\def\firstsecno#1.{\setbox0=\hbox{\toksA={#1.}\toksB={}% + \def\makenote{\addtokens\toksB{\the\toksC}\def\makenote{\toksD={} + \toksC={}\let\space\empty}\makenote}\maketoks}} +\def\addtokens#1#2{\edef\addtoks{\noexpand#1={\the#1#2}}\addtoks} +\def\poptoks#1#2|ENDTOKS|{\let\first=#1\toksD={#1}% + \ifcat\noexpand\first0\countB=`#1\else\countB=0\fi\toksA={#2}} +\def\maketoks{\expandafter\poptoks\the\toksA|ENDTOKS|% + \ifnum\countB>`9 \countB=0 \fi + \ifnum\countB<`0 + \ifnum0=\countC\else\makenote\fi + \ifx\first.\let\next=\maketoksdone\else + \let\next=\maketoks + \addtokens\toksB{\the\toksD} + \ifx\first,\addtokens\toksB{\space}\fi + \fi + \else \addtokens\toksC{\the\toksD}\global\countC=1\let\next=\maketoks + \fi + \next +} +\def\makenote{\addtokens\toksB + {\noexpand\pdflink{\the\toksC}{\romannumeral\the\toksC}}\toksC={}\global\countC=0} +\def\maketoksdone{\edef\st{\global\noexpand\toksA={\the\toksB}}\st} +\def\pdfURL#1#2{\ifpdftex\pdfannotlink height\ht\strutbox depth\dp\strutbox + attr {/Border [0 0 0]} user { /Type /Action /Subtype /Link /A + << /S /URI /URI (#2) >>}\BlueGreen #1\Black \pdfendlink + \else \ifpdf{\setbox0=\hbox{\special{pdf: bc [ \pdflinkcolor ]}{#1}% + \special{pdf: ec}}\special{pdf: ann width \thewidth\space height \theheight + \space depth \thedepth\space << /Border [0 0 0] + /Type /Action /Subtype /Link /A << /S /URI /URI (#2) >> >>}\box0\relax}% + \else #1 ({\tt#2})\fi\fi} +{\catcode`\~=12 \gdef\TILDE/{~}} % ~ in a URL +{\catcode`\_=12 \gdef\UNDER/{_}} % _ in a URL +\def\sanitizecommand#1#2{\addtokens\usersanitizer + {\noexpand\dosanitizecommand\noexpand#1{#2}}} +\def\dosanitizecommand#1#2{\ifx\nxt#1\addF{#2}\fi} + +\catcode`\[=1 \catcode`\]=2 \catcode`\{=12 \catcode`\}=12 + \def\lbchar[{] \def\rbchar[}] +\catcode`\[=12 \catcode`\]=12 \catcode`\{=1 \catcode`\}=2 +\catcode`\~=12 \def\tildechar{~} \catcode`\~=13 +\catcode`\|=0 |catcode`|\=12 |def|bschar{\} |catcode`|\=0 \catcode`\|=12 +\def\makeoutlinetoks{\Tnumfalse\afterassignment\makeolproctok\let\nxt= } +\def\makeolnexttok{\afterassignment\makeolproctok\let\nxt= } +\def\makeolgobbletok{\afterassignment\makeolnexttok\let\nxt= } +\def\addF#1{\addtokens\toksF{#1}\tokprocessedtrue} +% now comes a routine to "sanitize" section names, for pdf outlines +\def\makeolproctok{\tokprocessedfalse + \let\next\makeolnexttok % default + \ifx\nxt\outlinedone\let\next\outlinedone + \else\ifx{\nxt \else\ifx}\nxt \Tnumfalse \instrfalse % skip braces + \else\ifx$\nxt % or a $ sign + \else\ifx^\nxt \addF^\else\ifx_\nxt \addF_% sanitize ^ and _ + \else\ifx\nxt\spacechar \addF\space + \else\if\noexpand\nxt\relax % we have a control sequence; is it one we know? + \ifx\nxt~\addF\space + \else\ifx\nxt\onespace\addF\space + \else\the\usersanitizer + \iftokprocessed\else\makeolproctokctli + \iftokprocessed\else\makeolproctokctlii + \iftokprocessed\else\makeolproctokctliii % if not recognised, skip it + \fi\fi\fi\fi\fi + \else % we don't have a control sequence, it's an ordinary char + \ifx/\nxt \addF{\string\/}% quote chars special to PDF with backslash + \else\ifx(\nxt \addF{\string\(}\else\ifx)\nxt \addF{\string\)}% + \else\ifx[\nxt \addF{\string\[}\else\ifx]\nxt \addF{\string\]}% + \else\expandafter\makeolproctokchar\meaning\nxt + \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi + \next +} +\def\makeolproctokchar#1 #2 #3{\addF{#3}} +\def\makeolproctokctli{% + \ifx\nxt\CEE\addF{C}\let\next\makeolgobbletok % \CEE/ + \else\ifx\nxt\UNIX\addF{UNIX}\let\next\makeolgobbletok % \UNIX/ + \else\ifx\nxt\TEX\addF{TeX}\let\next\makeolgobbletok % \TEX/ + \else\ifx\nxt\TeX\addF{TeX}\else\ifx\nxt\LaTeX\addF{LaTeX}% + \else\ifx\nxt\CPLUSPLUS\addF{C++}\let\next\makeolgobbletok % \CPLUSPLUS/ + \else\ifx\nxt\Cee\addF{C}% + \else\ifx\nxt\PB \let\next\makeolgobbletok \tokprocessedtrue % \PB{...} + \else\ifx\nxt\.\tokprocessedtrue\instrtrue % \.{...} + % skip \| + \else\ifx\nxt\\\ifinstr\addF{\bschar\bschar}\else\tokprocessedtrue\fi + \else\ifx\nxt\&\ifinstr\addF&\else\tokprocessedtrue\fi + \else\ifx\nxt\~\ifTnum\addF{0}\else\addF\tildechar\fi % 077->\T{\~77} + \else\ifx\nxt\_\ifTnum\addF{E}\else\addF_\fi % 0.1E5->\T{0.1\_5} + \else\ifx\nxt\^\ifTnum\addF{0x}\else\addF^\fi % 0x77 -> \T{\^77} + \else\ifx\nxt\$\ifTnum\tokprocessedtrue\else\addF$\fi % \T{77\$L} + \else\ifx\nxt\{\addF\lbchar \else\ifx\nxt\}\addF\rbchar + \else\ifx\nxt\ \addF\space \else\ifx\nxt\#\addF{\string\#}% + \else\ifx\nxt\PP\addF{++}\else\ifx\nxt\MM\addF{--}% + \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi +} +\def\makeolproctokctlii{% + \ifx\nxt\MG\addF{->}\else\ifx\nxt\GG\addF{>>}% + \else\ifx\nxt\LL\addF{<<}\else\ifx\nxt\NULL\addF{NULL}% + \else\ifx\nxt\AND\addF&\else\ifx\nxt\OR\addF|% + \else\ifx\nxt\XOR\addF^\else\ifx\nxt\CM\addF\tildechar + \else\ifx\nxt\MOD\addF{\string\%}\else\ifx\nxt\DC\addF{::}% + \else\ifx\nxt\PA\addF{.*}\else\ifx\nxt\MGA\addF{->*}% + \else\ifx\nxt\this\addF{this}\else\ifx\nxt\?\addF?% + \else\ifx\nxt\E\addF{==}\else\ifx\nxt\G\addF{>=}% + \else\ifx\nxt\I\addF{!=}\else\ifx\nxt\K\addF{=}% + \else\ifx\nxt\l\addF{l}\else\ifx\nxt\L\addF{L}% + \else\ifx\nxt\o\addF{o}\else\ifx\nxt\O\addF{O}% + \else\ifx\nxt\R\addF!% + \else\ifx\nxt\T \Tnumtrue \let\next\makeolgobbletok + \tokprocessedtrue % \T{number} + \else\ifx\nxt\AM\addF&\else\ifx\nxt\%\addF{\string\%}% + \fi\fi\fi\fi\fi \fi\fi\fi\fi\fi + \fi\fi\fi\fi\fi \fi\fi\fi\fi\fi + \fi\fi\fi\fi\fi\fi +} +\def\makeolproctokctliii{% + \ifx\nxt\V\addF{||}\else\ifx\nxt\W\addF{&&}\else\ifx\nxt\Z\addF{<=}% + \else\ifx\nxt\*\addF*\else\ifx\nxt\Xand\addF{\space and\space}% + \else\ifx\nxt\Xandxeq\addF{\space and_eq\space}% + \else\ifx\nxt\Xbitand\addF{\space bitand\space}% + \else\ifx\nxt\Xbitor\addF{\space bitor\space}% + \else\ifx\nxt\Xcompl\addF{\space compl\space}% + \else\ifx\nxt\Xnot\addF{\space not\space}% + \else\ifx\nxt\Xnotxeq\addF{\space not_eq\space}% + \else\ifx\nxt\Xor\addF{\space or\space}% + \else\ifx\nxt\Xorxeq\addF{\space or_eq\space}% + \else\ifx\nxt\Xxor\addF{\space xor\space}% + \else\ifx\nxt\Xxorxeq\addF{\space xor_eq\space}% + \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi + \fi\fi\fi\fi\fi +} +\def\outlinedone{\edef\outlinest{\global\noexpand\toksE={\the\toksF}}% + \outlinest\let\outlinedone=\relax} +\fi % End of pdf macros + +\def\lapstar{\rlap{*}} +\def\stsec{\rightskip=0pt % get out of C mode (cf. \B) + \sfcode`;=1500 \pretolerance 200 \hyphenpenalty 50 \exhyphenpenalty 50 + \noindent{\let\*=\lapstar\bf\secstar.\quad}% + \ifpdftex\smash{\raise\baselineskip\hbox to0pt{% + \let\*=\empty\pdfdest num \secstar fith}} + \else\ifpdf\smash{\raise\baselineskip\hbox to0pt{% + \let\*=\empty\special{% + pdf: dest (\romannumeral\secstar) [ @thispage /FitH @ypos ]}}}\fi\fi} +\let\startsection=\stsec +\def\defin#1{\global\advance\ind by 2 \1\&{#1 } } % begin `define' or `format' +\def\A{\note{See also section}} % xref for doubly defined section name +\def\As{\note{See also sections}} % xref for multiply defined section name +\def\B{\rightskip=0pt plus 100pt minus 10pt % go into C mode + \sfcode`;=3000 + \pretolerance 10000 + \hyphenpenalty 1000 % so strings can be broken (discretionary \ is inserted) + \exhyphenpenalty 10000 + \global\ind=2 \1\ \unskip} +\def\C#1{\5\5\quad$/\ast\,${\cmntfont #1}$\,\ast/$} +\let\SHC\C % "// short comments" treated like "/* ordinary comments */" +%\def\C#1{\5\5\quad$\triangleright\,${\cmntfont#1}$\,\triangleleft$} +%\def\SHC#1{\5\5\quad$\diamond\,${\cmntfont#1}} +\def\D{\defin{\#define}} % macro definition +\let\E=\equiv % equivalence sign +\def\ET{ and~} % conjunction between two section numbers +\def\ETs{, and~} % conjunction between the last two of several section numbers +\def\F{\defin{format}} % format definition +\let\G=\ge % greater than or equal sign +% \H is long Hungarian umlaut accent +\let\I=\ne % unequal sign +\def\J{\.{@\&}} % TANGLE's join operation +\let\K== % assignment operator +%\let\K=\leftarrow % "honest" alternative to standard assignment operator +% \L is Polish letter suppressed-L +\outer\def\M#1{\MN{#1}\ifon\vfil\penalty-100\vfilneg % beginning of section + \vskip\intersecskip\startsection\ignorespaces} +\outer\def\N#1#2#3.{% beginning of starred section + \ifacro{\toksF={}\makeoutlinetoks#3\outlinedone\outlinedone}\fi + \gdepth=#1\gtitle={#3}\MN{#2}% + \ifon\ifnum#1<\secpagedepth \vfil\eject % force page break if depth is small + \else\vfil\penalty-100\vfilneg\vskip\intersecskip\fi\fi + \message{*\secno} % progress report + \def\stripprefix##1>{}\def\gtitletoks{#3}% + \edef\gtitletoks{\expandafter\stripprefix\meaning\gtitletoks}% + \edef\next{\write\cont{\ZZ{\gtitletoks}{#1}{\secno}% write to contents file + {\noexpand\the\pageno}{\the\toksE}}}\next % \ZZ{title}{depth}{sec}{page}{ss} + \ifpdftex\expandafter\xdef\csname curr#1\endcsname{\secno} + \ifnum#1>0\countB=#1 \advance\countB by-1 + \advancenumber{chunk\the\countB.\expnumber{curr\the\countB}}\fi\fi + \ifpdf\special{pdf: outline #1 << /Title (\the\toksE) /Dest + [ @thispage /FitH @ypos ] >>}\fi + \ifon\startsection{\bf#3.\quad}\ignorespaces} +\def\MN#1{\par % common code for \M, \N + {\xdef\secstar{#1}\let\*=\empty\xdef\secno{#1}}% remove \* from section name + \ifx\secno\secstar \onmaybe \else\ontrue \fi + \mark{{{\tensy x}\secno}{\the\gdepth}{\the\gtitle}}} +% each \mark is {section reference or null}{depth plus 1}{group title} +% \O is Scandinavian letter O-with-slash +% \P is paragraph sign +\def\Q{\note{This code is cited in section}} % xref for mention of a section +\def\Qs{\note{This code is cited in sections}} % xref for mentions of a section +\let\R=\lnot % logical not +% \S is section sign +\def\T#1{\leavevmode % octal, hex or decimal constant + \hbox{$\def\?{\kern.2em}% +% \def\$##1{\egroup_{\,\rm##1}\bgroup}% suffix to constant % versions < 3.67 + \def\$##1{\egroup_{\rm##1}\bgroup}% suffix to constant + \def\_{\cdot 10^{\aftergroup}}% power of ten (via dirty trick) + \let\~=\oct \let\^=\hex {#1}$}} +\def\U{\note{This code is used in section}} % xref for use of a section +\def\Us{\note{This code is used in sections}} % xref for uses of a section +\let\V=\lor % logical or +\let\W=\land % logical and +\def\X#1:#2\X{\ifmmode\gdef\XX{\null$\null}\else\gdef\XX{}\fi %$% section name + \XX$\langle\,${\let\I=\ne#2\eightrm\kern.5em + \ifacro{\pdfnote#1.}\else#1\fi}$\,\rangle$\XX} +\def\Y{\par\yskip} +\let\Z=\le +\let\ZZ=\let % now you can \write the control sequence \ZZ +\let\*=* + +\def\Xand{\W} \def\Xandxeq{\MRL{{\AND}{\K}}} \def\Xbitand{\AND} +\def\Xbitor{\OR} \def\Xcompl{\CM} \def\Xnot{\R} \def\Xnotxeq{\I} \def\Xor{\V} +\def\Xorxeq{\MRL{{\OR}{\K}}} \def\Xxor{\XOR} \def\Xxorxeq{\MRL{{\XOR}{\K}}} + +%\def\oct{\hbox{\rm\char'23\kern-.2em\it\aftergroup\?\aftergroup}} % WEB style +%\def\hex{\hbox{\rm\char"7D\tt\aftergroup}} % WEB style +\def\oct{\hbox{$^\circ$\kern-.1em\it\aftergroup\?\aftergroup}}% CWEB style +\def\hex{\hbox{$^{\scriptscriptstyle\#}$\tt\aftergroup}} % CWEB style +\def\vb#1{\leavevmode\hbox{\kern2pt\vrule\vtop{\vbox{\hrule + \hbox{\strut\kern2pt\.{#1}\kern2pt}} + \hrule}\vrule\kern2pt}} % verbatim string + +\def\onmaybe{\let\ifon=\maybe} \let\maybe=\iftrue +\newif\ifon \newif\iftitle \newif\ifpagesaved + +\newif\ifheader +\def\lheader{\headertrue\mainfont\the\pageno\eightrm\qquad\grouptitle + \hfill\title\qquad\mainfont\topsecno} % top line on left-hand pages +\def\rheader{\headertrue\mainfont\topsecno\eightrm\qquad\title\hfill + \grouptitle\qquad\mainfont\the\pageno} % top line on right-hand pages +\def\grouptitle{\let\i=I\let\j=J\uppercase\expandafter{\expandafter + \takethree\topmark}} +\def\topsecno{\expandafter\takeone\topmark} +\def\takeone#1#2#3{#1} +\def\taketwo#1#2#3{#2} +\def\takethree#1#2#3{#3} +\def\nullsec{\eightrm\kern-2em} % the \kern-2em cancels \qquad in headers + +\let\page=\pagebody \raggedbottom +% \def\page{\box255 }\normalbottom % faster, but loses plain TeX footnotes +\def\normaloutput#1#2#3{\ifodd\pageno\hoffset=\pageshift\fi + \shipout\vbox{ + \vbox to\fullpageheight{ + \iftitle\global\titlefalse + \else\hbox to\pagewidth{\vbox to10pt{}\ifodd\pageno #3\else#2\fi}\fi + \vfill#1}} % parameter #1 is the page itself + \global\advance\pageno by1} + +\gtitle={\.{CWEB} output} % this running head is reset by starred sections +\mark{\noexpand\nullsec0{\the\gtitle}} +\def\title{\expandafter\uppercase\expandafter{\jobname}} +\def\topofcontents{\centerline{\titlefont\title}\vskip.7in + \vfill} % this material will start the table of contents page +\def\startpdf{\ifpdftex\pdfcatalog{/PageMode /UseOutlines}\else + \ifpdf{\special{pdf: docview << /PageMode /UseOutlines >>}}\fi\fi} +\def\botofcontents{\vfill + \centerline{\covernote}} % this material will end the table of contents page +\def\covernote{} +\def\contentspagenumber{0} % default page number for table of contents +\newdimen\pagewidth \pagewidth=6.5in % the width of each page +\newdimen\pageheight \pageheight=8.7in % the height of each page +\newdimen\fullpageheight \fullpageheight=9in % page height including headlines +\newdimen\pageshift \pageshift=0in % shift righthand pages wrt lefthand ones +\def\magnify#1{\mag=#1\pagewidth=6.5truein\pageheight=8.7truein + \fullpageheight=9truein\setpage} +\def\setpage{\hsize\pagewidth\vsize\pageheight} % use after changing page size +\def\contentsfile{\jobname.toc} % file that gets table of contents info +\def\readcontents{\input \contentsfile} +\def\readindex{\input \jobname.idx} +\def\readsections{\input \jobname.scn} + +\newwrite\cont +\output{\setbox0=\page % the first page is garbage + \openout\cont=\contentsfile + \write\cont{\catcode `\noexpand\@=11\relax} % \makeatletter + \global\output{\normaloutput\page\lheader\rheader}} +\setpage +\vbox to \vsize{} % the first \topmark won't be null + +\def\ch{\note{The following sections were changed by the change file:} + \let\*=\relax} +\newbox\sbox % saved box preceding the index +\newbox\lbox % lefthand column in the index +\def\inx{\par\vskip6pt plus 1fil % we are beginning the index + \def\page{\box255 } \normalbottom + \write\cont{} % ensure that the contents file isn't empty + \write\cont{\catcode `\noexpand\@=12\relax} % \makeatother + \closeout\cont % the contents information has been fully gathered + \output{\ifpagesaved\normaloutput{\box\sbox}\lheader\rheader\fi + \global\setbox\sbox=\page \global\pagesavedtrue} + \pagesavedfalse \eject % eject the page-so-far and predecessors + \setbox\sbox\vbox{\unvbox\sbox} % take it out of its box + \vsize=\pageheight \advance\vsize by -\ht\sbox % the remaining height + \hsize=.5\pagewidth \advance\hsize by -10pt + % column width for the index (20pt between cols) + \parfillskip 0pt plus .6\hsize % try to avoid almost empty lines + \def\lr{L} % this tells whether the left or right column is next + \output{\if L\lr\global\setbox\lbox=\page \gdef\lr{R} + \else\normaloutput{\vbox to\pageheight{\box\sbox\vss + \hbox to\pagewidth{\box\lbox\hfil\page}}}\lheader\rheader + \global\vsize\pageheight\gdef\lr{L}\global\pagesavedfalse\fi} + \message{Index:} + \parskip 0pt plus .5pt + \outer\def\I##1, ##2.{\par\hangindent2em\noindent##1:\kern1em + \ifacro\pdfnote##2.\else##2\fi.} % index entry + \def\[##1]{$\underline{##1}$} % underlined index item + \rm \rightskip0pt plus 2.5em \tolerance 10000 \let\*=\lapstar + \hyphenpenalty 10000 \parindent0pt + \readindex} +\def\fin{\par\vfill\eject % this is done when we are ending the index + \ifpagesaved\null\vfill\eject\fi % output a null index column + \if L\lr\else\null\vfill\eject\fi % finish the current page + \parfillskip 0pt plus 1fil + \def\grouptitle{NAMES OF THE SECTIONS} + \let\topsecno=\nullsec + \message{Section names:} + \output={\normaloutput\page\lheader\rheader} + \setpage + \def\note##1##2.{\quad{\eightrm##1~\ifacro{\pdfnote##2.}\else{##2}\fi.}} + \def\Q{\note{Cited in section}} % crossref for mention of a section + \def\Qs{\note{Cited in sections}} % crossref for mentions of a section + \def\U{\note{Used in section}} % crossref for use of a section + \def\Us{\note{Used in sections}} % crossref for uses of a section + \def\I{\par\hangindent 2em}\let\*=* + \ifacro \def\outsecname{Names of the sections} \let\Xpdf\X + \ifpdftex \makebookmarks \pdfdest name {NOS} fitb + \pdfoutline goto name {NOS} count -\secno {\outsecname} + \def\X##1:##2\X{\Xpdf##1:##2\X \firstsecno##1.% + {\toksF={}\makeoutlinetoks##2\outlinedone\outlinedone}% + \pdfoutline goto num \the\toksA \expandafter{\the\toksE}} + \else\ifpdf + \special{pdf: outline -1 << /Title (\outsecname) + /Dest [ @thispage /FitH @ypos ] >>} + \def\X##1:##2\X{\Xpdf##1:##2\X \firstsecno##1.% + {\toksF={}\makeoutlinetoks##2\outlinedone\outlinedone}% + \special{pdf: outline 0 << /Title (\the\toksE) + /A << /S /GoTo /D (\romannumeral\the\toksA) >> >>}} + \fi\fi\fi + \readsections} +\def\makebookmarks{\let\ZZ=\writebookmarkline \readcontents\relax} +\def\expnumber#1{\expandafter\ifx\csname#1\endcsname\relax 0% + \else \csname#1\endcsname \fi} % Petr Olsak's macros from texinfo.tex +\def\advancenumber#1{\countA=\expnumber{#1}\relax \advance\countA by1 + \expandafter\xdef\csname#1\endcsname{\the\countA}} +\def\writebookmarkline#1#2#3#4#5{{% + \let\(=\let \let\)=\let \let\[=\let \let\]=\let \let\/=\let + \pdfoutline goto num #3 count -\expnumber{chunk#2.#3} {#5}}} +\def\con{\par\vfill\eject % finish the section names +% \ifodd\pageno\else\titletrue\null\vfill\eject\fi % for duplex printers + \rightskip 0pt \hyphenpenalty 50 \tolerance 200 + \setpage \output={\normaloutput\page\lheader\rheader} + \titletrue % prepare to output the table of contents + \pageno=\contentspagenumber + \def\grouptitle{TABLE OF CONTENTS} + \message{Table of contents:} + \topofcontents \startpdf + \line{\hfil Section\hbox to3em{\hss Page}} + \let\ZZ=\contentsline + \readcontents\relax % read the contents info + \botofcontents \end} % print the contents page(s) and terminate +\def\contentsline#1#2#3#4#5{\ifnum#2=0 \smallbreak\fi + \line{\consetup{#2}#1 + \rm\leaders\hbox to .5em{.\hfil}\hfil + \ \ifacro\pdflink{#3}{\romannumeral#3}\else#3\fi\hbox to3em{\hss#4}}} +\def\consetup#1{\ifcase#1 \bf % depth -1 (@**) + \or % depth 0 (@*) + \or \hskip2em % depth 1 (@*1) + \or \hskip4em \or \hskip6em \or \hskip8em \or \hskip10em % depth 2,3,4,5 + \else \hskip12em \fi} % depth 6 or more +\def\noinx{\let\inx=\end} % no indexes or table of contents +\def\nosecs{\let\FIN=\fin \def\fin{\let\parfillskip=\end \FIN}} + % no index of section names or table of contents +\def\nocon{\let\con=\end} % no table of contents +\def\today{\ifcase\month\or + January\or February\or March\or April\or May\or June\or + July\or August\or September\or October\or November\or December\fi + \space\number\day, \number\year} +\newcount\twodigits +\def\hours{\twodigits=\time \divide\twodigits by 60 \printtwodigits + \multiply\twodigits by-60 \advance\twodigits by\time :\printtwodigits} +\def\gobbleone1{} +\def\printtwodigits{\advance\twodigits100 + \expandafter\gobbleone\number\twodigits + \advance\twodigits-100 } +\def\TeX{{\ifmmode\it\fi + \leavevmode\hbox{T\kern-.1667em\lower.424ex\hbox{E}\hskip-.125em X}}} +\def\,{\relax\ifmmode\mskip\thinmuskip\else\thinspace\fi} +\def\datethis{\def\startsection{\leftline{\sc\today\ at \hours}\bigskip + \let\startsection=\stsec\stsec}} + % say `\datethis' in limbo, to get your listing timestamped before section 1 +%\def\datecontentspage{% versions up to 3.65 +% \def\topofcontents{\leftline{\sc\today\ at \hours}\bigskip +% \centerline{\titlefont\title}\vfill}} % timestamps the contents page +\def\datecontentspage{% changed in version 3.66 + \def\botofcontents{\vfill + \centerline{\covernote} + \bigskip + \leftline{\sc\today\ at \hours}}} % timestamps the contents page diff --git a/systems/knuth/local/lib/cyracc.def b/systems/knuth/local/lib/cyracc.def new file mode 100644 index 0000000000..8692858e92 --- /dev/null +++ b/systems/knuth/local/lib/cyracc.def @@ -0,0 +1,273 @@ +%% @texfile{ +%% filename="cyracc.def", +%% version="2.1", +%% date="31-MAY-1991", +%% filetype="TeX: option", +%% copyright="Copyright (C) American Mathematical Society, +%% all rights reserved. Copying of this file is +%% authorized only if either: +%% (1) you make absolutely no changes to your copy +%% including name; OR +%% (2) if you do make changes, you first rename it to some +%% other name.", +%% author="American Mathematical Society", +%% address="American Mathematical Society, +%% Technical Support Group, +%% P. O. Box 6248, +%% Providence, RI 02940, +%% USA", +%% telephone="401-455-4080 or (in the USA) 800-321-4AMS", +%% email="Internet: Tech-Support@Math.AMS.com", +%% codetable="ISO/ASCII", +%% checksumtype="line count", +%% checksum="273", +%% keywords="amsfonts, tex, cyrillic", +%% abstract="This file contains definitions of accents and +%% special characters required for use of cyrillic fonts +%% arranged according to the AMS scheme. +%% The \font specification(s) should be made elsewhere, and should include +%% \newfam\cyrfam +%% \font\...cyr=wncyr... (e.g. \font\tencyr=wncyr10 ) +%% An appropriate definition for cyrillic, usable in math and text, is +%% \def\cyr{\fam\cyrfam\...cyr\cyracc} +%% More extensive instructions for using cyrillic fonts are included in +%% the AMSFonts 2.0 User's Guide." +%% } +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +\chardef\tempcat=\the\catcode`\@ +\catcode`\@=11 + +% The first set of definitions is what will be in effect outside of cyrillic, +% i.e., in transliterated text. + +% Definition of \cydot is not ideal; real dot should be in an accent font. +\def\cydot{{\mathsurround=0pt$\cdot$}} + +% \ubar is the definition of \b from PLAIN; it may not work in math mode. +\def\ubar#1{\oalign{#1\crcr\hidewidth + \vbox to.2ex{\hbox{\char22}\vss}\hidewidth}} + +% Soft and hard signs are represented in transliteration by prime and +% double prime respectively. +\def\cprime{\/{\mathsurround=0pt$'$}} +\def\Cprime{{\mathsurround=0pt$'$}} +\def\cdprime{\/{\mathsurround=0pt$''$}} +\def\Cdprime{{\mathsurround=0pt$\ubar{\hbox{$''$}}$}} + +\def\dbar{dj} % make real barred d when accent font available +\def\Dbar{Dj} % "" + +% It would be nice to make these control sequences unnecessary; that will +% probably require d to become active. +\def\dz{dz} +\def\Dz{Dz} +\def\dzh{dzh\cydot } +\def\Dzh{Dzh\cydot } + + +% Stress marks are sometimes used in cyrillic text, mainly for pedagogic +% reasons. These definitions support stress marks within {\cyr ...}; +% in transliteration, they are suppressed. Stress is indicated in +% input by \! preceding a letter on which a stress mark is to appear; +% an acute accent will appear in the output. Since \! is also a plain +% command, for negative thin space in math mode, test for math mode and +% include the plain definition as appropriate. + +\def\@gobble#1{} +\def\@testgrave{\`} +\def\@stressit{\futurelet\chartest\@stresschar } + +\def\@stresschar#1{% + \ifx #1y\def\result{\futurelet\chartest\@yligature}% + \else \ifx #1Y\def\result{\futurelet\chartest\@Yligature}% + \else \ifx\chartest\@testgrave \def\result{\accent"26 }% + \else \def\result{\accent"26 #1}% + \fi \fi \fi + \result } + +\def\@yligature{% + \ifx a\chartest \def\result{\accent"26 \char"1F \@gobble}% + \else \ifx u\chartest \def\result{\accent"26 \char"18 \@gobble}% + \else \def\result{\accent"26 y}% + \fi \fi + \result } + +\def\@Yligature{% + \ifx a\chartest \def\result{\accent"26 \char"17 \@gobble}% + \else \ifx A\chartest \def\result{\accent"26 \char"17 \@gobble}% + \else \ifx u\chartest \def\result{\accent"26 \char"10 \@gobble}% + \else \ifx U\chartest \def\result{\accent"26 \char"10 \@gobble}% + \else \def\result{\accent"26 Y}% + \fi \fi \fi \fi + \result } + +\def\!{\ifmmode \mskip-\thinmuskip \fi} + + +% These are the definitions that will produce cyrillic letters within +% {\cyr ...} for letters represented in input by control sequences and +% accented latin letters. + +\def\cyracc{% + \def\cydot{{\kern0pt}}% + \def\cprime{\char"7E }\def\Cprime{\char"5E }% + \def\cdprime{\char"7F }\def\Cdprime{\char"5F }% + \def\dbar{dj}\def\Dbar{Dj}% + \def\dz{\char"1E }\def\Dz{\char"16 }% + \def\dzh{\char"0A }\def\Dzh{\char"02 }% + \def\'##1{\if c##1\char"0F % + \else \if C##1\char"07 % + \else \accent"26 ##1\fi \fi }% + \def\`##1{\if e##1\char"0B % + \else \if E##1\char"03 % + \else \errmessage{accent \string\` not defined in cyrillic}% + ##1\fi \fi }% + \def\=##1{\if e##1\char"0D % + \else \if E##1\char"05 % + \else \if \i##1\char"0C % + \else \if I##1\char"04 % + \else \errmessage{accent \string\= not defined in cyrillic}% + ##1\fi \fi \fi \fi }% + \def\u##1{\if \i##1\accent"24 i% + \else \accent"24 ##1\fi }% + \def\"##1{\if \i##1\accent"20 \char"3D % + \else \if I##1\accent"20 \char"04 % + \else \accent"20 ##1\fi \fi }% + \def\!{\ifmmode \def\result{\mskip-\thinmuskip}% + \else \def\result{\@stressit}\fi \result}} + + +% If cyrillic strings are to be included in \mark's, the accents need +% to be kept in unexpanded form until the \mark's are interpreted. +% See note on \mark below for details. + +\def\keep@cyracc{\let\cyr=\relax \let\i=\relax + \let\ubar=\relax \let\cydot=\relax + \let\cprime=\relax \let\Cprime=\relax + \let\cdprime=\relax \let\Cdprime=\relax + \let\dbar=\relax \let\Dbar=\relax + \let\dz=\relax \let\Dz=\relax + \let\dzh=\relax \let\Dzh=\relax + \let\'=\relax \let\`=\relax \let\==\relax + \let\u=\relax \let\"=\relax \let\!=\relax } + + +\catcode`\@=\tempcat +\endinput + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% +% ***** CYRACC.DEF ***** +% +% Access to the cyrillic is through the MR 1980 transliteration scheme, +% using TeX/Metafont ligature capability. (An alternate set of ligatures +% exists, for accessing letters beyond the 26 located in the font positions +% of the 26 roman letters. An authoritative list of the ligature rules is +% given below, under the heading Ligatures.) Successful use of this file +% requires appropriate cyrillic and accent fonts, arranged according to +% the AMS/MR scheme. +% +% There are some weaknesses in this ligaturing and accent system. +% The following are known to be less than satisfactory: +% +% the intermediate `ligatures' for shch access numerals; +% primes (transliteration of hard/soft signs) use math mode; +% underbar on `cap' double prime is too low (hard sign); +% thorn d's don't yet exist; +% \cydot uses math mode; +% this scheme is not compatible with automatic Russian hyphenation. +% +% +% Notes on the macros: +% +% The single space following each hex character code is necessary +% to prevent the next input character from being gobbled. +% +% +% Note on \mark : +% +% Control sequences such as these cyrillic accents should remain +% unexpanded when generating \mark's; otherwise, the definition of +% the expanded strings in effect when the \mark is used may be +% inappropriate. By \let\...=\relax , the \... takes on the important +% characteristic of a primitive that it will not be expanded further. +% The following code has been shown to generate correct \mark entries +% that can be used successfully in running heads: +% +% \newtoks\marktoks +% \def\domark{\keep@cyracc \mark{\the\marktoks}} +% +% In running heads, the marks should be accessed using \the to expand +% the tokens strings properly. +% +% +% Ligatures +% +% This is a list of all the letter ligatures in the AMS cyrillic fonts, +% and in other cyrillic fonts (such as those developed at the University +% of Washington that use the AMS arrangement). +% +% LOWER CASE LIGATURES +% +% A. All-letter ligatures +% +% ch = `q +% dj = '016 +% kh = `h +% lj = '011 +% nj = '010 +% sh = `x; xc = `7 (shc); 7h = `w (shch) +% ts = `c +% ya = '037 +% yu = '030 +% zh = '031 +% +% B. Ligatures with keyed numerals +% +% c1 = '017 +% d1 = '016 (dj); d2 = '012 (dzh); d3 = '036 (dz) +% e1 = '013; e2 = '015 +% i1 = '014 +% j1 = '037 (ya); j2 = '030 (yu) +% l1 = '011 (lj) +% n1 = '010 (nj) +% p1 = '176; p2 = '177 +% z1 = '031 (zh) +% +% UPPER CASE LIGATURES +% A. All-letter ligatures +% +% CH, Ch = `Q +% KH, Kh = `H +% LJ, Lj = '001 +% NJ, Nj = '000 +% SH, Sh = `X; XH, Xh = `6 (SHC, SHc, Shc); +% 6H, 6h = `W (SHCH, SHCh, SHch, Shch) +% TS, Ts = `C +% YA, Ya = '027 +% YU, Yu = '020 +% ZH, Zh = '021 +% +% B. Ligatures with keyed numerals +% +% C1 = '007 +% D1 = '006 (DJ); D2 = '002 (DZH); D3 = '026 (DZ) +% E1 = '003; E2 = '005 +% I1 = '004 +% J1 = '027 (YA); J2 = '020 (YU) +% L1 = '001 (LJ) +% N0 = '175 (Number sign); N1 = '000 (NJ) +% P1 = '136; P2 = '137 +% Z1 = '021 (ZH) +% +% DEACTIVATED LIGATURES +% +% The dzh and DZH ligatures were originally built in the following manner, +% but the results were not compatible with desired keyboarding schemes. +% +% dz = '036; '036(roman s)h = '012 (dzh) +% DZ = '026; '026(roman S)H = '002 (DZH) +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/systems/knuth/local/lib/domino.mf b/systems/knuth/local/lib/domino.mf new file mode 100644 index 0000000000..6bd9da121b --- /dev/null +++ b/systems/knuth/local/lib/domino.mf @@ -0,0 +1,100 @@ +% a font for double-9 dominoes +% initially designed to work best on 300dpi printer + +% Example: To typeset a 2x3 array containing a vertical "1 over 2" +% followed by horizontal "3 4" over horizontal "5 6", say +% \obeylines \catcode`\^=12 \offinterlineskip +% ^1<3>4 +% v2<5>6 + +% One can also typeset individual half dominoes without boundaries + +% Note: The "real" dominoes (made in Taiwan) have slightly different +% proportions, more or less as if the centers were at 17,32,47 instead +% instead of 16,32,48. But the present scheme seems mathematically better. +mode_setup; +p#:=in#/300; +d#:=64p#; +define_pixels(p); + +font_identifier:="DOMINO"; +font_coding_scheme:="dominoes"; +font_size:=10pt#; + +pickup pencircle scaled p; tiny_pen=savepen; +pickup pencircle scaled 13p; huge_pen=savepen; +% I first tried 15p, and it looked OK, but the Taiwan set has smaller dots +pickup pencircle scaled 3p; bound_pen=savepen; + +def begindomchar(expr code)= + beginchar(code,d#,d#,0); + pickup tiny_pen; + for x=0 step 2p until 60p: + drawdot (x+.5p,1.5p); drawdot (x+1.5p,.5p); + drawdot (.5p,x+3.5p); drawdot (1.5p,x+2.5p); + drawdot (w-1.5p,x+1.5p); drawdot (w-.5p,x+.5p); + drawdot (x+2.5p,h-.5p); drawdot (x+3.5p,h-1.5p); + endfor +% fill (2p,2p)--(w-2p,2p)--(w-2p,h-2p)--(2p,h-2p)--cycle; + fill (3p,3p)--(w-3p,3p)--(w-3p,h-3p)--(3p,h-3p)--cycle; + pickup huge_pen; +enddef; + +def dota = erase drawdot(16p,48p) enddef; +def dotb = erase drawdot(32p,48p) enddef; +def dotc = erase drawdot(48p,48p) enddef; +def dotd = erase drawdot(16p,32p) enddef; +def dote = erase drawdot(32p,32p) enddef; +def dotf = erase drawdot(48p,32p) enddef; +def dotg = erase drawdot(16p,16p) enddef; +def doth = erase drawdot(32p,16p) enddef; +def doti = erase drawdot(48p,16p) enddef; + +def v(expr code)=128+ASCII code enddef; + % change character code for vertical format + +begindomchar("0"); endchar; +begindomchar("1"); dote; endchar; +%begindomchar("2"); dotc; dotg; endchar; +%begindomchar(v("2")); dota; doti; endchar; % in vertical position +%begindomchar("3"); dotc; dote; dotg; endchar; +%begindomchar(v("3")); dota; dote; doti; endchar; % in vertical position +begindomchar("2"); dota; doti; endchar; +begindomchar(v("2")); dotc; dotg; endchar; % in vertical position +begindomchar("3"); dota; dote; doti; endchar; +begindomchar(v("3")); dotc; dote; dotg; endchar; % in vertical position +begindomchar("4"); dota; dotc; dotg; doti; endchar; +begindomchar("5"); dota; dotc; dote; dotg; doti; endchar; +begindomchar("6"); dota; dotb; dotc; dotg; doth; doti; endchar; +begindomchar(v("6")); dota; dotc; dotd; dotf; dotg; doti; endchar; % vert +begindomchar("7"); dota; dotb; dotc; dote; dotg; doth; doti; endchar; +begindomchar(v("7")); dota; dotc; dotd; dote; dotf; dotg; doti; endchar; % vert +begindomchar("8"); dota; dotb; dotc; dotd; dotf; dotg; doth; doti; endchar; +begindomchar("9"); dota; dotb; dotc; dotd; dote; dotf; dotg; doth; doti; + endchar; + +beginchar("<",d#,d#,0); % outline of left half +% fill (w-2.5p,h-2p)--(w+2.5p,h-2p)--(w+2.5p,2p)--(w-2.5p,2p)--cycle; + fill (w-3.5p,h-3p)--(w+3.5p,h-3p)--(w+3.5p,3p)--(w-3.5p,3p)--cycle; +endchar; +beginchar(">",d#,d#,0); % outline of right half +% fill (-2.5p,h-2p)--(2.5p,h-2p)--(2.5p,2p)--(-2.5p,2p)--cycle; + fill (-3.5p,h-3p)--(3.5p,h-3p)--(3.5p,3p)--(-3.5p,3p)--cycle; +endchar; +beginchar("^",d#,d#,0); % outline of top half +% fill (2p,-2.5p)--(2p,2.5p)--(w-2p,2.5p)--(w-2p,-2.5p)--cycle; + fill (3p,-3.5p)--(3p,3.5p)--(w-3p,3.5p)--(w-3p,-3.5p)--cycle; +endchar; +beginchar("v",d#,d#,0); % outline of bottom half +% fill (2p,h-2.5p)--(2p,h+2.5p)--(w-2p,h+2.5p)--(w-2p,h-2.5p)--cycle; + fill (3p,h-3.5p)--(3p,h+3.5p)--(w-3p,h+3.5p)--(w-3p,h-3.5p)--cycle; +endchar; + +ligtable "^": "v": "2" |=: v("2"), v("2") kern-d#, + "3" |=: v("3"), v("3") kern-d#, + "6" |=: v("6"), v("6") kern-d#, + "7" |=: v("7"), v("7") kern-d#, skipto 1; +ligtable "<": ">": "2" kern-d#, "3" kern-d#, "6" kern-d#, "7" kern-d#, 1:: + "0" kern-d#, "1" kern-d#, "4" kern-d#, "5" kern-d#, "8" kern-d#, "9" kern-d#; + +end. diff --git a/systems/knuth/local/lib/e.mft b/systems/knuth/local/lib/e.mft new file mode 100644 index 0000000000..729652d263 --- /dev/null +++ b/systems/knuth/local/lib/e.mft @@ -0,0 +1,33 @@ +%%%% MFT commands for the Computer Modern book (Volume E) +%%% } ( ) ]] {{ }} ! ^ %%%% tokens that need no special formatting +%%% step upto downto %%%% boldface binary operators +%%% addto fill unfill draw undraw %%%% boldface unary operators +%%% addto filldraw unfilldraw drawdot undrawdot erase pickup +%%% addto exitunless stop incr decr proofrulethickness screenrule +%%% addto define_pixels define_whole_pixels define_whole_vertical_pixels +%%% addto define_blacker_pixels define_whole_blacker_pixels +%%% addto define_whole_vertical_blacker_pixels +%%% addto define_corrected_pixels lowres_fix proofoffset penstroke +%%% addto beginchar beginarithchar italcorr font_size font_slant +%%% addto font_normal_space font_normal_stretch font_normal_shrink font_quad +%%% addto font_x_height font_extra_space font_identifier font_coding_scheme +%%% addto cmchar iff generate adjust_fit math_fit labels penlabels +%%% addto stroke circ_stroke padded +%%% enddef endchar %%%% boldface closing +%%% true relax mode_setup font_setup %%%% boldface nullary operators +%%% true clearit shipit cullit openit showit clearxy clearpen +%%% true nodisplay notransforms screenchars screenstrokes imagerules +%%% .. ... .... -- --- %%%% path operators made of dots and dashes +%%% length flex abs dir %%%% unary operators to be in roman type +%%% length unitvector inverse ceiling hround vround Vround counterclockwise +%%% length tensepath byte reflectedabout rotatedaround magstep max min +%%% and mod dotprod intersectionpoint softjoin %%%% binary operators to be roman +%%% ++ ** %%%% binary operators made of two special characters +%%% penoffset goodval direction directionpoint %%%% operators that take "of" +%%% pausing tolerance pixels_per_inch blacker o_correction %%%% internals +%%% pausing screen_rows screen_cols currentwindow displaying +%%% pausing pen_top pen_bot pen_lft pen_rt shrink_fit rt lft top bot +%%% = <= >= <> %%%% conversions for the SAIL character set only +%%% good crisp fine tiny rule light_rule cal light_cal med_cal heavy_cal +%%% good term fudged mfudged sloped_serif tilted med_tilted +%%% pausing slant fudge math_spread superness superpull beak_darkness ligs diff --git a/systems/knuth/local/lib/epsf.tex b/systems/knuth/local/lib/epsf.tex new file mode 100644 index 0000000000..81774da682 --- /dev/null +++ b/systems/knuth/local/lib/epsf.tex @@ -0,0 +1,215 @@ +% EPSF.TEX macro file: +% Written by Tomas Rokicki of Radical Eye Software, 29 Mar 1989. +% Revised by Don Knuth, 3 Jan 1990. +% Revised by Tomas Rokicki to accept bounding boxes with no +% space after the colon, 18 Jul 1990. +% Revised by Knuth to always report if no bounding box found, 27 Nov 2012. +% +% TeX macros to include an Encapsulated PostScript graphic. +% Works by finding the bounding box comment, +% calculating the correct scale values, and inserting a vbox +% of the appropriate size at the current position in the TeX document. +% +% To use with the center environment of LaTeX, preface the \epsffile +% call with a \leavevmode. (LaTeX should probably supply this itself +% for the center environment.) +% +% To use, simply say +% \input epsf % somewhere early on in your TeX file +% \epsfbox{filename.ps} % where you want to insert a vbox for a figure +% +% Alternatively, you can type +% +% \epsfbox[0 0 30 50]{filename.ps} % to supply your own BB +% +% which will not read in the file, and will instead use the bounding +% box you specify. +% +% The effect will be to typeset the figure as a TeX box, at the +% point of your \epsfbox command. By default, the graphic will have its +% `natural' width (namely the width of its bounding box, as described +% in filename.ps). The TeX box will have depth zero. +% +% You can enlarge or reduce the figure by saying +% \epsfxsize=<dimen> \epsfbox{filename.ps} +% (or +% \epsfysize=<dimen> \epsfbox{filename.ps} +% instead). Then the width of the TeX box will be \epsfxsize and its +% height will be scaled proportionately (or the height will be +% \epsfysize and its width will be scaled proportionately). The +% width (and height) is restored to zero after each use. +% +% A more general facility for sizing is available by defining the +% \epsfsize macro. Normally you can redefine this macro +% to do almost anything. The first parameter is the natural x size of +% the PostScript graphic, the second parameter is the natural y size +% of the PostScript graphic. It must return the xsize to use, or 0 if +% natural scaling is to be used. Common uses include: +% +% \epsfxsize % just leave the old value alone +% 0pt % use the natural sizes +% #1 % use the natural sizes +% \hsize % scale to full width +% 0.5#1 % scale to 50% of natural size +% \ifnum#1>\hsize\hsize\else#1\fi % smaller of natural, hsize +% +% If you want TeX to report the size of the figure (as a message +% on your terminal when it processes each figure), say `\epsfverbosetrue'. +% +\newread\epsffilein % file to \read +\newif\ifepsffileok % continue looking for the bounding box? +\newif\ifepsfbbfound % success? +\newif\ifepsfverbose % report what you're making? +\newdimen\epsfxsize % horizontal size after scaling +\newdimen\epsfysize % vertical size after scaling +\newdimen\epsftsize % horizontal size before scaling +\newdimen\epsfrsize % vertical size before scaling +\newdimen\epsftmp % register for arithmetic manipulation +\newdimen\pspoints % conversion factor +% +\pspoints=1bp % Adobe points are `big' +\epsfxsize=0pt % Default value, means `use natural size' +\epsfysize=0pt % ditto +% +\def\epsfbox#1{\global\def\epsfllx{72}\global\def\epsflly{72}% + \global\def\epsfurx{540}\global\def\epsfury{720}% + \def\lbracket{[}\def\testit{#1}\ifx\testit\lbracket + \let\next=\epsfgetlitbb\else\let\next=\epsfnormal\fi\next{#1}}% +% +\def\epsfgetlitbb#1#2 #3 #4 #5]#6{\epsfgrab #2 #3 #4 #5 .\\% + \epsfsetgraph{#6}}% +% +\def\epsfnormal#1{\epsfgetbb{#1}\epsfsetgraph{#1}}% +% +\def\epsfgetbb#1{% +% +% The first thing we need to do is to open the +% PostScript file, if possible. +% +\openin\epsffilein=#1 +\ifeof\epsffilein\errmessage{I couldn't open #1, will ignore it}\else +% +% Okay, we got it. Now we'll scan lines until we find one that doesn't +% start with %. We're looking for the bounding box comment. +% + {\epsffileoktrue \chardef\other=12 + \epsfbbfoundfalse % added by Knuth, 27 Nov 2012 + \def\do##1{\catcode`##1=\other}\dospecials \catcode`\ =10 + \loop + \read\epsffilein to \epsffileline + \ifeof\epsffilein\epsffileokfalse\else +% +% We check to see if the first character is a % sign; +% if not, we stop reading (unless the line was entirely blank); +% if so, we look further and stop only if the line begins with +% `%%BoundingBox:'. +% + \expandafter\epsfaux\epsffileline:. \\% + \fi + \ifepsffileok\repeat + \ifepsfbbfound\else +% \ifepsfverbose\message{No bounding box comment in #1; using defaults}\fi\fi + \errmessage{No bounding box comment in #1; using defaults}\fi + }\closein\epsffilein\fi}% +% +% Now we have to calculate the scale and offset values to use. +% First we compute the natural sizes. +% +\def\epsfclipstring{}% do we clip or not? If so, +\def\epsfclipon{\def\epsfclipstring{ clip}}% +\def\epsfclipoff{\def\epsfclipstring{}}% +% +\def\epsfsetgraph#1{% + \epsfrsize=\epsfury\pspoints + \advance\epsfrsize by-\epsflly\pspoints + \epsftsize=\epsfurx\pspoints + \advance\epsftsize by-\epsfllx\pspoints +% +% If `epsfxsize' is 0, we default to the natural size of the picture. +% Otherwise we scale the graph to be \epsfxsize wide. +% + \epsfxsize\epsfsize\epsftsize\epsfrsize + \ifnum\epsfxsize=0 \ifnum\epsfysize=0 + \epsfxsize=\epsftsize \epsfysize=\epsfrsize + \epsfrsize=0pt +% +% We have a sticky problem here: TeX doesn't do floating point arithmetic! +% Our goal is to compute y = rx/t. The following loop does this reasonably +% fast, with an error of at most about 16 sp (about 1/4000 pt). +% + \else\epsftmp=\epsftsize \divide\epsftmp\epsfrsize + \epsfxsize=\epsfysize \multiply\epsfxsize\epsftmp + \multiply\epsftmp\epsfrsize \advance\epsftsize-\epsftmp + \epsftmp=\epsfysize + \loop \advance\epsftsize\epsftsize \divide\epsftmp 2 + \ifnum\epsftmp>0 + \ifnum\epsftsize<\epsfrsize\else + \advance\epsftsize-\epsfrsize \advance\epsfxsize\epsftmp \fi + \repeat + \epsfrsize=0pt + \fi + \else \ifnum\epsfysize=0 + \epsftmp=\epsfrsize \divide\epsftmp\epsftsize + \epsfysize=\epsfxsize \multiply\epsfysize\epsftmp + \multiply\epsftmp\epsftsize \advance\epsfrsize-\epsftmp + \epsftmp=\epsfxsize + \loop \advance\epsfrsize\epsfrsize \divide\epsftmp 2 + \ifnum\epsftmp>0 + \ifnum\epsfrsize<\epsftsize\else + \advance\epsfrsize-\epsftsize \advance\epsfysize\epsftmp \fi + \repeat + \epsfrsize=0pt + \else + \epsfrsize=\epsfysize + \fi + \fi +% +% Finally, we make the vbox and stick in a \special that dvips can parse. +% + \ifepsfverbose\message{#1: width=\the\epsfxsize, height=\the\epsfysize}\fi + \epsftmp=10\epsfxsize \divide\epsftmp\pspoints + \vbox to\epsfysize{\vfil\hbox to\epsfxsize{% + \ifnum\epsfrsize=0\relax + \special{PSfile=#1 llx=\epsfllx\space lly=\epsflly\space + urx=\epsfurx\space ury=\epsfury\space rwi=\number\epsftmp + \epsfclipstring}% + \else + \epsfrsize=10\epsfysize \divide\epsfrsize\pspoints + \special{PSfile=#1 llx=\epsfllx\space lly=\epsflly\space + urx=\epsfurx\space ury=\epsfury\space rwi=\number\epsftmp\space + rhi=\number\epsfrsize \epsfclipstring}% + \fi + \hfil}}% +\global\epsfxsize=0pt\global\epsfysize=0pt}% +% +% We still need to define the tricky \epsfaux macro. This requires +% a couple of magic constants for comparison purposes. +% +{\catcode`\%=12 \global\let\epsfpercent=%\global\def\epsfbblit{%BoundingBox}}% +% +% So we're ready to check for `%BoundingBox:' and to grab the +% values if they are found. +% +\long\def\epsfaux#1#2:#3\\{\ifx#1\epsfpercent + \def\testit{#2}\ifx\testit\epsfbblit + \epsfgrab #3 . . . \\% + \epsffileokfalse + \global\epsfbbfoundtrue + \fi\else\ifx#1\par\else\epsffileokfalse\fi\fi}% +% +% Here we grab the values and stuff them in the appropriate definitions. +% +\def\epsfempty{}% +\def\epsfgrab #1 #2 #3 #4 #5\\{% +\global\def\epsfllx{#1}\ifx\epsfllx\epsfempty + \epsfgrab #2 #3 #4 #5 .\\\else + \global\def\epsflly{#2}% + \global\def\epsfurx{#3}\global\def\epsfury{#4}\fi}% +% +% We default the epsfsize macro. +% +\def\epsfsize#1#2{\epsfxsize} +% +% Finally, another definition for compatibility with older macros. +% +\let\epsffile=\epsfbox diff --git a/systems/knuth/local/lib/fontchart.tex b/systems/knuth/local/lib/fontchart.tex new file mode 100644 index 0000000000..6acc621155 --- /dev/null +++ b/systems/knuth/local/lib/fontchart.tex @@ -0,0 +1,89 @@ +% make a (fairly large) font chart + +\newlinechar=`@ +\message{@Name of the font to chart = } +\read-1 to \fontname + +\font\f=\fontname at .75in +\f + +% Here's the best way I know to discover character height and depth +% when they are possibly negative. +\fontdimen5\f=-10000pt % a new (rather small) xheight +\textfont0=\f +\newdimen\h \newdimen\d % will be set to the character's height, depth +\def\htdp#1{\setbox0=\hbox{\char#1}\h=-\ht0 + \setbox0=\hbox{\accent#1\char#1}\advance\h\ht0 \advance\h-10000pt + \setbox0=\null \wd0=-10000pt % in case the character has a charlist! + \setbox0=\hbox{$\mathaccent#1{\box0}$}% + \d=\ht0 \advance\d-10000pt \advance\d-\h} + +% (By the way, my previous best was this: +% \textfont15=\f % use family "F +% \fontdimen8\tenex=0pt % set defaultrulethickness zero +% \setbox1=\null \ht1=-10000pt \setbox2=\null \dp3=-10000pt +% \newdimen\d \newdimen\h \newcount\n +% \n=#1 \advance\n"F00 +% \setbox0=\hbox{$\radical\n{\copy1}$} +% \d=\dp0 \advance\d-5000pt \advance\d\d %\showthe\d +% \setbox0=\hbox{$\radical\n{\copy2}$} +% \h=\ht0 \advance\h-5000pt \advance\h-.5\d +% \ifdim\h>0pt \h=.5\h \fi +% ....very tricky! But it works only when height+depth is positive.) + +\tracinglostchars=0 +\nopagenumbers + +\def\testrow#1#2{\setbox0=\hbox{\penalty1\def\\{\char'#1#2}% + \\0\\1\\2\\3\\4\\5\\6\\7\global\chardef\p=\lastpenalty}} % p=1 if none there + +\raggedbottom +\baselineskip=1in +\topskip=.75in +\newdimen\w \w=.75in +\headline={\vtop{\hbox{\tt\fontname\unskip, page \folio\hfil} + \kern-.75in\unitsdigits}\hss} +\footline={\unitsdigits\hss} +\def\unitsdigits{\hbox{\kern.3in \tt + \hbox to\w{\ \ 0\hss}% + \hbox to\w{\ \ 1\hss}% + \hbox to\w{\ \ 2\hss}% + \hbox to\w{\ \ 3\hss}% + \hbox to\w{\ \ 4\hss}% + \hbox to\w{\ \ 5\hss}% + \hbox to\w{\ \ 6\hss}% + \hbox to\w{\ \ 7\hss}}} + +\def\row#1#2{\testrow#1#2% +\ifnum\p=0\hbox{\hbox to.3in{\tt#1#2\hfil}% + \mod#1#20\mod#1#21\mod#1#22\mod#1#23\mod#1#24\mod#1#25\mod#1#26\mod#1#27% + \hbox to.3in{\tt\hfil#1#2}}\fi} + +\newdimen\pixel \pixel=.00333333in +\def\mod#1#2#3{\chardef\c='#1#2#3 \htdp\c + \setbox0=\hbox{\penalty1\c\global\chardef\p=\lastpenalty}% + \ifnum\p=1 \hbox to\w{}\else + \setbox2=\hbox{\c\/}% + \hbox to\w{\kern-\pixel \vrule width\pixel height\h depth\d + \copy\leftbox\copy0\copy\rightbox + \vrule width\pixel height\h depth\d \kern-\pixel \kern-\wd0 + \raise\h\vbox{\hrule height\pixel width\wd0}\kern-\wd0 + \lower\d\vbox{\hrule height0pt depth\pixel width\wd0}\kern-\wd0 + \ifdim\wd2>\wd0 \kern\wd2\raise\h\copy\icbox \fi + \hss}\fi} + +\newbox\leftbox % marking the baseline at the left +\setbox\leftbox=\hbox{\kern-\pixel\vrule width\pixel height4pt + \vrule height0pt depth\pixel width4pt \kern-4pt} +\newbox\rightbox % marking the baseline at the right +\setbox\rightbox=\hbox{\kern-4pt\vrule height0pt depth\pixel width4pt + \vrule width\pixel height4pt \kern-\pixel} +\newbox\icbox % the mark of an italic correction +\setbox\icbox=\hbox{\kern-4pt\vrule height\pixel width4pt depth0pt + \vrule width\pixel depth4pt} + +\row00 \row01 \row02 \row03 \row04 \row05 \row06 \row07 +\row10 \row11 \row12 \row13 \row14 \row15 \row16 \row17 +\row20 \row21 \row22 \row23 \row24 \row25 \row26 \row27 +\row30 \row31 \row32 \row33 \row34 \row35 \row36 \row37 +\bye diff --git a/systems/knuth/local/lib/gkpmac.tex b/systems/knuth/local/lib/gkpmac.tex new file mode 100644 index 0000000000..1ae0f1a7a6 --- /dev/null +++ b/systems/knuth/local/lib/gkpmac.tex @@ -0,0 +1,890 @@ +\tracingpages=1 % TEMPORARY! +% Macros for `Concrete Mathematics' +\ifx\gkpmac\fmtversion\endinput\else\let\gkpmac=\fmtversion\fi + +% Fonts for regular text + +\font\textrm=ccr10 % roman +\font\textit=ccti10 % italic (emphasis) +\font\textsl=ccsl10 % slanted (titles) +\font\textbf=cmbx10 % bold +\font\textcsc=cccsc10 % caps and small caps +\font\oldsty=ccmi10 % equation numbers +\font\twelvett=cmtt12 + +% Fonts for regular math +% I'm setting \fontdimen2 to zero because AMS forgot to do it; +% they may have fixed the problem in the meantime, but no harm is done + +\font\mathtext=ccr10 + \font\mathsubtext=ccr7 + \font\mathsubsubtext=ccr5 +\font\mathlet=eurm10 \fontdimen2\mathlet=0pt + \font\mathsublet=eurm7 \fontdimen2\mathsublet=0pt + \font\mathsubsublet=eurm5 \fontdimen2\mathsubsublet=0pt + \skewchar\mathlet='177 \skewchar\mathsublet='177 \skewchar\mathsubsublet='177 +\font\mathsym=cmsy10 + \font\mathsubsym=cmsy7 + \font\mathsubsubsym=cmsy5 + \skewchar\mathsym='60 \skewchar\mathsubsym='60 \skewchar\mathsubsubsym='60 +\font\mathext=cmex10 + \font\mathsubext=cmex10 + \font\mathsubsubext=cmex10 +\font\mathscr=euxm10\fontdimen2\mathscr=0pt + \font\mathsubscr=euxm7 \fontdimen2\mathsubscr=0pt + \font\mathsubsubscr=euxm5 \fontdimen2\mathsubsubscr=0pt + \skewchar\mathscr='60 \skewchar\mathsubscr='60 \skewchar\mathsubsubscr='60 +\font\mathfr=eufm10\fontdimen2\mathfr=0pt + \font\mathsubfr=eufm7 \fontdimen2\mathsubfr=0pt + \font\mathsubsubfr=eufm5 \fontdimen2\mathsubsubfr=0pt +\font\matheuex=euex10\fontdimen2\matheuex=0pt + +\font\eulerbf=eurb10 \fontdimen2\eulerbf=0pt % not hooked in to these macros + +% Fonts for graffiti + +\font\gtext=ccslc9 +\font\goldstyle=ccmic9 + \fontdimen3\gtext=0pt \fontdimen4\gtext=0pt % no stretch or shrink +\font\gmathtext=ccr9 + \font\gmathsubtext=ccr6 + \font\gmathsubsubtext=ccr5 +\font\gmathlet=eurm10 scaled 900 \fontdimen2\gmathlet=0pt + \font\gmathsublet=eurm7 scaled 857 \fontdimen2\gmathsublet=0pt + \font\gmathsubsublet=eurm5 \fontdimen2\gmathsubsublet=0pt + \skewchar\gmathlet='177 \skewchar\gmathsublet='177 + \skewchar\gmathsubsublet='177 +\font\gmathsym=cmsy9 + \font\gmathsubsym=cmsy6 + \font\gmathsubsubsym=cmsy5 + \skewchar\gmathsym='60 \skewchar\gmathsubsym='60 \skewchar\gmathsubsubsym='60 +\font\gmathext=cmex9 + \font\gmathsubext=cmex9 + \font\gmathsubsubext=cmex9 +\font\gmathscr=euxm10 scaled 900 \fontdimen2\gmathscr=0pt + \font\gmathsubscr=euxm7 scaled 857 \fontdimen2\gmathsubscr=0pt + \font\gmathsubsubscr=euxm5 \fontdimen2\gmathsubsubscr=0pt + \skewchar\gmathscr='60 \skewchar\gmathsubscr='60 \skewchar\gmathsubsubscr='60 +\font\gmathfr=eufm10 scaled 900 \fontdimen2\gmathfr=0pt + \font\gmathsubfr=eufm7 scaled 857 \fontdimen2\gmathsubfr=0pt + \font\gmathsubsubfr=eufm5 \fontdimen2\gmathsubsubfr=0pt +\font\gmatheuex=euex9 \fontdimen2\gmatheuex=0pt + +% Fonts for headings, etc. + +\font\chapfont=cmbxcd10 scaled 8000 +\font\title=cmbx10 scaled \magstep5 +\font\subtitle=cmbx10 scaled 1315 % that's magstep 1.5 +\font\subsubtitle=cmbxsl10 +\font\runhead=cmbx9 +\font\foliofont=cmr9 +\font\gtfont=cmmi9 % for the \t accent +\font\ninesl=ccsl9 % used in the index only + +% Normal text conventions + +\catcode`@=11 % borrow the private macros of PLAIN (with care) +\def\wlog#1{} % don't put allocation info into the log + +\hsize=28pc +\vsize=45.25pc +\parindent=20pt +\baselineskip=13pt + +\let\sc=\textcsc +\let\bf=\textbf +\def\textindent#1{\noindent\hbox to\parindent{\bf#1\hfil}\ignorespaces} +\def\exitem{\hangindent2\parindent \textindent} + +\textfont0=\mathtext + \scriptfont0=\mathsubtext + \scriptscriptfont0=\mathsubsubtext +\textfont1=\mathlet \let\tfont=\teni + \scriptfont1=\mathsublet + \scriptscriptfont1=\mathsubsublet +\textfont2=\mathsym + \scriptfont2=\mathsubsym + \scriptscriptfont2=\mathsubsubsym +\textfont3=\mathext + \scriptfont3=\mathsubext + \scriptscriptfont3=\mathsubsubext +\def\rm{\fam\z@\textrm} +\def\it{\fam\itfam\textit} % \it is family 4, defined in PLAIN +\def\sl{\textsl} +\textfont\itfam=\textit +\newfam\scrfam \ifnum\scrfam=8\relax\else\error\fi % family 8, script +\textfont\scrfam=\mathscr + \scriptfont\scrfam=\mathsubscr + \scriptscriptfont\scrfam=\mathsubsubscr +\def\scr{\fam8 } +\mathcode`0="7130 +\mathcode`1="7131 +\mathcode`2="7132 +\mathcode`3="7133 +\mathcode`4="7134 +\mathcode`5="7135 +\mathcode`6="7136 +\mathcode`7="7137 +\mathcode`8="7138 +\mathcode`9="7139 +\newfam\frfam % family 9, fraktur +\textfont\frfam=\mathfr + \scriptfont\frfam=\mathsubfr + \scriptscriptfont\frfam=\mathsubsubfr +\def\frak{\fam9 } +\newfam\euexfam % family 10, substitions for euler symbols +\newfam\eqfam % family 11, cmr equal signs for Relbar (!) +\font\teneq=cmr10 \textfont\eqfam=\teneq +\font\nineeq=cmr9 +% I'm not using Relbar except in 9&10pt, so this family is very incomplete... + +\mathchardef\intop="1A52 +\mathchardef\ointop="1A48 +\mathchardef\coprod="1A60 +\mathchardef\prod="1A51 +\mathchardef\sum="1A50 +\mathchardef\braceld="A7A \mathchardef\bracerd="A7B +\mathchardef\bracelu="A7C \mathchardef\braceru="A7D +\mathchardef\infty="0A31 + +\mathchardef\nearrow="3A25 +\mathchardef\searrow="3A26 +\mathchardef\nwarrow="3A2D +\mathchardef\swarrow="3A2E +\mathchardef\Leftrightarrow="3A2C +\mathchardef\Leftarrow="3A28 +\mathchardef\Rightarrow="3A29 +\mathchardef\leftrightarrow="3A24 \mathcode`\^^W="3A24 +\mathchardef\leftarrow="3A20 \let\gets=\leftarrow \mathcode`\^^X="3A20 +\mathchardef\rightarrow="3A21 \let\to=\rightarrow \mathcode`\^^Y="3A21 +\def\uparrow{\delimiter"3A22378 } \mathcode`\^^K="3A22 +\def\downarrow{\delimiter"3A23379 } \mathcode`\^^A="3A23 +\def\updownarrow{\delimiter"3A6C33F } +\def\Uparrow{\delimiter"3A2A37E } +\def\Downarrow{\delimiter"3A2B37F } +\def\Updownarrow{\delimiter"3A6D377 } +\mathchardef\leftharpoonup="3A18 +\mathchardef\leftharpoondown="3A19 +\mathchardef\rightharpoonup="3A1A +\mathchardef\rightharpoondown="3A1B + +\textfont\euexfam=\matheuex +\scriptfont\euexfam=\mathsubsym % this is OK since I don't use all characters +% of euex in subscripts/superscripts; otherwise I'd have to make euex7 and euex6 +\scriptscriptfont\euexfam=\mathsubsym % only for \mathchoice, not really chosen +\mathcode`+="292B +\mathcode`-="292D +\mathcode`!="0921 +\mathcode`(="4928 \delcode`(="928300 +\mathcode`)="5929 \delcode`)="929301 +\mathcode`[="495B \delcode`[="95B302 +\mathcode`]="595D \delcode`]="95D303 +\mathcode`=="393D +\mathchardef\Relbar="3B3D % we need the old = to match \Arrows +\mathchardef\Gamma="7100 +\mathchardef\Delta="7101 +\mathchardef\Theta="7102 +\mathchardef\Lambda="7103 +\mathchardef\Xi="7104 +\mathchardef\Pi="7105 +\mathchardef\Sigma="7106 +\mathchardef\Upsilon="7107 +\mathchardef\Phi="7108 +\mathchardef\Psi="7109 +\mathchardef\Omega="710A +\let\varsigma=\sigma \let\varrho=\rho % Euler doesn't have these +\mathchardef\aleph="0840 +\def\rbrace{\delimiter"5867A09 } \let\}=\rbrace +\def\lbrace{\delimiter"4866A08 } \let\{=\lbrace +%\mathchardef\equiv="3811 \let\cong=\equiv % lowres bars weren't spaced right +\mathchardef\leq="3814 \let\le=\leq +\mathchardef\geq="3815 \let\ge=\geq +\mathchardef\Re="083C +\mathchardef\Im="083D +\def\vert{\delimiter"86A30C } +\def\backslash{\delimiter"86E30F } + +\setbox\strutbox=\hbox{\vrule height9pt depth4pt width\z@}% +\newbox\bigstrutbox \newbox\biggstrutbox +\setbox\bigstrutbox=\hbox{\vrule height11pt depth4pt width\z@}% +\def\bigstrut{\relax\ifmmode\copy\bigstrutbox\else\unhcopy\bigstrutbox\fi} +\setbox\biggstrutbox=\hbox{\vrule height17pt depth10pt width\z@}% +\def\biggstrut{\relax\ifmmode\copy\biggstrutbox\else\unhcopy\biggstrutbox\fi} +\rm + +\newmuskip\normalthick \normalthick=5mu plus 5mu +\newmuskip\normalmedmu \normalmedmu=\medmuskip +\newmuskip\displaythick \displaythick=10mu minus 3mu +\everymath{\thickmuskip=\normalthick} + +\abovedisplayskip=8pt plus 3pt minus 2pt % there's 2pt more (opened up) +\belowdisplayskip=10pt plus 3pt minus 2pt + +% displays not centered; all have capability of \eqalign +\outer\def\begindisplay{\obeylines\startdisplay} +{\obeylines\gdef\startdisplay#1 + {\catcode`\^^M=5$$% + \advance\displayindent\parindent\advance\displaywidth-\parindent% + \openup2pt #1\halign\bgroup\span\preamble\cr}} +\outer\def\enddisplay{\crcr\egroup$$} +\jot=\z@ % we do our own opening up + +\def\displaymath{$\thickmuskip=\displaythick\displaystyle} +\def\preamble{\hfil\displaymath{##}$&&\displaymath{{}##}$\hfil} +\def\tablepreamble{\bigstrut\hfil$##$\hfil\ &\vrule##&&\quad\hfil$##$\hfil} +\def\xbox{\qquad\hbox} % for third column of explanation + +\newcount\eqcount +\def\equ(#1.#2){{\rm({\oldsty#1}.{\oldsty#2})}} +\def\eq(#1){\equ(\chapno.#1)} +\def\thiseq{\xdef\next{(\chapno.\number\eqcount)}\expandafter\equ\next} +\def\eqno{\global\advance\eqcount 1 \global\everycr{\makeeqno\thiseq}} +\newdimen\backup +\def\makeeqno#1{\noalign{\global\everycr{}% + \advance\displaywidth\displayindent + \setbox0=\hbox to\displaywidth{\hfil#1}% + \backup=\prevdepth \advance\backup\ht0 + \setbox0=\vbox{\kern-\backup\box0}\ht0=\z@ \dp0=\z@ + \setbox0=\vbox{\box0}\unvbox0}} % that puts equation number on prev line! + +\newif\iftitle +\newskip\chaptopspace \chaptopspace=1in minus 5pt +\def\beginchapter#1 #2 \par{ % we should be at top of a page + \titletrue \eqcount=0 + \ifodd\pageno + \rightline{\chapfont#1\kern-.05em} + \vskip\chaptopspace + \rightline{\title#2} + \moveleft7pc % this applies to the \vbox after the \fi + \else % left-hand page + \leftline{\kern-.05em\chapfont#1} + \vskip\chaptopspace + \leftline{\title#2} \fi + \vbox{\hrule width 35pc} + \def\chapno{#1} \edef\chaptitle{#2} + \mark{#1\enspace #2} + \smallskip\noindent} + +\def\beginsection#1 #2 \par{ % should not be first in the chapter + \backup=\lastskip % but should come on first or second page of chapter + \mark{#1\enspace #2} % because the mark gives running head on right page + \nobreak\vskip-\backup\penalty-200 + {\subtitle\baselineskip=34pt + \noindent\hbox to2\parindent{#1\hfil}\uppercase{\kern-.05em#2}\par} + \nobreak\vskip5pt\noindent\hbox to2\parindent{}} + +\newcount\excount +\def\beginexercises{\backup=\lastskip \excount=0 + \mark{\chapno\enspace Exercises} + \nobreak\vskip-\backup\penalty-200 + {\subtitle\baselineskip=34pt\noindent Exercises\par}\nobreak} + +{\catcode`\|=\active +\gdef\table#1\tabref|#2|{\hrule height1pt width\hsize \kern2pt + \noindent\strut{\bf Table |#2|\enspace}#1\par + \hrule height.5pt width\hsize\tabref|#2|}} + +\def\medbr{\ifnum\lastpenalty>9999 \medskip \else\medbreak\fi} +\def\subhead#1\par{\medbr + {\subsubtitle\noindent#1\par}\nobreak} +\def\ex:{\par{\advance\medskipamount-1pt\medbr}% + \advance\excount 1 \item{\number\excount}} + +\def\dash---{\thinspace---\hskip.16667em\relax} +\def\qback{\kern-.15em} % between , or . and '' +\def\undertext#1{$\underline{\smash{\hbox{#1}}}$} +\def\newline{\hfil\break} +\def\Hint:{{\it Hint:\/}} +\let\macron=\= % we will use \= for congruence relation +\def\t#1{{\edef\next{\the\font}\tfont\accent"7F\next#1}} + +% Here's a definition that was corrected in plain.tex version 3.14159; +% I'm keeping the old version here, because I had already been compensating +% for its deficiencies in script and scriptscript styles; without this +% buggy version, it would be hard for me to match the old pages precisely +\def\bmod{\mskip-\medmuskip\mkern5mu + \mathbin{\rm mod}\penalty900\mkern5mu\mskip-\medmuskip} + +% Graffiti macros +\chardef\other=12 +\newread\grfi \openin\grfi=\jobname.grf +%\newwrite\grfo \immediate\openout\grfo=\jobname.grf % let's hope no conflict +%% Hmmm...; that doesn't work on Unix. +%% Here's my first solution, a kludge where I alternated between .grf and .gr +%\newif\ifgrf \newwrite\grfo \newwrite\grfempty +%\ifeof\grfi \grffalse +%\else\read\grfi to\grfitest \ifeof\grfi \grffalse \else \grftrue \fi\fi +%\ifgrf\else \openin\grfi=\jobname.gr +% \ifeof\grfi\else\read\grfi to\grfitest \fi\fi +%\immediate\openout\grfo=\jobname.gr\ifgrf\else f\fi +%\immediate\write\grfo{} % an empty line will start a nonempty file (Unix only) +%% and then at the end I said +% \immediate\openout\grfempty=\jobname.gr\ifgrf f\fi % clear the input file +%% That solution worked with the following original macros +%\def\testnextgrf{{\def\do##1{\catcode`##1=\other}\dospecials +% \global\read\grfi to\next}\expandafter\testgrf\meaning\next\testgrf} +%\expandafter\def\expandafter\testgrf\meaning\empty#1 #2\testgrf{% +% \setup#2!!!!!$\ifx\thisone\thatone\if#1R\Rtrue\else\Rfalse\fi\else\Rguess\fi} +%% Anyway, here's my second approach to Unix: (order n^2 algorithm) +\def\\{{\def\do##1{\catcode`##1=\other}\dospecials \endlinechar=-1 \let\eol=0 + \gdef\grfmem{} + \expandafter\def\expandafter\gbbl\meaning\empty{} + \def\appgrf{\read\grfi to\g + \ifx\g\empty\else\xdef\grfmem{\grfmem\expandafter\gbbl\meaning\g\eol}\fi} + \def\next{\ifeof\grfi\let\next\relax\else\appgrf\fi\next}\next}} +\\ % now \grfmem is "L aaaaa\eol R bbbbb\eol ... R zzzzz\eol". +\def\testnextgrf#1 #2\eol#3\\{\gdef\grfmem{#3}\setup#2!!!!!$% + \ifx\thisone\thatone\if#1R\Rtrue\else\Rfalse\fi\else\Rguess\fi} +\newwrite\grfo \immediate\openout\grfo=\jobname.grf % no conflict now + +\def\graffiti{% set up graffiti style + \hsize=6pc + \baselineskip=10pt \lineskip=0pt \lineskiplimit=0pt + \parindent=0pt + \mathsurround=1pt + \textfont0=\gmathtext + \scriptfont0=\gmathsubtext + \scriptscriptfont0=\gmathsubsubtext + \textfont1=\gmathlet \let\tfont=\gtfont + \scriptfont1=\gmathsublet + \scriptscriptfont1=\gmathsubsublet + \textfont2=\gmathsym + \scriptfont2=\gmathsubsym + \scriptscriptfont2=\gmathsubsubsym + \textfont3=\gmathext + \scriptfont3=\gmathsubext + \scriptscriptfont3=\gmathsubsubext +\textfont\scrfam=\gmathscr + \scriptfont\scrfam=\gmathsubscr + \scriptscriptfont\scrfam=\gmathsubsubscr +\textfont\frfam=\gmathfr + \scriptfont\frfam=\gmathsubfr + \scriptscriptfont\frfam=\gmathsubsubfr +\textfont\euexfam=\gmatheuex +\scriptfont\euexfam=\gmathsubsym % OK since I don't use all chars in this size +\textfont\eqfam=\nineeq + \def\rm{\fam\z@\gtext}% + \let\oldsty=\goldstyle + \let\big=\ninebig + \setbox\strutbox=\hbox{\vrule height7.25pt depth2.75pt width\z@}% + \gtext + \rightskip=\z@ plus2em % ragged right + \tolerance=2000 + \hyphenpenalty=300 + \exhyphenpenalty=300 + \doublehyphendemerits=100000 + \finalhyphendemerits=\doublehyphendemerits + } +\def\ninebig#1{{\hbox{$\textfont0=\tenrm\textfont2=\tensy + \left#1\vbox to7.25pt{}\right.\n@space$}}} +\def\grafctr{\hbox to4.5pc{\hfil##\hfil}} + +\newif\ifR % does this entry go on a right-hand page? +\def\Rguess{\def\ifR{\ifodd\pageno}} +\long\def\g#1\g{\def\next{#1!!!!!}\expandafter\writegrf\meaning\next$% + \ifx\grfmem\empty\Rguess\else\expandafter\testnextgrf\grfmem\\\fi +% pre-Unix, that line was \ifeof\grfi\Rguess\else\testnextgrf\fi + \setbox0=\vtop{\graffiti#1% + \write\m@ne\ifR{\Rcheck}\else{\Lcheck}\fi}% log file records successes + \ifvmode\kern-\prevdepth\kern-\ht0\dp0=\z@\nointerlineskip\bgroup + \else\dp0=\dp\strutbox\strut\vadjust{\kern-\dp\strutbox\kern-\ht0\fi + \ifR\moveleft7\else\moveright29\fi pc\box0}} +\expandafter\def\expandafter\writegrf\meaning\empty#1#2#3#4#5#6${% + \write\grfo{\LorR #1#2#3#4#5}\def\thisone{#1#2#3#4#5}} +\def\setup#1#2#3#4#5#6${\def\thatone{#1#2#3#4#5}} +\def\LorR{\ifodd\pageno R \else L \fi} +\def\Lcheck{\ifodd\pageno Bad guess!\fi} +\def\Rcheck{\ifodd\pageno\else Bad guess!\fi} + +% Page layout +\newif\ifpreprint \preprinttrue % should be false when making the final copy +\newdimen\pageheight \pageheight=\vsize +\newdimen\totheight \totheight=49.5pc +\newdimen\folioht \setbox0=\hbox{\foliofont0} \folioht=\ht0 +\def\leftheadline{\hbox to35pc{\vbox to 10pt{}% strut to position the baseline + \llap{\kern-2pc\iftitle\leftcorner\else\foliofont\folio\fi\hfil}% + \iftitle\hfil\copyrite\else\runhead\uppercase\expandafter{\chaptitle}\hfil\fi}} +\def\rightheadline{\hbox to35pc{\iftitle\copyrite\fi\hfil + \vbox to 10pt{}% strut to position the baseline + \iftitle\else\runhead\uppercase\expandafter{\topmark}\fi + \rlap{\hfil\iftitle\rightcorner\else\foliofont\folio\fi\kern-2pc}}} +\def\leftcorner{\iffinal\else\vrule\vbox to\folioht{\hrule width9pt\vfil}\fi} +\def\rightcorner{\iffinal\else\vbox to\folioht{\hrule width9pt\vfil}\vrule\fi} +\def\copyrite{\ifpreprint{\textfont2=\sevensy\sevenrm\copyright\ 1988 + Addison-Wesley Publishing Company; all rights reserved}\fi} + +\newdimen\htrimsize \htrimsize=7.5in +\newdimen\vtrimsize \vtrimsize=9.1875in +\newdimen\outermargin \outermargin=23mm +\newdimen\topmargin \topmargin=10mm % plus height of the headline box +\newbox\htrim \newbox\vtrim \newbox\trimmarks +\setbox\htrim=\hbox to\htrimsize{\kern-.65in + \vrule height .2pt depth .2pt width .4in\hfil\vrule width.4in\kern-.65in} + \wd\htrim=0pt +\setbox\vtrim=\vbox to\vtrimsize{\kern-.65in + \moveleft.2pt\hbox{\vrule height .4in}\vfil + \moveleft.2pt\hbox{\vrule height .4in}\kern-.65in} + \wd\vtrim=0pt +\setbox\trimmarks=\hbox to0pt{\raise\vtrimsize\copy\htrim \copy\htrim + \copy\vtrim \kern\htrimsize \copy\vtrim\hss} + \ht\trimmarks=0pt \dp\trimmarks=0pt + +\newif\iffinal % are we making the final copy? (pages.tex says "999") +\def\onepageout#1{\escapechar=-1 % for writing \tabrefs + \shipout % here we define one page of output + \iffinal % add the trim marks + \hbox to\htrimsize{\copy\trimmarks + \ifodd\pageno\hss\else \hskip\outermargin\fi + \vbox to\vtrimsize{\kern\topmargin\fi + \vbox to\totheight{ + \offinterlineskip % butt the boxes together + \vbox to 2pc{ % this part goes on top of the regular pages + \ifodd\pageno \rightheadline\else\leftheadline\fi + \vfill} % this completes the \vbox to 2pc + \ifodd\pageno\moveright7pc\fi #1 + \vfill + \iftitle \global\titlefalse % reset the titlepage switch + \ifodd\pageno \hbox to35pc{\hfil\foliofont\folio} + \else\hbox{\foliofont\folio}\fi\fi + \ifpreprint\ifinxmode\makeinxfooter\fi\fi + \iffinal % finish the trimmed page + }\vfill}\ifodd\pageno\hskip\outermargin\else\hss\fi + \rlap{\smash{\lower30pt\hbox to.35in{\hss\twelvett\number\pageno}}}\fi + } + \advancepageno} + +\output{\onepageout{\pagebody}} + +\newbox\inxfootbanner +\def\hours{\count0=\time \divide\count0 by60 % find the o'clock + \multiply\count0 by40 \advance\count0\time % convert to hhmm + \advance\count0 10000 \expandafter\gobbleone\number\count0\relax} +\def\gobbleone1{} +\setbox\inxfootbanner=\rlap{\hbox to 6.5in{\hrulefill\sevenrm\quad + Author's page proof produced by \TeX\ at + \hours\space on \ifcase\month\or + January\or February\or March\or April\or May\or June\or + July\or August\or September\or October\or November\or December\fi + \space\number\day}} +\def\makeinxfooter{\vbox to0pt{\kern10pt\copy\inxfootbanner\kern4pt + \rlap{\vbadness=\maxdimen \inxcolumns}\vss}} +\def\inxcolumns{\ifvoid\inxbox\let\next\relax\else\let\next\contribcol\fi\next} +\def\contribcol{\setbox0=\vsplit\inxbox to54pt + \vtop{\unvbox0}\kern20pt \inxcolumns} +\def\inxstyle{\vrule height6pt depth2pt width\z@ \sevenrm} +\splittopskip=6pt + +% Cross references + +% \ref{value}|name| gives value to |name| +% \eqref|name| gives \eqcount to |name| +% \exref|name| gives \excount to |name| +% \tabref|name| gives appropriate page number to |name| +% \refin foo inputs references from job foo (other than this job) +% \showmissestrue if you want to see missing references + +\newif\ifshowmisses +\def\vertical{|} +\def\inref#1 #{\expandafter\def\csname\vertical#1\endcsname} + +\catcode`\|=\active +\expandafter\def\expandafter\dospecials\expandafter{\dospecials\do\|} +\newcount\defcount % number of old definitions not yet repeated +\newcount\changecount % number of new definitions that are changed +\newcount\miscount % number of unknown references + +\newread\tempin +\def\refin#1 {\openin\tempin=#1.ref + \ifeof\tempin\closein\tempin + \else\closein\tempin \let|\inref \input#1.ref \let|\crossref \fi} + +{\let\|=\jobname + \def\def{\global\advance\defcount1 \gdef}\expandafter\refin\| } +\newwrite\refo \immediate\openout\refo=\jobname.ref + +\def\ref#1|#2|{\xdef\temp{#1}\expandafter\dordef\csname\vertical#2\endcsname} +\def\dordef#1{\ifx#1\temp \global\advance\defcount-1 + \else\global\advance\changecount1 \global\let#1\temp\fi + {\escapechar=-1\immediate\write\refo{\noexpand#1{\temp}}}} +\def\eqref{\ref{\number\eqcount}} +\def\exref{\ref{\number\excount}} +\def\tabref|#1|{\expandafter\pageref\csname\vertical#1\endcsname} +\def\pageref#1{\ifx#1\relax\else\global\advance\defcount-1 \fi + \write\refo{\noexpand#1{\number\pageno}}% + \write\m@ne{\ifx#1\relax New Pageref!\else + \ifnum#1=\pageno\else Changed Pageref!\fi\fi}} +\def\crossref#1|{\expandafter\usedef\csname\vertical#1\endcsname} +\def\usedef#1{\ifx#1\relax + \ifshowmisses\showmiss#1\fi\global\advance\miscount1 ??\else #1\fi} +\let|=\crossref +\def\showmiss#1{{\escapechar=-1% + \message{***** WARNING: Undefined reference #1\string|! *****}}} + +\def\cite#1.{\ifinxmode\write\bnx{[#1] \number\pageno.}\fi#1} +{\catcode`\@=\active +\gdef\newcite#1.{\ifinxmode\write\bnx{[#1'] \number\pageno.}\fi#1$'@$}} + +\outer\def\bye{ + \ifnum\miscount>0 + \message{(\the\miscount\space undefined references were present)}\fi + \ifnum\changecount>0 + \message{(\the\changecount\space new references written on \jobname.ref)}\fi + \ifnum\defcount>0 + \message{(\the\defcount\space old references dropped from \jobname.ref)}\fi + \par\vfill\supereject + \end} + +% Exercises + +\newwrite\ans +\immediate\openout\ans=\jobname.ans + +\outer\def\answer{\par + \immediate\write\ans{} + \immediate\write\ans{\string\ansno\chapno.\the\excount:} + \copytoblankline} +\def\copytoblankline{\begingroup\setupcopy\copyans} +\def\setupcopy{\def\do##1{\catcode`##1=\other}\dospecials \obeylines} +{\obeylines \gdef\copyans#1 + {\def\next{#1}% + \ifx\next\empty\let\next=\endgroup % + \else\immediate\write\ans{\next} \let\next=\copyans\fi\next}} + +\def\ansno#1:{\par\medbreak\def\thisansno{\source#1}% + \noindent\hbox to\parindent{\bf #1\hfil}\ignorespaces} + +% Pictures (a subset of \LaTeX's conventions) +\newskip\hsssglue \hsssglue=0pt plus 1fill minus 1fill \def\hsss{\hskip\hsssglue} + +\newdimen\unitlength \newdimen\linethickness +\newdimen\@picheight \newdimen\@xdim \newdimen\@ydim \newdimen\@len \newdimen\@save +\newcount\@multicount \newcount\@xarg \newcount\@yarg +\newbox\@picbox \newbox\@mpbox + +\font\tenln=line10 \font\tenlnw=linew10 +\font\tencirc=lcircle10 \font\tencircw=lcirclew10 +\font\smallln=linew10 scaled 483 % that's magstep-4 + +\def\thinlines{\let\linefont=\tenln \let\circlefont=\tencirc + \linethickness=\fontdimen8\linefont} +\def\thicklines{\let\linefont=\tenlnw \let\circlefont=\tencircw + \linethickness=\fontdimen8\linefont} +\thinlines + +\def\beginpicture(#1,#2)(#3,#4){\@picheight=#2\unitlength \let\line=\@line + \setbox\@picbox=\hbox to#1\unitlength\bgroup + \kern-#3\unitlength \lower#4\unitlength\hbox\bgroup\ignorespaces} +\def\endpicture{\egroup\hss\egroup + \ht\@picbox=\@picheight \dp\@picbox=\z@ + \leavevmode\box\@picbox} + +\def\put(#1,#2)#3{\raise#2\unitlength\rlap{\kern#1\unitlength #3}\ignorespaces} + +\def\multiput(#1,#2)(#3,#4)#5#6{\@multicount=#5 + \@xdim=#1\unitlength \@ydim=#2\unitlength \setbox\@mpbox=\hbox{#6}% + \loop\ifnum\@multicount>0 + \raise\@ydim\rlap{\kern\@xdim \unhcopy\@mpbox}% + \advance\@xdim#3\unitlength \advance\@ydim#4\unitlength + \advance\@multicount\m@ne \repeat\ignorespaces} + +\def\makebox(#1,#2)#3{\setbox\@picbox=\hbox to#1\unitlength{\hss#3\hss}% + \@ydim=\ht\@picbox \advance\@ydim-\dp\@picbox + \ht\@picbox=#2\unitlength \dp\@picbox=\z@ + \leavevmode\lower.5\@ydim\box\@picbox} + +\newif\ifneg +\def\@line(#1,#2)#3{\@xarg=#1 \@yarg=#2 \@len=#3\unitlength \leavevmode + \ifnum\@xarg<0 \reverseline \else \negfalse \@ydim=\z@\fi + \ifnum\@xarg=0 \@vline + \else\ifnum\@yarg=0 \@hline \else\@sline\fi\fi + \ifneg\kern-\@len\else\@save=\@ydim\fi} +\def\reverseline{\negtrue \kern-\@len \@xarg=-\@xarg + \@ydim=\@len \multiply\@ydim\@yarg \divide\@ydim\@xarg \@yarg=-\@yarg} + +\def\@hline{\vrule height.5\linethickness depth.5\linethickness width\@len} +\def\@vline{\kern-.5\linethickness\vrule width\linethickness + \ifnum\@yarg<0 height\z@ depth\else depth\z@ height\fi\@len + \kern-.5\linethickness} + +\def\@sline{\setbox\@picbox=\hbox{\linefont \count@=\@xarg \multiply\count@ 8 + \ifnum\@yarg>0 \advance\count@\@yarg \advance\count@-9 + \else \advance\count@-\@yarg \advance\count@ 55 \fi \char\count@}% + \ifnum\@yarg<0 \@picheight=-\ht\@picbox \advance\@ydim\@picheight + \else \@picheight=\ht\@picbox \fi + \@xdim=\wd\@picbox \@save=\@ydim + \loop\ifdim\@xdim<\@len \raise\@ydim\copy\@picbox + \advance\@xdim\wd\@picbox \advance\@ydim\@picheight \repeat + \advance\@xdim-\@len \kern-\@xdim + \multiply\@xdim\@yarg \divide\@xdim\@xarg \advance\@ydim-\@xdim + \raise\@ydim\box\@picbox} + +\def\vector(#1,#2)#3{\@line(#1,#2){#3}% + \ifnum\@xarg=0 \@vvector \else\ifnum\@yarg=0 \@hvector \else\@svector\fi\fi} +\def\@hvector{\ifneg\rlap{\linefont\char27}\else + \smash{\llap{\linefont\char45}}\fi} % we have to smash because of font bug +\def\@vvector{\ifnum\@yarg<0 \raise-\@len\rlap{\linefont\char63}% + \else\setbox\@picbox=\rlap{\linefont\char54}\advance\@len-\ht\@picbox + \raise\@len\box\@picbox\fi} + +\def\@svector{\setbox\@picbox=\hbox to\z@{\linefont + \ifnum\@yarg<0 \count@=55 \@yarg=-\@yarg \else\count@=-9 \fi + \ifneg\multiply\@xarg16 \multiply\@yarg2 + \else\hss % \llap + \ifnum\@xarg>2 \multiply\@xarg9 \multiply\@yarg2 \advance\count@29 + \else\ifnum\@yarg>2 \multiply\@xarg16 \multiply\@yarg9 \advance\count@-20 + \else\multiply\@xarg24 \multiply\@yarg3 \fi\fi\fi + \advance\count@\@xarg \advance\count@\@yarg \char\count@ + \ifneg\hss\fi}% \rlap + \raise\@save\box\@picbox} + +\def\disk#1{\@len=#1\unitlength \count@='160 \@diskcirc} +\def\circle#1{\@len=#1\unitlength \count@='140 \@diskcirc} +\def\@diskcirc{\setbox\@picbox=\hbox{\circlefont\char\count@}\@xdim=\wd\@picbox + \leavevmode \ifdim\@len>15.499\@xdim \@bigdc \else \@smalldc\fi} +\def\@bigdc{\ifnum\count@<'160 \@bigcirc + \else \@len=15\@xdim \@diskcirc\fi} +\def\@smalldc{{\advance\@len-.5\@xdim + \loop\ifdim\@xdim<\@len \advance\count@\@ne \advance\@xdim\wd\@picbox\repeat + \hbox{\circlefont\char\count@}}} +\def\@bigcirc{{\circlefont\count@=15 + \setbox\@picbox=\hbox{\char\count@}\@xdim=\wd\@picbox + \ifdim\@len>2.5\@xdim \@len=2.5\@xdim\fi + \advance\@len-.125\wd\@picbox + \loop\ifdim\@xdim<\@len \advance\count@ 4 \advance\@xdim.25\wd\@picbox\repeat + \@ydim=.5\@xdim \advance\@ydim.5\linethickness + \setbox\@picbox=\vbox{\hbox{\char\count@\advance\count@-3\char\count@}% + \nointerlineskip + \hbox{\advance\count@\m@ne\char\count@\advance\count@\m@ne\char\count@}}% + \kern-\@ydim\lower\@ydim\box\@picbox}} + +\newif\ifovaltl \newif\ifovaltr \newif\ifovalbl \newif\ifovalbr +\ovaltltrue \ovaltrtrue \ovalbltrue \ovalbrtrue +\def\oval(#1,#2){\@xdim=#1\unitlength \@ydim=#2\unitlength + {\circlefont \setbox\@picbox=\hbox{\char0} + \ifdim\@xdim<\wd\@picbox \@xdim=\wd\@picbox\fi + \ifdim\@ydim<\wd\@picbox \@ydim=\wd\@picbox\fi + \@save=\@xdim \ifdim\@ydim<\@save \@save=\@ydim \fi + \count@=39 + \loop \setbox\@picbox=\hbox{\char\count@}\ifdim\@save<\wd\@picbox + \advance\count@-4 \repeat + \setbox\strutbox=\hbox{\vrule height\ht\@picbox depth\dp\@picbox width\z@ + \kern\wd\@picbox}% + \@save=.5\wd\@picbox \advance\@save-.5\linethickness + \setbox0=\hbox to\@xdim{\ifovaltl\char\count@\else\strut\fi + \kern-\@save\leaders\hrule height\ifovaltl\linethickness\else\z@\fi\hfil + \leaders\hrule height\ifovaltr\linethickness\else\z@\fi\hfil\kern\@save + \ifovaltr\advance\count@-3\char\count@\else\strut\fi\kern-\wd\@picbox}% + \advance\count@\m@ne + \setbox2=\hbox to\@xdim{\ifovalbl\char\count@\else\strut\fi + \kern-\@save\leaders\hrule height\ifovalbl\linethickness\else\z@\fi\hfil + \leaders\hrule height\ifovalbr\linethickness\else\z@\fi\hfil\kern\@save + \ifovalbr\advance\count@\m@ne\char\count@\else\strut\fi\kern-\wd\@picbox}% + \@save=\@ydim \advance\@save-\wd\@picbox \divide\@save 2 + \setbox\@picbox=\vbox{\box0\nointerlineskip + \hbox to\@xdim{\vrule height\@save width\ifovaltl\linethickness\else\z@\fi + \hfil\ifovaltr\vrule width\linethickness\kern-\linethickness\fi}% + \nointerlineskip + \hbox to\@xdim{\vrule height\@save width\ifovalbl\linethickness\else\z@\fi + \hfil\ifovalbr\vrule width\linethickness\kern-\linethickness\fi}% + \nointerlineskip\box2}% + \@save=.5\@ydim \advance\@save.5\linethickness \leavevmode + \kern-.5\@xdim \kern-.5\linethickness \lower\@save\box\@picbox}} + +\def\cpic#1\endcpic{\vcenter{\hbox{\beginpicture#1\endpicture}}} + +% Squines (quadratic splines) +% example of use: to plot f(x) between x0 and x1, you can say +% \put(0,0){\squine(x0,xm,x1,y0,ym,y1)}, where y0=f(x0), y1=f(x1) +% xm=(y0-y1+s1x1-s0x0)/(s1-s0), ym=(s0(s1x1-y1)-s1(s0x0-y0))/(s1-s0), +% s0=f'(x0), and s1=f'(x1). + +\newdimen\@xi \newdimen\@xii \newdimen\@xiii \newdimen\@xiv +\newdimen\@xpt \newdimen\@xoldpt +\newdimen\@yi \newdimen\@yii \newdimen\@yiii \newdimen\@yiv +\newdimen\@ypt \newdimen\@yoldpt +\def\squine(#1,#2,#3,#4,#5,#6){\setbox\@picbox\hbox{\tencirc q}% + \global\@xoldpt=#1\unitlength \global\@yoldpt=#4\unitlength \kern\@xoldpt + \@xi=\@xoldpt \@xii=#2\unitlength \@xiii=#3\unitlength + \@yi=\@yoldpt \@yii=#5\unitlength \@yiii=#6\unitlength + \squinerec + \@xpt=#3\unitlength \@ypt=#6\unitlength \@addpoint + \raise\@ypt\copy\@picbox} +\newif\iffar +\def\squinerec{\farfalse \testnear\@xi\@xiii \testnear\@yi\@yiii + \iffar \decast \fi} +\def\testnear#1#2{\@save=#1\advance\@save-#2% + \ifdim\@save<\z@ \@save=-\@save\fi \ifdim\@save>\p@ \fartrue \fi} +\def\decast{\@xpt=\@xi \advance\@xpt\@xii \divide\@xpt2 + \advance\@xii\@xiii \divide\@xii2 + \@xiv=\@xpt \advance\@xiv\@xii \divide\@xiv2 + \@ypt=\@yi \advance\@ypt\@yii \divide\@ypt2 + \advance\@yii\@yiii \divide\@yii2 + \@yiv=\@ypt \advance\@yiv\@yii \divide\@yiv2 + \begingroup\@xii=\@xpt \@xiii=\@xiv + \@yii=\@ypt \@yiii=\@yiv \squinerec\endgroup + \@xpt=\@xiv \@ypt=\@yiv \@addpoint + \@xi=\@xiv \@yi=\@yiv \squinerec} +\def\@addpoint{%\message{(\the\@xpt,\the\@ypt)}% + \global\advance\@xoldpt-\@xpt \wd\@picbox=-\@xoldpt + \raise\@yoldpt\copy\@picbox \global\@xoldpt=\@xpt \global\@yoldpt=\@ypt} + +% Math operators +\def\2{\mskip-.5mu2\mskip.5mu} +\newmuskip\lessfortimes \lessfortimes=-2mu minus -2mu +\def\cdt{\mskip\lessfortimes\cdot\mskip\lessfortimes} +\def\nullnum{\phantom{0}} +\def\twonullnum{\phantom{00}} +\def\bex{\mskip-2mu} +\def\twoconditions#1#2{_{\scriptstyle#1\atop\scriptstyle#2}} +\def\tworestrictions#1#2{\vcenter{\offinterlineskip + \halign{\strut\hfil##\hfil\cr#1\cr#2\cr}}} +\def\dts{\mathinner{\ldotp\ldotp}} +\def\[#1]{[\hbox{$\mskip1mu\thickmuskip=\thinmuskip#1\mskip1mu$}]} +\def\bigi[#1\bigr]{\bigl[\hbox{$\thickmuskip=\thinmuskip#1$}\bigr]} +\def\Bigi[#1\Bigr]{\Bigl[\hbox{$\thickmuskip=\thinmuskip#1$}\Bigr]} +\def\prp(#1){(\hbox{$\thickmuskip=\thinmuskip#1$})} +\def\pbigi(#1\bigr){\bigl(\hbox{$\thickmuskip=\thinmuskip#1$}\bigr)} +\def\_#1{\def\next{#1}% + \ifx\next\risingsign\expandafter\rising\else^{\underline{#1}}\fi} +\def\risingsign{^} +\def\rising#1{^{\overline{#1}}} +\def\dotminus{\mathbin{\buildrel{\hbox{\runhead.}}\over{\smash{-}\vphantom{_2}}}} +\let\divides=\backslash +\def\edivides{\divides\mskip-4mu\divides} +\def\ndivides{\mathpalette\notdiv\relax} +\def\notdiv#1#2{\setbox0=\hbox{$#1\divides$}% + \vcenter{\hbox to\wd0{$\hss\scriptscriptstyle/\hss$}}\kern-\wd0 + \vcenter{\hbox to\wd0{$\hss\kern.5pt\scriptscriptstyle/\hss$}}\kern-\wd0 + \box0\relax} +\def\spec{\mathop{\rm Spec}} +\def\half{{1\over2}} +\def\rp{\mathchar"323F } % relatively prime +\def\lcm{\mathop{\rm lcm}} +\def\And{\quad{\rm and}\quad} +\let\==\equiv +\def\tmod#1{(mod~$#1$)} +\let\implies=\Longrightarrow +\def\?{\hbox{!`}} % subfactorial +\def\hyp{\mathop{F{}}\nolimits\hyper} +\def\tightplus{\medmuskip=1.5mu\relax} +\def\hyper#1#2#3{\mathchoice{\tightplus + \hbox{$\displaystyle\biggl({#1\atop#2}\Big\vert\,{#3}\!\biggr)$}}% + {\bigl({#1\atop#2}\vert\mskip2mu#3\bigr)}% + {}{}} % used only in D and T styles +%\def\hypk_#1{\mathop{F{}}_{#1}\nolimits\hyper} % confl with mFn convention +\def\hypk_#1#2#3#4{\mathop{F{}}\mathchoice{\tightplus + \hbox{$\displaystyle\biggl({#2\atop#3}\Big\vert\,{#4}\!\biggr)$}% + \lower\fontdimen11\mathsym\hbox{$\scriptstyle\!#1$}}% + {\bigl({#2\atop#3}\vert\mskip2mu#4\bigr)\lower\fontdimen12\mathsym + \hbox{$\scriptstyle\!#1$}}% + {}{}} % used only in D and T styles +\def\double(#1\choose#2){\mathchoice{\biggl(\!\!{#1\choose#2}\!\!\biggr)} + {\bigl(\!{#1\choose#2}\!\bigr)}{}{}} % only D and T styles +\def\hypstrut{\vphantom{_1\_^k}} % if there's another denominator with \_^k +\def\deg{\mathop{\rm deg}} +\def\Bscr{{\scr B}} +\def\Escr{{\scr E}} +\def\Fscr{{\scr F}} +\def\Pscr{{\scr P}} +\def\Sscr{{\scr S}} +\def\adj{\relbar\joinrel\relbar} % adjacent in a graph +\let\<=\langle \let \>=\rangle +\def\Pr{\mathop{\rm Pr}\nolimits} +\def\Mean{\mathop{\rm Mean}\nolimits} +\def\Var{\mathop{\rm Var}\nolimits} +\def\between{\big\vert\hbox{\vphantom)}} % \between_a^b +{\catcode`\'=\active \gdef'{^\bgroup\mskip2mu\prim@s}} % more space before ' +\def\array#1[#2]{\hbox{\tt#1[$#2$]}} +\def\given{\mskip1mu\vert\mskip1mu} +\def\euler{\atopwithdelims<>} +\def\Euler#1#2{\mathchoice{\biggl<\mskip-7mu{#1\euler#2}\mskip-7mu\biggr>}% + {\bigl<\!{#1\euler#2}\!\bigr>}{}{}} + +\newbox\phihatbox \newbox\scrphihatbox +\setbox\phihatbox=\hbox{$\phi$} \ht\phihatbox=1ex +\setbox\scrphihatbox=\hbox{$\scriptstyle\phi$} + \ht\scrphihatbox=\fontdimen5\mathsublet +\setbox\phihatbox=\hbox{$\widehat{\box\phihatbox}$} +\setbox\scrphihatbox=\hbox{$\hat{\box\scrphihatbox}$} +\def\phihat{\mathchoice{\copy\phihatbox}{\copy\phihatbox}% + {\copy\scrphihatbox}{{\hat\phi}}} + +\newbox\mathsizebox +\def\setmathsize#1{\global\setbox\mathsizebox=\hbox{\displaymath#1$}} +\def\mathsize#1{\hbox to\wd\mathsizebox{\displaymath#1$\hss}} + +\newbox\sqrtstrutbox +\setbox\sqrtstrutbox=\hbox{\vrule height10.5pt width\z@} +\def\strutsqrt#1{\copy\sqrtstrutbox\sqrt{{}^{\mathstrut}#1}} + +\newbox\Sqbox % for sum of squares +\setbox\Sqbox=\vbox{\tenrm\hrule height.6pt\kern-.6pt + \hbox to1.5ex{\vrule height1.5ex width.6pt\hss\vrule width.6pt}\kern-.6pt + \hrule height.3pt depth.3pt} +\def\Sq{\mskip1.5mu\copy\Sqbox\mskip1.5mu} + +% primitive index macros +% "stuff for index" will go into a file for sorting and into normal text +% "!stuff for index" will go into the file only +\expandafter\def\expandafter\dospecials\expandafter{\dospecials\do\"} +\def\hexcode{"} \catcode`\"=\active + +\newif\ifinxmode +\newwrite\inx \newwrite\bnx +\newbox\inxbox + +\newif\ifsilent +\def\beginxref{\futurelet\next\beginxrefswitch} +\def\beginxrefswitch{\ifx\next!\let\next=\silentxref + \else\silentfalse\let\next=\xref\fi \next} +\def\silentxref!{\silenttrue\xref} +\let"=\beginxref + +\def\xref#1"{\ifinxmode\edef\text{#1}\makexref\fi + \ifsilent\ignorespaces\else#1\fi} +\def\makexref{\global\setbox\inxbox=% + \vbox{\unvbox\inxbox\allowbreak\hbox{\inxstyle\text}}% + \xdef\writeit{\write\inx{\text\space!\space + \noexpand\number\pageno.}}\writeit} + +% Final considerations +\catcode`\@=\active \def@{\mskip1mu\relax} +\expandafter\def\expandafter\dospecials\expandafter{\dospecials\do\@} + +\hyphenation{logical Mac-Mahon hyper-geo-metric hyper-geo-met-rics Ber-noulli} + +\preprintfalse % WE ARE MAKING THE REAL BOOK! +\inxmodetrue % WE ARE PREPARING A ROUGH INDEX +\showmissestrue % THE REFERENCES SHOULD ALL BE READY NOW + +\ifinxmode\immediate\openout\inx=\jobname.inx \fi % file for index reminders +\ifinxmode\immediate\openout\bnx=\jobname.bnx \fi % file for bib reminders + +% To make the book: +% First TeX BIB, to get BIB.REF correct. (Must have \cite entries.) +% Then TeX CHAP1..CHAP9, PREF, ANS, CRED, FRONT, CONT. +% Then make BNX file from individual *.BNX files including BIB.BNX. +% Then reTeX BIB. +% *.INX files are raw data only. Index and Contents are prepared by hand. + +% To produce only a subset of pages, put the page numbers on separate +% lines in a file called pages.tex, ended by 999 +% WARNING: This will screw up the .grf file! Save it, then restore it. +% WARNING: This may screw up the .ref file (if there are \tabrefs). Ditto. +\let\Shipout=\shipout +\newread\pages \newcount\nxtpg \openin\pages=pages +\def\getnxtpg{\ifeof\pages\else + {\endlinechar=-1\read\pages to\next + \ifx\next\empty % in this case we should have eof now + \else\global\nxtpg=\next\fi}\fi} +\ifeof\pages\finalfalse\else\finaltrue + \getnxtpg +\ifnum\nxtpg=999 + \message{OK, I'm making final copy with trim marks!} + \hoffset=-.5in + \getnxtpg % this should ensure eof on the \pages file +\else\message{OK, I'll ship only the requested pages!}\fi\fi +\def\shipout{\ifeof\pages\let\next=\Shipout + \else\ifnum\pageno=\nxtpg\getnxtpg\let\next=\Shipout + \else\let\next=\Tosspage\fi\fi \next} +\newbox\garbage \def\Tosspage{\deadcycles=0\setbox\garbage=} diff --git a/systems/knuth/local/lib/gray.mf b/systems/knuth/local/lib/gray.mf new file mode 100644 index 0000000000..0392f30eb7 --- /dev/null +++ b/systems/knuth/local/lib/gray.mf @@ -0,0 +1,3 @@ +input graylj % `standard' gray font is for the laserjet + + diff --git a/systems/knuth/local/lib/grayaps.mf b/systems/knuth/local/lib/grayaps.mf new file mode 100644 index 0000000000..44f1c4eab6 --- /dev/null +++ b/systems/knuth/local/lib/grayaps.mf @@ -0,0 +1,9 @@ +% temporary kludge to make the APS font for proofmode with new MF +magnification 1.0; +tfmmode; +fontfacebyte 84; +ppi=722.909; % pixels per inch, according to DRF +fontidentifier "FIG"; +codingscheme "GFGRAY"; +input gray; +end diff --git a/systems/knuth/local/lib/grayimagen.mf b/systems/knuth/local/lib/grayimagen.mf new file mode 100644 index 0000000000..63381aa0af --- /dev/null +++ b/systems/knuth/local/lib/grayimagen.mf @@ -0,0 +1,10 @@ +% Gray font for Imagen 8/300; proofsheet resolution is 75 pixels per inch. +% Each pixel is represented by a 4x4 square, with 4/16 of the dots on. + +if mode<>imagen: errmessage "This file is for imagen only"; fi + +font_identifier "GRAYIMAGEN"; + +boolean lightweight; + +input grayf diff --git a/systems/knuth/local/lib/grayimagen3.mf b/systems/knuth/local/lib/grayimagen3.mf new file mode 100644 index 0000000000..d60fab3f9a --- /dev/null +++ b/systems/knuth/local/lib/grayimagen3.mf @@ -0,0 +1,7 @@ +% Gray font for Imagen with proofsheet resolution 25 pixels per inch + +if mode<>imagen: errmessage "This file is for imagen only"; fi + +font_identifier "GRAY3IMAGEN"; +rep=3; boolean large_pixels; +input grayf diff --git a/systems/knuth/local/lib/grayimagenlight.mf b/systems/knuth/local/lib/grayimagenlight.mf new file mode 100644 index 0000000000..5625d2554b --- /dev/null +++ b/systems/knuth/local/lib/grayimagenlight.mf @@ -0,0 +1,12 @@ +% Light gray font for Imagen 8/300; proofsheet resolution is 60 pixels per inch. +% Each pixel is represented by a 5x5 square, with 5/25 of the dots on. + +if mode<>imagen: errmessage "This file is for imagen only"; fi + +font_identifier "GRAYIMAGEN"; +picture pix_picture; pix_picture := nullpicture; +for z=(0,1),(1,4),(2,2),(3,0),(4,3): + addto pix_picture also unitpixel shifted z; endfor +pix_wd := pix_ht := 5; + +input grayf diff --git a/systems/knuth/local/lib/graylj.mf b/systems/knuth/local/lib/graylj.mf new file mode 100644 index 0000000000..5c87efde42 --- /dev/null +++ b/systems/knuth/local/lib/graylj.mf @@ -0,0 +1,10 @@ +% Gray font for HP LaserJet; proofsheet resolution is 150 pixels per inch. +% Each pixel is represented by a 4x4 square, with 4/16 of the dots on. + +if mode<>ljfour: errmessage "This file is for laserjet only"; fi + +font_identifier "GRAYLJ"; + +boolean lightweight; + +input grayf diff --git a/systems/knuth/local/lib/lcircle.mf b/systems/knuth/local/lib/lcircle.mf new file mode 100644 index 0000000000..1d0fa48c07 --- /dev/null +++ b/systems/knuth/local/lib/lcircle.mf @@ -0,0 +1,550 @@ +fontdimen 1: 0,0,0,0,0,0,0,thickness#; +font_coding_scheme:="LaTeX circle"; + +let cmchar=\; % cmchar should precede each character, for testing purposes + +thickness:=ceiling(thickness#*hppp); % the way rules thicknesses are done +% thickness#:=thickness/hppp; % and let thickness# round to right value +% NO, I deleted this BAD line! --- DEK, 9 Jul 87 +pickup pencircle scaled thickness; nib:=savepen; + +% arcs sets up the points 1, 2, ..., 8 as follows: +% +% |1 +% |* +% * * +% 8| 2 +% * | * +% 7* | *3 +% --*-----*-- +% 6| 4 +% * * +% |5 +% +% <----w----> + +pair upleft,upright,downleft,downright; +upright=-downleft=(1,1); downright=-upleft=(1,-1); + +% a quarter-circle has width, height and depth set as explained on +% page 389 of the TeXbook, not the real width, height, and depth + +def qbeginchar (expr c, diam_sharp) = +numeric hh, dd; hh:=.5*(diam_sharp+thickness#); +dd:=.5*(diam_sharp-thickness#); +beginchar(c,diam_sharp,hh,dd); +enddef; + +def arcs = +numeric delta; +delta:=.5 round((1-sqrt.5)*w); % distance from axis to arc's 45 degree points +bot y3=0; y7=y3=.5[y5,y1]; y1-y5=w; +lft x1=0; x5=x1=.5[x7,x3]; x3-x7=w; +x2-x1=delta; x1-x8=delta; x8=x6; x2=x4; +y8-y7=delta; y7-y6=delta; y8=y2; y6=y4; +enddef; + +cmchar "2pt, top right"; +qbeginchar(0,4pt#); +numeric delta; +pickup nib; +arcs; +draw z7{right}..z6{downright}..z5{down}; +endchar; + +cmchar "2pt, bottom right"; +qbeginchar(1,4pt#); +numeric delta; +pickup nib; +arcs; +draw z1{down}..z8{downleft}..z7{left}; +endchar; + +cmchar "2pt, bottom left"; +qbeginchar(2,4pt#); +numeric delta; +pickup nib; +arcs; +draw z3{left}..z2{upleft}..z1{up}; +endchar; + +cmchar "2pt, top left"; +qbeginchar(3,4pt#); +numeric delta; +pickup nib; +arcs; +draw z5{up}..z4{upright}..z3{right}; +endchar; + +cmchar "4pt, top right"; +qbeginchar(4,8pt#); +numeric delta; +pickup nib; +arcs; +draw z7{right}..z6{downright}..z5{down}; +endchar; + +cmchar "4pt, bottom right"; +qbeginchar(5,8pt#); +numeric delta; +pickup nib; +arcs; +draw z1{down}..z8{downleft}..z7{left}; +endchar; + +cmchar "4pt, bottom left"; +qbeginchar(6,8pt#); +numeric delta; +pickup nib; +arcs; +draw z3{left}..z2{upleft}..z1{up}; +endchar; + +cmchar "4pt, top left"; +qbeginchar(7,8pt#); +numeric delta; +pickup nib; +arcs; +draw z5{up}..z4{upright}..z3{right}; +endchar; + +cmchar "6pt, top right"; +qbeginchar(8,12pt#); +numeric delta; +pickup nib; +arcs; +draw z7{right}..z6{downright}..z5{down}; +endchar; + +cmchar "6pt, bottom right"; +qbeginchar(9,12pt#); +numeric delta; +pickup nib; +arcs; +draw z1{down}..z8{downleft}..z7{left}; +endchar; + +cmchar "6pt, bottom left"; +qbeginchar(10,12pt#); +numeric delta; +pickup nib; +arcs; +draw z3{left}..z2{upleft}..z1{up}; +endchar; + +cmchar "6pt, top left"; +qbeginchar(11,12pt#); +numeric delta; +pickup nib; +arcs; +draw z5{up}..z4{upright}..z3{right}; +endchar; + +cmchar "8pt, top right"; +qbeginchar(12,16pt#); +numeric delta; +pickup nib; +arcs; +draw z7{right}..z6{downright}..z5{down}; +endchar; + +cmchar "8pt, bottom right"; +qbeginchar(13,16pt#); +numeric delta; +pickup nib; +arcs; +draw z1{down}..z8{downleft}..z7{left}; +endchar; + +cmchar "8pt, bottom left"; +qbeginchar(14,16pt#); +numeric delta; +pickup nib; +arcs; +draw z3{left}..z2{upleft}..z1{up}; +endchar; + +cmchar "8pt, top left"; +qbeginchar(15,16pt#); +numeric delta; +pickup nib; +arcs; +draw z5{up}..z4{upright}..z3{right}; +endchar; + +cmchar "10pt, top right"; +qbeginchar(16,20pt#); +numeric delta; +pickup nib; +arcs; +draw z7{right}..z6{downright}..z5{down}; +endchar; + +cmchar "10pt, bottom right"; +qbeginchar(17,20pt#); +numeric delta; +pickup nib; +arcs; +draw z1{down}..z8{downleft}..z7{left}; +endchar; + +cmchar "10pt, bottom left"; +qbeginchar(18,20pt#); +numeric delta; +pickup nib; +arcs; +draw z3{left}..z2{upleft}..z1{up}; +endchar; + +cmchar "10pt, top left"; +qbeginchar(19,20pt#); +numeric delta; +pickup nib; +arcs; +draw z5{up}..z4{upright}..z3{right}; +endchar; + +cmchar "12pt, top right"; +qbeginchar(20,24pt#); +numeric delta; +pickup nib; +arcs; +draw z7{right}..z6{downright}..z5{down}; +endchar; + +cmchar "12pt, bottom right"; +qbeginchar(21,24pt#); +numeric delta; +pickup nib; +arcs; +draw z1{down}..z8{downleft}..z7{left}; +endchar; + +cmchar "12pt, bottom left"; +qbeginchar(22,24pt#); +numeric delta; +pickup nib; +arcs; +draw z3{left}..z2{upleft}..z1{up}; +endchar; + +cmchar "12pt, top left"; +qbeginchar(23,24pt#); +numeric delta; +pickup nib; +arcs; +draw z5{up}..z4{upright}..z3{right}; +endchar; + +cmchar "14pt, top right"; +qbeginchar(24,28pt#); +numeric delta; +pickup nib; +arcs; +draw z7{right}..z6{downright}..z5{down}; +endchar; + +cmchar "14pt, bottom right"; +qbeginchar(25,28pt#); +numeric delta; +pickup nib; +arcs; +draw z1{down}..z8{downleft}..z7{left}; +endchar; + +cmchar "14pt, bottom left"; +qbeginchar(26,28pt#); +numeric delta; +pickup nib; +arcs; +draw z3{left}..z2{upleft}..z1{up}; +endchar; + +cmchar "14pt, top left"; +qbeginchar(27,28pt#); +numeric delta; +pickup nib; +arcs; +draw z5{up}..z4{upright}..z3{right}; +endchar; + +cmchar "16pt, top right"; +qbeginchar(28,32pt#); +numeric delta; +pickup nib; +arcs; +draw z7{right}..z6{downright}..z5{down}; +endchar; + +cmchar "16pt, bottom right"; +qbeginchar(29,32pt#); +numeric delta; +pickup nib; +arcs; +draw z1{down}..z8{downleft}..z7{left}; +endchar; + +cmchar "16pt, bottom left"; +qbeginchar(30,32pt#); +numeric delta; +pickup nib; +arcs; +draw z3{left}..z2{upleft}..z1{up}; +endchar; + +cmchar "16pt, top left"; +qbeginchar(31,32pt#); +numeric delta; +pickup nib; +arcs; +draw z5{up}..z4{upright}..z3{right}; +endchar; + +cmchar "18pt, top right"; +qbeginchar(32,36pt#); +numeric delta; +pickup nib; +arcs; +draw z7{right}..z6{downright}..z5{down}; +endchar; + +cmchar "18pt, bottom right"; +qbeginchar(33,36pt#); +numeric delta; +pickup nib; +arcs; +draw z1{down}..z8{downleft}..z7{left}; +endchar; + +cmchar "18pt, bottom left"; +qbeginchar(34,36pt#); +numeric delta; +pickup nib; +arcs; +draw z3{left}..z2{upleft}..z1{up}; +endchar; + +cmchar "18pt, top left"; +qbeginchar(35,36pt#); +numeric delta; +pickup nib; +arcs; +draw z5{up}..z4{upright}..z3{right}; +endchar; + +cmchar "20pt, top right"; +qbeginchar(36,40pt#); +numeric delta; +pickup nib; +arcs; +draw z7{right}..z6{downright}..z5{down}; +endchar; + +cmchar "20pt, bottom right"; +qbeginchar(37,40pt#); +numeric delta; +pickup nib; +arcs; +draw z1{down}..z8{downleft}..z7{left}; +endchar; + +cmchar "20pt, bottom left"; +qbeginchar(38,40pt#); +numeric delta; +pickup nib; +arcs; +draw z3{left}..z2{upleft}..z1{up}; +endchar; + +cmchar "20pt, top left"; +qbeginchar(39,40pt#); +numeric delta; +pickup nib; +arcs; +draw z5{up}..z4{upright}..z3{right}; +endchar; + +% The full circles have height and depth 0pt because otherwise there +% are too many heights and depths for the TFM files + +cmchar "1pt, circle"; +beginchar(96,1pt#,0pt#,0pt#); +pickup nib; +draw fullcircle scaled w; +endchar; + +cmchar "2pt, circle"; +beginchar(97,2pt#,0pt#,0pt#); +pickup nib; +draw fullcircle scaled w; +endchar; + +cmchar "3pt, circle"; +beginchar(98,3pt#,0pt#,0pt#); +pickup nib; +draw fullcircle scaled w; +endchar; + +cmchar "4pt, circle"; +beginchar(99,4pt#,0pt#,0pt#); +pickup nib; +draw fullcircle scaled w; +endchar; + +cmchar "5pt, circle"; +beginchar(100,5pt#,0pt#,0pt#); +pickup nib; +draw fullcircle scaled w; +endchar; + +cmchar "6pt, circle"; +beginchar(101,6pt#,0pt#,0pt#); +pickup nib; +draw fullcircle scaled w; +endchar; + +cmchar "7pt, circle"; +beginchar(102,7pt#,0pt#,0pt#); +pickup nib; +draw fullcircle scaled w; +endchar; + +cmchar "8pt, circle"; +beginchar(103,8pt#,0pt#,0pt#); +pickup nib; +draw fullcircle scaled w; +endchar; + +cmchar "9pt, circle"; +beginchar(104,9pt#,0pt#,0pt#); +pickup nib; +draw fullcircle scaled w; +endchar; + +cmchar "10pt, circle"; +beginchar(105,10pt#,0pt#,0pt#); +pickup nib; +draw fullcircle scaled w; +endchar; + +cmchar "11pt, circle"; +beginchar(106,11pt#,0pt#,0pt#); +pickup nib; +draw fullcircle scaled w; +endchar; + +cmchar "12pt, circle"; +beginchar(107,12pt#,0pt#,0pt#); +pickup nib; +draw fullcircle scaled w; +endchar; + +cmchar "13pt, circle"; +beginchar(108,13pt#,0pt#,0pt#); +pickup nib; +draw fullcircle scaled w; +endchar; + +cmchar "14pt, circle"; +beginchar(109,14pt#,0pt#,0pt#); +pickup nib; +draw fullcircle scaled w; +endchar; + +cmchar "15pt, circle"; +beginchar(110,15pt#,0pt#,0pt#); +pickup nib; +draw fullcircle scaled w; +endchar; + +cmchar "1pt, blob"; +beginchar(112,1pt#,0pt#,0pt#); +pickup pencircle scaled w; +drawdot origin; +endchar; + +cmchar "2pt, blob"; +beginchar(113,2pt#,0pt#,0pt#); +pickup pencircle scaled w; +drawdot origin; +endchar; + +cmchar "3pt, blob"; +beginchar(114,3pt#,0pt#,0pt#); +pickup pencircle scaled w; +drawdot origin; +endchar; + +cmchar "4pt, blob"; +beginchar(115,4pt#,0pt#,0pt#); +pickup pencircle scaled w; +drawdot origin; +endchar; + +cmchar "5pt, blob"; +beginchar(116,5pt#,0pt#,0pt#); +pickup pencircle scaled w; +drawdot origin; +endchar; + +cmchar "6pt, blob"; +beginchar(117,6pt#,0pt#,0pt#); +pickup pencircle scaled w; +drawdot origin; +endchar; + +cmchar "7pt, blob"; +beginchar(118,7pt#,0pt#,0pt#); +pickup pencircle scaled w; +drawdot origin; +endchar; + +cmchar "8pt, blob"; +beginchar(119,8pt#,0pt#,0pt#); +pickup pencircle scaled w; +drawdot origin; +endchar; + +cmchar "9pt, blob"; +beginchar(120,9pt#,0pt#,0pt#); +pickup pencircle scaled w; +drawdot origin; +endchar; + +cmchar "10pt, blob"; +beginchar(121,10pt#,0pt#,0pt#); +pickup pencircle scaled w; +drawdot origin; +endchar; + +cmchar "11pt, blob"; +beginchar(122,11pt#,0pt#,0pt#); +pickup pencircle scaled w; +drawdot origin; +endchar; + +cmchar "12pt, blob"; +beginchar(123,12pt#,0pt#,0pt#); +pickup pencircle scaled w; +drawdot origin; +endchar; + +cmchar "13pt, blob"; +beginchar(124,13pt#,0pt#,0pt#); +pickup pencircle scaled w; +drawdot origin; +endchar; + +cmchar "14pt, blob"; +beginchar(125,14pt#,0pt#,0pt#); +pickup pencircle scaled w; +drawdot origin; +endchar; + +cmchar "15pt, blob"; +beginchar(126,15pt#,0pt#,0pt#); +pickup pencircle scaled w; +drawdot origin; +endchar; + +bye diff --git a/systems/knuth/local/lib/lcircle10.mf b/systems/knuth/local/lib/lcircle10.mf new file mode 100644 index 0000000000..c2b84de489 --- /dev/null +++ b/systems/knuth/local/lib/lcircle10.mf @@ -0,0 +1,7 @@ +font_identifier "CIRCLE"; font_size 10pt#; +font_coding_scheme:="LATEX CIRCLE"; +mode_setup; + +thickness#:=.4pt#; + +input lcircle diff --git a/systems/knuth/local/lib/lcirclew10.mf b/systems/knuth/local/lib/lcirclew10.mf new file mode 100644 index 0000000000..c57edbefbe --- /dev/null +++ b/systems/knuth/local/lib/lcirclew10.mf @@ -0,0 +1,6 @@ +font_identifier "CIRCLEW"; font_size 10pt#; +font_coding_scheme:="LATEX CIRCLE"; +mode_setup; + +thickness#:=.8pt#; +input lcircle diff --git a/systems/knuth/local/lib/letter.tex b/systems/knuth/local/lib/letter.tex new file mode 100644 index 0000000000..efa2bf02fd --- /dev/null +++ b/systems/knuth/local/lib/letter.tex @@ -0,0 +1,119 @@ +% This macro file is for business letters + +\def\today{\ifcase\month\or + January\or February\or March\or April\or May\or June\or + July\or August\or September\or October\or November\or December\fi + \space\number\day, \number\year} +\def\narrower{\advance\leftskip by 20pt \advance\rightskip by 20pt } + +\raggedbottom +\interlinepenalty=1000 +\hsize=6.25truein \voffset=24pt \advance\vsize by-\voffset +\parindent=0pt \parskip=0pt +\nopagenumbers +\headline={\ifnum\pageno>1 + \tenrm To \addressee\hfil\today\hfil Page \folio + \else\hfil\fi} + +\def\beginlinemode{\endmode + \begingroup\obeylines\def\endmode{\par\endgroup}} +\def\beginparmode{\endmode + \begingroup\parskip=\medskipamount \def\endmode{\par\endgroup}} +\let\endmode=\par +\def\endletter{\endmode\vfill\supereject \pageno=1 } + +\newdimen\longindentation \longindentation=4truein +\newbox\theaddress +\def\address{\beginlinemode\getaddress} +{\obeylines\gdef\getaddress#1 + #2 + {\gdef\addressee{#2\unskip}% + \global\setbox\theaddress=\vbox\bgroup\raggedright% + \hsize=\longindentation \everypar{\hangindent2em}#2 + \def\endmode{\egroup\endgroup \copy\theaddress \bigskip}}} + +\def\body{\beginparmode} +\def\closing{\beginlinemode\getclosing} +{\obeylines\gdef\getclosing #1 + #2 + {\nobreak\bigskip \leftskip=\longindentation #2 + \nobreak\bigskip\bigskip\bigskip % space for signature + \def + {\endgraf\nobreak}}} +\def\annotations{\beginlinemode\def\par{\endgraf\nobreak}\obeylines\par} +\def\ps{\beginparmode\nobreak + \interlinepenalty5000\def\par{\endgraf\penalty5000}} +\def\cc{\beginparmode\nobreak + \interlinepenalty5000\def\par{\endgraf\penalty5000}} + +\def\up#1{\leavevmode \raise.16ex\hbox{#1}} +\font\smallheadfont=cmr8 at 8truept +\font\largeheadfont=cmbx10 at 14.4truept +\font\logofont=stan70 at 70truept +\def\stanfordseal{\vbox{\kern-3truept\hbox{\logofont A}\kern-3truept}} + +\def\csdreturn{Computer Science Department\par \stanfordreturn} +\def\stanfordreturn{Stanford University\par + Stanford, CA 94305\kern.5pt-9045 USA\par} +\def\letterhead{\pageno=1 \univletterhead + {\leftskip=\longindentation + {\baselineskip9truept\smallheadfont\sendingaddress} + \bigskip\bigskip\rm\today\bigskip}} +\def\specrule#1{\nointerlineskip + \line{\hbox to 60truept{\hrulefill + \hphantom{\stanfordseal\kern-#1truept}% + \hrulefill}\hrulefill}\nointerlineskip} +\def\univletterhead{\vglue-34pt + \specrule{11}\vskip8truept + \hbox{\hbox to\longindentation{\smash{\hbox to60truept{\hfil\kern2.5truept + \lower10truept\stanfordseal\hfil}}% + \largeheadfont STANFORD UNIVERSITY\hfil}% + \smallheadfont STANFORD, CALIFORNIA 94305\kern.5pt-9045} + \vskip6truept\specrule{17}\vskip13truept } + +\def\deklet{ + \def\sendingaddress{DONALD E. KNUTH\par + Professor Emeritus of The Art of\par + \qquad Computer Programming\par + Department of Computer Science\par + Telephone \up[650\up]\thinspace 723-4367\par} + \def\returnaddress{Prof.~D. E. Knuth\par \csdreturn} + \letterhead} + +\def\memoto{\beginlinemode\parindent=60truept + \everypar{\hangindent70truept}\startmemo} +\def\bigmemoto{\beginlinemode\parindent=60pt % use this for magstep>1! + \everypar{\hangindent70pt}\startmemo} +\def\textin#1{\noindent\hbox to\parindent{#1\hss}\ignorespaces} +{\obeylines\gdef\startmemo #1 + {\gdef\addressee{#1}% + \global\pageno=1 \vglue-34pt\specrule{11}\vskip8truept + \leftline{\smash{\hbox to60truept{\hfil\kern2.5truept + \lower10truept\stanfordseal\hfil}}% + \largeheadfont Stanford Computer Science Department % + \rm\today}% + \vskip6truept\specrule{20}\bigskip\bigskip\bigskip% + \textin{Memo to:}#1 + \def\endmode{\par\endgroup\bigskip}} + \gdef\from #1 + {\smallskip\textin{From:}#1 + } + \gdef\subject #1 + {\smallskip\textin{Subject:}#1 + } +} + +\def\makelabel{\endletter\hbox{\vrule + \vbox{\hrule \kern6truept + \hbox{\kern6truept\stanfordseal\kern3pt + \vbox{\smallheadfont\baselineskip9truept\hsize=2truein\returnaddress} + \kern6truept}\kern6truept\hrule}\vrule} + \kern.1truein + \hbox{\vrule + \vbox{\hrule \kern12truept + \hbox{\kern12truept\copy\theaddress + \kern12truept}\kern12truept\hrule}\vrule} + \pageno=0\vfill\eject} + +\def\frac#1/#2{\leavemode\kern.1em\raise.5ex\hbox{\the\scriptfont0 + #1}\kern-.1em/\kern-.15em\lower.25ex\hbox{\the\scriptfont0 #2}} diff --git a/systems/knuth/local/lib/line.mf b/systems/knuth/local/lib/line.mf new file mode 100644 index 0000000000..97cc3105db --- /dev/null +++ b/systems/knuth/local/lib/line.mf @@ -0,0 +1,552 @@ +qqs:=ceiling(qqs#*hppp); % the way rule widths are calculated +define_pixels(qqh,qqw,arrowlen,arrowht,arrowcurve); + +def line (expr delx, dely) = +numeric qht,qwd,absdely; + +if dely > 0: + if delx > dely: qwd# := qqw#; qht# := dely*qqw#/delx; + else: qht# := qqw#; qwd# := delx*qqw#/dely; fi; + beginchar( 8(delx-1)+(dely-1),qwd#,qht#,0pt#); + x0=0; y0=0; + x1=w; y1=h; + else: + absdely=-dely; + if delx > absdely: qwd# := qqw#; qht# := absdely*qqw#/delx; + else: qht# := qqw#; qwd# := delx*qqw#/absdely; fi; + beginchar(64+8(delx-1)+(absdely-1),qwd#,qht#,0pt#); + x0=0; y0=h; + x1=w; y1=0; +fi; +pickup pencircle scaled qqs; +draw z0..z1 +enddef; + +def larrow (expr char, delx, dely) = +numeric rxa,rxb,rxc,rxd,rxe,rya,ryb,ryc,ryd,rye; +numeric qht,qwd,absdely; +if dely > 0: + if delx > dely: qwd# := qqw#; qht# := dely*qqw#/delx; + else: qht# := qqw#; qwd# := delx*qqw#/dely; fi; + % fixed by DEK on 24 Jan 89; previous code buggy but caused no harm + else: + absdely=-dely; + if delx > absdely: qwd# := qqw#; qht# := absdely*qqw#/delx; + else: qht# := qqw#; qwd# := delx*qqw#/absdely; fi; +fi; + +beginchar(char,qwd#,qht#,0pt#); +if dely > 0: y0=0; else: y0=h; fi; + +x0=0; +rxa=arrowlen; rya=0; +rxb=arrowlen; ryb=arrowht; +rxc=arrowlen; ryc=-arrowht; +rxd=.5rxa; ryd=.5ryb-arrowcurve; +rxe=rxd; rye=-ryd; + +numeric rlen; +rlen = sqrt(delx*delx + dely*dely); + +x1=(rxa*delx - rya*dely)/rlen; +y1=(rxa*dely+rya*delx)/rlen + y0; + +%x2=rxb; y2=ryb; +x2=(rxb*delx - ryb*dely)/rlen; +y2=(rxb*dely+ryb*delx)/rlen + y0; + +%x3=rxc; y3=ryc; +x3=(rxc*delx - ryc*dely)/rlen; +y3=(rxc*dely+ryc*delx)/rlen + y0; + +%x4=rxd; y4=ryd; +x4=(rxd*delx - ryd*dely)/rlen; +y4=(rxd*dely+ryd*delx)/rlen + y0; + +%x5=rxe; y5=rye; +x5=(rxe*delx - rye*dely)/rlen; +y5=(rxe*dely+rye*delx)/rlen + y0; + +fill z0..z5..z3--z1--z2..z4..z0--cycle +enddef; + +def rarrow (expr char, delx, dely) = + +numeric rxa,rxb,rxc,rxd,rxe,rya,ryb,ryc,ryd,rye; +numeric qht,qwd,absdely; +if dely > 0: + if delx > dely: qwd# := qqw#; qht# := dely*qqw#/delx; + else: qht# := qqw#; qwd# := delx*qqw#/dely; fi; + else: + absdely=-dely; + if delx > absdely: qwd# := qqw#; qht# := absdely*qqw#/delx; + else: qht# := qqw#; qwd# := delx*qqw#/absdely; fi; +fi; + +beginchar(char,qwd#,qht#,0pt#); + +if dely > 0: y0=h; else: y0=0; fi; + +x0=w; +rxa=-arrowlen; rya=0; +rxb=rxa; ryb=arrowht; +rxc=rxa; ryc=-arrowht; +rxd=.5rxa; ryd=.5ryb-arrowcurve; +rxe=rxd; rye=-ryd; + +numeric rlen; +rlen = sqrt(delx*delx + dely*dely); + +%x1= rxa;y1=rya; %%%% replace the following by rotations +x1=(rxa*delx - rya*dely)/rlen + x0; +y1=(rxa*dely+rya*delx)/rlen + y0; + +%x2=rxb; y2=ryb; +x2=(rxb*delx - ryb*dely)/rlen + x0; +y2=(rxb*dely+ryb*delx)/rlen + y0; + +%x3=rxc; y3=ryc; +x3=(rxc*delx - ryc*dely)/rlen + x0; +y3=(rxc*dely+ryc*delx)/rlen + y0; + +%x4=rxd; y4=ryd; +x4=(rxd*delx - ryd*dely)/rlen + x0; +y4=(rxd*dely+ryd*delx)/rlen + y0; + +%x5=rxe; y5=rye; +x5=(rxe*delx - rye*dely)/rlen + x0; +y5=(rxe*dely+rye*delx)/rlen + y0; + +fill z0..z5..z3--z1--z2..z4..z0--cycle +enddef; + +% character code rules, for +% line(x,y): +% 0 < x,y <= 6 : 8*(x-1) + (y-1) +% +% larrow(x,y): +% 0 < x,y <= 4 : 8*(2x-1) + (2y-1) +% y=0 : '33 +% rarrow(x,y): +% 0 < x,y < 3 : 8*(3x-1) + (3y-1) +% 0 < x <= 4, y=3 : 8*(2x-1) + 6 +% 0 < x < 4, y = 4 : 8*(2x) + 7 +% x=3, 0 < y <=4 : 8*6 + (2y-1) +% x = 4, 0 < y < 4 : 8*7 + 2y +% y=0 : 55 +% +% for y < 0: value is 64 + value for (x, |y|) +% +% up arrow: '66 down arrow: '77 + +fontdimen 1: 0,0,0,0,0,0,0,qqs#; % line thickness in points +let cmchar=\; % cmchar should precede each character, for testing purposes + + +font_coding_scheme:= "LaTeX line"; + +cmchar "Character '00"; +line(1,1); +endchar; + +cmchar "Character '11"; +larrow(9,1,1); +endchar; + +cmchar "Character '22"; +rarrow(18,1,1); +endchar; + +cmchar "Character '01"; +line(1,2); +endchar; + +cmchar "Character '13"; +larrow(11,1,2); +endchar; + +cmchar "Character '25"; +rarrow(21,1,2); +endchar; + +cmchar "Character '02"; +line(1,3); +endchar; + +cmchar "Character '15"; +larrow(13,1,3); +endchar; + +cmchar "Character '16"; +rarrow(14,1,3); +endchar; + +cmchar "Character '03"; +line(1,4); +endchar; + +cmchar "Character '17"; +larrow(15,1,4); +endchar; + +cmchar "Character '27"; +rarrow(23,1,4); +endchar; + +cmchar "Character '04"; +line(1,5); +endchar; + +cmchar "Character '05"; +line(1,6); +endchar; + +cmchar "Character '10"; +line(2,1); +endchar; + +cmchar "Character '31"; +larrow(25,2,1); +endchar; + +cmchar "Character '52"; +rarrow(42,2,1); +endchar; + +cmchar "Character '12"; +line(2,3); +endchar; + +cmchar "Character '35"; +larrow(29,2,3); +endchar; + +cmchar "Character '36"; +rarrow(30,2,3); +endchar; + +cmchar "Character '14"; +line(2,5); +endchar; + +cmchar "Character '20"; +line(3,1); +endchar; + +cmchar "Character '51"; +larrow(41,3,1); +endchar; + +cmchar "Character '61"; +rarrow(49,3,1); +endchar; + +cmchar "Character '21"; +line(3,2); +endchar; + +cmchar "Character '53"; +larrow(43,3,2); +endchar; + +cmchar "Character '63"; +rarrow(51,3,2); +endchar; + +cmchar "Character '23"; +line(3,4); +endchar; + +cmchar "Character '57"; +larrow(47,3,4); +endchar; + +cmchar "Character '67"; +rarrow(55,3,4); +endchar; + +cmchar "Character '24"; +line(3,5); +endchar; + +cmchar "Character '30"; +line(4,1); +endchar; + +cmchar "Character '71"; +larrow(57,4,1); +endchar; + +cmchar "Character '72"; +rarrow(58,4,1); +endchar; + +cmchar "Character '32"; +line(4,3); +endchar; + +cmchar "Character '75"; +larrow(61,4,3); +endchar; + +cmchar "Character '76"; +rarrow(62,4,3); +endchar; + +cmchar "Character '34"; +line(4,5); +endchar; + +cmchar "Character '40"; +line(5,1); +endchar; + +cmchar "Character '41"; +line(5,2); +endchar; + +cmchar "Character '42"; +line(5,3); +endchar; + +cmchar "Character '43"; +line(5,4); +endchar; + +cmchar "Character '45"; +line(5,6); +endchar; + +cmchar "Character '50"; +line(6,1); +endchar; + +cmchar "Character '54"; +line(6,5); +endchar; + +cmchar "Character '100"; +line(1,-1); +endchar; + +cmchar "Character '111"; +larrow(73,1,-1); +endchar; + +cmchar "Character '122"; +rarrow(82,1,-1); +endchar; + +cmchar "Character '101"; +line(1,-2); +endchar; + +cmchar "Character '113"; +larrow(75,1,-2); +endchar; + +cmchar "Character '125"; +rarrow(85,1,-2); +endchar; + +cmchar "Character '102"; +line(1,-3); +endchar; + +cmchar "Character '115"; +larrow(77,1,-3); +endchar; + +cmchar "Character '116"; +rarrow(78,1,-3); +endchar; + +cmchar "Character '103"; +line(1,-4); +endchar; + +cmchar "Character '117"; +larrow(79,1,-4); +endchar; + +cmchar "Character '127"; +rarrow(87,1,-4); +endchar; + +cmchar "Character '104"; +line(1,-5); +endchar; + +cmchar "Character '105"; +line(1,-6); +endchar; + +cmchar "Character '110"; +line(2,-1); +endchar; + +cmchar "Character '131"; +larrow(89,2,-1); +endchar; + +cmchar "Character '152"; +rarrow(106,2,-1); +endchar; + +cmchar "Character '112"; +line(2,-3); +endchar; + +cmchar "Character '135"; +larrow(93,2,-3); +endchar; + +cmchar "Character '136"; +rarrow(94,2,-3); +endchar; + +cmchar "Character '114"; +line(2,-5); +endchar; + +cmchar "Character '120"; +line(3,-1); +endchar; + +cmchar "Character '151"; +larrow(105,3,-1); +endchar; + +cmchar "Character '161"; +rarrow(113,3,-1); +endchar; + +cmchar "Character '121"; +line(3,-2); +endchar; + +cmchar "Character '153"; +larrow(107,3,-2); +endchar; + +cmchar "Character '163"; +rarrow(115,3,-2); +endchar; + +cmchar "Character '123"; +line(3,-4); +endchar; + +cmchar "Character '157"; +larrow(111,3,-4); +endchar; + +cmchar "Character '167"; +rarrow(119,3,-4); +endchar; + +cmchar "Character '124"; +line(3,-5); +endchar; + +cmchar "Character '130"; +line(4,-1); +endchar; + +cmchar "Character '171"; +larrow(121,4,-1); +endchar; + +cmchar "Character '172"; +rarrow(122,4,-1); +endchar; + +cmchar "Character '132"; +line(4,-3); +endchar; + +cmchar "Character '175"; +larrow(125,4,-3); +endchar; + +cmchar "Character '176"; +rarrow(126,4,-3); +endchar; + +cmchar "Character '134"; +line(4,-5); +endchar; + +cmchar "Character '140"; +line(5,-1); +endchar; + +cmchar "Character '141"; +line(5,-2); +endchar; + +cmchar "Character '142"; +line(5,-3); +endchar; + +cmchar "Character '143"; +line(5,-4); +endchar; + +cmchar "Character '145"; +line(5,-6); +endchar; + +cmchar "Character '150"; +line(6,-1); +endchar; + +cmchar "Character '154"; +line(6,-5); +endchar; + +%%%Horizontal arrows: + + +cmchar "Character '33"; +larrow(27,1,0); +endchar; + +cmchar "Character '55"; %right arrow +beginchar(45,qqw#,qqw#,0pt#); +x0=w; y0=0; +x1=x0-arrowlen; y1=0; +x2=x1; y2=arrowht; +x3=x1; y3=-y2; +x4=.5[x0,x1]; y4=.5y2-arrowcurve; +x5=x4; y5=-y4; +fill z0..z4..z2--z1--z3..z5..z0--cycle; +endchar; + +%%%vertical arrows + + +cmchar "Character '66"; %up arrow +beginchar(54,qqw#,qqw#,0pt#); +x0=0; y0=w; +y1=y0-arrowlen; x1=0; +y2=y1; x2=arrowht; +y3=y1; x3=-x2; +y4=.5[y0,y1]; x4=.5x2-arrowcurve; +y5=y4; x5=-x4; +fill z0..z4..z2--z1--z3..z5..z0--cycle; +endchar; + + +cmchar "Character '77"; %down arrow +beginchar(63,qqw#,qqw#,0pt#); +x0=0; y0=0; +y1=arrowlen; x1=0; +y2=y1; x2=arrowht; +y3=y1; x3=-x2; +y4=.5y1; x4=.5x2-arrowcurve; +y5=y4; x5=-x4; +fill z0..z4..z2--z1--z3..z5..z0--cycle; +endchar; + +bye diff --git a/systems/knuth/local/lib/line10.mf b/systems/knuth/local/lib/line10.mf new file mode 100644 index 0000000000..125c4eca93 --- /dev/null +++ b/systems/knuth/local/lib/line10.mf @@ -0,0 +1,11 @@ +font_identifier "LINE"; font_size 10pt#; +font_coding_scheme:="LATEX LINE"; +mode_setup; + +qqs#=.4pt#; %width of lines +qqh#=10pt#; %height of vertical stroke. +qqw#=10pt#; %length of horizontal stroke. + +%arrow dimensions: +arrowlen#=.4*qqw#; arrowht#=.15*qqw#; arrowcurve#=.1*arrowht#; +input line; diff --git a/systems/knuth/local/lib/linew10.mf b/systems/knuth/local/lib/linew10.mf new file mode 100644 index 0000000000..cab30e9801 --- /dev/null +++ b/systems/knuth/local/lib/linew10.mf @@ -0,0 +1,11 @@ +font_identifier "LINEW"; font_size 10pt#; +font_coding_scheme:="LATEX LINE"; +mode_setup; + +qqs#=.8pt#; %width of lines +qqh#=10pt#; %height of vertical stroke. +qqw#=10pt#; %length of horizontal stroke. + +%arrow dimensions: +arrowlen#=.6*qqw#; arrowht#=.22*qqw#; arrowcurve#=.1*arrowht#; +input line; diff --git a/systems/knuth/local/lib/list-latin.tex b/systems/knuth/local/lib/list-latin.tex new file mode 100644 index 0000000000..71d5bb6d9a --- /dev/null +++ b/systems/knuth/local/lib/list-latin.tex @@ -0,0 +1,94 @@ +% This program by D. E. Knuth is not copyrighted and can be used freely. +% Makes a listing of one or more files +% Extended to allow the Latin-1 accented characters in UTF-8 encoding +% Typical usage: +% tex list-latin *.txt \\end + +\def\grabfile#1 {\setbox0=\lastbox\endgraf\doit{#1}} +\everypar{\grabfile} + +\font\filenamefont= cmtt8 scaled\magstep3 +\font\headlinefont= cmr8 +\font\listingfont= cmtex10 +\font\ttfont= cmtt10 +\font\syttfont= cmsytt10 +\font\eoffont= cmti8 + +\def\today{\ifcase\month\or + January\or February\or March\or April\or May\or June\or + July\or August\or September\or October\or November\or December\fi + \space\number\day, \number\year} +\newcount\m \newcount\n +\n=\time \divide\n 60 \m=-\n \multiply\m 60 \advance\m \time +\def\hours{\twodigits\n\twodigits\m} +\def\twodigits#1{\ifnum #1<10 0\fi \number#1} + +\newlinechar=`@ +\message{@\today\space at \hours} + +\raggedbottom +\nopagenumbers + +\newcount\n +\catcode`\^^c3=\active +\def\missing{{\syttfont\char15}} +\def^^c3#1{\n=`#1\advance\n by-128 + {\ttfont\ifcase\n + \`A\or\'A\or\^A\or\~A\or\"A\or\AA\or\AE\or\c C\or + \`E\or\'E\or\^E\or\"E\or\`I\or\'I\or\^I\or\"I\or + \missing\or\~N\or\`O\or\'O\or\^O\or\~O\or\"O\or{\syttfont\char2}\or + \O\or\`U\or\'U\or\^U\or\"U\or\'Y\or\missing\or\ss\or + \`a\or\'a\or\^a\or\~a\or\"a\or\aa\or\ae\or\c c\or + \`e\or\'e\or\^e\or\"e\or\`\i\or\'\i\or\^\i\or\"\i\or + \missing\or\~n\or\`o\or\'o\or\^o\or\~o\or\"o\or{\syttfont\char4}\or + \o\or\`u\or\'u\or\^u\or\"u\or\'y\or\missing\or\"y\fi}} + +\chardef\other=12 +\def\doit#1{\message{@Listing #1@} + \begingroup \everypar{} \frenchspacing + \headline{\filenamefont#1\quad\headlinefont \today\ at \hours + \hfill Page \folio} + \def\do##1{\catcode`##1=\other}\dospecials + \catcode127=\other \catcode9=\other \catcode12=\other + \parindent 0pt \parfillskip=0pt plus 1fil minus 1in + \everypar{\hangindent 1in} \rightskip=0pt plus 2in + \def\par{\ifvmode\penalty-500\medskip\else\endgraf\fi} + \listingfont \obeylines \obeyspaces \global\pageno=1 + \input #1 {\eoffont(end of\/ file)}\endgraf\vfill\eject\endgroup} +{\obeyspaces\global\let =\ } +\catcode`\_=\other % allow _ in file names + +% A tab (^^I) prints as lowercase gamma. +% Character ^^M could be made visible, with a bit of work; +% at present, it's indistinguishable from newline (^^J). + +% You can get up to 103 characters on a line without an overfull box. + +% Further notes from Don, January 2017: +% +% Maybe I'm the only person left who still uses plain TeX in a UTF-8 world. +% +% But for what it's worth, I'm appending a little file that I prepared today, +% since it turned out to be useful in a project of interest to me. +% +% Namely, I've got a program that takes an XML encoding of organ-pipe +% settings, used by performers when they change the stops during a +% performance, and translates it into a human-readable form. +% I mean, the output says "when you reach combination nunber 0013, +% the following ranks of pipes are set to play". +% +% The names of those ranks of pipes often contain accented characters, +% as well as things like the German \ss. In order to use such texts on the Web, +% I have them in UTF-8 code. But to make a verbatim hardcopy listing using +% nice typewriter-style fonts, I wanted a program like "list.tex", which +% I've been using to print text files for more than 25 years. +% +% Fortunately, the accented characters all turn out to be two-character +% sequences in UTF-8, where the first character is always '303. So I +% can simply make that character active, and it can then change the +% following character appropriately. +% +% Therefore I added a few lines to "list.tex", resulting in "list-latin.tex". +% And it works! Hence it might be a useful addition to the CTAN archives. +% +% Yours truly, Don diff --git a/systems/knuth/local/lib/list.tex b/systems/knuth/local/lib/list.tex new file mode 100644 index 0000000000..1daeba2bbe --- /dev/null +++ b/systems/knuth/local/lib/list.tex @@ -0,0 +1,47 @@ +% Makes a listing of one or more files +% Typical usage: +% tex list *.c \\end + +\def\grabfile#1 {\setbox0=\lastbox\endgraf\doit{#1}} +\everypar{\grabfile} + +\font\filenamefont= cmtt8 scaled\magstep3 +\font\headlinefont= cmr8 +\font\listingfont= cmtex10 +\font\eoffont= cmti8 + +\def\today{\ifcase\month\or + January\or February\or March\or April\or May\or June\or + July\or August\or September\or October\or November\or December\fi + \space\number\day, \number\year} +\newcount\m \newcount\n +\n=\time \divide\n 60 \m=-\n \multiply\m 60 \advance\m \time +\def\hours{\twodigits\n\twodigits\m} +\def\twodigits#1{\ifnum #1<10 0\fi \number#1} + +\newlinechar=`@ +\message{@\today\space at \hours} + +\raggedbottom +\nopagenumbers + +\chardef\other=12 +\def\doit#1{\message{@Listing #1@} + \begingroup \everypar{} \frenchspacing + \headline{\filenamefont#1\quad\headlinefont \today\ at \hours + \hfill Page \folio} + \def\do##1{\catcode`##1=\other}\dospecials + \catcode127=\other \catcode9=\other \catcode12=\other + \parindent 0pt \parfillskip=0pt plus 1fil minus 1in + \everypar{\hangindent 1in} \rightskip=0pt plus 2in + \def\par{\ifvmode\penalty-500\medskip\else\endgraf\fi} + \listingfont \obeylines \obeyspaces \global\pageno=1 + \input #1 {\eoffont(end of\/ file)}\endgraf\vfill\eject\endgroup} +{\obeyspaces\global\let =\ } +\catcode`\_=\other % allow _ in file names + +% A tab (^^I) prints as lowercase gamma. +% Character ^^M could be made visible, with a bit of work; +% at present, it's indistinguishable from newline (^^J). + +% You can get up to 103 characters on a line without an overfull box. diff --git a/systems/knuth/local/lib/llist.tex b/systems/knuth/local/lib/llist.tex new file mode 100644 index 0000000000..f107169e24 --- /dev/null +++ b/systems/knuth/local/lib/llist.tex @@ -0,0 +1,67 @@ +% Makes a landscape listing of one or more files +% Typical usage: +% tex llist *.c \\end + +\def\grabfile#1 {\setbox0=\lastbox\endgraf\doit{#1}} +\everypar{\grabfile} + +\font\filenamefont= cmtt8 scaled\magstep3 +\font\headlinefont= cmr8 +\font\listingfont= cmtex8 +\font\eoffont= cmti8 + +\def\today{\ifcase\month\or + January\or February\or March\or April\or May\or June\or + July\or August\or September\or October\or November\or December\fi + \space\number\day, \number\year} +\newcount\m \newcount\n +\n=\time \divide\n 60 \m=-\n \multiply\m 60 \advance\m \time +\def\hours{\twodigits\n\twodigits\m} +\def\twodigits#1{\ifnum #1<10 0\fi \number#1} + +\newlinechar=`@ +\message{@\today\space at \hours} + +\baselineskip=9pt +\medskipamount=4pt minus 1pt +\raggedbottom +\nopagenumbers + +\chardef\other=12 +\def\doit#1{\message{@Listing #1@} + \begingroup \everypar{} \frenchspacing + \headline{\ifright \headlinefont \hfill Page \folio + \else\filenamefont#1\quad\headlinefont \today\ at \hours\hfill \fi} + \def\do##1{\catcode`##1=\other}\dospecials + \catcode127=\other \catcode9=\other \catcode12=\other + \parindent 0pt \parfillskip=0pt plus 1fil minus .8in + \everypar{\hangindent 1in} \rightskip=0pt plus 2in + \def\par{\ifvmode\penalty-50\medskip\else\endgraf\fi} + \listingfont \obeylines \obeyspaces \global\pageno=1 + \input #1 {\eoffont(end of\/ file)}\endgraf\vfill\eject + \ifright\null\vfill\eject\fi\endgroup} +{\obeyspaces\global\let =\ } +\catcode`\_=\other % allow _ in file names + +\hsize=4.6truein +\vsize=7truein +\hoffset=-.5truein +\voffset=-.2truein +\newif\ifright +\newbox\lefthalf +\output{\ifright + \shipout\hbox{\hbox to5.5in{\box\lefthalf\hss}% + \vbox{\makeheadline\pagebody\makefootline}} + \advancepageno\global\rightfalse + \else\global\setbox\lefthalf\vbox{\makeheadline\pagebody\makefootline} + \global\righttrue\fi} + +\special{landscape} + +% A tab (^^I) prints as lowercase gamma. +% Character ^^M could be made visible, with a bit of work; +% at present, it's indistinguishable from newline (^^J). + +% You can get up to 91 characters on a line without an overfull box. +% (But lines with more than 84 characters will be clipped, if they +% appear on a righthand halfpage.) diff --git a/systems/knuth/local/lib/local.mf b/systems/knuth/local/lib/local.mf new file mode 100644 index 0000000000..1690d48049 --- /dev/null +++ b/systems/knuth/local/lib/local.mf @@ -0,0 +1,122 @@ +% This file can be loaded after plain.mf. +% It introduces conventions that are commonly used on my home computer, +% while remaining compatible with the plain base. +% It also adds some macros added by AMS in their amsmodes.mf, version 2.1a +base_version:=base_version&"/art"; + +def cand(text q) = startif true q else: false fi enddef; +def cor(text q) = startif true true else: q fi enddef; +tertiarydef p startif true = if p: enddef; + +def mode_def suffix $ = + if known($) cand + (numeric $ cand + ($<number_of_modes cand + (mode_name[$] = (str $ & "_")))): + else: if known(mode-$) cand (unknown mode): mode:= fi + $:=incr number_of_modes; + mode_name[$]:=str$ & "_"; + fi + expandafter quote def scantokens mode_name[$] enddef; + +screen_rows:=1024; screen_cols:=1024; + +% Here are conventions for local output devices: + +mode_def imagen = % imagen mode: for the Imagen 8/300 (Canon engine) + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=0; % no, don't show titles in the log + pixels_per_inch:=300; + blacker:=0; % Canon engine is black enough + fillin:=.2; % and it tends to fill in diagonals + o_correction:=.6; % + enddef; + +mode_def aps = % aps mode: for the Autologic APS-Micro5 + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=1; % yes, show titles online + pixels_per_inch:=722.909; % that's roughly 10 per pt + blacker:=.2; % make pens a teeny bit blacker + fillin:=.2; % but compensate for diagonal fillin + o_correction:=1; % and keep the full overshoot + enddef; + +mode_def linohi = % lino mode: for the Linotronic at 1270dpi + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=1; % yes, show titles online + pixels_per_inch:=1270; + blacker:=.2; % make pens a teeny bit blacker + fillin:=.2; % but compensate for diagonal fillin + o_correction:=1; % and keep the full overshoot + enddef; + +mode_def fourc = % for 400dpi printers + proofing:=0; % no, we're not making proofs + fontmaking:=1; % yes, we are making a font + tracingtitles:=0; % no, don't show titles in the log + pixels_per_inch:=400; + blacker:=0; % engine is black enough + fillin:=.2; % and it tends to fill in diagonals + o_correction:=.6; % + enddef; + +localfont:=imagen; + +% Macros to add mode information specials to fonts. (by Pierre MacKay) + +def mode_special(suffix $) = + string s,d; + s:=str$; d:=decimal scantokens s; + special s&":="&d&";" enddef; + +def font_mode_specials = + p_p_i=pixels_per_inch/mag; + if fontmaking > 0: + begingroup; save d,s,p; save pixels_per_inch; + string p; + pixels_per_inch:=p_p_i; + special jobname; + mode_special(mag); + if string mode: p:=mode; + else: p:=substring(0,length(mode_name[mode])-1) of mode_name[mode]; fi + special "mode:="&p&";"; + mode_special(pixels_per_inch); + mode_special(blacker); + mode_special(fillin); + mode_special(o_correction); + endgroup; + fi +enddef; + +% Finally, here are macros for Xerox-world font info: + +def font_family expr s = % string s names the font family, e.g., "CMR" + headerbyte 49: BCPL_string(s,20); + special "identifier "&s enddef; +def coding_scheme expr s = % string s names the scheme, e.g. "TEX TEXT" + headerbyte 9: BCPL_string(s,40); + special "codingscheme "&s enddef; +def font_face_byte expr x = % integer x gives the family member number, + headerbyte 72: x; % which should be between 0 and 255 + special "fontfacebyte"; numspecial x enddef; + +def BCPL_string(expr s,n)= % string s becomes an n-byte BCPL string + for l:=if length(s)>=n: n-1 else: length(s) fi: l + for k:=1 upto l: , substring (k-1,k) of s endfor + for k:=l+2 upto n: , 0 endfor endfor enddef; + +Xerox_world:=1; % users can say `if known Xerox_world:...fi' + +inner end; +def bye= + if fontmaking>0: font_family font_identifier_; + coding_scheme font_coding_scheme_; + font_face_byte max(0,254-round 2designsize); + font_mode_specials; fi + end + enddef; + +outer bye,end; diff --git a/systems/knuth/local/lib/local.tex b/systems/knuth/local/lib/local.tex new file mode 100644 index 0000000000..6ea2d45cbf --- /dev/null +++ b/systems/knuth/local/lib/local.tex @@ -0,0 +1,8 @@ +% This file can be loaded after plain.tex. +% It introduces conventions that are commonly used on my home computer, +% while remaining compatible with the plain format. +\xdef\fmtversion{\fmtversion/art} + +% actually there's nothing needed here, now that \loggingall is public + + diff --git a/systems/knuth/local/lib/logod10.mf b/systems/knuth/local/lib/logod10.mf new file mode 100644 index 0000000000..fc484a4b18 --- /dev/null +++ b/systems/knuth/local/lib/logod10.mf @@ -0,0 +1,10 @@ +% 10-point demibold METAFONT logo +font_size 10pt#; % the "design size" of this font +ht#:=6pt#; % height of characters +xgap#:=21/20*0.6pt#; % horizontal adjustment +u#:=21/20*4/9pt#; % unit width +s#:=0; % extra space at the left and the right +o#:=1/9pt#; % overshoot +px#:=.5[2/3pt#,44/36pt#]; % horizontal thickness of pen +input logo % now generate the font +bye % and stop. diff --git a/systems/knuth/local/lib/logosl9.mf b/systems/knuth/local/lib/logosl9.mf new file mode 100644 index 0000000000..03b3d92288 --- /dev/null +++ b/systems/knuth/local/lib/logosl9.mf @@ -0,0 +1,3 @@ +% 9-point slanted METAFONT logo +slant := 1/4; +input logo9 diff --git a/systems/knuth/local/lib/mfman.mf b/systems/knuth/local/lib/mfman.mf new file mode 100644 index 0000000000..e272689889 --- /dev/null +++ b/systems/knuth/local/lib/mfman.mf @@ -0,0 +1,2481 @@ +% This file generates most of the figures for The METAFONTbook + +lcode_:=" /"; % suppress overflow labels +grayfont black; + +def clear_all = clearit; clearxy; pickup standardpen; +proofrulethickness 0; +enddef; + +def heavy_dot expr z = + makelabel.top("",z-(1,0)); + makelabel.top("",z+(1,0)); + makelabel.top("",z-(0,1)); + makelabel.top("",z+(0,1)); + makelabel.top("",z+(1,1)/sqrt2); + makelabel.top("",z+(1,-1)/sqrt2); + makelabel.top("",z-(1,1)/sqrt2); + makelabel.top("",z-(1,-1)/sqrt2); + enddef; + +def font_setup= +define_pixels(u,tiny,axis,hheight,border); +define_blacker_pixels(hair,thin,thick,rulethickness); +pickup if tiny<.5: nullpen else: pencircle scaled tiny fi; +tinypen:=savepen; +currenttransform:=identity slanted slant yscaled aspect_ratio; +enddef; + +mode=proof; mode_setup; +standardpen=savepen; + +"Figure 2a"; % 6 points and a grid +clear_all; +pair offset; offset=(.5,.5); +z1=(0,100)+offset; +z2=(100,100)+offset; +z3=(200,100)+offset; +z4=(0,0)+offset; +z5=(100,0)+offset; +z6=(200,0)+offset; +proofrulethickness .8; +proofrule (z1+(0,5),z4-(0,5)); proofrule (z4-(5,0),z6+(5,0)); +makelabel.top("1 ",z1); +makelabel.top("2 ",z2); +makelabel.top("3 ",z3); +makelabel.bot("4 ",z4); +makelabel.bot("5 ",z5); +makelabel.bot("6 ",z6); +for k=1 upto 6: heavy_dot z[k]; endfor; +pickup pencircle; +for x=10 step 10 until 200: draw (x,-5)+offset..(x,105)+offset; endfor +for y=10 step 10 until 100: draw (-5,y)+offset..(205,y)+offset; endfor +showit; +shipit; + +"Figure A2a"; % 6 points and a grid and two more points +clear_all; +proofoffset(30,0); +pair offset; offset=(.5,.5); +z1=(0,100)+offset; +z2=(100,100)+offset; +z3=(200,100)+offset; +z4=(0,0)+offset; +z5=(100,0)+offset; +z6=(200,0)+offset; +proofrulethickness .8; +proofrule (z1+(0,5),z4-(0,5)); proofrule (z4-(5,0),z6+(5,0)); +makelabel.top("1 ",z1); +makelabel.top("2 ",z2); +makelabel.top("3 ",z3); +makelabel.bot("4 ",z4); +makelabel.bot("5 ",z5); +makelabel.bot("6 ",z6); +for k=1 upto 6: heavy_dot z[k]; endfor; +makelabel.lft("(-5,15)",(-5,15)+offset); +makelabel.top("(60,30) ",(60,30)+offset); +%makelabel.top(" ,30) ",(60,30)+offset); +%makelabel.top("(60 ",(60,30)+offset); +heavy_dot (-5,15)+offset; +heavy_dot (60,30)+offset; +pickup pencircle; +for x=10 step 10 until 200: draw (x,-5)+offset..(x,105)+offset; endfor +for y=10 step 10 until 100: draw (-5,y)+offset..(205,y)+offset; endfor +showit; +shipit; + +"Figure 2b"; % 6 points and a line +clear_all; +z1=(0,100); +z2=(100,100); +z3=(200,100); +z4=(0,0); +z5=(100,0); +z6=(200,0); +draw (x1-epsilon,y1)..(x6,y6); +makelabel.lft("1 ",z1); +makelabel.lft("2",z2); +makelabel.rt("3",z3); +makelabel.lft("4",z4); +makelabel.lft("5",z5); +makelabel.rt(" 6",z6); +showit; +shipit; + +"Figure 2c"; % 6 points and three lines (hex symbol, version 1) +clear_all; +z1=(0,100); +z2=(100,100); +z3=(200,100); +z4=(0,0); +z5=(100,0); +z6=(200,0); +draw z1..z6; draw z2..z5; draw z3..z4; +for k=1 upto 6: drawdot z[k]; endfor +makelabel.lft("1 ",z1); +makelabel.lft("2 ",z2); +makelabel.rt(" 3",z3); +makelabel.lft("4 ",z4); +makelabel.lft("5 ",z5); +makelabel.rt(" 6",z6); +showit; +shipit; + +"Figure 2d"; % hex symbols with top and bottom adjusted +clear_all; +top z1=(0,100); +top z2=(100,100); +top z3=(200,100); +bot z4=(0,0); +bot z5=(100,0); +bot z6=(200,0); +draw z1..z6; draw z2..z5; draw z3..z4; +for k=1 upto 6: drawdot z[k]; endfor +makelabel.lft("1 ",z1); +makelabel.lft("2 ",z2); +makelabel.rt(" 3",z3); +makelabel.lft("4 ",z4); +makelabel.lft("5 ",z5); +makelabel.rt(" 6",z6); +showit; +clearxy; pair offset; offset=(250,0); +pickup pencircle scaled .6pt; +top z1=(0,100)+offset; +top z2=(100,100)+offset; +top z3=(200,100)+offset; +bot z4=(0,0)+offset; +bot z5=(100,0)+offset; +bot z6=(200,0)+offset; +draw z1..z6; draw z2..z5; draw z3..z4; +for k=1 upto 6: drawdot z[k]; endfor +makelabel.lft("1 ",z1); +makelabel.lft("2 ",z2); +makelabel.rt(" 3",z3); +makelabel.lft("4 ",z4); +makelabel.lft("5 ",z5); +makelabel.rt(" 6",z6); +proofrule ((-5,100),(210,100)+offset); +proofrule ((-5,0),(210,0)+offset); +showit; +shipit; + +"Figure 2e"; % stick-letter A +b#:=250/36pt#; a#:=150/36pt#; s#:=30/36pt#; +define_pixels(b,a,s); +def A(expr alpha)= +beginchar (incr(charcode),s#+a#+s#,b#,0); +pickup standardpen; +bot z1=(good.x s,0); z5=z1+(a,0); +z3=(1/2[x1,x5],good.y b); +z2=alpha[z1,z3]; z4=alpha[z5,z3]; +draw z1..z3; draw z3..z5; draw z2..z4; +drawdot z1; drawdot z5; drawdot z3; +makelabel.lft("1 ",z1); +makelabel.lft("2 ",z2); +makelabel.top("3 ",z3); +makelabel.rt(" 4",z4); +makelabel.rt(" 5",z5); +endchar; enddef; + +A((3-sqrt5)/2); % (area above bar / area below) = golden ratio + +"Figure 3a"; % 4 points and 3 midpoints +clear_all; +z1=(.5,.5); z2=(40.5,80.5); z3=(150.5,100.5); z4=(300.5,.5); +z12=1/2[z1,z2]; z23=1/2[z2,z3]; z34=1/2[z3,z4]; +pickup pencircle; +draw z1--z2--z3--z4; +heavy_dot z1; heavy_dot z2; heavy_dot z3; heavy_dot z4; +makelabel.lft("1",z1); +makelabel.lft("2",z2); +makelabel.top(" 3",z3); +makelabel.rt("4",z4); +makelabel.rt("12",z12); +makelabel.bot(" 23",z23); +makelabel.bot("34 ",z34); +showit; +shipit; + +"Figure 3b"; % 4 points and 6 midpoints +clear_all; +z1=(.5,.5); z2=(40.5,80.5); z3=(150.5,100.5); z4=(300.5,.5); +z12=1/2[z1,z2]; z23=1/2[z2,z3]; z34=1/2[z3,z4]; +z123=1/2[z12,z23]; z234=1/2[z23,z34]; z1234=1/2[z123,z234]; +heavy_dot z1; heavy_dot z2; heavy_dot z3; heavy_dot z4; +pickup pencircle; +draw z1--z2--z3--z4; draw z12--z23--z34; draw z123--z234; +makelabel.lft("1",z1); +makelabel.lft("2",z2); +makelabel.top(" 3",z3); +makelabel.rt("4",z4); +makelabel.lft("12",z12); +makelabel.top("23 ",z23); +makelabel.rt("34",z34); +makelabel.bot(" 123",z123); +makelabel.bot("234 ",z234); +makelabel.bot("1234",z1234); +showit; +shipit; + +"Figure 3c"; % 4 points and infinitely many midpoints +clear_all; +z1=(.5,.5); z2=(40.5,80.5); z3=(150.5,100.5); z4=(300.5,.5); +heavy_dot z1; heavy_dot z2; heavy_dot z3; heavy_dot z4; +pickup pencircle; + +def makedot(expr x)= special " 1"; + numspecial xpart x; numspecial ypart x enddef; + +def recurse(expr a,b,c,d)= +dist:=abs(a-d); +if dist>4: +begingroup save e,f,g,h,i,j; pair e,f,g,h,i,j; +e=(a+b)/2; makedot(e); +f=(b+c)/2; makedot(f); +g=(c+d)/2; makedot(g); +h=(e+f)/2; makedot(h); +i=(f+g)/2; makedot(i); +j=(h+i)/2; makedot(j); +if dist>20: draw a--b--c--d; draw e--f--g; draw h--i; fi +recurse(a,e,h,j); recurse(j,i,g,d); +endgroup; +fi enddef; + +makedot(z1); makedot(z2); makedot(z3); makedot(z4); recurse(z1,z2,z3,z4); +makelabel.bot.nodot("ignore",(160,-10)); % kludge for GFtoEPS! +shipit; + +"Figure 3d"; % 4 points and various cubics +clear_all; +z1=(0,0); z2=5/6(40,80); z3=5/6(150,100); z4=5/6(300,0); +draw z1..controls z2 and z3..z4; +drawdot z1; drawdot z4; +makelabel.lft("1 ",z1); +makelabel.lft("2",z2); +makelabel.rt("3",z3); +makelabel.rt(" 4",z4); +pair offset; offset:=(325,0); +draw (z1..controls z3 and z2..z4) shifted offset; +drawdot z1+offset; drawdot z4+offset; +makelabel.lft("1 ",z1+offset); +makelabel.lft("3",z2+offset); +makelabel.rt("2",z3+offset); +makelabel.rt(" 4",z4+offset); +offset:=(0,-100); +draw (z2..controls z1 and z3..z4) shifted offset; +drawdot z2+offset; drawdot z4+offset; +makelabel.lft("2",z1+offset); +makelabel.lft("1 ",z2+offset); +makelabel.rt("3",z3+offset); +makelabel.rt(" 4",z4+offset); +offset:=(325,-100); +draw (z1..controls z4 and z2..z3) shifted offset; +drawdot z1+offset; drawdot z3+offset; +makelabel.lft("1 ",z1+offset); +makelabel.lft("3",z2+offset); +makelabel.rt(" 4",z3+offset); +makelabel.rt("2",z4+offset); +showit; +shipit; + +"Figure 3e"; % example curves with automatic control points +clear_all; +z1=(0,100); z2=(100,100); z3=(200,100); +z4=(0,0); z5=(100,0); z6=(200,0); +path p; p=z4..z1..z2..z6; +draw p; +drawdot z4; drawdot z6; +makelabel.bot.nodot(" 1",z1); +makelabel.top.nodot(" 2",z2); +makelabel.rt.nodot("3",z3+(2,0)); +makelabel.rt.nodot(" 4",z4); +makelabel.rt.nodot("5",z5+(2,0)); +makelabel.rt.nodot(" 6",z6); +for k=1 upto 6: heavy_dot z[k]; endfor; +for k=1 upto length p: heavy_dot postcontrol k-1 of p; + heavy_dot precontrol k of p; endfor +pair offset; offset=(325,0); +p:=(z5..z4..z1..z3..z6..z5) shifted offset; draw p; +drawdot z5+offset; +makelabel.bot.nodot(" 1",z1+offset); +makelabel.top.nodot("2",z2+offset+(0,2)); +makelabel.bot.nodot("3 ",z3+offset); +makelabel.top.nodot(" 4",z4+offset); +makelabel.top.nodot("5",z5+offset+(0,5)); +makelabel.top.nodot("6 ",z6+offset); +for k=1 upto 6: heavy_dot z[k]+offset; endfor; +for k=1 upto length p: heavy_dot postcontrol k-1 of p; + heavy_dot precontrol k of p; endfor +showit; +shipit; + +"Figure 3f"; % bean shape with automatic control points +clear_all; +z1=(0,100); z2=(100,100); z3=(200,100); +z4=(0,0); z5=(100,0); z6=(200,0); +path p; p=z5..z4..z1..z3..z6..cycle; +draw p; +makelabel.bot.nodot(" 1",z1); +makelabel.bot.nodot("2",z2-(0,2)); +makelabel.bot.nodot("3 ",z3); +makelabel.top.nodot(" 4",z4+(-1,1)); +makelabel.top.nodot("5",z5+(0,5)); +makelabel.top.nodot("6 ",z6+(1,1)); +for k=1 upto 6: heavy_dot z[k]; endfor; +for k=1 upto length p: heavy_dot postcontrol k-1 of p; + heavy_dot precontrol k of p; endfor +showit; +shipit; + +"Figure 3g"; % bean shape with more tension between 1 and 3 +clear_all; +z1=(0,100); z2=(100,100); z3=(200,100); +z4=(0,0); z5=(100,0); z6=(200,0); +path p; p=z5..z4..z1..tension1.2..z3..z6..cycle; +draw p; +makelabel.bot.nodot(" 1",z1); +makelabel.bot.nodot("2",z2-(0,2)); +makelabel.bot.nodot("3 ",z3); +makelabel.top.nodot(" 4",z4+(-1,1)); +makelabel.top.nodot("5",z5+(0,5)); +makelabel.top.nodot("6 ",z6+(1,1)); +for k=1 upto 6: heavy_dot z[k]; endfor; +for k=1 upto length p: heavy_dot postcontrol k-1 of p; + heavy_dot precontrol k of p; endfor +showit; +shipit; + +"Figure 3h"; % bean shape with more tension before and after 1 +clear_all; +z1=(0,100); z2=(100,100); z3=(200,100); +z4=(0,0); z5=(100,0); z6=(200,0); +path p; p=z5..z4..tension 1 and 1.5..z1..tension 1.5 and 1..z3..z6..cycle; +draw p; +makelabel.bot.nodot(" 1",z1); +makelabel.bot.nodot("2",z2-(0,2)); +makelabel.bot.nodot("3 ",z3); +makelabel.top.nodot(" 4",z4+(-1,1)); +makelabel.top.nodot("5",z5+(0,5)); +makelabel.top.nodot("6 ",z6+(1,1)); +for k=1 upto 6: heavy_dot z[k]; endfor; +for k=1 upto length p: heavy_dot postcontrol k-1 of p; + heavy_dot precontrol k of p; endfor +showit; +shipit; + +"Figure 3i"; % bean shape with straight bottom +clear_all; +z1=(0,100); z2=(100,100); z3=(200,100); +z4=(0,0); z5=(100,0); z6=(200,0); +path p; p=z5..z4{left}..z1..z3..z6{left}..cycle; +draw p; +makelabel.bot.nodot(" 1",z1-(1,1)); +makelabel.bot.nodot("2",z2-(0,2)); +makelabel.bot.nodot("3 ",z3+(1,-1)); +makelabel.top.nodot(" 4",z4+(0,5)); +makelabel.top.nodot("5",z5+(0,5)); +makelabel.top.nodot("6 ",z6+(0,5)); +for k=1 upto 6: heavy_dot z[k]; endfor; +for k=1 upto length p: heavy_dot postcontrol k-1 of p; + heavy_dot precontrol k of p; endfor +showit; +shipit; + +"Figure 3j"; % example with direction specified +clear_all; +z1=(0,100); z2=(100,100); z3=(200,100); +z4=(0,0); z5=(100,0); z6=(200,0); +path p; p=z4..z2{z3-z4}..z3; +draw p; +makelabel.rt.nodot("1",z1+(0,-9)); +makelabel.rt.nodot("2",z2+(1,-11)); +makelabel.rt.nodot("3",z3+(1,-11)); +makelabel.rt.nodot("4",z4+(1,-11)); +makelabel.rt.nodot("5",z5+(0,-9)); +makelabel.rt.nodot("6",z6+(0,-9)); +for k=1 upto 6: heavy_dot z[k]; endfor; +for k=1 upto length p: heavy_dot postcontrol k-1 of p; + heavy_dot precontrol k of p; endfor +showit; +shipit; + +"Figure 3k"; % wiggly shape for exercise +clear_all; +z1=(0,100); z2=(100,100); z3=(200,100); +z4=(0,0); z5=(100,0); z6=(200,0); +path p; p=z5..z4{z4-z2}..z1..z3..z6{z2-z6}..cycle; +draw p; +makelabel.bot.nodot(" 1",z1-(2,2)); +makelabel.bot.nodot("2",z2-(0,2)); +makelabel.bot.nodot("3 ",z3+(2,-2)); +makelabel.bot.nodot(" 4",z4); +makelabel.top.nodot("5",z5+(0,5)); +makelabel.bot.nodot("6 ",z6); +for k=1 upto 6: heavy_dot z[k]; endfor; +showit; +shipit; + +"Figure 3l"; % examples of varying curl +clear_all; +z1=(0,100); z2=(100,100); z3=(200,100); +z4=(0,0); z5=(100,0); z6=(200,0); +path p; p=z4{curl0}..z2{z3-z4}..{curl0}z3; +draw p; +drawdot z4; drawdot z3; +makelabel.rt.nodot("1",z1+(0,-9)); +makelabel.rt.nodot("2",z2+(1,-11)); +makelabel.rt.nodot("3",z3+(1,-11)); +makelabel.rt.nodot("4",z4+(1,-11)); +makelabel.rt.nodot("5",z5+(0,-9)); +makelabel.rt.nodot("6",z6+(0,-9)); +for k=1 upto 6: heavy_dot z[k]; endfor; +for k=1 upto length p: heavy_dot postcontrol k-1 of p; + heavy_dot precontrol k of p; endfor +pair offset; offset=(325,0); +p:=(z4{curl2}..z2{z3-z4}..{curl2}z3) shifted offset; draw p; +drawdot z4+offset; drawdot z3+offset; +makelabel.rt.nodot("1",z1+(0,-9)+offset); +makelabel.rt.nodot("2",z2+(1,-11)+offset); +makelabel.rt.nodot("3",z3+(1,-11)+offset); +makelabel.rt.nodot("4",z4+(1,-11)+offset); +makelabel.rt.nodot("5",z5+(0,-9)+offset); +makelabel.rt.nodot("6",z6+(0,-9)+offset); +for k=1 upto 6: heavy_dot z[k]+offset; endfor; +for k=1 upto length p: heavy_dot postcontrol k-1 of p; + heavy_dot precontrol k of p; endfor +showit; +shipit; + +"Figure 3m"; % two directions specified +clear_all; +z1=(0,100); z2=(100,100); z3=(200,100); +z4=(0,0); z5=(100,0); z6=(200,0); +path p; p=z4{z2-z4}..z6{down}; +draw p; +drawdot z4; drawdot z6; +makelabel.rt.nodot("1",z1+(2,0)); +makelabel.rt.nodot("2",z2+(2,0)); +makelabel.rt.nodot("3",z3+(2,0)); +makelabel.bot.nodot(" 4",z4); +makelabel.rt.nodot("5",z5+(2,0)); +makelabel.rt.nodot(" 6",z6); +for k=1 upto 6: heavy_dot z[k]; endfor; +for k=1 upto length p: heavy_dot postcontrol k-1 of p; + heavy_dot precontrol k of p; endfor +showit; +shipit; + +"Figure 3n"; % two control points specified +clear_all; +z1=(0,100); z2=(100,100); z3=(200,100); +z4=(0,0); z5=(100,0); z6=(200,0); +path p; p=z4..controls z1 and z2..z6; +draw p; +drawdot z4; drawdot z6; +makelabel.rt.nodot("1",z1+(2,0)); +makelabel.rt.nodot("2",z2+(2,0)); +makelabel.rt.nodot("3",z3+(2,0)); +makelabel.rt.nodot(" 4",z4); +makelabel.rt.nodot("5",z5+(2,0)); +makelabel.rt.nodot(" 6",z6); +for k=1 upto 6: heavy_dot z[k]; endfor; +showit; +shipit; + +"Figure 4a"; % bean shape with elliptical pens +clear_all; +z1=(0,100); z2=(100,100); z3=(200,100); +z4=(0,0); z5=(100,0); z6=(200,0); +path p; p=z5..z4..z1..z3..z6..cycle; +pickup pencircle xscaled .8pt yscaled .2pt rotated 30; +draw p; +makelabel.bot(" 1",z1); +makelabel.bot("2",z2); +makelabel.bot(" 3",z3); +makelabel.top("4 ",z4); +makelabel.top("",z5); makelabel.top.nodot("5",z5+(0,5)); +makelabel.top("",z6); makelabel.top.nodot("6 ",z6+(1,1)); +pair offset; offset=(325,0); +pickup pencircle xscaled .8pt rotated 30; +draw p shifted offset; +makelabel.bot(" 1",z1+offset); +makelabel.bot("2",z2+offset); +makelabel.bot(" 3",z3+offset); +makelabel.top("4 ",z4+offset); +makelabel.top("",z5+offset); makelabel.top.nodot("5",z5+(0,5)+offset); +makelabel.top("",z6+offset); makelabel.top.nodot("6 ",z6+(1,1)+offset); +showit; +shipit; + +"Figure 4b"; % T of METAFONT logo +alpha:=.45; % controls bar location and similar things +beta:=.2; % controls squareness of bowls +numeric h#, xx#, yy#, o#, s#, u#, ph#, pv#; +numeric leftstemloc, barheight; + h#=6; % height of characters, in pt + xx#=0.6; % extra length of certain features, in pt + u#=4/9; % unit width, in pt + s#=0; % extra sidebar, in pt + o#=1/9; % overshoot of curves, in pt + ph#=2/3; % horizontal thickness of pen, in pt +yy#=xx#; define_whole_pixels(xx,yy); +define_pixels(s,u); +define_corrected_pixels(o); +pv#=.9ph#; define_blacker_pixels(ph,pv); +pickup pencircle xscaled ph yscaled pv; +logo_pen:=savepen; +leftstemloc:=good.x((2.5u#+s#)*pt); +barheight:=good.y(alpha*h#*pt); +def beginlogochar(suffix c)(expr n) = % code c; width is n units plus sidebars + beginchar(str c,n*u#+2s#,h#,0); pickup logo_pen enddef; + +beginlogochar(T,13); +if odd(w-ph): w:=w+1; fi % allows a symmetric stem +x1+x2=2x3=2x4=w; lft.x1=-epsilon; % I tried s-o instead; was not as good +y1=y2=y3; top.y1=h; bot.y4=-o; +draw z1..z2; draw z3..z4; +labels.rt(2,3); +makelabel.top("1",z1); +makelabel.top("4",z4); +endchar; + +"Figure 4c"; % M of METAFONT logo +alpha:=.45; % controls bar location and similar things +beta:=.2; % controls squareness of bowls +numeric h#, xx#, yy#, o#, s#, u#, ph#, pv#; +numeric leftstemloc, barheight; + h#=6; % height of characters, in pt + xx#=0.6; % extra length of certain features, in pt + u#=4/9; % unit width, in pt + s#=0; % extra sidebar, in pt + o#=1/9; % overshoot of curves, in pt + ph#=2/3; % horizontal thickness of pen, in pt +yy#=xx#; define_whole_pixels(xx,yy); +define_pixels(s,u); +define_corrected_pixels(o); +pv#=.9ph#; define_blacker_pixels(ph,pv); +pickup pencircle xscaled ph yscaled pv; +logo_pen:=savepen; +leftstemloc:=good.x((2.5u#+s#)*pt); +barheight:=good.y(alpha*h#*pt); +def beginlogochar(suffix c)(expr n) = % code c; width is n units plus sidebars + beginchar(str c,n*u#+2s#,h#,0); pickup logo_pen enddef; + +beginlogochar(M,18); +x1+x5=x2+x4=2x3=w; x1=x2=leftstemloc; +y1=y5; y2=y4; bot.y1=-o; top y2=h+o; y3=y1+yy; +draw z1--z2--z3--z4--z5; +labels.rt(3,5); +makelabel.lft("1",z1); +makelabel.bot("2",z2); +makelabel.bot("4",z4); +endchar; + +"Figure 4d"; % solid kidney bean +clear_all; +z1=(0,100); z2=(100,100); z3=(200,100); +z4=(0,0); z5=(100,0); z6=(200,0); +path p; p=z5..z4..z1..z3..z6..cycle; +fill p; +makelabel.bot(" 1",z1); +makelabel.bot("2",z2); +makelabel.bot("3 ",z3); +makelabel.top(" 4",z4); +makelabel.top("5",z5); +makelabel.top("6 ",z6); +showit; +shipit; + +"Figure 4e"; % black triangle character for exercises +beginchar(oct"170", 5pt#, 6.25pt#, 0); +t:=(2-sqrt3)/2; +x1=x2=w-x3+.5-t=round .43pt; y3=.5+floor.5h; % MANUAL font has it different! +%x1=x2=w-x3=round .43pt; y3=.5+floor.5h; +z1-z2=(z3-z2) rotated 60; +y2:=t+round(y2-t); y1:=h-y2; +fill z1--z2--z3--cycle; +labels.lft(1,2); labels.rt(3); endchar; + +"Figure 4f"; % black bean with white holes +clear_all; +z1=(0,100); z2=(100,100); z3=(200,100); +z4=(0,0); z5=(100,0); z6=(200,0); +path p; p=z5..z4..z1..z3..z6..cycle; +fill p; +unfill 1/4[z4,z2]..3/4[z4,z2]..cycle; +unfill 1/4[z6,z2]..3/4[z6,z2]..cycle; +makelabel.bot(" 1",z1); +makelabel.bot("2",z2); +makelabel.bot("3 ",z3); +makelabel.top(" 4",z4); +makelabel.top("5",z5); +makelabel.top("6 ",z6); +showit; +shipit; + +"Figure 4g"; % black bean with skewed interior cutout +clear_all; +z1=(0,100); z2=(100,100); z3=(200,100); +z4=(0,0); z5=(100,0); z6=(200,0); +path p; p=z5..z4..z1..z3..z6..cycle; +fill p; +z0=(.8[x1,x2],.5[y1,y4]); +for k=1 upto 6: z[k]'=.2[z[k],z0]; endfor +unfill z5'..z4'..z1'..z3'..z6'..cycle; +makelabel.bot("0",z0); +makelabel.top("1 ",z1); +makelabel.top("2",z2); +makelabel.top(" 3",z3); +makelabel.bot("4 ",z4); +makelabel.bot("5",z5); +makelabel.bot(" 6",z6); +makelabel.bot(" 1'",z1'); +makelabel.bot(" 2'",z2'); +makelabel.bot("3' ",z3'); +makelabel.top(" 4'",z4'); +makelabel.top("5'",z5'); +makelabel.top("6' ",z6'); +showit; +shipit; + +"Figure 4h"; % sample penstroke +clear_all; +penpos1(1.2pt,30); penpos2(1.0pt,45); penpos3(0.8pt,90); +z1=(0,2pt); z2=(4pt,0); x3=9pt; y3l=y2r; +penstroke z1e..z2e{right}..z3e{right}; +labels.top(2r,3r); +labels.bot(2l,3l); +labels.rt(3,1r); +labels.lft(1l,2); +makelabel.top("1 ",z1); +showit; +shipit; + +"Figure 4i"; % cyclic penstroke example +clear_all; +d:=25; +penpos1(d,30); +penpos2(d,60); +penpos3(d,210); +penpos4(d,240); +y1=.51y2r; y2r=175; y3=.49y2r; y4r=0; +x1r=175; x2=x4=.5x1r; x3r=0; +penstroke z1e{up}..z2e{left}..z3e{down}..z4e{right}..cycle; +labels.lft(1l,2,3r,4); +labels.rt(1r,3l); +labels.top(2r,3,4l); +labels.bot(1,2l,4r); +showit; +shipit; + +"Figure 4j"; % I from IOnian font +clear_all; +em#:=10pt#; cap#:=7pt#; +bar#:=.8pt#; +stem#:=.9pt#; +thin#:=.8pt#; +thick#:=1pt#; +define_pixels(em,cap); +define_blacker_pixels(thin,thick,bar,stem); +beginchar(27,.35em#,cap#,0); % "The letter I"; \IOI=27 + penpos1(stem,15); penpos2(.9stem,12); penpos3(stem,10); + x1=x2=x3=.5w; y1=h; y2=.55h; y3=0; + x2l:=1/6[x2l,x2]; + penstroke z1e..z2e{down}..z3e; +labels.top(1,2,1r); +labels.lft(2l); +labels.rt(2r); +labels.bot(3,3l); +makelabel("",z1l); makelabel("",z3r); +makelabel.lft.nodot("1l",z1l-(0,2)); +makelabel.rt.nodot("3r",z3r+(0,2)); +endchar; + +"Figure 4k"; % fixed pens versus penstrokes +clear_all; +z1=(0,0); z2=(150,0); +pickup pencircle xscaled 0.8pt rotated 25; +draw z1..z2..cycle; +labels.lft(1,2); +clearxy; +pair offset; offset=(250,0); +penpos1(0.8pt,25); penpos2(0.8pt,25); +z1=(0,0)+offset; z2=(150,0)+offset; +penstroke z1e..z2e..cycle; +labels.lft(1l,2l); +labels.rt(1r,2r); +labels.bot(1,2); +showit; +shipit; + +"Figure 4l"; % hex symbol with pen-pressure adjustments +%b#:=1.0pt#; define_blacker_pixels(b); % FOR INITIAL TESTS ONLY +%beginchar(0,500/36pt#,250/36pt#,0); % that's magnified 2.5 as in the type +b#:=0.4pt#; define_blacker_pixels(b); +beginchar(0,200/36pt#,100/36pt#,0); +pickup pencircle scaled b; +w:=2good.x .5w; +top z1=(0,h); top z2=(.5w,h); top z3=(w,h); +bot z4=(0,0); bot z5=(.5w,0); bot z6=(w,0); +draw z2..z5; +for k=1 upto 6: drawdot z[k]; endfor +z1'=.25[z1,z6]; z6'=.75[z1,z6]; +z3'=.25[z3,z4]; z4'=.75[z3,z4]; + theta1:=angle(z6-z1)+90; + theta3:=angle(z4-z3)+90; +penpos1'(b,theta1); penpos6'(b,theta1); penpos7(.6b,theta1); +penpos3'(b,theta3); penpos4'(b,theta3); penpos8(.6b,theta3); +z7=z8=.5[z1,z6]; +draw z1..z1'; draw z6'..z6; + penstroke z1'e{z6'-z1'}..z7e..{z6'-z1'}z6'e; +draw z3..z3'; draw z4'..z4; + penstroke z3'e{z4'-z3'}..z8e..{z4'-z3'}z4'e; +labels.top(1'r,3'l,4'l,6'r); +labels.bot(1'l,3'r,4'r,6'l); +forsuffixes $=1',3',4',6': makelabel("",z$); endfor +makelabel.lft("1 ",z1); +makelabel.lft("2 ",z2); +makelabel.rt(" 3",z3); +makelabel.lft("4 ",z4); +makelabel.lft("5 ",z5); +makelabel.rt(" 6",z6); +makelabel.top("8l ",z8l); +makelabel.top(" 7r",z7r); +makelabel.bot("7l ",z7l); +makelabel.bot(" 8r",z8r); +endchar; + +"Figure 4m"; % same, cut sharp at the terminals, and inside the box +%b#:=1.0pt#; define_blacker_pixels(b); % FOR INITIAL TESTS ONLY +%beginchar(0,500/36pt#,250/36pt#,0); % that's magnified 2.5 as in the type +b#:=0.4pt#; define_blacker_pixels(b); +beginchar(0,200/36pt#,100/36pt#,0); +pickup pencircle scaled b; +w:=2good.x .5w; +x1l=x4l=0;x2=x5=.5w;x3r=x6r=w; +y1r=y2=y3l=h; y4r=y5=y6l=0; +z1'=.25[z1,z6]; z6'=.75[z1,z6]; theta1:=angle(w,-h)+90; +z3'=.25[z3,z4]; z4'=.75[z3,z4]; theta3:=angle(-w,-h)+90; +z7=z8=.5[z1,z6]; +penpos1(b,theta1); penpos6(b,theta1); +penpos1'(b,theta1); penpos6'(b,theta1); penpos7(.6b,theta1); +penpos3(b,theta3); penpos4(b,theta3); +penpos3'(b,theta3); penpos4'(b,theta3); penpos8(.6b,theta3); +penstroke z1e..z1'e{z6'-z1'}..z7e..{z6'-z1'}z6'e..z6e; +penpos2(b,0); penpos5(b,0); penstroke z2e..z5e; +penstroke z3e..z3'e{z4'-z3'}..z8e..{z4'-z3'}z4'e..z4e; +penlabels(1,1',3,3',4,4',6,6'); +labels.top(1r,1'r,2,3l,3'l,4l,4'l,6r,6'r); +labels.bot(1l,1'l,3r,3'r,4r,4'r,5,6l,6'l); +labels.lft(2l,5l); +labels.rt(2r,5r); +forsuffixes $=1,1',3,3',4,4',6,6': makelabel("",z$); endfor +makelabel.top("8l ",z8l); +makelabel.top(" 7r",z7r); +makelabel.bot("7l ",z7l); +makelabel.bot(" 8r",z8r); +endchar; + +"Figure A5a"; % S from IOnian font +clear_all; +em#:=10pt#; cap#:=7pt#; +slab#:=.8pt#; +stem#:=.9pt#; +thin#:=.8pt#; +thick#:=5/6pt#; + o#:=1/5pt#; +define_corrected_pixels(o); +define_pixels(em,cap); +define_blacker_pixels(thin,thick,slab,stem); +beginchar(25,5/9em#,cap#,0); % "The letter S"; /IOS=25 +penpos1(slab,70); +penpos2(.5slab,80); +penpos3(.5[slab,thick],200); +penpos5(.5[slab,thick],210); +penpos6(.7slab,80); +penpos7(.25[slab,thick],72); +x1=x5; y1r=.94h+o; +x2=x4=x6=.5w; y2r=h+o; y4=.54h; y6l=-o; +x3r=.04em; y3=.5[y4,y2]; +x5l=w-.03em; y5=.5[y4,y6]; +.5[x7l,x7]=.04em; y7l=.12h-o; +path trial; trial=z3{down}..z4..{down}z5; +pair dz; dz=direction 1 of trial; +penpos4(thick,angle dz-90); +penstroke z1e..z2e{left}..z3e{down}..z4e{dz}..z5e{down}..z6e{left}..z7e; +labels.lft(2,3r,5r,6,7); +labels.rt(1,3l,4,5l); +labels.top(1r,2r,3,4l,5,6r,7r); +labels.bot(1l,2l,4r,6l,7l); +endchar; + +"Figure 8a"; % twenty points on p2 +clear_all; +path p[]; p1=(0,0)..(3,3); p2=(0,0)..(3,3)..cycle; +transform t; t=identity scaled 60 shifted (50,0); +pair zz; +z=(1.5,1.5) transformed t; +pickup pencircle; +draw p2 transformed t; +for n=0 upto 19: zz:=point n/10 of p2 transformed t; + heavy_dot zz; + makelabel.top.nodot(decimal(n/10) if n mod 10=0:&".0" fi, +.09[zz,z] shifted(.05xpart(z-zz),-6.5)); endfor +%.1[zz,z] shifted(.1xpart(z-zz),-8)); endfor +shipit; +showit; + +"Figure 11a"; % E of METAFONT logo +alpha:=.45; % controls bar location and similar things +beta:=.2; % controls squareness of bowls +numeric h#, xx#, yy#, o#, s#, u#, ph#, pv#; +numeric leftstemloc, barheight; + h#=6; % height of characters, in pt + xx#=0.6; % extra length of certain features, in pt + u#=4/9; % unit width, in pt + s#=0; % extra sidebar, in pt + o#=1/9; % overshoot of curves, in pt + ph#=2/3; % horizontal thickness of pen, in pt +yy#=xx#; define_whole_pixels(xx,yy); +define_pixels(s,u); +define_corrected_pixels(o); +pv#=.9ph#; define_blacker_pixels(ph,pv); +pickup pencircle xscaled ph yscaled pv; +logo_pen:=savepen; +leftstemloc:=good.x((2.5u#+s#)*pt); +barheight:=good.y(alpha*h#*pt); +def beginlogochar(suffix c)(expr n) = % code c; width is n units plus sidebars + beginchar(str c,n*u#+2s#,h#,0); pickup logo_pen enddef; + +beginlogochar(E,14); +x1=x2=x3=leftstemloc; x4=x6=w-x1+o; x5=x4-xx; +y1=y6; y2=y5; y3=y4; bot.y1=0; top.y3=h; y2=barheight; +draw z6--z1--z3--z4; draw z2..z5; +labels.rt(1,2,3); +labels.lft(4,5,6); +endchar; + +"Figure 12a"; % cmr10 left parenthesis +u#:=20/36pt#; +tiny#:=0; +axis#:=90/36pt#; +hheight#:=250/36pt#; +border#:=20/36pt#; +hair#:=8/36pt#; +thin#:=9/36pt#; +thick#:=25/36pt#; +slant:=0; +rulethickness:=.4pt#; + +font_setup; +beginchar("(",7u#, hheight#+border#, hheight#+border#-2axis#); +italcorr (hheight#+border#)*slant-.5u#; +pickup tinypen; +penpos1(hair-tiny,0); penpos3(hair-tiny,0); +penpos2(.75[thin,thick]-tiny,0); +rt x1r = rt x3r = w-u; lft x2l = x1-4u; +top y1=h; y2=.5[y1,y3]=axis; +filldraw z1l{curl 4}..z2l..{curl 4}z3l-- + z3r{curl 4}..z2r..{curl 4}z1r--cycle; +labels.top(3,2); +labels.bot(1); +labels.lft(1l,2l,3l); +labels.rt(1r,2r,3r); +endchar; + +"Figure 12b"; % cmbx10 left parenthesis +u#:=23/36pt#; +tiny#:=0; +axis#:=90/36pt#; +hheight#:=250/36pt#; +border#:=20/36pt#; +hair#:=13/36pt#; +thin#:=17/36pt#; +thick#:=41/36pt#; +slant:=0; + +font_setup; +beginchar("(",7u#, hheight#+border#, hheight#+border#-2axis#); +italcorr (hheight#+border#)*slant-.5u#; +pickup tinypen; +penpos1(hair-tiny,0); penpos3(hair-tiny,0); +penpos2(.75[thin,thick]-tiny,0); +rt x1r = rt x3r = w-u; lft x2l = x1-4u; +top y1=h; y2=.5[y1,y3]=axis; +filldraw z1l{curl 4}..z2l..{curl 4}z3l-- + z3r{curl 4}..z2r..{curl 4}z1r--cycle; +labels.top(3,2); +labels.bot(1); +labels.lft(1l,2l,3l); +labels.rt(1r,2r,3r); +endchar; + +"Figure 12c"; % cmvtt10 left parenthesis +u#:=21/36pt#; +tiny#:=22/36pt#; +axis#:=110/36pt#; +hheight#:=220/36pt#; +border#:=30/36pt#; +hair#:=22/36pt#; +thin#:=25/36pt#; +thick#:=25/36pt#; +slant:=0; + +font_setup; +beginchar("(",7u#, hheight#+border#, hheight#+border#-2axis#); +italcorr (hheight#+border#)*slant-.5u#; +pickup tinypen; +penpos1(hair-tiny,0); penpos3(hair-tiny,0); +penpos2(.75[thin,thick]-tiny,0); +rt x1r = rt x3r = w-u; lft x2l = x1-4u; +top y1=h; y2=.5[y1,y3]=axis; +filldraw z1l{curl 4}..z2l..{curl 4}z3l-- + z3r{curl 4}..z2r..{curl 4}z1r--cycle; +labels.top(3,2); +labels.bot(1); +labels.lft(1l,2l,3l); +labels.rt(1r,2r,3r); +endchar; + +"Figure 12d"; % cmssdc10 left parenthesis +u#:=19/36pt#; +tiny#:=8/36pt#; +axis#:=95/36pt#; +hheight#:=250/36pt#; +border#:=20/36pt#; +hair#:=23/36pt#; +thin#:=40/36pt#; +thick#:=40/36pt#; +slant:=0; + +font_setup; +beginchar("(",7u#, hheight#+border#, hheight#+border#-2axis#); +italcorr (hheight#+border#)*slant-.5u#; +pickup tinypen; +penpos1(hair-tiny,0); penpos3(hair-tiny,0); +penpos2(.75[thin,thick]-tiny,0); +rt x1r = rt x3r = w-u; lft x2l = x1-4u; +top y1=h; y2=.5[y1,y3]=axis; +filldraw z1l{curl 4}..z2l..{curl 4}z3l-- + z3r{curl 4}..z2r..{curl 4}z1r--cycle; +labels.top(3,2); +labels.bot(1); +labels.lft(1l,2l,3l); +labels.rt(1r,2r,3r); +endchar; + +"Figure 12e"; % cmti10 left parenthesis +u#:=18.4/36pt#; +tiny#:=7/36; +axis#:=90/36pt#; +hheight#:=250/36pt#; +border#:=20/36pt#; +hair#:=8/36pt#; +thin#:=11/36pt#; +thick#:=23/36pt#; +slant:=.25; + +font_setup; +beginchar("(",7u#, hheight#+border#, hheight#+border#-2axis#); +italcorr (hheight#+border#)*slant-.5u#; +pickup tinypen; +penpos1(hair-tiny,0); penpos3(hair-tiny,0); +penpos2(.75[thin,thick]-tiny,0); +rt x1r = rt x3r = w-u; lft x2l = x1-4u; +top y1=h; y2=.5[y1,y3]=axis; +filldraw z1l{curl 4}..z2l..{curl 4}z3l-- + z3r{curl 4}..z2r..{curl 4}z1r--cycle; +labels.top(3,2); +labels.bot(1); +labels.lft(1l,2l,3l); +labels.rt(1r,2r,3r); +endchar; +currenttransform:=identity yscaled aspect_ratio; + +"Figure 12f"; % Dangerous bend symbol +def font_setup= +define_pixels(u,tiny,axis,hheight,border); +define_blacker_pixels(hair,thin,thick,rulethickness); +pickup if tiny<.5: nullpen else: pencircle scaled tiny fi; +tinypen:=savepen; +currenttransform:=identity slanted slant; +enddef; + +% typical cmr10 parameters +u#:=20/36pt#; +tiny#:=0; +axis#:=90/36pt#; +hheight#:=250/36pt#; +border#:=20/36pt#; +hair#:=8/36pt#; +thin#:=9/36pt#; +thick#:=25/36pt#; +fixwidth:=0; +slant:=0; +rulethickness#:=.4pt#; + +baselinedistance#:=11pt#; +heavyline#:=50/36pt#; +font_setup; +define_whole_pixels(baselinedistance); +define_blacker_pixels(heavyline); + +beginchar(127,25u#,hheight#+border#,0); +pickup pencircle scaled rulethickness; +top y1=25/27h; lft x4=0; +x1+x1=x1a+x1b=x4b+x2a=x4+x2=x4a+x2b=x3b+x3a=x3+x3=w; +x4a=x4b=x4+u; x3b=x1a=x1-2u; +y4+y4=y4a+y4b=y3b+y1a=y3+y1=y3a+y1b=y2b+y2a=y2+y2=0; +y1a=y1b=y1-2/27h; y4b=y2a=y4+4/27h; +draw z1a..z1..z1b---z2a..z2..z2b--- + z3a..z3..z3b---z4a..z4..z4b---cycle; % signboard +x10=x11=x12=x13=good.x(.5w-u); x14=x15=x16=x17=w-x10; +y10=y14=28/27h+epsilon; bot y13=-baselinedistance; +z11=(z10..z13) intersectionpoint (z1a{z1a-z4b}..z1{right}); +y15=y11; y16=y12=-y11; y17=y20=y21=y13; +draw z11--z10--z14--z15; draw z12--z13; draw z16--z17; % signpost +x20=w-x21; x21-x20=16u; draw z20--z21; % ground level +x36=w-x31; x36-x31=8u; x32=x33=x36; x31=x34=x35; +y31=-y36=12/27h; y32=-y35=9/27h; y33=-y34=3/27h; +pickup pencircle scaled heavyline; +draw z32{z32-z31}..z33---z34..z35{z36-z35}; % the dangerous bend +pickup penrazor xscaled heavyline rotated (angle(z32-z31)+90); +draw z31--z32; draw z35--z36; % upper and lower bars +labels.top(11,15,2a,4b,4,2,32,34); +labels.bot(10,14,2b,4a,33,35); +labels.lft(1a,3b,12,13,21,36); +labels.rt(1,1b,3a,3,16,20,17,31); +endchar; + +"Figure 13a"; % Possible cube +clear_all; +fudge_factor:=1/2; +s#:=5pt#*fudge_factor; define_pixels(s); % side of the square +z1=(-epsilon,-epsilon); z2=(s+epsilon,-epsilon); + z3=(-epsilon,s+epsilon); z4=(s+epsilon,s+epsilon); +for k=1 upto 4: z[k+4]=z[k]+(2/3s,1/3s); endfor +pickup pencircle scaled (.4pt*fudge_factor); +draw z5--z6--z8--z7--cycle; +pickup pencircle scaled (1.6pt*fudge_factor); +erase draw z2--z4--z3; +pickup pencircle scaled (.4pt*fudge_factor); +draw z1--z2--z4--z3--cycle; +for k=1 upto 4: draw z[k]--z[k+4]; endfor +labels.top(1,2,5,6); +labels.bot(3,4,7,8); +showit; +shipit; + +"Figure 14a"; % El Palo Alto +begingroup save flex; clear_all; +def flex(text t) = % puts dots into normal flex + hide(n_:=0; + for z=t: z_[incr n_]:=z; makelabel("",z); endfor + dz_:=z_[n_]-z_1) + z_1 for k=2 upto n_-1: ...z_[k]{dz_} endfor ...z_[n_] enddef; + +def grid= proofoffset (30,0); + for y:=0 step 50 until 650: proofrule((-110,y),(110,y)); + makelabel.lft.nodot(str[y],(100,y+5)); + endfor; + for x:=-100 step 50 until 100: proofrule((x,-10),(x,660));endfor enddef; + +path branch[],trunk; + +branch1= + flex((0,660),(-9,633),(-22,610)) + &flex((-22,610),(-3,622),(17,617)) + &flex((17,617),(7,637),(0,660)) + &cycle; + +branch2= + flex((30,570),(10,590),(-1,616)) + &flex((-1,616),(-11,592),(-29,576),(-32,562)) + &flex((-32,562),(-10,577),(30,570)) + &cycle; + +branch3= + flex((-1,570),(-17,550),(-40,535)) + &flex((-40,535),(-45,510),(-60,477)) + &flex((-60,477),(-20,505),(40,512)) + &flex((40,512),(31,532),(8,550),(-1,570)) + &cycle; + +branch4= + flex((0,509),(-14,492),(-32,481)) + &flex((-32,481),(-42,455),(-62,430)) + &flex((-62,430),(-20,450),(42,448)) + &flex((42,448),(38,465),(4,493),(0,509)) + &cycle; + +branch5= + flex((-22,470),(-23,435),(-44,410)) + &flex((-44,410),(-10,421),(35,420)) + &flex((35,420),(15,455),(-22,470)) + &cycle; + +branch6= + flex((18,375),(9,396),(5,420)) + &flex((5,420),(-5,410),(-50,375),(-50,350)) + &flex((-50,350),(-25,375),(18,375)) + &cycle; + +branch7= + flex((0,400),(-13,373),(-30,350)) + &flex((-30,350),(0,358),(30,350)) + &flex((30,350),(13,373),(0,400)) + &cycle; + +branch8= + flex((50,275),(45,310),(3,360)) + &flex((3,360),(-20,330),(-70,300),(-100,266)) + &flex((-100,266),(-75,278),(-60,266)) + &flex((-60,266),(0,310),(50,275)) + &cycle; + +branch9= + flex((10,333),(-15,290),(-43,256)) + &flex((-43,256),(8,262),(58,245)) + &flex((58,245),(34,275),(10,333)) + &cycle; + +branch10= + flex((8,262),(-21,249),(-55,240)) + &flex((-55,240),(-51,232),(-53,220)) + &flex((-53,220),(-28,229),(27,235)) + &flex((27,235),(16,246),(8,262)) + &cycle; + +branch11= + flex((0,250),(-25,220),(-70,195)) + &flex((-70,195),(-78,180),(-90,170)) + &flex((-90,170),(-5,188),(74,183)) + &flex((74,183),(34,214),(0,250)) + &cycle; + +branch12= + flex((8,215),(-35,175),(-72,155)) + &flex((-72,155),(-75,130),(-92,110),(-95,88)) + &flex((-95,88),(-65,117),(-54,104)) + &flex((-54,104),(10,151),(35,142))..flex((42,130),(60,123),(76,124)) + &flex((76,124),(62,146),(26,180),(8,215))&cycle; + +trunk=(0,660)---(-12,70)..{curl 5}(-28,-8) + &flex((-28,-8),(-16,-4),(-10,-11)) + &flex((-10,-11),(0,-5),(14,-10)) + &flex((14,-10),(20,-6),(29,-11)) + &(29,-11){curl 4}..(10,100)---cycle; + +makelabel("",(-12,70)); +makelabel("",(10,100)); + +pickup pencircle scaled 2; +draw trunk; +for n=1 upto 12: draw branch[n]; endfor +grid; +showit;shipit; +endgroup; + +"Figure 14b"; % Detail of one branch +clear_all; +pair zz[]; +zz1=(0,509); +zz2=(-14,492); +zz3=(-32,481); +zz4=(-42,455); +zz5=(-62,430); +zz6=(-20,450); +zz7=(42,448); +zz8=(38,465); +zz9=(4,493); +for n=1 upto 9: z[n]=(zz[n]+(62,-430)) scaled 2.5; endfor +pickup pencircle; +filldraw flex(z1,z2,z3)&flex(z3,z4,z5) + &flex(z5,z6,z7)&flex(z7,z8,z9,z1)&cycle; +labels.lft(2,3,4,5); +labels.rt(1,7,8,9); +labels.bot(6); +showit; shipit; + +"Figure 14c"; % superellipses +clear_all; +w:=100; h:=150; +pickup pencircle xscaled 0.7pt yscaled 0.2pt rotated 30; +forsuffixes ss=65,70,75,80: s:=ss/100; +draw superellipse((w,.5h),(.5w,h),(0,.5h),(.5w,0),s) shifted (150/.05(s-.65),0); +makelabel.top.nodot("."&str ss,(.5w,.45h) shifted (150/.05(s-.65),0)); +endfor +showit; +shipit; + +"Figure 14d"; % demo of joinery +clear_all; +pickup standardpen; +z0=(0,100); z1=(50,0); z2=(180,0); +for n=3 upto 9: z[n]=z[n-3]+(200,0); endfor +draw z0..z1---z2...{up}z3 + & z3..z4--z5...{up}z6 + & z6...z7---z8..{up}z9; +makelabel.bot("0 ",z0); +makelabel.bot("6 ",z6); +labels.bot(3,9); +labels.rt(1,4,7); +labels.lft(2,5,8); +showit; +shipit; + +"Figure 14e"; % JofA logo +beginchar("A",29mm#*.22,25mm#*.22,0); +interim autorounding:=0; interim smoothing:=0; +if odd(w-h): h:=h-1; fi +thick#:=2mm#*.22; thin#:=5/4mm#*.22; +define_whole_blacker_pixels(thick,thin); +forsuffixes @=a,b,c: transform @; + forsuffixes e=l,r: path @e,@'e; numeric t@[]e; endfor endfor +penpos1(thick,0); penpos2(thick,90); penpos3(thick,180); penpos4(thick,270); +penpos5(thick,0); penpos6(thick,90); penpos7(thick,180); penpos8(thick,270); +x2=x4=x6=x8=.5[x5,x7]=.5w; x1r=w; x3r=0; x5-x7=y6-y8; +y1=y3=y5=y7=.5[y6,y8]=.5h; y2r=h; y4r=0; y6r=round.75h; +forsuffixes e=l,r: a.e=b'e=c'e=superellipse(z1e,z2e,z3e,z4e,.75); + a'e=b.e=c.e=superellipse(z5e,z6e,z7e,z8e,.72); endfor +penpos.a1(thin,0); penpos.a5(whatever,-90); penpos.a9(thin,180); +x.a1l-x.a9l=1/3(x5l-x7l); x.a5=.5w; y.a1=y.a9; y.a5r=4/7h; +x.a3l=x.a1l; x.a3r=x.a1r; x.a4r=1/6[x.a3r,x1l]; x0=.5w; y0=.52h; +x.a6l+x.a4l=x.a6r+x.a4r=x.a7l+x.a3l=x.a7r+x.a3r=x.a9+x.a1=w; +y.a3r=y.a4r=y.a6r=y.a7r=.2[y2l,y0]; y.a3l=y.a4l=y.a6l=y.a7l=y.a3r-thin; +z.a4l=z.a4r+(thin,0)rotated(angle(z.a4r-z.a5r)+90) + +whatever*(z.a4r-z.a5r); z.a4l-z.a5l=whatever*(z.a4r-z.a5r); +z=a.r intersectionpoint (z0--(w,0)); y.a1-y.a5=length(z-z0); +b=identity shifted(0,y0-y.a1)rotatedaround(z0,90-angle(z0-(w,0))); +c=b reflectedabout (z2,z4); +for n=1,3,4,5,6,7,9: forsuffixes e=l,,r: forsuffixes @=b,c: + z@[n]e=z.a[n]e transformed @; endfor endfor endfor +forsuffixes e=l,r: forsuffixes @=a,b,c: + z@2e=@r intersectionpoint (z@1e--z@3e); + z@8e=@r intersectionpoint (z@9e--z@7e); + t@1e=xpart(@e intersectiontimes (z@1l--z@3l)); + t@9e=xpart(@e intersectiontimes (z@9l--z@7l)); + t@4e=xpart(@'e intersectiontimes (z@5r--z@4l)); + t@6e=xpart(@'e intersectiontimes (z@5r--z@6l)); endfor endfor +penstroke subpath(t.a9e,t.b6e) of a.e; +penstroke subpath(t.b4e,t.c4e) of b'e; +penstroke subpath(t.c6e,t.a1e+8) of c'e; +penstroke subpath(t.a6e,t.b9e) of a'e; +penstroke subpath(t.b1e,t.c1e) of b.e; +penstroke subpath(t.c9e,t.a4e+8) of c.e; +forsuffixes @=a,b,c: + penstroke z@2e--z@3e--z@4e--z@5e--z@6e--z@7e--z@8e; endfor +labels.lft(0,1l,3r,3,5l,7r,7,a1l,a2l,a3l,a6l, + a6r,a8r,a9r,b2l,b5,b5r,b9,c1,c2r,c5l); +labels.rt(1,1r,3l,5,5r,7l,a1r,a2r,a4l,a4r,a7l, + a9l,b1,b2r,b5l,c2l,c5,c5r,c9); +labels.top(2r,2,2l,4l,6r,6,6l,8l,a3r,a7r,a8l, + b1l,b3l,b3r,b6r,b6l,b8r,b9r,c1l,c3l,c3r,c6r,c6l,c8r,c9r); +labels.bot(2r,2,2l,4,4r,8,8r,a1,a5l,a5,a5r,a9, + b1r,b4l,b4r,b7l,b7r,b8l,c1r,c4l,c4r,c7l,c7r,c8l); +makelabel("",z.b9l); +makelabel("",z.c9l); +makelabel.lft.nodot("b9l",z.b9l-(0,3)); +makelabel.rt.nodot("c9l",z.c9l-(0,3)); +endchar; + +"Figure 15a"; % four u's +beginchar("4",11pt#,11pt#,0); +pickup pencircle scaled 3/4pt yscaled 1/3 rotated 30; +save t; transform t; +t=identity rotatedaround((.5w,.5h),-90); +x2=.35w; x3=good.x .6w; +y2=good.y .1h; top y3=round .4h+eps; +save p; path p; p=z2{right}...{up}z3; +top z1=point .5 of p transformed t; +draw z1...z2{right}...{up}z3; +addto currentpicture also currentpicture transformed t; +addto currentpicture also currentpicture transformed(t transformed t); +labels.bot(1,3); labels.rt(2); endchar; + +"Figure 16a"; % circular pen polygon +clear_all; +path p; +p=makepath(pencircle scaled 20) scaled 10 shifted (110,110); +if length p<>32: error; fi +fill p; +for k=1 upto length p: heavy_dot point k of p; endfor +for x=0 step 10 until 220: proofrule((x,0),(x,220)); endfor +for y=0 step 10 until 220: proofrule((0,y),(220,y)); endfor +proofrulethickness .8; +proofrule ((0,110),(220,110)); proofrule ((110,0),(110,220)); +makelabel.bot.nodot("ignore",(160,-10)); % kludge for GFtoEPS! +showit; +shipit; + +"Figure 16b"; % elliptical pen polygon +clear_all; +path p; +p=makepath(pencircle xscaled 30 yscaled 20) scaled 10 shifted (160,110); +if length p<>40: error; fi +fill p; +for k=1 upto length p: heavy_dot point k of p; endfor +for x=0 step 10 until 320: proofrule((x,0),(x,220)); endfor +for y=0 step 10 until 220: proofrule((0,y),(320,y)); endfor +proofrulethickness .8; +proofrule ((0,110),(320,110)); proofrule ((160,0),(160,220)); +makelabel.bot.nodot("ignore",(160,-10)); % kludge for GFtoEPS! +showit; +shipit; + +"Figure 16c"; % elliptical pen hexagon +clear_all; +path p; +p=makepath((pencircle xscaled 30) yscaled 20) scaled 10 shifted (160,110); +if length p<>6: error; fi +fill p; +for k=1 upto length p: heavy_dot point k of p; endfor +for x=0 step 10 until 320: proofrule((x,0),(x,220)); endfor +for y=0 step 10 until 220: proofrule((0,y),(320,y)); endfor +proofrulethickness .8; +proofrule ((0,110),(320,110)); proofrule ((160,0),(160,220)); +makelabel.bot.nodot("ignore",(160,-10)); % kludge for GFtoEPS! +showit; +shipit; + +"Figure 16d"; % cutoff version of Figure 3n +clear_all; +z1=(0,100); z2=(100,100); z3=(200,100); +z4=(0,0); z5=(100,0); z6=(200,0); +path p; p=z4..controls z1 and z2..z6; +cutdraw p; +makelabel.rt.nodot("1",z1+(2,0)); +makelabel.rt.nodot("2",z2+(2,0)); +makelabel.rt.nodot("3",z3+(2,0)); +makelabel.rt.nodot(" 4",z4); +makelabel.rt.nodot("5",z5+(2,0)); +makelabel.rt.nodot(" 6",z6); +for k=1 upto 6: heavy_dot z[k]; endfor; +showit; +shipit; + +"Figure 16e"; % cutoff version of Figure 4b +alpha:=.45; % controls bar location and similar things +beta:=.2; % controls squareness of bowls +numeric h#, xx#, yy#, o#, s#, u#, ph#, pv#; +numeric leftstemloc, barheight; + h#=6; % height of characters, in pt + xx#=0.6; % extra length of certain features, in pt + u#=4/9; % unit width, in pt + s#=0; % extra sidebar, in pt + o#=1/9; % overshoot of curves, in pt + ph#=2/3; % horizontal thickness of pen, in pt +yy#=xx#; define_whole_pixels(xx,yy); +define_pixels(s,u); +define_corrected_pixels(o); +pv#=.9ph#; define_blacker_pixels(ph,pv); +pickup pencircle xscaled ph yscaled pv; +logo_pen:=savepen; +leftstemloc:=good.x((2.5u#+s#)*pt); +barheight:=good.y(alpha*h#*pt); +def beginlogochar(suffix c)(expr n) = % code c; width is n units plus sidebars + beginchar(str c,n*u#+2s#,h#,0); pickup logo_pen enddef; + +beginlogochar(T,13); +if odd(w-ph): w:=w+1; fi % allows a symmetric stem +x1+x2=2x3=2x4=w; lft.x1=0; +y1=y2=y3; top.y1=h; y4=0; +draw z1--z2; +cutoff(z1,170); +cutoff(z2,-10); +draw z3--z4; +cutoff(z4,-80); +labels.rt(1); +labels.lft(2); +labels.bot(3); +makelabel.top("4",z4); +endchar; + +"Figure 16f"; % tilde with pencircle +clear_all; +pickup pencircle xscaled .8pt yscaled .2pt rotated 50; +z1=(0,0); z4=(200,30); +z2-z1=z4-z3=whatever*dir 50; +y2-y1=3(y4-y1); +draw z1..controls z2 and z3..z4; +makelabel.lft("1 ",z1); +makelabel.rt(" 4",z4); +showit; +shipit; + +"Figure 16g"; % tilde with pensquare +clear_all; +pickup pensquare xscaled .8pt yscaled .2pt rotated 50; +z1=(0,0); z4=(200,30); +z2-z1=z4-z3=whatever*dir 50; +y2-y1=3(y4-y1); +draw z1..controls z2 and z3..z4; +makelabel.lft("1 ",z1); +makelabel.rt(" 4",z4); +showit; +shipit; + +"Figure 16h"; % fancy serif with pencircle +clear_all; +pickup pencircle xscaled .8pt yscaled .2pt rotated 20; +z1=(20,175); bot z3=(0,0); +z4=(50,0); z6=(25,175); +x2=x1; z2=z3+whatever*dir 20; +x5=x6; z5=z4+whatever*dir -20; +pair dishing; dishing=(8,0) rotated 20; +filldraw z1..controls z2..z3 +--(flex(z3,.5[z3,z4]+dishing,z4))shifted(0,-epsilon) +-- z4..controls z5..z6--cycle; +showit; +labels.lft(1,2,3); +labels.rt(4,5,6); +shipit; + +"Figure 16i"; % fancy serif with pensquare +clear_all; +pickup pensquare xscaled .8pt yscaled .2pt rotated 20; +z1=(20,175); bot z3=(0,0); +z4=(50,0); z6=(25,175); +x2=x1; z2=z3+whatever*dir 20; +x5=x6; z5=z4+whatever*dir -20; +pair dishing; dishing=(8,0) rotated 20; +filldraw z1..controls z2..z3 +--(flex(z3,.5[z3,z4]+dishing,z4))shifted(0,-epsilon) +-- z4..controls z5..z6--cycle; +showit; +labels.lft(1,2,3); +labels.rt(4,5,6); +shipit; + +"Figure 18a"; % O of METAFONT logo +alpha:=.45; % controls bar location and similar things +beta:=.2; % controls squareness of bowls +numeric h#, xx#, yy#, o#, s#, u#, ph#, pv#; +numeric leftstemloc, barheight; + h#=6; % height of characters, in pt + xx#=0.6; % extra length of certain features, in pt + u#=4/9; % unit width, in pt + s#=0; % extra sidebar, in pt + o#=1/9; % overshoot of curves, in pt + ph#=2/3; % horizontal thickness of pen, in pt +yy#=xx#; define_whole_pixels(xx,yy); +define_pixels(s,u); +define_corrected_pixels(o); +pv#=.9ph#; define_blacker_pixels(ph,pv); +pickup pencircle xscaled ph yscaled pv; +logo_pen:=savepen; +leftstemloc:=good.x((2.5u#+s#)*pt); +barheight:=good.y(alpha*h#*pt); +def beginlogochar(expr c)(expr n) = % code c; width is n units plus sidebars + beginchar(c,n*u#+2s#,h#,0); pickup logo_pen enddef; + +def super_half(suffix i,j,k) = + draw z.i{0,y.j-y.i} + ... (.8[x.j,x.i],.8[y.i,y.j]){z.j-z.i} + ... z.j{x.k-x.i,0} + ... (.8[x.j,x.k],.8[y.k,y.j]){z.k-z.j} + ... z.k{0,y.k-y.j} enddef; + +beginlogochar("O",15); +x1=x4=.5w; top y1=h+o; bot y4=-o; +x2=w-x3=good.x(1.5u+s); +y2=y3=barheight; +super_half(2,1,3); super_half(3,4,2); +labels.lft(2); labels.rt(1,3,4); endchar; + +"Figure A18a"; % A of METAFONT logo +alpha:=.45; % controls bar location and similar things +beta:=.2; % controls squareness of bowls +numeric h#, xx#, yy#, o#, s#, u#, ph#, pv#; +numeric leftstemloc, barheight; + h#=6; % height of characters, in pt + xx#=0.6; % extra length of certain features, in pt + u#=4/9; % unit width, in pt + s#=0; % extra sidebar, in pt + o#=1/9; % overshoot of curves, in pt + ph#=2/3; % horizontal thickness of pen, in pt +yy#=xx#; define_whole_pixels(xx,yy); +define_pixels(s,u); +define_corrected_pixels(o); +pv#=.9ph#; define_blacker_pixels(ph,pv); +pickup pencircle xscaled ph yscaled pv; +logo_pen:=savepen; +leftstemloc:=good.x((2.5u#+s#)*pt); +barheight:=good.y(alpha*h#*pt); +def beginlogochar(expr c)(expr n) = % code c; width is n units plus sidebars + beginchar(c,n*u#+2s#,h#,0); pickup logo_pen enddef; + +def super_half(suffix i,j,k) = + draw z.i{0,y.j-y.i} + ... (.8[x.j,x.i],.8[y.i,y.j]){z.j-z.i} + ... z.j{x.k-x.i,0} + ... (.8[x.j,x.k],.8[y.k,y.j]){z.k-z.j} + ... z.k{0,y.k-y.j} enddef; + +beginlogochar("A",15); +x1=.5w; +x2=x4=leftstemloc; +x3=x5=w-x2; +top y1=h+o; +y2=y3=barheight; +bot y4=bot y5=-o; +draw z4--z2--z3--z5; +super_half(2,1,3); +labels.top(2,3,4,5); +labels.rt(1); +endchar; + +"Figure 18b"; % serif points +clear_all; +def serif(suffix $)(expr breadth,theta,left_jut,right_jut)= + penpos$(breadth/abs sind theta,0); +z$a-z$l=z$f-z$r=(bracket/abs sind theta)*dir theta; +y$c=y$d; y$b=y$e=y$; y$b-y$c=if theta<0:-fi slab; +x$b=x$c=x$l-left_jut; x$d=x$e=x$r+right_jut; +enddef; + +def serif_edge suffix $ = + (serif_bracket($a,$l,$b)--z$c + --z$d--reverse serif_bracket($f,$r,$e)) enddef; + +def serif_bracket(suffix i,j,k) = + (z.i{z.j-z.i}...serif_darkness[z.j,.5[z.i,z.k] ]{z.k-z.i} + ...z.k{z.k-z.j}) enddef; + +serif_darkness:=1/4; slab:=50; bracket:=175; +z$=(150,slab); +serif($,100,75,80,90); +pickup pencircle scaled 2; draw serif_edge $; +labels.lft($l,$a); +labels.rt($,$r,$f); +labels.top($b,$e); +labels.bot($c,$d); +showit; +shipit; + +"Figure 18c"; % AI by outlines +clear_all; +def serif(suffix $)(expr breadth,theta,left_jut,right_jut)= + penpos$(breadth/abs sind theta,0); +z$a-z$l=z$f-z$r=(bracket/abs sind theta)*dir theta; +y$c=y$d; y$b=y$e=y$; y$b-y$c=if theta<0:-fi slab; +x$b=x$c=x$l-left_jut; x$d=x$e=x$r+right_jut; +enddef; + +def serif_edge suffix $ = + (serif_bracket($a,$l,$b)--z$c + --z$d--reverse serif_bracket($f,$r,$e)) enddef; + +def serif_bracket(suffix i,j,k) = + (z.i{z.j-z.i}...serif_darkness[z.j,.5[z.i,z.k] ]{z.k-z.i} + ...z.k{z.k-z.j}) enddef; + +serif_darkness:=1/3; +slab#:=1/4pt#; +bracket#:=1pt#; +jut#:=.9pt#; +u#:=3/5pt#; +ht#:=7pt#; +thin#:=.5pt#; +thick#:=1.1pt#; +define_pixels(slab,bracket,jut,u,ht,thin,thick); + +beginchar("A",13u#,ht#,0); +z1=(.5w,round 1.05h); x4l=w-x5r=u; y4l=y5r=slab; +numeric theta[]; theta4=angle(z1-z4l); theta5=angle(z1-z5r); +serif(4,thin,theta4,.6jut,jut); serif(5,thick,theta5,jut,.6jut); +z0=z4r+whatever*dir theta4=z5l+whatever*dir theta5; +fill z1--serif_edge4--z0 & z0--serif_edge5--z1 & cycle; +penpos2(whatever,theta4); penpos3(whatever,theta5); +y2r=y3r=.5[y4,y0]; y2l=y3l=y2r-thin; +z2=whatever[z1,z4r]; z3=whatever[z1,z5l]; +penstroke z2e--z3e; +labels.lft(3,5l,5,4a,5a); +labels.rt(2,4r,4f,5f); +labels.top(1,2r,3r,4l,5r,4b,4e,5b,5e); +labels.bot(0,2l,3l,4,4c,4d,5c,5d); + +ww:=w; % special hacks to get two on one +picture tmp; tmp:=currentpicture; +proofrule((w,-d.o_),(w,h.o_)); +endgroup; + +beginchar("I",6u#,ht#,0); +currentpicture:=tmp; +currenttransform:=currenttransform shifted(ww,0); +x1=x2=.5w; y1=h-y2; y2=slab; +serif(1,thick,-90,1.1jut,1.1jut); serif(2,thick,90,1.1jut,1.1jut); +fill serif_edge 2 -- reverse serif_edge 1 -- cycle; +w:=w+ww; +labels.lft(1a,2a,1l); +labels.rt(1f,2f,1,1r); +labels.top(2l,2,2r,2e,1c,1d); +labels.bot(2d,1b,1e); +makelabel("",z2b); makelabel("",z2c); +makelabel.rt.nodot("2b",z2b+(0,3)); +makelabel.rt.nodot("2c",z2c-(0,3)); +endchar; + +currenttransform:=identity yscaled aspect_ratio; + +"Figure A18b"; % H by outlines +clear_all; +def serif(suffix $)(expr breadth,theta,left_jut,right_jut)= + penpos$(breadth/abs sind theta,0); +z$a-z$l=z$f-z$r=(bracket/abs sind theta)*dir theta; +y$c=y$d; y$b=y$e=y$; y$b-y$c=if theta<0:-fi slab; +x$b=x$c=x$l-left_jut; x$d=x$e=x$r+right_jut; +enddef; + +def serif_edge suffix $ = + (serif_bracket($a,$l,$b)--z$c + --z$d--reverse serif_bracket($f,$r,$e)) enddef; + +def serif_bracket(suffix i,j,k) = + (z.i{z.j-z.i}...serif_darkness[z.j,.5[z.i,z.k] ]{z.k-z.i} + ...z.k{z.k-z.j}) enddef; + +serif_darkness:=1/3; +slab#:=1/4pt#; +bracket#:=1pt#; +jut#:=.9pt#; +u#:=3/5pt#; +ht#:=7pt#; +thin#:=.5pt#; +thick#:=1.1pt#; +define_pixels(slab,bracket,jut,u,ht,thin,thick); + +beginchar("H",13u#,ht#,0); +x1=x2=x5=3u; x3=x4=x6=w-x1; y1c=y3c=h; y2c=y4c=0; +serif(1,thick,-90,jut,jut); +serif(2,thick,90,jut,jut); +serif(3,thick,-90,jut,jut); +serif(4,thick,90,jut,jut); +fill serif_edge 2 -- reverse serif_edge 1 -- cycle; +fill serif_edge 4 -- reverse serif_edge 3 -- cycle; +penpos5(thin,90); penpos6(thin,90); +y5=y6=.52h; penstroke z5e--z6e; +labels.lft(1a,2a,3a,4a,5,1,2,1l,2l,3l,4l); +labels.rt(1f,2f,3f,4f,6,3,4,1r,2r,3r,4r); +labels.top(1c,1d,2b,2e,4b,4e,3c,3d,5r,6r); +labels.bot(1b,1e,2c,2d,4c,4d,3b,3e,5l,6l); +endchar; + +"Figure 18d"; % AI by broadpen +clear_all; +def bot_serif(suffix $)(expr xx,theta,left_jut,right_jut)= + penpos$(xx,0); +z$a-z$l=z$f-z$r=(bracket/abs sind theta)*dir theta; +y$c=top y$l; y$d=y$r; x$c=x$l-left_jut; x$d=x$r+right_jut; +z$b=z$l+whatever*dir theta=z$c+whatever*dir phi; +z$e=z$r+whatever*dir theta=z$d+whatever*dir -phi; +enddef; + +def top_serif(suffix $)(expr xx,theta,left_jut,right_jut)= + penpos$(xx,0); +z$a-z$l=z$f-z$r=(bracket/abs sind theta)*dir theta; +%y$c=top y$l; y$d=y$r; x$c=x$l-left_jut; x$d=x$r+right_jut; +y$c=y$d=y$; x$c=x$l-left_jut; x$d=x$r+right_jut; +z$b=z$l+whatever*dir theta=z$c+whatever*dir -phi; +z$e=z$r+whatever*dir theta=z$d+whatever*dir phi; +enddef; + +def bot_serif_edge suffix $ = + (z$a..controls z$b..z$c + --(flex(z$c,.5[z$c,z$d]+dishing,z$d)) shifted (0,-epsilon) + -- z$d..controls z$e..z$f) enddef; + +def top_serif_edge suffix $ = + (z$a..controls z$b..z$c + --(flex(z$c,.5[z$c,z$d]-dishing,z$d)) shifted (0,+epsilon) + -- z$d..controls z$e..z$f) enddef; + +phi:=20; +pair dishing; dishing:=(1/4pt,0) rotated phi; +bracket#:=1pt#; +jut#:=.9pt#; +u#:=3/5pt#; +ht#:=7pt#; +px#:=.8pt#; +py#:=.2pt#; +xx#:=.3pt#; +define_pixels(bracket,jut,u,ht,px,py,xx); + +pickup pensquare xscaled px yscaled py rotated phi; broad_pen:=savepen; + +beginchar("A",13u#,ht#,0); pickup broad_pen; +z1=(.5w,top h); lft x4l=w-rt x5r=1.2u; y4l=y5r=0; +numeric theta[]; theta4=angle(z1-z4l); theta5=angle(z1-z5r); +numeric xxx; +px*sind(theta5-phi)+xxx*sind theta5 = px*cosd phi+xx; +bot_serif(4,0,theta4,.8jut,.8jut); +bot_serif(5,xxx,theta5,.6jut,.8jut); +z0=z4r+whatever*dir theta4=z5l+whatever*dir theta5; +filldraw z1--bot_serif_edge4--z0 & z0--bot_serif_edge5--z1 & cycle; +top y2=top y3=.45 bot y0; z2=whatever[z1,z4r]; z3=whatever[z1,z5l]; +draw z2--z3; +labels.lft(4a,4b,4c,4,5l,5a,5c); +labels.rt(4f,4e,5r,5d,5e,5f); +labels.top(1,2,3,5b); +labels.bot(0,4d,5); + +ww:=w; % special hacks to get two on one +picture tmp; tmp:=currentpicture; +proofrule((w,-d.o_),(w,h.o_)); +endgroup; + +beginchar("I",6u#,ht#,0); pickup broad_pen; +currentpicture:=tmp; +currenttransform:=currenttransform shifted(ww,0); +x1=x2=.5w; y1=h; y2=0; +top_serif(1,xx,-90,1.1jut,1.1jut); +bot_serif(2,xx,90,1.1jut,1.1jut); +filldraw bot_serif_edge 2 -- reverse top_serif_edge 1 -- cycle; +labels.lft(1l,2l,1a,1b,1c,2a,2b); +labels.rt(1r,2r,1d,1e,1f,2d,2e,2f); +labels.top(1); +labels.bot(2,2c); +w:=w+ww; +endchar; + +currenttransform:=identity yscaled aspect_ratio; + +"Figure A18c"; % H by broadpen +clear_all; +def bot_serif(suffix $)(expr xx,theta,left_jut,right_jut)= + penpos$(xx,0); +z$a-z$l=z$f-z$r=(bracket/abs sind theta)*dir theta; +y$c=top y$l; y$d=y$r; x$c=x$l-left_jut; x$d=x$r+right_jut; +z$b=z$l+whatever*dir theta=z$c+whatever*dir phi; +z$e=z$r+whatever*dir theta=z$d+whatever*dir -phi; +enddef; + +def top_serif(suffix $)(expr xx,theta,left_jut,right_jut)= + penpos$(xx,0); +z$a-z$l=z$f-z$r=(bracket/abs sind theta)*dir theta; +y$c=y$d=y$; x$c=x$l-left_jut; x$d=x$r+right_jut; +z$b=z$l+whatever*dir theta=z$c+whatever*dir -phi; +z$e=z$r+whatever*dir theta=z$d+whatever*dir phi; +enddef; + +def bot_serif_edge suffix $ = + (z$a..controls z$b..z$c + --(flex(z$c,.5[z$c,z$d]+dishing,z$d))shifted (0,-epsilon) + -- z$d..controls z$e..z$f) enddef; + +def top_serif_edge suffix $ = + (z$a..controls z$b..z$c + --(flex(z$c,.5[z$c,z$d]-dishing,z$d))shifted (0,+epsilon) + -- z$d..controls z$e..z$f) enddef; + +phi:=20; +pair dishing; dishing:=(1/4pt,0) rotated phi; +bracket#:=1pt#; +jut#:=.9pt#; +u#:=3/5pt#; +ht#:=7pt#; +px#:=.8pt#; +py#:=.2pt#; +xx#:=.3pt#; +define_pixels(bracket,jut,u,ht,px,py,xx); + +pickup pensquare xscaled px yscaled py rotated phi; broad_pen:=savepen; + +beginchar("H",13u#,ht#,0); pickup broad_pen; +x1=x2=x5=3u; x3=x4=x6=w-x1; y1=y3=h; y2=y4=0; +top_serif(1,xx,-90,jut,jut); +bot_serif(2,xx,90,jut,jut); +top_serif(3,xx,-90,jut,jut); +bot_serif(4,xx,90,jut,jut); +filldraw bot_serif_edge 2 -- reverse top_serif_edge 1 -- cycle; +filldraw bot_serif_edge 4 -- reverse top_serif_edge 3 -- cycle; +y5=y6=.52h; draw z5--z6; +labels.lft(l1,2l,3l,4l,1a,1b,1c,2a,2b,2c,3a,3b,3c,4a,4b,4c); +labels.rt(1r,2r,3r,4r,1d,1e,1f,2d,2e,2f,3d,3e,3f,4d,4e,4f); +labels.top(1,3); +labels.bot(2,4,5,6); +endchar; + +currenttransform:=identity yscaled aspect_ratio; + +"Figure 20a"; % example of `solve' +clear_all; +z1=(0,25); z2=(100,100); z3=(300,100); z4=(320,0); +vardef upward(expr x)= + ypart direction 1 of (z1{z2-z1}..(x,y2)..{z4-z3}z4)>0 enddef; +z=(solve upward(x2,x3),y2); +pickup pencircle scaled 4; +draw z1{z2-z1}..z..{z4-z3}z4; +pickup pencircle scaled 2; +draw z1--z2; draw z3--z4; +makelabel.lft("z1 ",z1); +makelabel.lft("z2 ",z2); +makelabel.rt(" z3",z3); +makelabel.rt(" z4",z4); +makelabel.top.nodot("z",z+(0,2)); +forsuffixes $=1,2,3,4,: heavy_dot z$; endfor +showit; +shipit; + +"Figure 21a"; % N of METAFONT logo +alpha:=.45; % controls bar location and similar things +beta:=.2; % controls squareness of bowls +numeric h#, xx#, yy#, o#, s#, u#, ph#, pv#; +numeric leftstemloc, barheight; + h#=6; % height of characters, in pt + xx#=0.6; % extra length of certain features, in pt + u#=4/9; % unit width, in pt + s#=0; % extra sidebar, in pt + o#=1/9; % overshoot of curves, in pt + ph#=2/3; % horizontal thickness of pen, in pt +yy#=xx#; define_whole_pixels(xx,yy); +define_pixels(s,u); +define_corrected_pixels(o); +pv#=.9ph#; define_blacker_pixels(ph,pv); +pickup pencircle xscaled ph yscaled pv; +logo_pen:=savepen; +leftstemloc:=good.x((2.5u#+s#)*pt); +barheight:=good.y(alpha*h#*pt); +def beginlogochar(expr c)(expr n) = % code c; width is n units plus sidebars + beginchar(c,n*u#+2s#,h#,0); pickup logo_pen enddef; + +beginlogochar("N",15); +x1+x4=x1+x3=x2+x5=w; x1=x2=leftstemloc; +y1=y4=y3-yy; bot.y1=-o; y2=y5; top.y5=h+o; +draw z1--z2--z3; draw z4..z5; +labels.top(1,3,4); +labels.bot(2,5); +endchar; + +"Figure 21b"; % random N of METAFONT logo, nine-point size +randomseed:=1; + +vardef noise=normaldeviate*.1pt enddef; + +ht#:=.9*6pt#; +xgap#:=.9*0.6pt#; +u#:=.91*4/9pt#; +s#:=.08pt#; +o#:=1/10pt#; +px#:=.9*2/3pt#; +ygap#:=(ht#/13.5u#)*xgap#; +leftstemloc#:=2.5u#+s#; +barheight#:=.45ht#; +define_pixels(s,u,xgap,ygap,leftstemloc,barheight); +py#:=.9px#; define_blacker_pixels(px,py); +pickup pencircle xscaled px yscaled py; logo_pen:=savepen; +define_corrected_pixels(o); + +def beginlogochar(expr c,n) = + beginchar(c,n*u#+2s#,ht#,0); pickup logo_pen enddef; + +beginlogochar("N",15); +x1=leftstemloc+noise; +x2=leftstemloc+noise; +x4=w-leftstemloc+noise; +x5=w-leftstemloc+noise; +bot y1=noise-o; +top y2=h+o+noise; +y3=y4+ygap+noise; +bot y4=noise-o; +top y5=h+o+noise; +z3=whatever[z4,z5]; +draw z1--z2--z3; draw z4--z5; +labels.top(1,3,4); +labels.bot(2,5); +endchar; + +"Figure 21c"; % random N of METAFONT logo, nine-point size +randomseed:=2; + +vardef noise=normaldeviate*.1pt enddef; + +ht#:=.9*6pt#; +xgap#:=.9*0.6pt#; +u#:=.91*4/9pt#; +s#:=.08pt#; +o#:=1/10pt#; +px#:=.9*2/3pt#; +ygap#:=(ht#/13.5u#)*xgap#; +leftstemloc#:=2.5u#+s#; +barheight#:=.45ht#; +define_pixels(s,u,xgap,ygap,leftstemloc,barheight); +py#:=.9px#; define_blacker_pixels(px,py); +pickup pencircle xscaled px yscaled py; logo_pen:=savepen; +define_corrected_pixels(o); + +def beginlogochar(expr c,n) = + beginchar(c,n*u#+2s#,ht#,0); pickup logo_pen enddef; + +beginlogochar("N",15); +x1=leftstemloc+noise; +x2=leftstemloc+noise; +x4=w-leftstemloc+noise; +x5=w-leftstemloc+noise; +bot y1=noise-o; +top y2=h+o+noise; +y3=y4+ygap+noise; +bot y4=noise-o; +top y5=h+o+noise; +z3=whatever[z4,z5]; +draw z1--z2--z3; draw z4--z5; +labels.top(1,3,4); +labels.bot(2,5); +endchar; + +"Figure 21d"; % random N of METAFONT logo, nine-point size +randomseed:=3; + +vardef noise=normaldeviate*.1pt enddef; + +ht#:=.9*6pt#; +xgap#:=.9*0.6pt#; +u#:=.91*4/9pt#; +s#:=.08pt#; +o#:=1/10pt#; +px#:=.9*2/3pt#; +ygap#:=(ht#/13.5u#)*xgap#; +leftstemloc#:=2.5u#+s#; +barheight#:=.45ht#; +define_pixels(s,u,xgap,ygap,leftstemloc,barheight); +py#:=.9px#; define_blacker_pixels(px,py); +pickup pencircle xscaled px yscaled py; logo_pen:=savepen; +define_corrected_pixels(o); + +def beginlogochar(expr c,n) = + beginchar(c,n*u#+2s#,ht#,0); pickup logo_pen enddef; + +beginlogochar("N",15); +x1=leftstemloc+noise; +x2=leftstemloc+noise; +x4=w-leftstemloc+noise; +x5=w-leftstemloc+noise; +bot y1=noise-o; +top y2=h+o+noise; +y3=y4+ygap+noise; +bot y4=noise-o; +top y5=h+o+noise; +z3=whatever[z4,z5]; +draw z1--z2--z3; draw z4--z5; +labels.top(1,3,4); +labels.bot(2,5); +endchar; + +"Figure 24a"; % Ionian O at 200 pixels/inch +ss:=10; +begingroup interim hppp:=200/72.27; % lowres parameters +interim blacker:=.65; % make pens a bit blacker +interim o_correction:=.4; % but don't overshoot as much + em#:=10pt#; cap#:=7pt#; + thin#:=1/3pt#; thick#:=5/6pt#; + o#:=1/5pt#; +define_pixels(em,cap); +define_blacker_pixels(thin,thick); +define_corrected_pixels(o); + curve_sidebar:=round 1/18em; +pair u,uu,v; +beginchar("O",0.8em#,cap#,0); + penpos1(thick,10); penpos2(.1[thin,thick],90-10); + penpos3(thick,180+10); penpos4(thin,270-10); + x1l=w-x3l=curve_sidebar; x2=x4=.5w; + y1=.49h; y2l=-o; y3=.51h; y4l=h+o; + penstroke (z1e{down}..z2e{right} + ..z3e{up}..z4e{left}..cycle) scaled ss; +for m=0 upto w: proofrule((m*ss,0),(m*ss,h*ss)); endfor +for n=0 upto h: proofrule((0,n*ss),(w*ss,n*ss)); endfor +proofrulethickness 1; +forsuffixes e=l,r: + u:=round((point 0 of path_.e)/ss); + for t=0 step 1/64 until 4: + v:=round((point t of path_.e)/ss); + if u<>v: if abs(u-v)=1: proofrule(u*ss,v*ss); + else: del:=1/128; tt:=t-del; + forever: uu:=round((point tt of path_.e)/ss); + exitif abs(u-uu)=1; + if del=epsilon:ddt;fi + del:=del/2; + tt:=tt if uu=u:+ else:-fi del; endfor + proofrule(u*ss,uu*ss); proofrule(uu*ss,v*ss); fi + u:=v; fi endfor + endfor +showit; +shipit; +endgroup; +endgroup; +numeric u,uu,v; + +"Figure 24b"; % Ionian O at 200 pixels/inch, unrounded position +ss:=10; +begingroup interim hppp:=200/72.27; % lowres parameters +interim blacker:=.65; % make pens a bit blacker +interim o_correction:=.4; % but don't overshoot as much + em#:=10pt#; cap#:=7pt#; + thin#:=1/3pt#; thick#:=5/6pt#; + o#:=1/5pt#; +define_pixels(em,cap); +define_blacker_pixels(thin,thick); +define_corrected_pixels(o); + curve_sidebar:= 1/18em; +pair u,uu,v; +beginchar("O",0.8em#,cap#,0); + penpos1(thick,10); penpos2(.1[thin,thick],90-10); + penpos3(thick,180+10); penpos4(thin,270-10); + x1l=w-x3l=curve_sidebar; x2=x4=.5w; + y1=.49h; y2l=-o; y3=.51h; y4l=h+o; + penstroke (z1e{down}..z2e{right} + ..z3e{up}..z4e{left}..cycle) scaled ss; +for m=0 upto w: proofrule((m*ss,0),(m*ss,h*ss)); endfor +for n=0 upto h: proofrule((0,n*ss),(w*ss,n*ss)); endfor +proofrulethickness 1; +forsuffixes e=l,r: + u:=round((point 0 of path_.e)/ss); + for t=0 step 1/64 until 4: + v:=round((point t of path_.e)/ss); + if u<>v: if abs(u-v)=1: proofrule(u*ss,v*ss); + else: del:=1/128; tt:=t-del; + forever: uu:=round((point tt of path_.e)/ss); + exitif abs(u-uu)=1; + if del=epsilon:ddt;fi + del:=del/2; + tt:=tt if uu=u:+ else:-fi del; endfor + proofrule(u*ss,uu*ss); proofrule(uu*ss,v*ss); fi + u:=v; fi endfor + endfor +showit; +shipit; +endgroup; +endgroup; +numeric u,uu,v; + +"Figure 24c"; % Fig 24b shifted right .05 pixel +ss:=10; +begingroup interim hppp:=200/72.27; % lowres parameters +interim blacker:=.65; % make pens a bit blacker +interim o_correction:=.4; % but don't overshoot as much + em#:=10pt#; cap#:=7pt#; + thin#:=1/3pt#; thick#:=5/6pt#; + o#:=1/5pt#; +define_pixels(em,cap); +define_blacker_pixels(thin,thick); +define_corrected_pixels(o); + curve_sidebar:= 1/18em; +pair u,uu,v; +beginchar("O",0.8em#,cap#,0); + penpos1(thick,10); penpos2(.1[thin,thick],90-10); + penpos3(thick,180+10); penpos4(thin,270-10); + x1l=w-x3l=curve_sidebar; x2=x4=.5w; + y1=.49h; y2l=-o; y3=.51h; y4l=h+o; + penstroke (z1e{down}..z2e{right} + ..z3e{up}..z4e{left}..cycle) shifted (.05,0) scaled ss; +for m=0 upto w: proofrule((m*ss,0),(m*ss,h*ss)); endfor +for n=0 upto h: proofrule((0,n*ss),(w*ss,n*ss)); endfor +proofrulethickness 1; +forsuffixes e=l,r: + u:=round((point 0 of path_.e)/ss); + for t=0 step 1/64 until 4: + v:=round((point t of path_.e)/ss); + if u<>v: if abs(u-v)=1: proofrule(u*ss,v*ss); + else: del:=1/128; tt:=t-del; + forever: uu:=round((point tt of path_.e)/ss); + exitif abs(u-uu)=1; + if del=epsilon:ddt;fi + del:=del/2; + tt:=tt if uu=u:+ else:-fi del; endfor + proofrule(u*ss,uu*ss); proofrule(uu*ss,v*ss); fi + u:=v; fi endfor + endfor +showit; +shipit; +endgroup; +endgroup; +numeric u,uu,v; + +"Figure 24d"; % Fig 24c shifted right .05 pixel +ss:=10; +begingroup interim hppp:=200/72.27; % lowres parameters +interim blacker:=.65; % make pens a bit blacker +interim o_correction:=.4; % but don't overshoot as much + em#:=10pt#; cap#:=7pt#; + thin#:=1/3pt#; thick#:=5/6pt#; + o#:=1/5pt#; +define_pixels(em,cap); +define_blacker_pixels(thin,thick); +define_corrected_pixels(o); + curve_sidebar:= 1/18em; +pair u,uu,v; +beginchar("O",0.8em#,cap#,0); + penpos1(thick,10); penpos2(.1[thin,thick],90-10); + penpos3(thick,180+10); penpos4(thin,270-10); + x1l=w-x3l=curve_sidebar; x2=x4=.5w; + y1=.49h; y2l=-o; y3=.51h; y4l=h+o; + penstroke (z1e{down}..z2e{right} + ..z3e{up}..z4e{left}..cycle) shifted (.1,0) scaled ss; +for m=0 upto w: proofrule((m*ss,0),(m*ss,h*ss)); endfor +for n=0 upto h: proofrule((0,n*ss),(w*ss,n*ss)); endfor +proofrulethickness 1; +forsuffixes e=l,r: + u:=round((point 0 of path_.e)/ss); + for t=0 step 1/64 until 4: + v:=round((point t of path_.e)/ss); + if u<>v: if abs(u-v)=1: proofrule(u*ss,v*ss); + else: del:=1/128; tt:=t-del; + forever: uu:=round((point tt of path_.e)/ss); + exitif abs(u-uu)=1; + if del=epsilon:ddt;fi + del:=del/2; + tt:=tt if uu=u:+ else:-fi del; endfor + proofrule(u*ss,uu*ss); proofrule(uu*ss,v*ss); fi + u:=v; fi endfor + endfor +showit; +shipit; +endgroup; +endgroup; +numeric u,uu,v; + +"Figure 24e"; % hash mark +numeric u; +u#:=10/18pt#; define_pixels(u); +beginchar(0,15u#,250/36pt#,70/36pt#); +pickup pencircle scaled (.4pt+blacker); +lft x1=round u-eps; x3=x1; x2=x4=w-x1; +y1=y2=good.y(.5[-d,h]+1.1pt); y3=y4=h-d-y1; +draw z1--z2; draw z3--z4; +lft x6=round 3u; x7=w-x6; +x8=good.x .5w; x5-x6=x7-x8; +top y5=top y7=h+eps; bot y6=bot y8=-d-eps; +draw z5--z6; draw z7--z8; +labels.top(6,8); +labels.bot(5,7); +labels.lft(2,4); +labels.rt(1,3); +endchar; + +"Figure 24f"; % Ionian O at 200 pixels/inch, autorounding=1 +ss:=10; +begingroup interim hppp:=200/72.27; % lowres parameters +interim blacker:=.65; % make pens a bit blacker +interim o_correction:=.4; % but don't overshoot as much + em#:=10pt#; cap#:=7pt#; + thin#:=1/3pt#; thick#:=5/6pt#; + o#:=1/5pt#; +define_pixels(em,cap); +define_blacker_pixels(thin,thick); +define_corrected_pixels(o); + curve_sidebar:= 1/18em; +interim autorounding:=1; +interim granularity:=10; +beginchar("O",0.8em#,cap#,0); + penpos1(thick,10); penpos2(.1[thin,thick],90-10); + penpos3(thick,180+10); penpos4(thin,270-10); + x1l=w-x3l=curve_sidebar; x2=x4=.5w; + y1=.49h; y2l=-o; y3=.51h; y4l=h+o; + penstroke (z1e{down}..z2e{right} + ..z3e{up}..z4e{left}..cycle) scaled ss; +for m=0 upto w: proofrule((m*ss,0),(m*ss,h*ss)); endfor +for n=0 upto h: proofrule((0,n*ss),(w*ss,n*ss)); endfor +proofrulethickness 1; +pair u; +for v= % pairs gotten from tracingedges on a separate run! +(2,9), (2,6), (3,6), (3,4), (4,4), (4,3), (5,3), (5,2), (6,2), +(6,1), (8,1), (8,0), (14,0), (14,1), (16,1), (16,2), (17,2), (17,3), +(18,3), (18,4), (19,4), (19,7), (20,7), (20,13), (19,13), (19,15), +(18,15), (18,16), (17,16), (17,17), (16,17), (16,18), (14,18), (14,19), +(8,19), (8,18), (6,18), (6,17), (5,17), (5,16), (4,16), (4,15), (3,15), +(3,12), (2,12), (2,9) +:if known u: proofrule(u*ss,v*ss) ; fi +u:=v; endfor + +pair u; +for v= +(4,9), (4,7), (5,7), (5,5), (6,5), +(6,4), (7,4), (7,3), (9,3), (9,2), (14,2), (14,3), (15,3), (15,4), (16,4), +(16,5), (17,5), (17,7), (18,7), (18,12), (17,12), (17,14), (16,14), +(16,15), (15,15), (15,16), (13,16), (13,17), (8,17), (8,16), (7,16), +(7,15), (6,15), (6,14), (5,14), (5,12), (4,12), (4,9) +:if known u: proofrule(u*ss,v*ss) ; fi +u:=v; endfor +showit; +shipit; +endgroup; +endgroup; +numeric u; + +"Figure 24g"; % Ionian O at 200 pixels/inch, autorounding=2 +ss:=10; +begingroup interim hppp:=200/72.27; % lowres parameters +interim blacker:=.65; % make pens a bit blacker +interim o_correction:=.4; % but don't overshoot as much + em#:=10pt#; cap#:=7pt#; + thin#:=1/3pt#; thick#:=5/6pt#; + o#:=1/5pt#; +define_pixels(em,cap); +define_blacker_pixels(thin,thick); +define_corrected_pixels(o); + curve_sidebar:= 1/18em; +interim autorounding:=2; +interim granularity:=10; +beginchar("O",0.8em#,cap#,0); + penpos1(thick,10); penpos2(.1[thin,thick],90-10); + penpos3(thick,180+10); penpos4(thin,270-10); + x1l=w-x3l=curve_sidebar; x2=x4=.5w; + y1=.49h; y2l=-o; y3=.51h; y4l=h+o; + penstroke (z1e{down}..z2e{right} + ..z3e{up}..z4e{left}..cycle) scaled ss; +for m=0 upto w: proofrule((m*ss,0),(m*ss,h*ss)); endfor +for n=0 upto h: proofrule((0,n*ss),(w*ss,n*ss)); endfor +proofrulethickness 1; +pair u; +for v= +(2,9), (2,6), (3,6), +(3,4), (4,4), (4,3), (5,3), (5,2), (6,2), (6,1), (8,1), (8,0), (14,0), +(14,1), (16,1), (16,2), (17,2), (17,3), (18,3), (18,4), (19,4), (19,7), +(20,7), (20,13), (19,13), (19,15), (18,15), (18,16), (17,16), (17,17), +(16,17), (16,18), (14,18), (14,19), (8,19), (8,18), (6,18), (6,17), +(5,17), (5,16), (4,16), (4,15), (3,15), (3,12), (2,12), (2,9) +:if known u: proofrule(u*ss,v*ss) ; fi +u:=v; endfor + +pair u; +for v= +(4,9), (4,7), (5,7), (5,5), (6,5), +(6,4), (7,4), (7,3), (9,3), (9,2), (13,2), (13,3), (15,3), (15,4), (16,4), +(16,5), (17,5), (17,7), (18,7), (18,12), (17,12), (17,14), (16,14), +(16,15), (15,15), (15,16), (13,16), (13,17), (9,17), (9,16), (7,16), +(7,15), (6,15), (6,14), (5,14), (5,12), (4,12), (4,9) +:if known u: proofrule(u*ss,v*ss) ; fi +u:=v; endfor +showit; +shipit; +endgroup; +endgroup; +numeric u; + +"Figure 24h"; % Ionian O at 200 pixels/inch, autorounding=0, smoothing=1 +ss:=10; +begingroup interim hppp:=200/72.27; % lowres parameters +interim blacker:=.65; % make pens a bit blacker +interim o_correction:=.4; % but don't overshoot as much + em#:=10pt#; cap#:=7pt#; + thin#:=1/3pt#; thick#:=5/6pt#; + o#:=1/5pt#; +define_pixels(em,cap); +define_blacker_pixels(thin,thick); +define_corrected_pixels(o); + curve_sidebar:= 1/18em; +beginchar("O",0.8em#,cap#,0); + penpos1(thick,10); penpos2(.1[thin,thick],90-10); + penpos3(thick,180+10); penpos4(thin,270-10); + x1l=w-x3l=curve_sidebar; x2=x4=.5w; + y1=.49h; y2l=-o; y3=.51h; y4l=h+o; + penstroke (z1e{down}..z2e{right} + ..z3e{up}..z4e{left}..cycle) scaled ss; +for m=0 upto w: proofrule((m*ss,0),(m*ss,h*ss)); endfor +for n=0 upto h: proofrule((0,n*ss),(w*ss,n*ss)); endfor +proofrulethickness 1; +pair u; +for v= +(2,9), (2,5), (3,5), +(3,3), (4,3), (4,2), (6,2), (6,1), (8,1), (8,0), (14,0), (14,1), (16,1), +(16,2), (17,2), (17,3), (18,3), (18,4), (19,4), (19,6), (20,6), (20,14), +(19,14), (19,16), (18,16), (18,17), (16,17), (16,18), (14,18), (14,19), +(8,19), (8,18), (6,18), (6,17), (5,17), (5,16), (4,16), (4,15), (3,15), +(3,13), (2,13), (2,9) +:if known u: proofrule(u*ss,v*ss) ; fi +u:=v; endfor + +pair u; +for v= +(4,10), (4,9), (5,9), (5,5), (6,5), +(6,4), (7,4), (7,3), (8,3), (8,2), (14,2), (14,3), (15,3), (15,4), (16,4), +(16,6), (17,6), (17,8), (18,8), (18,10), (17,10), (17,13), (16,13), +(16,15), (15,15), (15,16), (14,16), (14,17), (8,17), (8,16), (7,16), +(7,15), (6,15), (6,13), (5,13), (5,11), (4,11), (4,10) +:if known u: proofrule(u*ss,v*ss) ; fi +u:=v; endfor +showit; +shipit; +endgroup; +endgroup; +numeric u; + +"Figure 27a"; % Modification of Fig. 14b +clear_all; +pair zz[]; +zz1=(0,509); +zz2=(-14,492); +zz3=(-32,481); +zz4=(-42,455); +zz5=(-62,430); +zz6=(-20,452); +zz7=(42,448); +zz8=(38,465); +zz9=(4,493); +for n=1 upto 9: z[n-1]=(zz[n]+(62,-430)) scaled 2.5; heavy_dot z[n-1]; endfor +pickup pencircle scaled 3; +draw flex(z0,z1,z2)&flex(z2,z3,z4) + &flex(z4,z5,z6)&flex(z6,z7,z8,z0)&cycle; +labels.lft(1,2,3,4); +labels.rt(0,6,7,8); +labels.bot(5); +showit; shipit; + +"Figure Da"; % Neenie's problem +clear_all; +z1l=(0,240-y); z1r=(15,288-y); +z0l-z0r=z1l-z1r; z0r=(144,189-y); y0l=0; +pickup pencircle scaled 2; +numeric a,b,c,d; +a=x1l; b=y1r; (c,d)=z0r; +draw z0l--z0r--z1r--z1l--cycle; +proofrule((a,d),(a,b)); proofrule((a,b),(a-d+b,b)); +for z=z0l,z0r,z1l,z1r,(a,b): heavy_dot z; endfor +makelabel.bot.nodot("<=",z1r+(3,-8)); +makelabel.lft("(a,b)",(a,b)); +makelabel.top("z1r",z1r); +makelabel.lft("z1l",z1l); +makelabel.rt("(c,d)",z0r); +makelabel.lft("z0r ",z0r); +makelabel.lft("z0l ",z0l); +showit; shipit; + +"Figure Ea"; % T of METAFONT logo, with italic correction +alpha:=.45; % controls bar location and similar things +beta:=.2; % controls squareness of bowls +numeric h#, xx#, yy#, o#, s#, u#, ph#, pv#; +numeric leftstemloc, barheight; + h#=6; % height of characters, in pt + xx#=0.6; % extra length of certain features, in pt + u#=4/9; % unit width, in pt + s#=0; % extra sidebar, in pt + o#=1/9; % overshoot of curves, in pt + ph#=2/3; % horizontal thickness of pen, in pt +yy#=xx#; define_whole_pixels(xx,yy); +define_pixels(s,u); +define_corrected_pixels(o); +pv#=.9ph#; define_blacker_pixels(ph,pv); +pickup pencircle xscaled ph yscaled pv; +logo_pen:=savepen; +leftstemloc:=good.x((2.5u#+s#)*pt); +barheight:=good.y(alpha*h#*pt); +def beginlogochar(suffix c)(expr n) = % code c; width is n units plus sidebars + beginchar(str c,n*u#+2s#,h#,0); pickup logo_pen enddef; +slant:=0; + +beginlogochar(T,13); +italcorr h#*slant+.5u#; +if odd(w-ph): w:=w+1; fi % allows a symmetric stem +x1+x2=2x3=2x4=w; lft.x1=-epsilon; % I tried s-o instead; was not as good +y1=y2=y3; top.y1=h; bot.y4=-o; +draw z1..z2; draw z3..z4; +labels.rt(2,3); +makelabel.top("1",z1); +makelabel.top("4",z4); +endchar; + +"Figure Eb"; % F of METAFONT logo +alpha:=.45; % controls bar location and similar things +beta:=.2; % controls squareness of bowls +numeric h#, xx#, yy#, o#, s#, u#, ph#, pv#; +numeric leftstemloc, barheight; + h#=6; % height of characters, in pt + xx#=0.6; % extra length of certain features, in pt + u#=4/9; % unit width, in pt + s#=0; % extra sidebar, in pt + o#=1/9; % overshoot of curves, in pt + ph#=2/3; % horizontal thickness of pen, in pt +yy#=xx#; define_whole_pixels(xx,yy); +define_pixels(s,u); +define_corrected_pixels(o); +pv#=.9ph#; define_blacker_pixels(ph,pv); +pickup pencircle xscaled ph yscaled pv; +logo_pen:=savepen; +leftstemloc:=good.x((2.5u#+s#)*pt); +barheight:=good.y(alpha*h#*pt); +def beginlogochar(suffix c)(expr n) = % code c; width is n units plus sidebars + beginchar(str c,n*u#+2s#,h#,0); pickup logo_pen enddef; + +beginlogochar(F,14); +x1=x2=x3=leftstemloc; x4=w-x1+o; x5=x4-xx; +y2=y5; y3=y4; bot.y1=-o; top.y3=h; y2=barheight; +draw z1--z3--z4; draw z2--z5; +labels.rt(2,3); +labels.lft(4,5); +labels.top(1); +endchar; + +"Figure Ec"; % cmr10 period +u#:=20/36pt#; +dot_diam#:=38/36pt#; +body_height#:=270/36pt#; % height of tallest characters +asc_height#:=250/36pt#; % height of lowercase ascenders +x_height#:=155/36pt#; % height of lowercase without ascenders +bar_height#:=87/36pt#; % height of crossbar in lowercase e +desc_depth#:=70/36pt#; % depth of lowercase descenders +body_depth#:=90/36pt#; +fine#:=7/36pt#; + +define_pixels(u); +define_whole_blacker_pixels(dot_diam,fine); +define_whole_vertical_pixels(body_height,asc_height,x_height,bar_height, + desc_depth,body_depth); + +beginchar(".",5u#,dot_diam#,0); +def makebox(text rule) = + for y=0,asc_height,body_height,x_height,bar_height,-desc_depth,-body_depth: + rule((0,y),(w,y)); endfor % horizontals + for x=0,w: rule((x,-body_depth),(x,body_height)); endfor % verticals + for x=u step u until w-1: + rule((x,-body_depth),(x,body_height)); endfor % more verticals + if charic<>0: + rule((w+charic*pt,h.o_),(w+charic*pt,.5h.o_)); fi % italic correction + enddef; +pickup pencircle scaled fine; +penpos1(dot_diam-fine,0); penpos2(dot_diam-fine,90); +x1l=good.x(x1l+.5w-x1); bot y2l=0; z1=z2; +filldraw z1l...z2l...z1r...z2r...cycle; % roundish dot +labels.lft(1,1l); +labels.rt(2,1r); +labels.top(2r); +labels.bot(2l); +endchar; + +"Figure Ed"; % cmr10 emdash +u#:=20/36pt#; +dot_diam#:=38/36pt#; +body_height#:=270/36pt#; % height of tallest characters +asc_height#:=250/36pt#; % height of lowercase ascenders +x_height#:=155/36pt#; % height of lowercase without ascenders +bar_height#:=87/36pt#; % height of crossbar in lowercase e +desc_depth#:=70/36pt#; % depth of lowercase descenders +body_depth#:=90/36pt#; +vair#:=8/36pt#; % vertical diameter of hairlines + +define_pixels(u); +define_whole_blacker_pixels(dot_diam,vair); +define_whole_vertical_pixels(body_height,asc_height,x_height,bar_height, + desc_depth,body_depth); + +beginchar(oct"174",18u#,x_height#,0); +def makebox(text rule) = + for y=0,asc_height,body_height,x_height,bar_height,-desc_depth,-body_depth: + rule((0,y),(w,y)); endfor % horizontals + for x=0,w: rule((x,-body_depth),(x,body_height)); endfor % verticals + for x=u step u until w-1: + rule((x,-body_depth),(x,body_height)); endfor % more verticals + if charic<>0: + rule((w+charic*pt,h.o_),(w+charic*pt,.5h.o_)); fi % italic correction + enddef; +italcorr .61803x_height#*0 + .5u#; +pickup nullpen; +penpos1(vair,90); penpos2(vair,90); +y1r=y2r=good.y(y1r+.61803h-y1); +lft x1=-eps; rt x2=w+eps; +penstroke z1e--z2e; % crossbar +labels.lft(1); +labels.rt(2); +labels.top(1r,2r); +labels.bot(1l,2l); +endchar; + +bye diff --git a/systems/knuth/local/lib/mproof.tex b/systems/knuth/local/lib/mproof.tex new file mode 100644 index 0000000000..aac809db3a --- /dev/null +++ b/systems/knuth/local/lib/mproof.tex @@ -0,0 +1,28 @@ +% To produce proof sheets from MetaPost output (includes date and time): +% tex mproof <MetaPost output file names> + +\input epsf +\font\textt=cmtex10 \textt +\def\okbreak{\vfil\penalty2000\vfilneg} + +\def\today{\ifcase\month\or + January\or February\or March\or April\or May\or June\or + July\or August\or September\or October\or November\or December\fi + \space\number\day, \number\year} +\newcount\m \newcount\n +\n=\time \divide\n 60 \m=-\n \multiply\m 60 \advance\m \time +\def\hours{\twodigits\n\twodigits\m} +\def\twodigits#1{\ifnum #1<10 0\fi \number#1} + +\footline={\sevenrm\today\ at \hours\hss\tenrm\folio\hss} + +\def\endit{\\} +\def\munch#1 {\def\next{#1}\ifx\next\endit\endit + \else#1$$\epsfverbosetrue\epsfbox{#1}$$\par\okbreak\fi\munch} + +\def\\{\let\munch=\relax\def\\{}} + +\everypar{\everypar{}\munchline} + +\obeylines\def\munchline#1 +{\catcode`\^^M=5 \munch#1\\ \vfill\end}% diff --git a/systems/knuth/local/lib/oneone.mf b/systems/knuth/local/lib/oneone.mf new file mode 100644 index 0000000000..efa30cf1f2 --- /dev/null +++ b/systems/knuth/local/lib/oneone.mf @@ -0,0 +1,10 @@ +% Black font for Imagen with proofsheet resolution 300 pixels per inch + +if mode<>imagen: errmessage "This file is for imagen only"; fi + +font_identifier "BLACKIMAGEN"; +picture pix_picture; pix_wd := pix_ht := 1; +pix_picture := unitpixel; +dotsize:=10; + +input grayf diff --git a/systems/knuth/local/lib/picmac.tex b/systems/knuth/local/lib/picmac.tex new file mode 100644 index 0000000000..0e1b537ab8 --- /dev/null +++ b/systems/knuth/local/lib/picmac.tex @@ -0,0 +1,178 @@ +% Pictures (a subset of \LaTeX's conventions, plus squines) +\catcode`@=11 % enable private control sequences +\def\wlog#1{} % don't put allocation info into the log + +\newskip\hsssglue \hsssglue=0pt plus 1fill minus 1fill \def\hsss{\hskip\hsssglue} + +\newdimen\unitlength \newdimen\linethickness +\newdimen\@picheight \newdimen\@xdim \newdimen\@ydim \newdimen\@len \newdimen\@save +\newcount\@multicount \newcount\@xarg \newcount\@yarg +\newbox\@picbox \newbox\@mpbox + +\font\tenln=line10 \font\tenlnw=linew10 +\font\tencirc=lcircle10 \font\tencircw=lcirclew10 + +\def\thinlines{\let\linefont=\tenln \let\circlefont=\tencirc + \linethickness=\fontdimen8\linefont} +\def\thicklines{\let\linefont=\tenlnw \let\circlefont=\tencircw + \linethickness=\fontdimen8\linefont} +\thinlines + +\def\beginpicture(#1,#2)(#3,#4){\@picheight=#2\unitlength + \setbox\@picbox=\hbox to#1\unitlength\bgroup \let\line=\@line + \kern-#3\unitlength \lower#4\unitlength\hbox\bgroup\ignorespaces} +\def\endpicture{\egroup\hss\egroup + \ht\@picbox=\@picheight \dp\@picbox=\z@ + \leavevmode\box\@picbox} + +\def\put(#1,#2)#3{\raise#2\unitlength\rlap{\kern#1\unitlength #3}\ignorespaces} + +\def\multiput(#1,#2)(#3,#4)#5#6{\@multicount=#5\relax + \@xdim=#1\unitlength \@ydim=#2\unitlength \setbox\@mpbox=\hbox{#6}% + \loop\ifnum\@multicount>0 + \raise\@ydim\rlap{\kern\@xdim \unhcopy\@mpbox}% + \advance\@xdim#3\unitlength \advance\@ydim#4\unitlength + \advance\@multicount\m@ne \repeat\ignorespaces} + +\def\makebox(#1,#2)#3{\setbox\@picbox=\hbox to#1\unitlength{\hss#3\hss}% + \@ydim=\ht\@picbox \advance\@ydim-\dp\@picbox + \ht\@picbox=#2\unitlength \dp\@picbox=\z@ + \leavevmode\lower.5\@ydim\box\@picbox} + +\newif\ifneg +\def\@line(#1,#2)#3{\@xarg=#1 \@yarg=#2 \@len=#3\unitlength \leavevmode + \ifnum\@xarg<0 \reverseline \else \negfalse \@ydim=\z@\fi + \ifnum\@xarg=0 \@vline + \else\ifnum\@yarg=0 \@hline \else\@sline\fi\fi + \ifneg\kern-\@len\else\@save=\@ydim\fi} +\def\reverseline{\negtrue \kern-\@len \@xarg=-\@xarg + \@ydim=\@len \multiply\@ydim\@yarg \divide\@ydim\@xarg \@yarg=-\@yarg} + +\def\@hline{\vrule height.5\linethickness depth.5\linethickness width\@len} +\def\@vline{\kern-.5\linethickness\vrule width\linethickness + \ifnum\@yarg<0 height\z@ depth\else depth\z@ height\fi\@len + \kern-.5\linethickness} + +\def\@sline{\setbox\@picbox=\hbox{\linefont \count@=\@xarg \multiply\count@ 8 + \ifnum\@yarg>0 \advance\count@\@yarg \advance\count@-9 + \else \advance\count@-\@yarg \advance\count@ 55 \fi \char\count@}% + \ifnum\@yarg<0 \@picheight=-\ht\@picbox \advance\@ydim\@picheight + \else \@picheight=\ht\@picbox \fi + \@xdim=\wd\@picbox \@save=\@ydim + \loop\ifdim\@xdim<\@len \raise\@ydim\copy\@picbox + \advance\@xdim\wd\@picbox \advance\@ydim\@picheight \repeat + \advance\@xdim-\@len \kern-\@xdim + \multiply\@xdim\@yarg \divide\@xdim\@xarg \advance\@ydim-\@xdim + \raise\@ydim\box\@picbox} + +\def\vector(#1,#2)#3{\@line(#1,#2){#3}% + \ifnum\@xarg=0 \@vvector \else\ifnum\@yarg=0 \@hvector \else\@svector\fi\fi} +\def\@hvector{\ifneg\rlap{\linefont\char27}\else + \smash{\llap{\linefont\char45}}\fi} % we have to smash because of font bug +\def\@vvector{\ifnum\@yarg<0 \raise-\@len\rlap{\linefont\char63}% + \else\setbox\@picbox=\rlap{\linefont\char54}\advance\@len-\ht\@picbox + \raise\@len\box\@picbox\fi} + +\def\@svector{\setbox\@picbox=\hbox to\z@{\linefont + \ifnum\@yarg<0 \count@=55 \@yarg=-\@yarg \else\count@=-9 \fi + \ifneg\multiply\@xarg16 \multiply\@yarg2 + \else\hss % \llap + \ifnum\@xarg>2 \multiply\@xarg9 \multiply\@yarg2 \advance\count@29 + \else\ifnum\@yarg>2 \multiply\@xarg16 \multiply\@yarg9 \advance\count@-20 + \else\multiply\@xarg24 \multiply\@yarg3 \fi\fi\fi + \advance\count@\@xarg \advance\count@\@yarg \char\count@ + \ifneg\hss\fi}% \rlap + \raise\@save\box\@picbox} + +\def\disk#1{\@len=#1\unitlength \count@='160 \@diskcirc} +\def\circle#1{\@len=#1\unitlength \count@='140 \@diskcirc} +\def\@diskcirc{\setbox\@picbox=\hbox{\circlefont\char\count@}\@xdim=\wd\@picbox + \leavevmode \ifdim\@len>15.499\@xdim \@bigdc \else \@smalldc\fi} +\def\@bigdc{\ifnum\count@<'160 \@bigcirc + \else \@len=15\@xdim \@diskcirc\fi} +\def\@smalldc{{\advance\@len-.5\@xdim + \loop\ifdim\@xdim<\@len \advance\count@\@ne \advance\@xdim\wd\@picbox\repeat + \hbox{\circlefont\char\count@}}} +\def\@bigcirc{{\circlefont\count@=15 + \setbox\@picbox=\hbox{\char\count@}\@xdim=\wd\@picbox + \ifdim\@len>2.5\@xdim \@len=2.5\@xdim\fi + \advance\@len-.125\wd\@picbox + \loop\ifdim\@xdim<\@len \advance\count@ 4 \advance\@xdim.25\wd\@picbox\repeat + \@ydim=.5\@xdim \advance\@ydim.5\linethickness + \setbox\@picbox=\vbox{\hbox{\char\count@\advance\count@-3\char\count@}% + \nointerlineskip + \hbox{\advance\count@\m@ne\char\count@\advance\count@\m@ne\char\count@}}% + \kern-\@ydim\lower\@ydim\box\@picbox}} + +\newif\ifovaltl \newif\ifovaltr \newif\ifovalbl \newif\ifovalbr +\ovaltltrue \ovaltrtrue \ovalbltrue \ovalbrtrue +\def\oval(#1,#2){\@xdim=#1\unitlength \@ydim=#2\unitlength + {\circlefont \setbox\@picbox=\hbox{\char0} + \ifdim\@xdim<\wd\@picbox \@xdim=\wd\@picbox\fi + \ifdim\@ydim<\wd\@picbox \@ydim=\wd\@picbox\fi + \@save=\@xdim \ifdim\@ydim<\@save \@save=\@ydim \fi + \count@=39 + \loop \setbox\@picbox=\hbox{\char\count@}\ifdim\@save<\wd\@picbox + \advance\count@-4 \repeat + \setbox\strutbox=\hbox{\vrule height\ht\@picbox depth\dp\@picbox width\z@ + \kern\wd\@picbox}% + \@save=.5\wd\@picbox \advance\@save-.5\linethickness + \setbox0=\hbox to\@xdim{\ifovaltl\char\count@\else\strut\fi + \kern-\@save\leaders\hrule height\ifovaltl\linethickness\else\z@\fi\hfil + \leaders\hrule height\ifovaltr\linethickness\else\z@\fi\hfil\kern\@save + \ifovaltr\advance\count@-3\char\count@\else\strut\fi\kern-\wd\@picbox}% + \advance\count@\m@ne + \setbox2=\hbox to\@xdim{\ifovalbl\char\count@\else\strut\fi + \kern-\@save\leaders\hrule height\ifovalbl\linethickness\else\z@\fi\hfil + \leaders\hrule height\ifovalbr\linethickness\else\z@\fi\hfil\kern\@save + \ifovalbr\advance\count@\m@ne\char\count@\else\strut\fi\kern-\wd\@picbox}% + \@save=\@ydim \advance\@save-\wd\@picbox \divide\@save 2 + \setbox\@picbox=\vbox{\box0\nointerlineskip + \hbox to\@xdim{\vrule height\@save width\ifovaltl\linethickness\else\z@\fi + \hfil\ifovaltr\vrule width\linethickness\kern-\linethickness\fi}% + \nointerlineskip + \hbox to\@xdim{\vrule height\@save width\ifovalbl\linethickness\else\z@\fi + \hfil\ifovalbr\vrule width\linethickness\kern-\linethickness\fi}% + \nointerlineskip\box2}% + \@save=.5\@ydim \advance\@save.5\linethickness \leavevmode + \kern-.5\@xdim \kern-.5\linethickness \lower\@save\box\@picbox}} + +\def\cpic#1\endcpic{\vcenter{\hbox{\beginpicture#1\endpicture}}} + +% Squines (quadratic splines) +% example of use: to plot f(x) between x0 and x1, you can say +% \put(0,0){\squine(x0,xm,x1,y0,ym,y1)}, where y0=f(x0), y1=f(x1) +% xm=(y0-y1+s1x1-s0x0)/(s1-s0), ym=(s0(s1x1-y1)-s1(s0x0-y0))/(s1-s0), +% s0=f'(x0), and s1=f'(x1). + +\newdimen\@xi \newdimen\@xii \newdimen\@xiii \newdimen\@xiv +\newdimen\@xpt \newdimen\@xoldpt +\newdimen\@yi \newdimen\@yii \newdimen\@yiii \newdimen\@yiv +\newdimen\@ypt \newdimen\@yoldpt +\def\squine(#1,#2,#3,#4,#5,#6){\setbox\@picbox\hbox{\tencirc q}% + \global\@xoldpt=#1\unitlength \global\@yoldpt=#4\unitlength \kern\@xoldpt + \@xi=\@xoldpt \@xii=#2\unitlength \@xiii=#3\unitlength + \@yi=\@yoldpt \@yii=#5\unitlength \@yiii=#6\unitlength + \squinerec + \@xpt=#3\unitlength \@ypt=#6\unitlength \@addpoint + \raise\@ypt\copy\@picbox} +\newif\iffar +\def\squinerec{\farfalse \testnear\@xi\@xiii \testnear\@yi\@yiii + \iffar \decast \fi} +\def\testnear#1#2{\@save=#1\advance\@save-#2% + \ifdim\@save<\z@ \@save=-\@save\fi \ifdim\@save>\p@ \fartrue \fi} +\def\decast{\@xpt=\@xi \advance\@xpt\@xii \divide\@xpt2 + \advance\@xii\@xiii \divide\@xii2 + \@xiv=\@xpt \advance\@xiv\@xii \divide\@xiv2 + \@ypt=\@yi \advance\@ypt\@yii \divide\@ypt2 + \advance\@yii\@yiii \divide\@yii2 + \@yiv=\@ypt \advance\@yiv\@yii \divide\@yiv2 + \begingroup\@xii=\@xpt \@xiii=\@xiv + \@yii=\@ypt \@yiii=\@yiv \squinerec\endgroup + \@xpt=\@xiv \@ypt=\@yiv \@addpoint + \@xi=\@xiv \@yi=\@yiv \squinerec} +\def\@addpoint{%\message{(\the\@xpt,\the\@ypt)}% + \global\advance\@xoldpt-\@xpt \wd\@picbox=-\@xoldpt + \raise\@yoldpt\copy\@picbox \global\@xoldpt=\@xpt \global\@yoldpt=\@ypt} + +\catcode`\@=12 % disable private control sequences diff --git a/systems/knuth/local/lib/proofmac.tex b/systems/knuth/local/lib/proofmac.tex new file mode 100644 index 0000000000..29533b84b4 --- /dev/null +++ b/systems/knuth/local/lib/proofmac.tex @@ -0,0 +1,353 @@ +% standard macros for CWEB listings (in addition to plain.tex) +% Version 3.6 --- May 2000 +% Modified for proofs in CTWILL +\ifx\documentstyle\undefined\else\endinput\fi % LaTeX will use other macros +\xdef\fmtversion{\fmtversion+CWEB3.6+PROOFS} + +\let\:=\. % preserve a way to get the dot accent + % (all other accents will still work as usual) + +\parskip 0pt % no stretch between paragraphs +\parindent 1em % for paragraphs and for the first line of C text + +\font\ninerm=cmr9 +\let\mc=\ninerm % medium caps +\def\CEE/{{\mc C\spacefactor1000}} +\def\UNIX/{{\mc U\kern-.05emNIX\spacefactor1000}} +\def\TEX/{\TeX} +\def\CPLUSPLUS/{{\mc C\PP\spacefactor1000}} +\def\Cee{\CEE/} % for backward compatibility +\def\9#1{} +\font\eightrm=cmr8 +\let\sc=\eightrm % small caps (NOT a caps-and-small-caps font) +\let\mainfont=\tenrm +\let\cmntfont\tenrm +%\font\tenss=cmss10 \let\cmntfont\tenss % alternative comment font +\font\titlefont=cmr7 scaled\magstep4 % title on the contents page +\font\ttitlefont=cmtt10 scaled\magstep2 % typewriter type in title +\font\tentex=cmtex10 % TeX extended character set (used in strings) +\fontdimen7\tentex=0pt % no double space after sentences + +\def\\#1{\leavevmode\hbox{\it#1\/\kern.05em}} % italic type for identifiers +\def\|#1{\leavevmode\hbox{$#1$}} % one-letter identifiers look better this way +\def\{\leavevmode\hbox{\bf + \def\_{\kern.04em\vbox{\hrule width.3em height .6pt}\kern.08em}% + #1\/\kern.05em}} % boldface type for reserved words +\def\.#1{\leavevmode\hbox{\tentex % typewriter type for strings + \let\\=\BS % backslash in a string + \let\{=\LB % left brace in a string + \let\}=\RB % right brace in a string + \let\~=\TL % tilde in a string + \let\ =\SP % space in a string + \let\_=\UL % underline in a string + \let\&=\AM % ampersand in a string + \let\^=\CF % circumflex in a string + #1\kern.05em}} +\def\){{\tentex\kern-.05em}\discretionary{\hbox{\tentex\BS}}{}{}} +\def\AT{@} % at sign for control text (not needed in versions >= 2.9) +\def\ATL{\par\noindent\bgroup\catcode`\_=12 \postATL} % print @l in limbo +\def\postATL#1 #2 {\bf letter \\{\uppercase{\char"#1}} + tangles as \tentex "#2"\egroup\par} +\def\noATL#1 #2 {} +\def\noatl{\let\ATL=\noATL} % suppress output from @l +\def\ATH{\X\kern-.5em:Preprocessor definitions\X} +\let\PB=\relax % hook for program brackets |...| in TeX part or section name + +\chardef\AM=`\& % ampersand character in a string +\chardef\BS=`\\ % backslash in a string +\chardef\LB=`\{ % left brace in a string +\chardef\RB=`\} % right brace in a string +\def\SP{{\tt\char`\ }} % (visible) space in a string +\chardef\TL=`\~ % tilde in a string +\chardef\UL=`\_ % underline character in a string +\chardef\CF=`\^ % circumflex character in a string + +\newbox\PPbox % symbol for ++ +\setbox\PPbox=\hbox{\kern.5pt\raise1pt\hbox{\sevenrm+\kern-1pt+}\kern.5pt} +\def\PP{\copy\PPbox} +\newbox\MMbox \setbox\MMbox=\hbox{\kern.5pt\raise1pt\hbox{\sevensy\char0 + \kern-1pt\char0}\kern.5pt} +\def\MM{\copy\MMbox} +\newbox\MGbox % symbol for -> +\setbox\MGbox=\hbox{\kern-2pt\lower3pt\hbox{\teni\char'176}\kern1pt} +\def\MG{\copy\MGbox} +\def\MRL#1{\mathrel{\let\K==#1}} +\let\GG=\gg +\let\LL=\ll +\let\NULL=\Lambda +\mathchardef\AND="2026 % bitwise and; also \& (unary operator) +\let\OR=\mid % bitwise or +\let\XOR=\oplus % bitwise exclusive or +\def\CM{{\sim}} % bitwise complement +\newbox\MODbox \setbox\MODbox=\hbox{\eightrm\%} +\def\MOD{\mathbin{\copy\MODbox}} +\def\DC{\kern.1em{::}\kern.1em} % symbol for :: +\def\PA{\mathbin{.*}} % symbol for .* +\def\MGA{\mathbin{\MG*}} % symbol for ->* +\def\this{\&{this}} + +\newbox\bak \setbox\bak=\hbox to -1em{} % backspace one em +\newbox\bakk\setbox\bakk=\hbox to -2em{} % backspace two ems + +\newcount\ind % current indentation in ems +\def\1{\global\advance\ind by1\hangindent\ind em} % indent one more notch +\def\2{\global\advance\ind by-1} % indent one less notch +\def\3#1{\hfil\penalty#10\hfilneg} % optional break within a statement +\def\4{\copy\bak} % backspace one notch +\def\5{\hfil\penalty-1\hfilneg\kern2.5em\copy\bakk\ignorespaces}% optional break +\def\6{\ifmmode\else\par % forced break + \hangindent\ind em\noindent\kern\ind em\copy\bakk\ignorespaces\fi} +\def\7{\Y\6} % forced break and a little extra space +\def\8{\hskip-\ind em\hskip 2em} % no indentation + +\newcount\gdepth % depth of current major group, plus one +\newcount\secpagedepth +\secpagedepth=3 % page breaks will occur for depths -1, 0, and 1 +\newtoks\gtitle % title of current major group +\newskip\intersecskip \intersecskip=12pt minus 3pt % space between sections +\let\yskip=\smallskip +\def\?{\mathrel?} +\def\note#1#2.{\Y\noindent{\hangindent2em\baselineskip10pt\eightrm#1~#2.\par}} +\def\lapstar{\rlap{*}} +\def\stsec{\rightskip=0pt % get out of C mode (cf. \B) + \sfcode`;=1500 \pretolerance 200 \hyphenpenalty 50 \exhyphenpenalty 50 + \noindent{\let\*=\lapstar\bf\secstar.\quad}} +\let\startsection=\stsec +\def\defin#1{\global\advance\ind by 2 \1\&{#1 } } % begin `define' or `format' +\def\A{\note{See also section}} % xref for doubly defined section name +\def\As{\note{See also sections}} % xref for multiply defined section name +\def\B{\rightskip=0pt plus 100pt minus 10pt % go into C mode + \sfcode`;=3000 + \pretolerance 10000 + \hyphenpenalty 1000 % so strings can be broken (discretionary \ is inserted) + \exhyphenpenalty 10000 + \global\ind=2 \1\ \unskip} +\def\C#1{\5\5\quad$/\ast\,${\cmntfont #1}$\,\ast/$} +\let\SHC\C % "// short comments" treated like "/* ordinary comments */" +%\def\C#1{\5\5\quad$\triangleright\,${\cmntfont#1}$\,\triangleleft$} +%\def\SHC#1{\5\5\quad$\diamond\,${\cmntfont#1}} +\def\D{\defin{\#define}} % macro definition +\let\E=\equiv % equivalence sign +\def\ET{ and~} % conjunction between two section numbers +\def\ETs{, and~} % conjunction between the last two of several section numbers +\def\F{\defin{format}} % format definition +\let\G=\ge % greater than or equal sign +% \H is long Hungarian umlaut accent +\let\I=\ne % unequal sign +\def\J{\.{@\&}} % TANGLE's join operation +\let\K== % assignment operator +%\let\K=\leftarrow % "honest" alternative to standard assignment operator +% \L is Polish letter suppressed-L +\outer\def\M#1{\MN{#1}\ifon\vfil\penalty-100\vfilneg % beginning of section + \vskip\intersecskip\startsection\ignorespaces} +\outer\def\N#1#2#3.{\gdepth=#1\gtitle={#3}\MN{#2}% beginning of starred section + \ifon\ifnum#1<\secpagedepth \vfil\eject % force page break if depth is small + \else\vfil\penalty-100\vfilneg\vskip\intersecskip\fi\fi + \message{*\secno} % progress report + \edef\next{\write\cont{\ZZ{#3}{#1}{\secno}% write to contents file + {\noexpand\the\pageno}}}\next % \ZZ{title}{depth}{sec}{page} + \ifon\startsection{\bf#3.\quad}\ignorespaces} +\def\MN#1{\par % common code for \M, \N + {\xdef\secstar{#1}\let\*=\empty\xdef\secno{#1}}% remove \* from section name + \ifx\secno\secstar \onmaybe \else\ontrue \fi + \mark{{{\tensy x}\secno}{\the\gdepth}{\the\gtitle}}} +% each \mark is {section reference or null}{depth plus 1}{group title} +% \O is Scandinavian letter O-with-slash +% \P is paragraph sign +\def\Q{\note{This code is cited in section}} % xref for mention of a section +\def\Qs{\note{This code is cited in sections}} % xref for mentions of a section +\let\R=\lnot % logical not +% \S is section sign +\def\T#1{\leavevmode % octal, hex or decimal constant + \hbox{$\def\?{\kern.2em}% + \def\$##1{\egroup_{\,\rm##1}\bgroup}% suffix to constant + \def\_{\cdot 10^{\aftergroup}}% power of ten (via dirty trick) + \let\~=\oct \let\^=\hex {#1}$}} +\def\U{\note{This code is used in section}} % xref for use of a section +\def\Us{\note{This code is used in sections}} % xref for uses of a section +\let\V=\lor % logical or +\let\W=\land % logical and +\def\X#1:#2\X{\ifmmode\gdef\XX{\null$\null}\else\gdef\XX{}\fi % section name + \XX$\langle\,${\let\I=\ne#2\eightrm\kern.5em#1}$\,\rangle$\XX} +\def\Y{\par\yskip} +\let\Z=\le +\let\ZZ=\let % now you can \write the control sequence \ZZ +\let\*=* + +%\def\oct{\hbox{\rm\char'23\kern-.2em\it\aftergroup\?\aftergroup}} % WEB style +%\def\hex{\hbox{\rm\char"7D\tt\aftergroup}} % WEB style +\def\oct{\hbox{$^\circ$\kern-.1em\it\aftergroup\?\aftergroup}}% CWEB style +\def\hex{\hbox{$^{\scriptscriptstyle\#}$\tt\aftergroup}} % CWEB style +\def\vb#1{\leavevmode\hbox{\kern2pt\vrule\vtop{\vbox{\hrule + \hbox{\strut\kern2pt\.{#1}\kern2pt}} + \hrule}\vrule\kern2pt}} % verbatim string + +\def\onmaybe{\let\ifon=\maybe} \let\maybe=\iftrue +\newif\ifon \newif\iftitle \newif\ifpagesaved + +\def\lheader{\mainfont\the\pageno\eightrm\qquad\grouptitle\hfill\title\qquad + \mainfont\topsecno} % top line on left-hand pages +\def\rheader{\mainfont\topsecno\eightrm\qquad\title\hfill\grouptitle + \qquad\mainfont\the\pageno} % top line on right-hand pages +\def\grouptitle{\let\i=I\let\j=J\uppercase\expandafter{\expandafter + \takethree\topmark}} +\def\topsecno{\expandafter\takeone\topmark} +\def\takeone#1#2#3{#1} +\def\taketwo#1#2#3{#2} +\def\takethree#1#2#3{#3} +\def\nullsec{\eightrm\kern-2em} % the \kern-2em cancels \qquad in headers + +\def\page{\box255 } +\def\normaloutput#1#2#3{\ifodd\pageno\hoffset=\pageshift\fi + \shipout\vbox{ + \vbox to\fullpageheight{ + \iftitle\global\titlefalse + \else\hbox to\pagewidth{\vbox to10pt{}\ifodd\pageno #3\else#2\fi}\fi + \vfill#1}} % parameter #1 is the page itself + \global\advance\pageno by1} + +\gtitle={\.{CWEB} output} % this running head is reset by starred sections +\mark{\noexpand\nullsec0{\the\gtitle}} +\def\title{\expandafter\uppercase\expandafter{\jobname}} +\def\topofcontents{\centerline{\titlefont\title}\vskip.7in + \vfill} % this material will start the table of contents page +\def\botofcontents{\vfill + \centerline{\covernote}} % this material will end the table of contents page +\def\covernote{} +\def\contentspagenumber{0} % default page number for table of contents +\newdimen\pagewidth \pagewidth=6.5in % the width of each page +\newdimen\pageheight \pageheight=8.7in % the height of each page +\newdimen\fullpageheight \fullpageheight=9in % page height including headlines +\newdimen\pageshift \pageshift=0in % shift righthand pages wrt lefthand ones +\def\magnify#1{\mag=#1\pagewidth=6.5truein\pageheight=8.7truein + \fullpageheight=9truein\setpage} +\def\setpage{\hsize\pagewidth\vsize\pageheight} % use after changing page size +\def\contentsfile{\jobname.toc} % file that gets table of contents info +\def\readcontents{\input \contentsfile} +\def\readindex{\input \jobname.idx} +\def\readsections{\input \jobname.scn} + +\newwrite\cont +\output{\setbox0=\page % the first page is garbage + \openout\cont=\contentsfile + \write\cont{\catcode `\noexpand\@=11\relax} % \makeatletter + \global\output{\normaloutput\page\lheader\rheader}} +\setpage +\vbox to \vsize{} % the first \topmark won't be null + +\def\mini{\Y\bgroup\obeylines} +{\obeylines + \gdef\[#1 #2 #3 +{\noindent\kern.5\hsize #2\miniform#3, \S#1.\par}% + \gdef\]#1 #2 #3 +{\noindent\kern.5\hsize #2\miniform#3, \extref#1.\par}} +\def\miniform{\futurelet\next\miniforma} +\def\miniforma{\ifx\next\zip + \else\if=\noexpand\next \let\next\gobbleq + \else\let\next\colon\fi\fi\next} +\def\zip{} +\def\gobbleq={\,=\,} +\def\colon{: } +\def\extref{\futurelet\next\extrefa} +\def\extrefa{\if"\next\let\next\gobblest\else\let\next\cite\fi\next} +\def\gobblest"#1"{{\tentex#1}} +\def\cite#1#2.{{\sc#1}\,\S#2.} +\let\FI=\fi +\let\shortpage=\relax +\let\forcebr=\relax +\def\uninitialized{???} + +\def\ch{\note{The following sections were changed by the change file:} + \let\*=\relax} +\newbox\sbox % saved box preceding the index +\newbox\lbox % lefthand column in the index +\def\inx{\par\vskip6pt plus 1fil % we are beginning the index + \write\cont{} % ensure that the contents file isn't empty + \write\cont{\catcode `\noexpand\@=12\relax} % \makeatother + \closeout\cont % the contents information has been fully gathered + \output{\ifpagesaved\normaloutput{\box\sbox}\lheader\rheader\fi + \global\setbox\sbox=\page \global\pagesavedtrue} + \pagesavedfalse \eject % eject the page-so-far and predecessors + \setbox\sbox\vbox{\unvbox\sbox} % take it out of its box + \vsize=\pageheight \advance\vsize by -\ht\sbox % the remaining height + \hsize=.5\pagewidth \advance\hsize by -10pt + % column width for the index (20pt between cols) + \parfillskip 0pt plus .6\hsize % try to avoid almost empty lines + \def\lr{L} % this tells whether the left or right column is next + \output{\if L\lr\global\setbox\lbox=\page \gdef\lr{R} + \else\normaloutput{\vbox to\pageheight{\box\sbox\vss + \hbox to\pagewidth{\box\lbox\hfil\page}}}\lheader\rheader + \global\vsize\pageheight\gdef\lr{L}\global\pagesavedfalse\fi} + \message{Index:} + \parskip 0pt plus .5pt + \outer\def\I##1, {\par\hangindent2em\noindent##1:\kern1em} % index entry + \def\[##1]{$\underline{##1}$} % underlined index item + \rm \rightskip0pt plus 2.5em \tolerance 10000 \let\*=\lapstar + \hyphenpenalty 10000 \parindent0pt + \readindex} +\def\fin{\par\vfill\eject % this is done when we are ending the index + \ifpagesaved\null\vfill\eject\fi % output a null index column + \if L\lr\else\null\vfill\eject\fi % finish the current page + \parfillskip 0pt plus 1fil + \def\grouptitle{NAMES OF THE SECTIONS} + \let\topsecno=\nullsec + \message{Section names:} + \output={\normaloutput\page\lheader\rheader} + \setpage + \def\note##1##2.{\quad{\eightrm##1~##2.}} + \def\Q{\note{Cited in section}} % crossref for mention of a section + \def\Qs{\note{Cited in sections}} % crossref for mentions of a section + \def\U{\note{Used in section}} % crossref for use of a section + \def\Us{\note{Used in sections}} % crossref for uses of a section + \def\I{\par\hangindent 2em}\let\*=* + \readsections} +\def\con{\par\vfill\eject % finish the section names + \rightskip 0pt \hyphenpenalty 50 \tolerance 200 + \setpage \output={\normaloutput\page\lheader\rheader} + \titletrue % prepare to output the table of contents + \pageno=\contentspagenumber + \def\grouptitle{TABLE OF CONTENTS} + \message{Table of contents:} + \topofcontents + \line{\hfil Section\hbox to3em{\hss Page}} + \let\ZZ=\contentsline + \readcontents\relax % read the contents info + \botofcontents \end} % print the contents page(s) and terminate +\def\contentsline#1#2#3#4{\ifnum#2=0 \smallbreak\fi + \line{\consetup{#2}#1 + \rm\leaders\hbox to .5em{.\hfil}\hfil\ #3\hbox to3em{\hss#4}}} +\def\consetup#1{\ifcase#1 \bf % depth -1 (@**) + \or % depth 0 (@*) + \or \hskip2em % depth 1 (@*1) + \or \hskip4em % depth 2 (@*2) + \or \hskip6em % depth 3 (@*3) + \or \hskip8em % depth 4 (@*4) + \or \hskip10em % depth 5 (@*5) + \else \hskip12em \fi} % depth 6 or more +\def\noinx{\let\inx=\end} % no indexes or table of contents +\def\nosecs{\let\FIN=\fin \def\fin{\let\parfillskip=\end \FIN}} + % no index of section names or table of contents +\def\nocon{\let\con=\end} % no table of contents +\def\today{\ifcase\month\or + January\or February\or March\or April\or May\or June\or + July\or August\or September\or October\or November\or December\fi + \space\number\day, \number\year} +\newcount\twodigits +\def\hours{\twodigits=\time \divide\twodigits by 60 \printtwodigits + \multiply\twodigits by-60 \advance\twodigits by\time :\printtwodigits} +\def\gobbleone1{} +\def\printtwodigits{\advance\twodigits100 + \expandafter\gobbleone\number\twodigits + \advance\twodigits-100 } +\def\TeX{{\ifmmode\it\fi + \leavevmode\hbox{T\kern-.1667em\lower.424ex\hbox{E}\hskip-.125em X}}} +\def\,{\relax\ifmmode\mskip\thinmuskip\else\thinspace\fi} +\def\datethis{\def\startsection{\leftline{\sc\today\ at \hours}\bigskip + \let\startsection=\stsec\stsec}} + % say `\datethis' in limbo, to get your listing timestamped before section 1 +\def\datecontentspage{% + \def\topofcontents{\leftline{\sc\today\ at \hours}\bigskip + \centerline{\titlefont\title}\vfill}} % timestamps the contents page +\def\formatoff{\gdef\F##1\par{\setbox0=\lastbox\par}} % omits output of @f +\def\formaton{\gdef\F{\defin{format}}} % restores output of @f + % hack: you can say @t}\par\formaton{@> at end of an @f being suppressed diff --git a/systems/knuth/local/lib/random.mf b/systems/knuth/local/lib/random.mf new file mode 100644 index 0000000000..cc433a8d1f --- /dev/null +++ b/systems/knuth/local/lib/random.mf @@ -0,0 +1,198 @@ +% Font for examples in Chapter 21 of The METAFONTbook + +font_size 10pt#; +mode_setup; + +font_identifier "RANDOM"; +font_coding_scheme "PI"; + +% uniforms (characters 0--9) +randomseed:=3.14159; +for code=0 upto 9: +beginchar(code,10pt#,10pt#,0); +pickup pencircle scaled .3pt; draw unitsquare scaled w; +pickup pencircle scaled 1pt; +for k=1 upto 100: drawdot(uniformdeviate w,uniformdeviate w); endfor +endchar; +endfor + +% normals (characters 10--19) +randomseed:=3.14159; +for code=10 upto 19: +beginchar(code,10pt#,10pt#,0); +pickup pencircle scaled .3pt; draw unitsquare scaled w; +pickup pencircle scaled 1pt; +for k=1 upto 100: drawdot(1/6w*normaldeviate+.5w,1/6w*normaldeviate+.5w); endfor +endchar; +endfor + +% both (characters 20--29) +randomseed:=3.14159; +for code=20 upto 29: +beginchar(code,10pt#,10pt#,0); +pickup pencircle scaled .3pt; draw unitsquare scaled w; +pickup pencircle scaled 1pt; +for k=1 upto 100: drawdot(uniformdeviate w,1/6w*normaldeviate+.5w); endfor +endchar; +endfor + +% METAFONT logo (characters 30--109) +randomseed:=ASCII"M"+epsilon*ASCII"F"; +vardef noise=normaldeviate*craziness enddef; + +ht#:=6pt#; +xgap#:=0.6pt#; +u#:=4/9pt#; +s#:=0; +o#:=1/9pt#; +px#:=2/3pt#; +ygap#:=xgap#; +leftstemloc#:=2.5u#+s#; +barheight#:=.45ht#; +define_pixels(s,u,xgap,ygap,leftstemloc,barheight); +py#:=.9px#; define_blacker_pixels(px,py); +pickup pencircle xscaled px yscaled py; logo_pen:=savepen; +define_corrected_pixels(o); + +def beginlogochar(expr c,n) = + beginchar(incr code,n*u#+2s#,ht#,0); pickup logo_pen enddef; + +def NN= +beginlogochar("N",15); +x1=leftstemloc+noise; +x2=leftstemloc+noise; +x4=w-leftstemloc+noise; +x5=w-leftstemloc+noise; +bot y1=noise-o; +top y2=h+o+noise; +y3=y4+ygap+noise; +bot y4=noise-o; +top y5=h+o+noise; +z3=whatever[z4,z5]; +draw z1--z2--z3; draw z4--z5; labels(1,2,3,4,5); endchar; +enddef; + +def MM= +beginlogochar("M",18); +x1=leftstemloc+noise; +x2=leftstemloc+noise; +x3=.5w+noise; +x4=w-leftstemloc+noise; +x5=w-leftstemloc+noise; +bot y1=noise-o; +top y2=h+o+noise; +bot y3=ygap+noise; +top y4=h+o+noise; +bot y5=noise-o; +draw z1--z2--z3--z4--z5; labels(1,2,3,4,5); endchar; +enddef; + +def EE= +beginlogochar("E",14); +x1=leftstemloc+noise; +x3=leftstemloc+noise; +x4=w-leftstemloc+o+noise; +x5=w-leftstemloc+o-xgap+noise; +x6=w-leftstemloc+o+noise; +bot y1=noise; +y2=barheight+noise; +top y3=h+noise; +top y4=h+noise; +y5=barheight+noise; +bot y6=noise; +z2=whatever[z1,z3]; +draw z6--z1--z3--z4; draw z2--z5; labels(1,2,3,4,5,6); endchar; +enddef; + +def FF= +beginlogochar("F",14); +x1=leftstemloc+noise; +x3=leftstemloc+noise; +x4=w-leftstemloc+o+noise; +x5=w-leftstemloc+o-xgap+noise; +bot y1=noise-o; +y2=barheight+noise; +top y3=h+noise; +top y4=h+noise; +y5=barheight+noise; +bot y6=noise; +z2=whatever[z1,z3]; +draw z1--z3--z4; draw z2--z5; labels(1,2,3,4,5); endchar; +enddef; + +def TT= +beginlogochar("T",13); +lft x1=noise; +rt x2=w+noise; +x3=.5w+noise; +x4=.5w+noise; +top y1=h+noise; +top y2=h+noise; +bot y4=noise-o; +z3=whatever[z1,z2]; +draw z1--z2; draw z3--z4; labels(1,2,3,4); endchar; +enddef; + +def AA= +beginlogochar("A",15); +x1=.5w+noise; +x2'=leftstemloc+noise; +x3'=w-leftstemloc+noise; +x4=leftstemloc+noise; +x5=w-leftstemloc+noise; +top y2'=h+o+noise; +top y3'=h+o+noise; +y2=barheight+noise; +y3=barheight+noise; +bot y4=noise-o; +bot y5=noise-o; +z1=whatever[z2',z3']; +z2=whatever[z4,z2']; +z3=whatever[z5,z3']; +draw z4--z2--z3--z5; +draw z2{z2'-z2}...z2+.8(z2'-z2)-.2(z2'-z1){z1-z2} + ...z1{z3'-z2'}...z3+.8(z3'-z3)-.2(z3'-z1){z3-z1}...z3{z3-z3'}; +labels(1,2,3,4,5,2',3'); endchar; +enddef; + +def OO= +beginlogochar("O",15); +x1'=1.5u+s+noise; +x2'=1.5u+s+noise; +x3'=w-1.5u-s+noise; +x4'=w-1.5u-s+noise; +bot y1'=noise-o; +top y2'=h+o+noise; +top y3'=h+o+noise; +bot y4'=noise-o; +z1=.5[z1',z2']; z2=.5[z2',z3']; z3=.5[z3',z4']; z4=.5[z4',z1']; +draw z2{z2'-z3'}...z2+.8(z2'-z2)-.2(z2'-z1){z1-z2} + ...z1{z1'-z2'}...z1+.8(z1'-z1)-.2(z1'-z4){z4-z1} + ...z4{z4'-z1'}...z4+.8(z4'-z4)-.2(z4'-z3){z3-z4} + ...z3{z3'-z4'}...z3+.8(z3'-z3)-.2(z3'-z2){z2-z3}...cycle; +labels(1,2,3,4,5,2',3'); endchar; +enddef; + + +code:=29; +for c=10 downto 1:craziness:=c*.05pt; + MM; EE; TT; AA; FF; OO; NN; TT; endfor + +% histogram (character 126) +randomseed:=0; +beginchar(126,24pt#,10pt#,0); +%pickup pencircle scaled .3pt; draw unitsquare xscaled w yscaled h; + numeric count[]; pickup pencircle scaled 1pt; +for n:=1 upto 100: x:=normaldeviate*4pt+12pt; +y:=floor(x/pt); if unknown count[y]: count[y]:=-1; fi +drawdot(x,pt*incr count[y]); endfor endchar; + +% skyline (character 127) +randomseed:=2.71828; +beginchar(127,100pt#,10pt#,0); +for n:=0 upto 99: +fill unitsquare xscaled 1pt yscaled uniformdeviate h shifted (n*pt,0); +endfor +endchar; + +bye diff --git a/systems/knuth/local/lib/rotate.tex b/systems/knuth/local/lib/rotate.tex new file mode 100644 index 0000000000..27891ee95e --- /dev/null +++ b/systems/knuth/local/lib/rotate.tex @@ -0,0 +1,43 @@ +% +% These macros allow you to rotate or flip a \TeX\ box. Very useful for +% sideways tables or upsidedown answers. +% +% To use, create a box containing the information you want to rotate. +% (An hbox or vbox will do.) Now call \rotr\boxnum to rotate the +% material and create a new box with the appropriate (flipped) dimensions. +% \rotr rotates right, \rotl rotates left, \rotu turns upside down, and +% \rotf flips. These boxes may contain other rotated boxes. +% +\newdimen\rotdimen +\def\vspec#1{\special{ps:#1}}% passes #1 verbatim to the output +\def\rotstart#1{\vspec{gsave currentpoint currentpoint translate + #1 neg exch neg exch translate}}% #1 can be any origin-fixing transformation +\def\rotfinish{\vspec{currentpoint grestore moveto}}% gets back in synch +% +% First, the rotation right. The reference point of the rotated box +% is the lower right corner of the original box. +% +\def\rotr#1{\rotdimen=\ht#1\advance\rotdimen by\dp#1% + \hbox to\rotdimen{\hskip\ht#1\vbox to\wd#1{\rotstart{90 rotate}% + \box#1\vss}\hss}\rotfinish} +% +% Next, the rotation left. The reference point of the rotated box +% is the upper left corner of the original box. +% +\def\rotl#1{\rotdimen=\ht#1\advance\rotdimen by\dp#1% + \hbox to\rotdimen{\vbox to\wd#1{\vskip\wd#1\rotstart{270 rotate}% + \box#1\vss}\hss}\rotfinish}% +% +% Upside down is simple. The reference point of the rotated box +% is the upper right corner of the original box. (The box's height +% should be the current font's xheight, \fontdimen5\font, +% if you want that xheight to be at the baseline after rotation.) +% +\def\rotu#1{\rotdimen=\ht#1\advance\rotdimen by\dp#1% + \hbox to\wd#1{\hskip\wd#1\vbox to\rotdimen{\vskip\rotdimen + \rotstart{-1 dup scale}\box#1\vss}\hss}\rotfinish}% +% +% And flipped end for end is pretty ysae too. We retain the baseline. +% +\def\rotf#1{\hbox to\wd#1{\hskip\wd#1\rotstart{-1 1 scale}% + \box#1\hss}\rotfinish}% diff --git a/systems/knuth/local/lib/slantaps4.mf b/systems/knuth/local/lib/slantaps4.mf new file mode 100644 index 0000000000..1d7ecbd492 --- /dev/null +++ b/systems/knuth/local/lib/slantaps4.mf @@ -0,0 +1,11 @@ +% slant font for slope 1/4 on the APS + +if mode<>aps: errmessage "This file is for aps only"; fi + +s=1/4; +n=30; +r#=.4; +u=4; % an approximation to r in pixels + +font_identifier "SLANTAPS4"; +input slant diff --git a/systems/knuth/local/lib/slantimagen4.mf b/systems/knuth/local/lib/slantimagen4.mf new file mode 100644 index 0000000000..ffe19c7b90 --- /dev/null +++ b/systems/knuth/local/lib/slantimagen4.mf @@ -0,0 +1,11 @@ +% slant font for slope 1/4 on the Imagen + +if mode<>imagen: errmessage "This file is for imagen only"; fi + +s=1/4; +n=30; +r#=.4; +u=2; % an approximation to r in pixels + +font_identifier "SLANTIMAGEN4"; +input slant diff --git a/systems/knuth/local/lib/slantimagen6.mf b/systems/knuth/local/lib/slantimagen6.mf new file mode 100644 index 0000000000..3859b471fd --- /dev/null +++ b/systems/knuth/local/lib/slantimagen6.mf @@ -0,0 +1,11 @@ +% slant font for slope 1/6 on the Imagen + +if mode<>imagen: errmessage "This file is for imagen only"; fi + +s=1/6; +n=30; +r#=.4; +u=2; % an approximation to r in pixels + +font_identifier "SLANTIMAGEN6"; +input slant diff --git a/systems/knuth/local/lib/slantlino4.mf b/systems/knuth/local/lib/slantlino4.mf new file mode 100644 index 0000000000..02ef790a03 --- /dev/null +++ b/systems/knuth/local/lib/slantlino4.mf @@ -0,0 +1,11 @@ +% slant font for slope 1/4 on the Linotronic + +if mode<>linohi: errmessage "This file is for lino only"; fi + +s=1/4; +n=30; +r#=.4; +u=7; % an approximation to r in pixels + +font_identifier "SLANTLINO4"; +input slant diff --git a/systems/knuth/local/lib/slantlj4.mf b/systems/knuth/local/lib/slantlj4.mf new file mode 100644 index 0000000000..53264d0536 --- /dev/null +++ b/systems/knuth/local/lib/slantlj4.mf @@ -0,0 +1,11 @@ +% slant font for slope 1/4 on the LaserJet + +if mode<>ljfour: errmessage "This file is for LaserJet only"; fi + +s=1/4; +n=30; +r#=.4; +u=3; % an approximation to r in pixels + +font_identifier "SLANTLJ4"; +input slant diff --git a/systems/knuth/local/lib/slist.tex b/systems/knuth/local/lib/slist.tex new file mode 100644 index 0000000000..26ec4d5fbe --- /dev/null +++ b/systems/knuth/local/lib/slist.tex @@ -0,0 +1,49 @@ +% Makes a small-print listing of one or more files +% Typical usage: +% tex slist *.c \\end + +\def\grabfile#1 {\setbox0=\lastbox\endgraf\doit{#1}} +\everypar{\grabfile} + +\font\filenamefont= cmtt8 scaled\magstep3 +\font\headlinefont= cmr8 +\font\listingfont= cmtex8 +\font\eoffont= cmti8 + +\def\today{\ifcase\month\or + January\or February\or March\or April\or May\or June\or + July\or August\or September\or October\or November\or December\fi + \space\number\day, \number\year} +\newcount\m \newcount\n +\n=\time \divide\n 60 \m=-\n \multiply\m 60 \advance\m \time +\def\hours{\twodigits\n\twodigits\m} +\def\twodigits#1{\ifnum #1<10 0\fi \number#1} + +\newlinechar=`@ +\message{@\today\space at \hours} + +\baselineskip=9pt minus 1pt +\medskipamount=4pt minus 1pt +\raggedbottom +\nopagenumbers + +\chardef\other=12 +\def\doit#1{\message{@Listing #1@} + \begingroup \everypar{} \frenchspacing + \headline{\filenamefont#1\quad\headlinefont \today\ at \hours + \hfill Page \folio} + \def\do##1{\catcode`##1=\other}\dospecials + \catcode127=\other \catcode9=\other \catcode12=\other + \parindent 0pt \parfillskip=0pt plus 1fil minus 1in + \everypar{\hangindent 1in} \rightskip=0pt plus 2in + \def\par{\ifvmode\penalty-500\medskip\else\endgraf\fi} + \listingfont \obeylines \obeyspaces \global\pageno=1 + \input #1 {\eoffont(end of\/ file)}\endgraf\vfill\eject\endgroup} +{\obeyspaces\global\let =\ } +\catcode`\_=\other % allow _ in file names + +% A tab (^^I) prints as lowercase gamma. +% Character ^^M could be made visible, with a bit of work; +% at present, it's indistinguishable from newline (^^J). + +% You can get up to 103 characters on a line without an overfull box. diff --git a/systems/knuth/local/lib/snfont.mf b/systems/knuth/local/lib/snfont.mf new file mode 100644 index 0000000000..dd50508dff --- /dev/null +++ b/systems/knuth/local/lib/snfont.mf @@ -0,0 +1,165 @@ +% special font for Surreal Numbers "Conway Stone" + +u#:=1mm#/2.5; % basic unit, corresponds to 1mm after 250% magnification +mode_setup; +define_pixels(u); + +vardef nd= u*normaldeviate enddef; +randomseed:=3.14; + +def .... = .. tension1.2 .. enddef; +def ..... = .. tension2 .. enddef; + +def zerochar(expr code) = + beginchar(code,(10+normaldeviate)*u#,10u#,0); + z0=(.5w,5u); + for j=1 upto 5: + z[j]=z0+((0,4u+.125nd) rotated (j*72+8normaldeviate)); + endfor + fill z1....z2....z3....z4....z5....cycle; + labels(0,1,2,3,4,5); + endchar; +enddef; + +def colonchar(expr code) = + beginchar(code,(5.5+normaldeviate)*u#,10u#,0); + z0=(.5w,3u); z10=(.5w,8u); + for j=1 upto 3: + z[j]=z0+((0,1.75u+.075nd) rotated (j*120+8normaldeviate)); + z[10+j]=z10+((0,1.75u+.075nd) rotated (60+j*120+8normaldeviate)); + endfor + fill z1....z2....z3....cycle; + fill z11....z12....z13....cycle; + labels(0,1,2,3,10,11,12,13); + endchar; +enddef; + +def horizchar(expr code) = + beginchar(code,(13+normaldeviate)*u#,10u#,0); + z1=(2u+nd/4,5u+nd/10); + z2=(w-2u+nd/4,5u+nd/10); + penpos1(1.5u,90); + penpos2(1.5u,90); + z10r=z1r+(nd/2,nd/8); + z10l=z1l+(nd/2,nd/8); + z10=(.5+uniformdeviate.3)[z10l,z10r]-(abs nd,0); + z20l=z2l+(nd/2,nd/8); + z20r=z2r+(nd/2,nd/8); + z20=(.5+uniformdeviate.3)[z20l,z20r]+(abs nd,0); + pickup pencircle scaled u; + filldraw z10r{dir(180+10normaldeviate)}...z10...z10l{dir 10normaldeviate} + ....z20l{dir 10normaldeviate}....z20....z20r{dir(180+10normaldeviate)} + ....cycle; + penlabels(1,2,10,20); + endchar; +enddef; + +def equalchar(expr code) = + beginchar(code,(15+normaldeviate)*u#,10u#,0); + z1=(4.5u+nd/4,6u+nd/10); + z2=(w-4.5u+nd/4,6u+nd/10); + penpos1(u,90); + penpos2(u,90); + z10r=z1r+(nd/2,nd/8); + z10l=z1l+(nd/2,nd/8); + z10=(.5+uniformdeviate.3)[z10l,z10r]-(abs nd,0); + z20l=z2l+(nd/2,nd/8); + z20r=z2r+(nd/2,nd/8); + z20=(.5+uniformdeviate.3)[z20l,z20r]+(abs nd,0); + pickup pencircle scaled .5u; + filldraw z10r{dir(180+5normaldeviate)}...z10...z10l{dir 5normaldeviate} + ....z20l{dir 5normaldeviate}....z20....z20r{dir(180+5normaldeviate)} + ....cycle; + z3=(4.5u+nd/4,2.5u+nd/10); + z4=(w-4.5u+nd/4,2.5u+nd/10); + penpos3(u,90); + penpos4(u,90); + z30r=z3r+(nd/2,nd/8); + z30l=z3l+(nd/2,nd/8); + z30=(.5+uniformdeviate.3)[z30l,z30r]-(abs nd,0); + z40l=z4l+(nd/2,nd/8); + z40r=z4r+(nd/2,nd/8); + z40=(.5+uniformdeviate.3)[z40l,z40r]+(abs nd,0); + filldraw z30r{dir(180+5normaldeviate)}...z30...z30l{dir 5normaldeviate} + ....z40l{dir 5normaldeviate}....z40....z40r{dir(180+5normaldeviate)} + ....cycle; + penlabels(1,2,3,4,10,20,30,40); + endchar; +enddef; + +def vertchar(expr code) = + beginchar(code,(5.5+normaldeviate)*u#,10u#,0); + z1=(.5w+nd/10,9u+nd/4); + z2=(.5w+nd/10,u+nd/4); + penpos1(1.8u,0); + penpos2(1.8u,0); + z10r=z1r+(nd/8,nd/2); + z10l=z1l+(nd/8,nd/2); + z10=(.5+uniformdeviate.3)[z10l,z10r]+(0,abs nd); + z20l=z2l+(nd/8,nd/2); + z20r=z2r+(nd/8,nd/2); + z20=(.5+uniformdeviate.3)[z20l,z20r]-(0,abs nd); + pickup pencircle scaled .6u; + filldraw z10r{dir(90+10normaldeviate)}....z10....z10l{dir-(90+10normaldeviate)} + ....z20l{dir-(90+10normaldeviate)}....z20....z20r{dir(90+10normaldeviate)} + ....cycle; + penlabels(1,2,10,20); + endchar; +enddef; + +def leftchar(expr code) = + beginchar(code,(10+normaldeviate)*u#,10u#,0); + z1=(w-2u+nd/16,11u+nd/8); + z0=z2=(3u+nd/16,5u+nd/16); + z3=(w-2u+nd/16,-u+nd/8); + penpos1(u,-35+10normaldeviate); + penpos0(u,-35); + penpos3(u,35+10normaldeviate); + penpos2(u,35); + z4=whatever[z0l,z1l]=whatever[z2l,z3l]; + pickup pencircle scaled u; + filldraw z1l{(z0l-z1l)rotated 5normaldeviate}....z4--z0r + ....z1r{(z1r-z0r)rotated 5normaldeviate}.....cycle; + filldraw z3l{(z2l-z3l)rotated 5normaldeviate}....z4--z2r + ....z3r{(z3r-z2r)rotated 5normaldeviate}.....cycle; + penlabels(0,1,2,3,4); + endchar; +enddef; + +def rightchar(expr code) = + beginchar(code,(10+normaldeviate)*u#,10u#,0); + z1=(2u+nd/16,11u+nd/8); + z0=z2=(w-3u+nd/16,5u+nd/16); + z3=(2u+nd/16,-u+nd/8); + penpos1(u,35+10normaldeviate); + penpos0(u,35); + penpos3(u,-35+10normaldeviate); + penpos2(u,-35); + z4=whatever[z0r,z1r]=whatever[z2r,z3r]; + pickup pencircle scaled u; + filldraw z1r{(z0r-z1r)rotated 5normaldeviate}....z4--z0l + ....z1l{(z1l-z0l)rotated 5normaldeviate}.....cycle; + filldraw z3r{(z2r-z3r)rotated 5normaldeviate}....z4--z2l + ....z3l{(z3l-z2l)rotated 5normaldeviate}.....cycle; + penlabels(0,1,2,3,4); + endchar; +enddef; + +for r=0 upto 9: + zerochar(10+r); + colonchar(20+r); + horizchar(30+r); + equalchar(40+r); + vertchar(50+r); + leftchar(60+r); + rightchar(70+r); +endfor + +font_quad:=10u#; +font_normal_space:=5u#; +font_normal_stretch:=3u#; +font_normal_shrink:=2u#; +font_identifier:="SNFONT"; +font_coding_scheme:="PI"; + +end. diff --git a/systems/knuth/local/lib/tinywlist.tex b/systems/knuth/local/lib/tinywlist.tex new file mode 100644 index 0000000000..cebc29e0a4 --- /dev/null +++ b/systems/knuth/local/lib/tinywlist.tex @@ -0,0 +1,53 @@ +% Makes a landscape listing of one or more files with wide lines +% Typical usage: +% tex list *.c \\end + +\hsize=9in +\vsize=6.5in +\special{landscape} + +\def\grabfile#1 {\setbox0=\lastbox\endgraf\doit{#1}} +\everypar{\grabfile} + +\font\filenamefont= cmtt8 scaled\magstep3 +\font\headlinefont= cmr8 +\font\listingfont= cmtex8 scaled 800 +\font\eoffont= cmti8 + +\def\today{\ifcase\month\or + January\or February\or March\or April\or May\or June\or + July\or August\or September\or October\or November\or December\fi + \space\number\day, \number\year} +\newcount\m \newcount\n +\n=\time \divide\n 60 \m=-\n \multiply\m 60 \advance\m \time +\def\hours{\twodigits\n\twodigits\m} +\def\twodigits#1{\ifnum #1<10 0\fi \number#1} + +\newlinechar=`@ +\message{@\today\space at \hours} + +\baselineskip=7pt +\medskipamount=4pt minus 1pt +\raggedbottom +\nopagenumbers + +\chardef\other=12 +\def\doit#1{\message{@Listing #1@} + \begingroup \everypar{} \frenchspacing + \headline{\filenamefont#1\quad\headlinefont \today\ at \hours + \hfill Page \folio} + \def\do##1{\catcode`##1=\other}\dospecials + \catcode127=\other \catcode9=\other \catcode12=\other + \parindent 0pt \parfillskip=0pt plus 1fil minus 1in + \everypar{\hangindent 1in} \rightskip=0pt plus 2in + \def\par{\ifvmode\penalty-500\medskip\else\endgraf\fi} + \listingfont \obeylines \obeyspaces \global\pageno=1 + \input #1 {\eoffont(end of\/ file)}\endgraf\vfill\eject\endgroup} +{\obeyspaces\global\let =\ } +\catcode`\_=\other % allow _ in file names + +% A tab (^^I) prints as lowercase gamma. +% Character ^^M could be made visible, with a bit of work; +% at present, it's indistinguishable from newline (^^J). + +% You can get up to 170 characters on a line without an overfull box. diff --git a/systems/knuth/local/lib/twimac.tex b/systems/knuth/local/lib/twimac.tex new file mode 100644 index 0000000000..99905f168c --- /dev/null +++ b/systems/knuth/local/lib/twimac.tex @@ -0,0 +1,400 @@ +% Special formatting for Computers and Typesetting: The Programs + +\xdef\fmtversion{\fmtversion+TWIMAC} + +\newif\ifsorted +\newread\sreffile \openin\sreffile=\jobname.sref +\newwrite\reffile +\ifeof\sreffile \immediate\openout\reffile=\jobname.ref \sortedfalse + \message{This is the first pass!} +\else \sortedtrue \message{This is the second pass!} \fi + +\newdimen\em \em=10pt +\parskip 0pt % no stretch between paragraphs +\parindent 1\em % for paragraphs and for the first line of Pascal text + +\font\manual=manfnt +\font\ninerm=cmr9 +\font\eightrm=cmr8 +\font\sixrm=cmr6 +\font\ninei=cmmi9 +\font\eighti=cmmi8 +\font\sixi=cmmi6 +\skewchar\ninei='177 \skewchar\eighti='177 \skewchar\sixi='177 +\font\ninesy=cmsy9 +\font\eightsy=cmsy8 +\font\sixsy=cmsy6 +\skewchar\ninesy='60 \skewchar\eightsy='60 \skewchar\sixsy='60 +\font\ninebf=cmbx9 +\font\eightbf=cmbx8 +\font\sixbf=cmbx6 +\font\ninett=cmtt9 +\font\eighttt=cmtt8 +\hyphenchar\ninett=-1 \hyphenchar\eighttt=-1 +\font\ninesl=cmsl9 +\font\eightsl=cmsl8 +\font\nineit=cmti9 +\font\eightit=cmti8 + +\newif\iftenpoint +\def\tenpoint{\tenpointtrue + \def\rm{\fam0\tenrm}% + \textfont0=\tenrm \scriptfont0=\sevenrm \scriptscriptfont0=\fiverm + \textfont1=\teni \scriptfont1=\seveni \scriptscriptfont1=\fivei + \textfont2=\tensy \scriptfont2=\sevensy \scriptscriptfont2=\fivesy + \textfont3=\tenex \scriptfont3=\tenex \scriptscriptfont3=\tenex + \def\it{\fam\itfam\tenit}% + \textfont\itfam=\tenit + \def\sl{\fam\slfam\tensl}% + \textfont\slfam=\tensl + \def\bf{\fam\bffam\tenbf}% + \textfont\bffam=\tenbf \scriptfont\bffam=\sevenbf + \scriptscriptfont\bffam=\fivebf + \def\tt{\fam\ttfam\tentt}% + \textfont\ttfam=\tentt + \def\ttx{\tentex}% + \normalbaselineskip=12pt + \def\MF{{\manual META}\-{\manual FONT}}% + \let\sc=\eightrm + \let\big=\tenbig + \setbox\strutbox=\hbox{\vrule height8pt depth3pt width 0pt}% + \normalbaselines\rm} + +\def\ninepoint{\tenpointfalse + \def\rm{\fam0\ninerm}% + \textfont0=\ninerm \scriptfont0=\sixrm \scriptscriptfont0=\fiverm + \textfont1=\ninei \scriptfont1=\sixi \scriptscriptfont1=\fivei + \textfont2=\ninesy \scriptfont2=\sixsy \scriptscriptfont2=\fivesy + \textfont3=\tenex \scriptfont3=\tenex \scriptscriptfont3=\tenex + \def\it{\fam\itfam\nineit}% + \textfont\itfam=\nineit + \def\sl{\fam\slfam\ninesl}% + \textfont\slfam=\ninesl + \def\bf{\fam\bffam\ninebf}% + \textfont\bffam=\ninebf \scriptfont\bffam=\sixbf + \scriptscriptfont\bffam=\fivebf + \def\tt{\fam\ttfam\ninett}% + \textfont\ttfam=\ninett + \def\ttx{\ninetex}% + \normalbaselineskip=11pt + \def\MF{{\manual hijk}\-{\manual lmnj}}% + \let\sc=\sevenrm + \let\big=\ninebig + \setbox\strutbox=\hbox{\vrule height8pt depth3pt width 0pt}% + \normalbaselines\rm} + +\def\eightpoint{% + \def\rm{\fam0\eightrm}% + \textfont0=\eightrm \scriptfont0=\sixrm \scriptscriptfont0=\fiverm + \textfont1=\eighti \scriptfont1=\sixi \scriptscriptfont1=\fivei + \textfont2=\eightsy \scriptfont2=\sixsy \scriptscriptfont2=\fivesy + \textfont3=\tenex \scriptfont3=\tenex \scriptscriptfont3=\tenex + \def\it{\fam\itfam\eightit}% + \textfont\itfam=\eightit + \def\sl{\fam\slfam\eightsl}% + \textfont\slfam=\eightsl + \def\bf{\fam\bffam\eightbf}% + \textfont\bffam=\eightbf \scriptfont\bffam=\sixbf + \scriptscriptfont\bffam=\fivebf + \def\tt{\fam\ttfam\eighttt}% + \textfont\ttfam=\eighttt + \def\ttx{\eighttex}% + \normalbaselineskip=9pt + \def\MF{{\manual opqr}\-{\manual stuq}}% + \let\sc=\sixrm + \let\big=\eightbig + \setbox\strutbox=\hbox{\vrule height7pt depth2pt width 0pt}% + \normalbaselines\rm} + +\def\tenbig#1{{\hbox{$\left#1\vbox to8.5pt{}\right.\nulldelimiterspace=0pt$}}} +\def\ninebig#1{{\hbox{$\textfont0=\tenrm\textfont2=\tensy + \left#1\vbox to7.25pt{}\right.\nulldelimiterspace=0pt$}}} +\def\eightbig#1{{\hbox{$\textfont0=\ninerm\textfont2=\ninesy + \left#1\vbox to6.5pt{}\right.\nulldelimiterspace=0pt$}}} + +\font\tentex=cmtex10 +\font\ninetex=cmtex9 % TeX extended character set (used in strings) +\font\eighttex=cmtex8 + +\def\\#1{\hbox{\it#1\/\kern.05em}} % italic type for identifiers +\def\|#1{\hbox{$#1$}} % one-letter identifiers look a bit better this way +\def\{\hbox{\bf#1\/}} % boldface type for reserved words +\def\.#1{\hbox{\ttx % typewriter type for strings + \let\\=\BS % backslash in a string + \let\'=\RQ % right quote in a string + \let\`=\LQ % left quote in a string + \let\{=\LB % left brace in a string + \let\}=\RB % right brace in a string + \let\~=\TL % tilde in a string + \let\ =\SP % space in a string + \let\_=\UL % underline in a string + \let\&=\AM % ampersand in a string + #1}} +\def\#{\hbox{\tt\char`\#}} % parameter sign +\def\${\hbox{\tt\char`\$}} % dollar sign +\def\%{\hbox{\tt\char`\%}} % percent sign +\def\^{\ifmmode\mathchar"222 \else\char`^ \fi} % pointer or hat +% circumflex accents can be obtained from \^^D instead of \^ +\def\AT!{@} % at sign for control text +\def\pct!{{\char`\%}} % percent sign in ordinary text + +\chardef\AM=`\& % ampersand character in a string +\chardef\BS=`\\ % backslash in a string +\chardef\LB=`\{ % left brace in a string +\def\LQ{{\tt\char'22}} % left quote in a string +\chardef\RB=`\} % right brace in a string +\def\RQ{{\tt\char'23}} % right quote in a string +\def\SP{{\tt\char`\ }} % (visible) space in a string +\chardef\TL=`\~ % tilde in a string +\chardef\UL=`\_ % underline character in a string + +\newbox\bak \setbox\bak=\hbox to -\em{} % backspace one em +\newbox\bakk\setbox\bakk=\hbox to -2\em{} % backspace two ems + +\newcount\ind % current indentation in ems +\def\1{\global\advance\ind by1\hangindent\ind\em} % indent one more notch +\def\2{\global\advance\ind by-1} % indent one less notch +\def\3#1{\hfil\penalty#10\hfilneg} % optional break within a statement +\def\4{\copy\bak} % backspace one notch +\def\5{\hfil\penalty-1\hfilneg\kern2.5\em\copy\bakk\ignorespaces}%optional break +\def\6{\ifmmode\else\par % forced break + \hangindent\ind\em\noindent\kern\ind\em\copy\bakk\ignorespaces\fi} +\def\7{\Y\6} % forced break and a little extra space + +\let\yskip=\smallskip +\def\to{\mathrel{.\,.}} % double dot, used only in math mode +\def\ellipsis{\kern5\em\smash{\vdots}\qquad\vbox to12pt{}\par} +\def\note#1#2.{\par\penalty5000 + \Y\noindent{\hangindent2\em\baselineskip10pt\eightrm#1 #2.\par}} +\def\startsection{\Q\noindent\strut{\bf\modno.\quad}} +\def\defin#1{\global\advance\ind by 2 \1\&{#1 }} % begin `define' or `format' +\def\A{\note{See also}} % cross-reference for multiply defined section names +\def\B{\mathopen{\.{@\{}}} % begin controlled comment +\def\C#1{\ifmmode\gdef\XX{\null$\null}\else\gdef\XX{}\fi % Pascal comments + \XX\hfil\penalty-1\hfilneg\quad$\{\,$#1$\,\}$\XX} +\def\D{\defin{define}} % macro definition +\def\E{\cdot10^} % exponent in floating point constant +\def\F{\defin{format}} % format definition +\let\G=\ge % greater than or equal sign +\def\H#1{\hbox{\rm\char"7D\tt#1}} % hexadecimal constant +\let\I=\ne % unequal sign +\def\J{\.{@\&}} % TANGLE's join operation +\let\K=\gets % left arrow +\let\L=\le % less than or equal sign +\outer\def\M#1.{\def\modno{#1}\startsection\ignorespaces} +\outer\def\N#1. \[#2]#3.{\def\modno{#1}\flushout % begin starred section + \gdef\rhead{PART #2:\uppercase{#3}} % define running headline + \global\let\rrhead=\rhead + \message{*\modno} % progress report + \startsection{\bf\ignorespaces#3.\quad}\ignorespaces} +\outer\def\NN#1. \[#2]#3.{\def\modno{#1} % begin starred section on rh page + \global\setbox\partialpage=\vbox{ + \vbox to 44pc{\box\partialpage\vfill}\break} + \gdef\rrhead{PART #2:\uppercase{#3}} % define running headline + \message{!\modno} % progress report + \startsection{\bf\ignorespaces#3.\quad}\ignorespaces} +\def\O#1{\hbox{\rm\char'23\kern-.2em\it#1\/\kern.05em}} % octal constant +\def\P{\iftenpoint \ninepoint\fi + \rightskip=0pt plus 100pt minus 10pt % go into Pascal mode + \sfcode`;=3000 + \pretolerance 10000 + \hyphenpenalty 10000 \exhyphenpenalty 10000 + \global\ind=2 \1\ \unskip} +\def\Q{\tenpoint + \rightskip=0pt % get out of Pascal mode + \sfcode`;=1500 \pretolerance 200 \hyphenpenalty 50 \exhyphenpenalty 50 } +\let\R=\lnot % logical not +\let\S=\equiv % equivalence sign +\def\T{\mathclose{\.{@\}}}} % terminate controlled comment +\def\U{\note{This code is used in}} % cross-reference for uses of sections +\let\V=\lor % logical or +\let\W=\land % logical and +\def\X#1:#2\X{\ifmmode\gdef\XX{\null$\null}\else\gdef\XX{}\fi % section name + \XX$\langle\,$#2{\sevenrm\kern.5em#1}$\,\rangle$\XX} +\def\Y{\par\yskip} +\let\Z=\let % now you can \send the control sequence \Z +\def\){\hbox{\.{@\$}}} % sign for string pool check sum +\def\]{\hbox{\.{@\\}}} % sign for forced line break +\def\=#1{\kern2pt\hbox{\vrule\vtop{\vbox{\hrule + \hbox{\strut\kern2pt\.{#1}\kern2pt}} + \hrule}\vrule}\kern2pt} % verbatim string +\let\~=\ignorespaces + +\newcount\nrefs % total number of references in partial page +\newcount\baseno % smallest module number in partial page +\countdef\nprefs=199 % the number in \prefs +\countdef\nfrefs=220 % the number in \frefs +\toksdef\prefs=199 \toksdef\frefs=220 +% \count and \toks registers 200--219 are also used to keep track of refs +\newcount\nn \newcount\mm \newcount\pp +\newdimen\nsize \newdimen\msize +\newskip\intermodskip \intermodskip=8pt plus 2pt minus 3pt +\newbox\partialpage +\newbox\newmod +\newtoks\newrefs +\newdimen\ninept \ninept=9pt + +\def\uline{_} +\begingroup\catcode`\_=\active \globaldefs=1 +\def\flushout{\ifvoid\partialpage\else + \setbox0=\vsplit\partialpage to 44pc + \shipout\vbox{ + \vbox to 3pc{ + \hbox to 35pc{\vbox to10pt{}\nineit\rhead\hfil\eightrm\folio}\vfill} + \nointerlineskip\box0} + \global\advance\pageno 1 + \let\=\makeref + \ifsorted \let\readin=\readln \readrefs + \else \immediate\write\reffile{!\the\pageno}\let\readin=\readrefs \fi + \setbox0=\vbox{\eightpoint \hsize=11pc \catcode`\_=\active \let_=\_ + \rightskip=0pt plus 100pt minus 10pt + \pretolerance 10000 + \hyphenpenalty 10000 \exhyphenpenalty 10000 + \noindent\vbox to1pt{}\par % 1pt = \topskip - \ninept + \readin} + \shipout\vbox to47pc{ + \vbox to 3pc{ + \hbox to 35pc{\vbox to10pt{}\eightrm\folio\hfil\nineit\rrhead\/}\vfill} + \unvbox\partialpage + \vfill +% \ifdim\ht0>1pt \kern8pt\hrule \hbox{% + \ifdim\ht0>1pt \kern11pt\hrule \hbox{% % changed Oct 87 by DEK! + \nsize=\ht0 \advance\nsize-\topskip + \divide\nsize by 3 \divide\nsize by\ninept + \multiply\nsize by\ninept \advance\nsize\topskip + \vsplit0 to\nsize \kern1pc + \msize=\ht0 \advance\msize-\topskip + \divide\msize by 2 \divide\msize by\ninept + \multiply\msize by\ninept \advance\msize\topskip + \vbox to\nsize{\vsplit0 to\msize\vss}\kern1pc + \vbox to\nsize{\box0\vss}} \fi} + \global\advance\pageno 1 \global\let\rhead=\rrhead\fi + {\globaldefs=1 + \nn=199 \loop \ifnum\nn<221 \toks\nn={} \count\nn=0 \advance\nn 1 \repeat + \nrefs=0 + \baseno=\modno}} + +\def\{\begingroup \catcode`\_=\active \let_=\uline \globaldefs=1 + \newrefs=\bgroup} +\def\FI{\nn=\modno \advance\nn-\baseno \advance\nn 200 + \advance\nrefs-\count\nn \nn=\nrefs + \let\=\countnewref \the\newrefs \endgroup + \nobreak\null\nobreak\vskip-\baselineskip\penalty-500\vfil\eject} +\def\twillout{\setbox\newmod=\vbox{\unvbox255} + \ifnum\nn=0 \nsize=0pt +% \else \nsize=3pt \multiply\nsize\nn \advance\nsize 1pc \fi + \else \nsize=3pt \multiply\nsize\nn \advance\nsize 1.25pc \fi % changed Oct 87! + \ifvoid\partialpage\else\advance\nsize 5pt \advance\nsize\ht\partialpage\fi + \advance\nsize\ht\newmod + \message{\the\nsize} % show the page break decision amount + \ifdim\nsize>88pc \flushout \message{\modno}\fi + \addtopartialpage} +\def\addtopartialpage{\let\=\addnewref \catcode`\_=\active \let_=\uline + \globaldefs=1 \the\newrefs + \nsize=\dp\partialpage + \setbox\partialpage=\ifvoid\partialpage \box\newmod + \else \vbox{\unvbox\partialpage \vfilneg + \vskip\intermodskip \unvbox\newmod}\fi} +\endgroup +\def\shortpage{\par\vskip-2\baselineskip + \null\vfill\penalty-5000\message{(shortpage)}} + +\def\countnewref #1 #2 {\ifnum#2<\baseno \let\next\cn + \else\ifnum#2>\modno \let\next\cn \else\let\next\flushref\fi\fi\next#1 #2 } +\def\cn #1 #2 {\expandafter\cnr\csname#1 #2\endcsname #2 } +\def\cnr#1#2 #3 {\ifx#1\relax \advance\nn 1 \fi} +\def\flushref#1 #2 #3 {} +\def\addnewref #1 #2 {\ifnum#2<\baseno \let\next\an \nn=199 + \else\ifnum#2>\modno \let\next\an \nn=#2 \advance\nn-\baseno + \advance\nn200 \ifnum\nn>219 \nn=220 \fi + \else\let\next\flushref\fi\fi\next#1 #2 } +\def\an #1 #2 {\expandafter\anr\csname#1 #2\endcsname #1 #2 } +\def\anr#1#2 #3 #4 {\ifx#1\relax + \advance\nrefs1 \advance\count\nn 1 + \def#1{\#2 #3 #4 }\toks\nn=\expandafter{\the\toks\nn\#1}\fi} +\ifsorted \def\#1{\global\let#1\relax} +\else \def\#1{#1\global\let#1\relax} \fi +\def\makeref #1 #2 #3#4 {\nn=#2 \hangindent=1em + \ifsorted\else\toks0={#1 #2 #3#4}\immediate\write\reffile{+ \the\toks0}\fi + \noindent\\{#1}\ifx#3\\else + \if#3:: \else\unhcopy\eqbox \fi#4\fi, \section\number\nn.\par} +\newbox\eqbox \setbox\eqbox=\hbox{\kern2pt\eightrm=\kern2pt} +\def\section{\mathhexbox278} +\def\{\} +\def\readrefs{\the\prefs \mm=\modno \advance\mm-\baseno \advance\mm200 + {\def\##1{\global\let##1\relax}\pp=200 % this patch made AFTER first edition + \loop\ifnum\pp<\mm \the\toks\pp \advance\pp 1 \repeat} % of Vol B!! + \loop\ifnum\mm<221 \the\toks\mm \advance\mm 1 \repeat} +\def\readln{\read\sreffile to\next \expandafter\next\space \readin} +\def\donewithpage#1 {%\ifnum\pageno=#1 \else\message{page #1??}\fi + \let\readin=\relax} +\def\rhead{BLANK PAGE TO THROW AWAY} + +\hsize=35pc \vsize=\maxdimen \output={\twillout} + +% the remaining stuff applies only to the rear matter + +\newif\ifpagesaved +\def\lheader{\vbox to10pt{}\nineit\rhead\hfil\eightrm\folio} +\def\rheader{\vbox to10pt{}\eightrm\folio\hfil\nineit\rhead\/} +\def\page{\box255 } +\def\normaloutput#1{\shipout\vbox{ + \vbox to 3pc{ + \hbox to 35pc{\ifodd\pageno\rheader\else\lheader\fi}\vfill} + \nointerlineskip#1} + \global\advance\pageno 1 } + +\newbox\sbox % saved box preceding the index +\newbox\lbox % lefthand column in the index +\def\inx{\box\partialpage + \vskip24pt plus 1fil % we are beginning the index + \output{\ifpagesaved\normaloutput{\box\sbox}\fi + \global\setbox\sbox=\page \global\pagesavedtrue} + \pagesavedfalse \eject % eject the page-so-far and predecessors + \setbox\sbox\vbox{\unvbox\sbox} % take it out of its box + \vsize=44pc \advance\vsize by -\ht\sbox % the remaining height + \hsize=17pc % column width for the index (1pc between cols) + \eightpoint + \parfillskip 0pt plus .6\hsize % try to avoid almost empty lines + \def\lr{L} % this tells whether the left or right column is next + \output{\if L\lr\global\setbox\lbox=\page \gdef\lr{R} + \else\normaloutput{\vbox to44pc{\box\sbox\vss + \hbox to35pc{\box\lbox\hfil\page}}} + \global\vsize=44pc\gdef\lr{L}\global\pagesavedfalse\fi} + \message{Index:} + \parskip 0pt plus .5pt + \gdef\rhead{INDEX} + \outer\def\:##1, {\par\hangindent2em\noindent##1:\kern1em} % index entry + \let\ttentry=\. \def\.##1{\ttentry{##1\kern.2em}} % give \tt a little room + \def\[##1]{$\underline{##1}$} % underlined index item + \rm \rightskip0pt plus 2.5em \tolerance 10000 + \hyphenpenalty 10000 \parindent0pt} +\def\fin{\par\vfill\eject % this is done when we are ending the index + \ifpagesaved\null\vfill\eject\fi % output a null index column + \if L\lr\else\null\vfill\eject\fi % finish the current page + \parfillskip 0pt plus 1fil + \gdef\rhead{NAMES OF THE SECTIONS} + \message{Section names:} + \output{\normaloutput\page} + \ninepoint + \hsize=35pc \vsize=44pc + \def\note##1##2.{\hfil\penalty-1\hfilneg\quad{\eightrm##1 ##2.}} + \linepenalty=10 % try to conserve lines + \def\U{\note{Used in}} % cross-reference for uses of sections + \def\:{\par\hangindent 2em}\let\*=*\let\.=\ttentry} +\def\con{\par\vfill\eject\end} % finish the section names + +% To produce only a subset of pages, put the page numbers on separate +% lines in a file called pages.tex +\let\Shipout=\shipout +\newread\pages \newcount\nextpage \openin\pages=pages +\def\getnextpage{\ifeof\pages\else + {\endlinechar=-1\read\pages to\next + \ifx\next\empty % in this case we should have eof now + \else\global\nextpage=\next\fi}\fi} +\ifeof\pages\else\message{OK, I'll ship only the requested pages!} + \getnextpage\fi +\def\shipout{\ifeof\pages\let\next=\Shipout + \else\ifnum\pageno=\nextpage\getnextpage\let\next=\Shipout + \else\let\next=\Tosspage\fi\fi \next} +\newbox\garbage \def\Tosspage{\deadcycles=0\setbox\garbage=} diff --git a/systems/knuth/local/lib/unicode.tex b/systems/knuth/local/lib/unicode.tex new file mode 100644 index 0000000000..3453c2c251 --- /dev/null +++ b/systems/knuth/local/lib/unicode.tex @@ -0,0 +1,25 @@ +% macros to typeset with unicode in a rudimentary way + +% There's a program "unichar" which produces TeX code for typesetting +% a given Unicode character, provided that one uses these macros. +% At present, the character is assumed to have width but no height; +% struts should be used in case extremely tall or deep characters appear. + +% Say "\input unicode" at the top of your file, and change \unicodeptsize +% to whatever point size you are using (if it is not 10pt, the default). + +\newdimen\unicodeptsize \unicodeptsize=10pt + +\begingroup +\catcode`@=11 % we will define two private macro names + +\gdef\Uni#1:#2:#3:#4:#5<#6>% ems:cols:rows:-hoff:rows+voff<hexbitmap> + {\leavevmode \hbox to#1\unicodeptsize + {\special{" 0 0 moveto currentpoint translate + \unic@deptsize \unic@deptsize scale #2 #3 true + [24 0 0 -24 #4 #5] {<#6>} imagemask}\hss}} + +{\catcode`p=12\catcode`t=12\gdef\uni@ff#1pt{#1}} +\gdef\unic@deptsize{\expandafter\uni@ff\the\unicodeptsize\space} + +\endgroup diff --git a/systems/knuth/local/lib/wlist.tex b/systems/knuth/local/lib/wlist.tex new file mode 100644 index 0000000000..a665a32a62 --- /dev/null +++ b/systems/knuth/local/lib/wlist.tex @@ -0,0 +1,53 @@ +% Makes a landscape listing of one or more files with wide lines +% Typical usage: +% tex list *.c \\end + +\hsize=9in +\vsize=6.5in +\special{landscape} + +\def\grabfile#1 {\setbox0=\lastbox\endgraf\doit{#1}} +\everypar{\grabfile} + +\font\filenamefont= cmtt8 scaled\magstep3 +\font\headlinefont= cmr8 +\font\listingfont= cmtex8 +\font\eoffont= cmti8 + +\def\today{\ifcase\month\or + January\or February\or March\or April\or May\or June\or + July\or August\or September\or October\or November\or December\fi + \space\number\day, \number\year} +\newcount\m \newcount\n +\n=\time \divide\n 60 \m=-\n \multiply\m 60 \advance\m \time +\def\hours{\twodigits\n\twodigits\m} +\def\twodigits#1{\ifnum #1<10 0\fi \number#1} + +\newlinechar=`@ +\message{@\today\space at \hours} + +\baselineskip=9pt +\medskipamount=4pt minus 1pt +\raggedbottom +\nopagenumbers + +\chardef\other=12 +\def\doit#1{\message{@Listing #1@} + \begingroup \everypar{} \frenchspacing + \headline{\filenamefont#1\quad\headlinefont \today\ at \hours + \hfill Page \folio} + \def\do##1{\catcode`##1=\other}\dospecials + \catcode127=\other \catcode9=\other \catcode12=\other + \parindent 0pt \parfillskip=0pt plus 1fil minus 1in + \everypar{\hangindent 1in} \rightskip=0pt plus 2in + \def\par{\ifvmode\penalty-500\medskip\else\endgraf\fi} + \listingfont \obeylines \obeyspaces \global\pageno=1 + \input #1 {\eoffont(end of\/ file)}\endgraf\vfill\eject\endgroup} +{\obeyspaces\global\let =\ } +\catcode`\_=\other % allow _ in file names + +% A tab (^^I) prints as lowercase gamma. +% Character ^^M could be made visible, with a bit of work; +% at present, it's indistinguishable from newline (^^J). + +% You can get up to 170 characters on a line without an overfull box. diff --git a/systems/knuth/local/lib/xepsf.tex b/systems/knuth/local/lib/xepsf.tex new file mode 100644 index 0000000000..87d2788d5a --- /dev/null +++ b/systems/knuth/local/lib/xepsf.tex @@ -0,0 +1,219 @@ +% XEPSF.TEX macro file: +% Same as EPSF.TEX except that it uses the ExactBoundingBox put out by +% MetaPost under appropriate coding. +% +% (I made this unnecessary on 22 Jan 97 by changing MetaPost to +% output the exact bounding box when prologues<0. But I retain this +% file for compatibility with older uses of MetaPost, e.g. gbmac.tex.) +% +% Written by Tomas Rokicki of Radical Eye Software, 29 Mar 1989. +% Revised by Don Knuth, 3 Jan 1990. +% Revised by Tomas Rokicki to accept bounding boxes with no +% space after the colon, 18 Jul 1990. +% +% TeX macros to include an Encapsulated PostScript graphic. +% Works by finding the bounding box comment, +% calculating the correct scale values, and inserting a vbox +% of the appropriate size at the current position in the TeX document. +% +% To use with the center environment of LaTeX, preface the \epsffile +% call with a \leavevmode. (LaTeX should probably supply this itself +% for the center environment.) +% +% To use, simply say +% \input epsf % somewhere early on in your TeX file +% \epsfbox{filename.ps} % where you want to insert a vbox for a figure +% +% Alternatively, you can type +% +% \epsfbox[0 0 30 50]{filename.ps} % to supply your own BB +% +% which will not read in the file, and will instead use the bounding +% box you specify. +% +% The effect will be to typeset the figure as a TeX box, at the +% point of your \epsfbox command. By default, the graphic will have its +% `natural' width (namely the width of its bounding box, as described +% in filename.ps). The TeX box will have depth zero. +% +% You can enlarge or reduce the figure by saying +% \epsfxsize=<dimen> \epsfbox{filename.ps} +% (or +% \epsfysize=<dimen> \epsfbox{filename.ps} +% instead). Then the width of the TeX box will be \epsfxsize and its +% height will be scaled proportionately (or the height will be +% \epsfysize and its width will be scaled proportionately). The +% width (and height) is restored to zero after each use. +% +% A more general facility for sizing is available by defining the +% \epsfsize macro. Normally you can redefine this macro +% to do almost anything. The first parameter is the natural x size of +% the PostScript graphic, the second parameter is the natural y size +% of the PostScript graphic. It must return the xsize to use, or 0 if +% natural scaling is to be used. Common uses include: +% +% \epsfxsize % just leave the old value alone +% 0pt % use the natural sizes +% #1 % use the natural sizes +% \hsize % scale to full width +% 0.5#1 % scale to 50% of natural size +% \ifnum#1>\hsize\hsize\else#1\fi % smaller of natural, hsize +% +% If you want TeX to report the size of the figure (as a message +% on your terminal when it processes each figure), say `\epsfverbosetrue'. +% +\newread\epsffilein % file to \read +\newif\ifepsffileok % continue looking for the bounding box? +\newif\ifepsfbbfound % success? +\newif\ifepsfverbose % report what you're making? +\newdimen\epsfxsize % horizontal size after scaling +\newdimen\epsfysize % vertical size after scaling +\newdimen\epsftsize % horizontal size before scaling +\newdimen\epsfrsize % vertical size before scaling +\newdimen\epsftmp % register for arithmetic manipulation +\newdimen\pspoints % conversion factor +% +\pspoints=1bp % Adobe points are `big' +\epsfxsize=0pt % Default value, means `use natural size' +\epsfysize=0pt % ditto +% +\def\epsfbox#1{\global\def\epsfllx{72}\global\def\epsflly{72}% + \global\def\epsfurx{540}\global\def\epsfury{720}% + \def\lbracket{[}\def\testit{#1}\ifx\testit\lbracket + \let\next=\epsfgetlitbb\else\let\next=\epsfnormal\fi\next{#1}}% +% +\def\epsfgetlitbb#1#2 #3 #4 #5]#6{\epsfgrab #2 #3 #4 #5 .\\% + \epsfsetgraph{#6}}% +% +\def\epsfnormal#1{\epsfgetbb{#1}\epsfsetgraph{#1}}% +% +\def\epsfgetbb#1{% +% +% The first thing we need to do is to open the +% PostScript file, if possible. +% +\openin\epsffilein=#1 +\ifeof\epsffilein\errmessage{I couldn't open #1, will ignore it}\else +% +% Okay, we got it. Now we'll scan lines until we find one that doesn't +% start with %. We're looking for the bounding box comment. +% + {\epsffileoktrue \chardef\other=12 + \def\do##1{\catcode`##1=\other}\dospecials \catcode`\ =10 + \loop + \read\epsffilein to \epsffileline + \ifeof\epsffilein\epsffileokfalse\else +% +% We check to see if the first character is a % sign; +% if not, we stop reading (unless the line was entirely blank); +% if so, we look further and stop only if the line begins with +% `%%%ExactBoundingBox:'. +% + \expandafter\epsfaux\epsffileline:. \\% + \fi + \ifepsffileok\repeat + \ifepsfbbfound\else + \ifepsfverbose\message{No bounding box comment in #1; using defaults}\fi\fi + }\closein\epsffilein\fi}% +% +% Now we have to calculate the scale and offset values to use. +% First we compute the natural sizes. +% +\def\epsfclipstring{}% do we clip or not? If so, +\def\epsfclipon{\def\epsfclipstring{ clip}}% +\def\epsfclipoff{\def\epsfclipstring{}}% +% +\def\epsfsetgraph#1{% + \epsfrsize=\epsfury\pspoints + \advance\epsfrsize by-\epsflly\pspoints + \epsftsize=\epsfurx\pspoints + \advance\epsftsize by-\epsfllx\pspoints +% +% If `epsfxsize' is 0, we default to the natural size of the picture. +% Otherwise we scale the graph to be \epsfxsize wide. +% + \epsfxsize\epsfsize\epsftsize\epsfrsize + \ifnum\epsfxsize=0 \ifnum\epsfysize=0 + \epsfxsize=\epsftsize \epsfysize=\epsfrsize + \epsfrsize=0pt +% +% We have a sticky problem here: TeX doesn't do floating point arithmetic! +% Our goal is to compute y = rx/t. The following loop does this reasonably +% fast, with an error of at most about 16 sp (about 1/4000 pt). +% + \else\epsftmp=\epsftsize \divide\epsftmp\epsfrsize + \epsfxsize=\epsfysize \multiply\epsfxsize\epsftmp + \multiply\epsftmp\epsfrsize \advance\epsftsize-\epsftmp + \epsftmp=\epsfysize + \loop \advance\epsftsize\epsftsize \divide\epsftmp 2 + \ifnum\epsftmp>0 + \ifnum\epsftsize<\epsfrsize\else + \advance\epsftsize-\epsfrsize \advance\epsfxsize\epsftmp \fi + \repeat + \epsfrsize=0pt + \fi + \else \ifnum\epsfysize=0 + \epsftmp=\epsfrsize \divide\epsftmp\epsftsize + \epsfysize=\epsfxsize \multiply\epsfysize\epsftmp + \multiply\epsftmp\epsftsize \advance\epsfrsize-\epsftmp + \epsftmp=\epsfxsize + \loop \advance\epsfrsize\epsfrsize \divide\epsftmp 2 + \ifnum\epsftmp>0 + \ifnum\epsfrsize<\epsftsize\else + \advance\epsfrsize-\epsftsize \advance\epsfysize\epsftmp \fi + \repeat + \epsfrsize=0pt + \else + \epsfrsize=\epsfysize + \fi + \fi +% +% Finally, we make the vbox and stick in a \special that dvips can parse. +% + \ifepsfverbose\message{#1: width=\the\epsfxsize, height=\the\epsfysize}\fi + \epsftmp=10\epsfxsize \divide\epsftmp\pspoints + \vbox to\epsfysize{\vfil\hbox to\epsfxsize{% + \ifnum\epsfrsize=0\relax + \special{PSfile=#1 llx=\epsfllx\space lly=\epsflly\space + urx=\epsfurx\space ury=\epsfury\space rwi=\number\epsftmp + \epsfclipstring}% + \else + \epsfrsize=10\epsfysize \divide\epsfrsize\pspoints + \special{PSfile=#1 llx=\epsfllx\space lly=\epsflly\space + urx=\epsfurx\space ury=\epsfury\space rwi=\number\epsftmp\space + rhi=\number\epsfrsize \epsfclipstring}% + \fi + \hfil}}% +\global\epsfxsize=0pt\global\epsfysize=0pt}% +% +% We still need to define the tricky \epsfaux macro. This requires +% a couple of magic constants for comparison purposes. +% +{\catcode`\%=12 \global\let\epsfpercent=%\global\def\epsfbblit{%%ExactBoundingBox}}% +% +% So we're ready to check for `%%ExactBoundingBox:' and to grab the +% values if they are found. +% +\long\def\epsfaux#1#2:#3\\{\ifx#1\epsfpercent + \def\testit{#2}\ifx\testit\epsfbblit + \epsfgrab #3 . . . \\% + \epsffileokfalse + \global\epsfbbfoundtrue + \fi\else\ifx#1\par\else\epsffileokfalse\fi\fi}% +% +% Here we grab the values and stuff them in the appropriate definitions. +% +\def\epsfempty{}% +\def\epsfgrab #1 #2 #3 #4 #5\\{% +\global\def\epsfllx{#1}\ifx\epsfllx\epsfempty + \epsfgrab #2 #3 #4 #5 .\\\else + \global\def\epsflly{#2}% + \global\def\epsfurx{#3}\global\def\epsfury{#4}\fi}% +% +% We default the epsfsize macro. +% +\def\epsfsize#1#2{\epsfxsize} +% +% Finally, another definition for compatibility with older macros. +% +\let\epsffile=\epsfbox diff --git a/systems/knuth/local/man1/dvitype.1 b/systems/knuth/local/man1/dvitype.1 new file mode 100644 index 0000000000..6bf82fb7e0 --- /dev/null +++ b/systems/knuth/local/man1/dvitype.1 @@ -0,0 +1,37 @@ +.TH DVITYPE 1L 10/18/89 +.SH NAME +dvitype - translate a dvi file for humans to read +.SH SYNOPSIS +.B dvitype +dvi_file_name +.SH DESCRIPTION +.I DVItype +translates a DVI (DeVice Independent) file (output by TeX or GFtoDVI) to a +file humans can read. It also serves as a DVI file-validating +program (i.e., if +.I DVItype +can read it, it's correct) and as an example of a DVI-reading +program for future device drivers. +.PP +The output file can include all commands, just the important +ones, or none at all (in which case only errors are reported). +A subinterval of pages may be selected for transliteration; the +magnification and resolution of the ``output device'' may be +changed; and so on. All options are specified with an on-line dialog. +.PP +The DVI filename on the command line must be complete. The +.I .dvi +extension is not supplied if omitted. The output always goes +to +.IR dvitype.out . +.SH "SEE ALSO" +gftype(1), tex(1), gftodvi(1) +.br +Donald Knuth, +.I TeXware +.SH "AUTHORS" +Donald Knuth wrote the program. It was published as +part of the +.I TeXware +technical report (Stanford CS1097), available from TUG (the TeX Users Group). +Howard Trickey and Pavel Curtis ported it to Unix. diff --git a/systems/knuth/local/man1/gftodvi.1 b/systems/knuth/local/man1/gftodvi.1 new file mode 100644 index 0000000000..3c268d519b --- /dev/null +++ b/systems/knuth/local/man1/gftodvi.1 @@ -0,0 +1,83 @@ +.TH GFTODVI 1L 10/21/89 +.SH NAME +gftodvi - make proofsheets from generic font files +.SH SYNOPSIS +.B gftodvi +[gf_file_name] +.SH DESCRIPTION +.I GFtoDVI +converts a generic font file (output by METAFONT) to a +device independent (DVI) file that can be typeset using the same +software as for TeX output. The characters in the GF file will +appear one per page, with labels, titles, and annotations as +specified in Appendix H (Hardcopy Proofs) of +.I The +.IR METAFONTbook . +.PP +.I GFtoDVI +uses four other fonts, in addition to the main gf file +input. A `gray' font isused to typeset the +pixels that actually make up the character. (We wouldn't +want all the pixels to be simply black, since then labels, +key points, and other information would be lost.) A `title' font +is used for the information at the top of the page. A `label' font +is used for the labels on key points of the figure. A `slant' +font is used to typeset diagonal lines, which would +otherwise have to be simulated using horizontal and vertical rules. +The default gray, title, and label fonts are respectively `gray', +`cmr8', and `cmtt10'; there is no default slant font. +.PP +The filename on the command line must be complete. (The program prompts +you for it if you don't give it.) Because +the resolution is part of the extension, it would not make +sense to add on a default extension as is done with TeX or +DVI-reading software. The output file name defaults to the same +root as the gf file, with the `dvi' extension added. For +example, the input file +.I io.2602gf +would become +.IR io.dvi . +.PP +The TEXFONTS environment variable is used to find tfm +files that the program needs. If TEXFONTS is not defined, the directory +/home/fonts is assumed. +.PP +To change the default fonts, you can give `special' commands in your +GF file, or you can change the fonts online. An online dialog ensues if you +type `/' after the gf_file_name. For example, +.br +.ti +2 +gftodvi io.300gf/ +.br +.ti +2 +Special font substitution: grayfont black +.br +.ti +2 +OK; any more? grayfontarea /home/art/don/ +.br +.ti +2 +OK; any more? slantfont slantimagen6 +.br +.ti +2 +OK; any more? <RET> +.br +will use /home/art/don/black as the `gray' font and /home/fonts/slantimagen6 +as the slant font (it's a font for lines with slant 1/6 at imagen resolution). +.SH "FILES" +/home/fonts/{gray.tfm,...} The default fonts +.PP +/home/tex/{dist,local}/lib/{gray.mf,...} The METAFONT sources +.SH "SEE ALSO" +tex(1), mf(1) +.br +Donald Knuth, +.I The METAFONTbook +.br +Donald Knuth et al., +.I METAFONTware +.SH "AUTHORS" +Donald Knuth wrote the program. The program was published as +part of the +.I METAFONTware +technical report (Stanford CS1255), available from TUG (the TeX Users Group). +Paul Richards ported it to Unix. diff --git a/systems/knuth/local/man1/gftopk.1 b/systems/knuth/local/man1/gftopk.1 new file mode 100644 index 0000000000..5984ec57fc --- /dev/null +++ b/systems/knuth/local/man1/gftopk.1 @@ -0,0 +1,37 @@ +.TH GFTOPK 1L 10/21/89 +.SH NAME +gftopk - convert generic font files to packed font files +.SH SYNOPSIS +.B gftopk +gf_file_name [pk_file_name] +.SH DESCRIPTION +.I GFtoPK +converts a generic font file (output by METAFONT) to a +packed font file for use by DVI-reading programs. Packed +font files (PK files) are much smaller than the corresponding GFfiles, +so they are rapidly becoming the font format of choice. +.PP +The gf_file_name on the command line must be complete. Because +the resolution is part of the extension, it would not make +sense to add on a default extension as is done with TeX or +DVI-reading software. The pk_file_name defaults to the same +stripped name as the gf file, and it is placed in the current +working directory with the an extension consisting of the resolution +in dots per inch followed by `pk'. For +example, the input file +.I io.300gf +would become +.IR io.300pk . +.PP +.SH "SEE ALSO" +mf(1), gftype(1), pktype(1) +.br +Donald Knuth et al, +.I METAFONTware +.SH "AUTHORS" +Tomas Rokicki wrote the program. The program was published as +part of the +.I METAFONTware +technical report (Stanford CS1255), available from TUG (the TeX Users Group). +Paul Richards ported it to Unix. + diff --git a/systems/knuth/local/man1/gftype.1 b/systems/knuth/local/man1/gftype.1 new file mode 100644 index 0000000000..14e6c28868 --- /dev/null +++ b/systems/knuth/local/man1/gftype.1 @@ -0,0 +1,35 @@ +.TH GFTYPE 1L 10/21/89 +.SH NAME +gftype - translate a generic font file for humans to read +.SH SYNTAX +.B gftype +gf_file_name [output_file_name] +.SH DESCRIPTION +.I GFtype +translates a \fIgeneric font\fR file (output by METAFONT) to a +file humans can read. It also serves as a GF file-validating +program (i.e., if +.I GFtype +can read it, it's correct) and as an example of a GF-reading +program for other software that wants to read GF files. +.PP +The gf_file_name on the command line must be complete. Because +the resolution is part of the extension, it would not make +sense to add on a default extension as is done with TeX or +DVI-reading software. If no output_file_name is specified, the +output goes to the standard output. +.SH "OPTIONS" +The output file can include a symbolic listing of the \fIgf\fR commands, +and/or bit-map images of the characters +(which makes it a lot longer). +Both options are specified by an online dialog. +.SH "SEE ALSO" +dvitype(1), mf(1) +.br +Donald Knuth et al., +.I METAFONTware +.SH "AUTHORS" +David Fuchs and Don Knuth wrote the program. The program was published as +part of the +.I METAFONTware +technical report (Stanford CS1255), available from TUG (the TeX User Group). diff --git a/systems/knuth/local/man1/mf.1 b/systems/knuth/local/man1/mf.1 new file mode 100644 index 0000000000..40ed164704 --- /dev/null +++ b/systems/knuth/local/man1/mf.1 @@ -0,0 +1,448 @@ +.TH MF 1L 10/19/89 +.SH NAME +mf, inimf \- METAFONT, a language for font design +.SH SYNOPSIS +.B mf +[ first line ] +.PP +.B inimf +[ first line ] +.ie t .ds TX \fRT\v'+0.3m'E\v'-0.3m'X\fP \" for troff +.el .ds TX TeX \" for nroff +.\" to use, type \*(TX +.ie t .ds OX \fIT\v'+0.3m'E\v'-0.3m'X\fP \" for troff +.el .ds OX TeX \" for nroff +.\" the same but obliqued + +.SH DESCRIPTION +M\s-2ETAFONT\s0 +reads the program in the specified files +and outputs font rasters (in gf format) and font metrics (tfm files). +M\s-2ETAFONT\s0 +capabilities and language are described in +.I The M\s-2ETAFONT\s0\^book +by Donald E. Knuth, published by Addison-Wesley. +.PP +Like +\*(TX, M\s-2ETAFONT\s0 +is normally used with a large body of precompiled macros, and font generation +in particular requires the support of several macro files. The basic +program as compiled is called +.I inimf; +it can be used to precompile macros into a ``*.base'' file, which can be +preloaded when you invoke inimf under another name. If you call it `mf', +the file plain.base is quickly loaded; if you call it `foo' and link +`foo' to `inimf', you get the file foo.base. A different base file +can be loaded if you say &mybase at the beginning of your first input line. +As described in +.I The M\s-2ETAFONT\s0\^book, +that line should otherwise begin with a file name +or a \\\|controlsequence. +The normal usage is to say +.IP +\fBmf\ \fR ' \\\|mode=<printengine>\^;\^ [\^\\\|mag=magstep(\fI\^n\fR\^)\^;\^] ' input\ \^\fI font \fR +.PP +to start processing +.I font.mf. +The single quotes are the best way of keeping the +shell from misinterpreting the semicolons and +from removing the \\ characters, which are needed here to +keep M\s-2ETAFONT\s0 from thinking that you want to produce a font called +``mode'' or ``mag''. (Or you can just say `mf' and give the other stuff +on the next line, without quotes.) Other +\\\|controlsequences, such as \\\|batchmode (for silent operation) can +also appear. +The name ``font'' will be the ``jobname'', and is used in forming +output file names. +If M\s-2ETAFONT\s0 doesn't get a file name in the first line, +the jobname is ``mfput''. +The default `.mf' extension can be overridden by specifying an extension +explicitly. +There is no way to read a M\s-2ETAFONT\s0 input file with no filename extension. +.PP +A log of error messages goes +into \fI font\fB\^.\^\fIlog\fR where\fI font\fR is the jobname. +The output files +are \fI font\fB\^.\^\fItfm\fR and \fI font\fB\^.\^\fI<\fR\^number\^\fI>gf\fR +where <number> depends on the resolution and +magnification of the font. The ``\\\|mode'' in this example is +shown generically as <printengine>, a symbolic term for which the name +of an actual printengine or the name ``localfont'' (see below) must be +substituted. +If the ``\\\|mode'' is not specified +or is not valid for your site, +M\s-2ETAFONT\s0 +will +default to ``proof'' mode which produces large character images for +use in font design and refinement. Proof mode can immediately +be recognized by the appearance of the suffix +.I .2602gf +\^ after the jobname. Examples of proof mode output can be found +in +.I The Computer Modern Fonts, +(Volume E of +.I Computers and Typesetting +), by Donald Knuth. +The system of +.I magsteps +is identical to the system used by +\*(TX, +with values normally in the range 0.5, 1.0, 2.0, 3.0, 4.0 and 5.0. +A listing of gf numbers for 118-dpi, 240-dpi and 300-dpi fonts +is shown below. +.ds f. mf.tbl \" tbl output inserted here +.TS +.if \n+(b.=1 .nr d. \n(.c-\n(c.-1 +.de 35 +.ps \n(.s +.vs \n(.vu +.in \n(.iu +.if \n(.u .fi +.if \n(.j .ad +.if \n(.j=0 .na +.. +.nf +.nr #~ 0 +.if n .nr #~ 0.6n +.ds #d .d +.if \(ts\n(.z\(ts\(ts .ds #d nl +.fc +.nr 33 \n(.s +.rm 80 81 82 83 +.nr 80 0 +.nr 38 \w\s-2MAGSTEP\s0 +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wmag=magstep(0) +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wmag=magstep(0.5) +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wmag=magstep(1) +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wmag=magstep(2) +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wmag=magstep(3) +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wmag=magstep(4) +.if \n(80<\n(38 .nr 80 \n(38 +.nr 38 \wmag=magstep(5) +.if \n(80<\n(38 .nr 80 \n(38 +.80 +.rm 80 +.nr 81 0 +.nr 38 \w118 dpi +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \w118 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \w129 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \w142 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \w170 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \w204 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \w245 +.if \n(81<\n(38 .nr 81 \n(38 +.nr 38 \w294 +.if \n(81<\n(38 .nr 81 \n(38 +.81 +.rm 81 +.nr 82 0 +.nr 38 \w240 dpi +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w240 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w263 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w288 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w346 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w415 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w498 +.if \n(82<\n(38 .nr 82 \n(38 +.nr 38 \w597 +.if \n(82<\n(38 .nr 82 \n(38 +.82 +.rm 82 +.nr 83 0 +.nr 38 \w300 dpi +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w300 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w329 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w360 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w432 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w518 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w622 +.if \n(83<\n(38 .nr 83 \n(38 +.nr 38 \w746 +.if \n(83<\n(38 .nr 83 \n(38 +.83 +.rm 83 +.nr 38 1n +.nr 79 0 +.nr 40 \n(79+(0*\n(38) +.nr 80 +\n(40 +.nr 41 \n(80+(3*\n(38) +.nr 81 +\n(41 +.nr 42 \n(81+(3*\n(38) +.nr 82 +\n(42 +.nr 43 \n(82+(3*\n(38) +.nr 83 +\n(43 +.nr TW \n(83 +.if t .if \n(TW>\n(.li .tm Table at line 13 file mf.tbl is too wide - \n(TW units +.nr #I \n(.i +.in +(\n(.lu-\n(TWu-\n(.iu)/2u +.fc +.nr #T 0-1 +.nr #a 0-1 +.eo +.de T# +.ds #d .d +.if \(ts\n(.z\(ts\(ts .ds #d nl +.mk ## +.nr ## -1v +.ls 1 +.ls +.. +.ec +.ta \n(80u \n(81u \n(82u \n(83u +.nr 31 \n(.f +.nr 35 1m +\&\h'|\n(40u'\s-2MAGSTEP\s0\h'|\n(41u'118 dpi\h'|\n(42u'240 dpi\h'|\n(43u'300 dpi +.ta \n(80u \n(81u \n(82u \n(83u +.nr 31 \n(.f +.nr 35 1m +\&\h'|\n(40u'mag=magstep(0)\h'|\n(41u'118\h'|\n(42u'240\h'|\n(43u'300 +.ta \n(80u \n(81u \n(82u \n(83u +.nr 31 \n(.f +.nr 35 1m +\&\h'|\n(40u'mag=magstep(0.5)\h'|\n(41u'129\h'|\n(42u'263\h'|\n(43u'329 +.ta \n(80u \n(81u \n(82u \n(83u +.nr 31 \n(.f +.nr 35 1m +\&\h'|\n(40u'mag=magstep(1)\h'|\n(41u'142\h'|\n(42u'288\h'|\n(43u'360 +.ta \n(80u \n(81u \n(82u \n(83u +.nr 31 \n(.f +.nr 35 1m +\&\h'|\n(40u'mag=magstep(2)\h'|\n(41u'170\h'|\n(42u'346\h'|\n(43u'432 +.ta \n(80u \n(81u \n(82u \n(83u +.nr 31 \n(.f +.nr 35 1m +\&\h'|\n(40u'mag=magstep(3)\h'|\n(41u'204\h'|\n(42u'415\h'|\n(43u'518 +.ta \n(80u \n(81u \n(82u \n(83u +.nr 31 \n(.f +.nr 35 1m +\&\h'|\n(40u'mag=magstep(4)\h'|\n(41u'245\h'|\n(42u'498\h'|\n(43u'622 +.ta \n(80u \n(81u \n(82u \n(83u +.nr 31 \n(.f +.nr 35 1m +\&\h'|\n(40u'mag=magstep(5)\h'|\n(41u'294\h'|\n(42u'597\h'|\n(43u'746 +.fc +.nr T. 1 +.T# 1 +.in \n(#Iu +.35 +.TE +.if \n-(b.=0 .nr c. \n(.c-\n(d.-12 + +.br +Magnification can also be specified not as a magstep but as an +arbitrary value, such as 1.315, to create special character sizes. +.PP + +Before font production can begin, it is necessary to set up the +appropriate `base' files. The minimum set of components for font +production for a given print-engine is the `plain.mf' macro file +and the local `mode_def' file. The macros in `plain.mf' can be +studied in an appendix to the +.I M\s-2ETAFONT\s0\^book; +they were developed by Donald Knuth, and this file should never be +altered except when it is officially upgraded. +Each mode_def specification helps adapt fonts to a particular print-engine. +There is a regular discussion of mode_defs in the journal of the +\*(TX +Users Group, +.I TUGboat; +the local ones in use on this computer (art) are in the +file /home/tex/local/lib/art.mf. +With only `plain.mf' and `<\^\s-2SITE\s0\^>\^-modes.mf' +loaded it is possible to +create fonts of simple characters, such as those used for the +M\s-2ETAFONT\s0 +logo, and those used for the LaTeX line and circle fonts, +but the production of Computer Modern fonts would be facilitated by +making a cmmf.base file (which includes the macros in cmbase.mf as +well as those in plain.mf). +.PP +Several environment variables can be used to set up directory +paths to search when M\s-2ETAFONT\s0 opens a file for input. +For example, the +.I csh +command +.br +.in +4 +setenv \s-2MFINPUTS\s0\ .\^:\^/usr/me/mylib\^:\^/usr/local/lib/mf/inputs +.in -4 +or the +.I sh +command sequence +.br +.in +4 +\s-2MFINPUTS\s0\|=\|.\^:\^/usr/me/mylib\^:\^/usr/local/lib/mf/inputs +.br +export \s-2MFINPUTS\s0 +.in -4 +.br +would cause all invocations of M\s-2ETAFONT\s0 and its derivatives to look for +\\\|input files first in the current directory, then in a hypothetical +user's ``mylib'', and finally in the system library. +Normally, the user will place the command sequence which sets up the +\s-2MFINPUTS\s0 environment variable in the +.I .\|cshrc +or +.I .\|profile +file. +.PP +The +.I e +response to M\s-2ETAFONT\s0\|'s error-recovery mode invokes the +.I GNU emacs +editor at the erroneous line of the source file. +There is an environment variable, \s-2MFEDIT\s0, +that can be used to specify the editor. +It should contain a string with "%s" indicating where the +filename goes and "%d" indicating where the decimal linenumber (if any) goes. +For example, an \s-2MFEDIT\s0 string for the "vi" editor can be set by: +.br + +.ti +3 + setenv \s-2MFEDITOR\s0 "/usr/bin/vi +%d %s" +.br +.sp .7 +(replacing the path name for the editor +as appropriate on your system). +The Environment section below lists the relevant environment variables, +and their defaults. +.PP +A convenient file in the library is null.mf, containing nothing. +When mf can't find the file it thinks you want to input, it keeps +asking you for another file name; responding `null' gets you out +of the loop if you don't want to input anything. +.PP +.SH ENVIRONMENT +The defaults for all environments are set at the +time of compilation, by reference to a file called /home/tex/local/mfpaths.h. +The values given below are preset in this file. +.PP +.IP \s-2MFINPUTS\s0 +Search path for \\\|input and \\\|openin files. It should be colon-separated, +and start with ``.''. The entire path must be no longer than 700 +characters long. +Default: .\^:\^/home/tex/local/lib\^:\^/home/tex/dist/lib +.IP \s-2MFBASES\s0 +Search path for base files. Default: .\^:\^/home/tex/local/mf +.IP \s-2MFPOOL\s0 +Search path for M\s-2ETAFONT\s internal +strings. Default: .\^:\^/home/tex/local/mf +.IP \s-2MFEDIT\s0 +Command template for switching to editor. Default: /emacs +%d %s +.br + +.SH "FONT UTILITIES" +.PP +A number of utility programs are available (see section See Also). +The following is a partial list of available utilities and their purpose. +Consult your local M\s-2ETAFONT\s0 guru for details. +.br +.TP 1.5i +.B gftopk +Takes a GF file and produces a more tightly packed PK font file +TP +.B gftodvi +Produces proof sheets for fonts +.TP +.B gftype +Displays the contents of a GF file in mnemonics and images +.br +.TP +.B pktype +Mnemonically displays the contents of a PK file +.br +.TP +.B mft +Formats a source file (font.mf) as shown in +.I Computer Modern Typefaces +.PP + +.SH "FILES" +.TP 1.3i +/home/tex/{dist,local}/lib +M\s-2ETAFONT\s0's library areas +.TP +/home/tex/local/mf/mf.pool +Encoded text of M\s-2ETAFONT\s0's messages +.TP +/home/tex/local/mf/*.base +M\s-2ETAFONT\s0 base files +.TP +/home/tex/dist/lib/plain.mf +The ``standard'' macro package +.TP +/home/tex/local/lib/art.mf +The file of ``mode_def''s for your site's various printers +.TP +/home/tex/dist/cm +M\s-2ETAFONT\s0 sources for Computer Modern +.TP +/home/tex/local/cm +Local variations of Computer Modern +.br + +.SH "SUGGESTED READING" +Donald E. Knuth, +.I The M\s-2ETAFONT\s0\^book +(Volume C of \fI Computers and Typesetting\fR\|) +.br +Donald E. Knuth, +.I M\s-2ETAFONT\s0\^ the Program +(Volume D of \fI Computers and Typesetting\fR\|) +.br +Donald E. Knuth, +.I Computer Modern Typefaces +(Volume E of \fI Computers and Typesetting\fR\|) +.br +.I TUGboat +(the publication of the \*(TX Users Group) +.br +.SH "COMMENTS" +Warning: ``Type design can be hazardous to your other interests. +Once you get hooked, you will develop intense feelings about letterforms; +the medium will intrude on the messages that you read. +And you will perpetually be thinking of improvements to the fonts that +you see everywhere, especially those of your own design.'' +.br +.SH "BUGS" +On January 4, 1986 the ``final'' +bug in M\s-2ETAFONT\s0 was discovered and removed. If an error still +lurks in the code, D. E. Knuth promises to +pay a finders fee which doubles every year +to the first person who finds it. Happy +hunting. +.SH "AUTHORS" +M\s-2ETAFONT\s0 was designed by Donald E. Knuth, +who implemented it using his W\s-2EB\s0 system for Pascal programs. +It was ported to Unix by Paul Richards at the University of Illinois +at Urbana-Champaign. +This page written by Pierre MacKay (mostly). +.br +.SH "SEE ALSO" +dvitype(1), gftopk(1), gftodvi(1), gftype(1), mft(1), +pktype(1), pltotf(1), tftopl(1) + diff --git a/systems/knuth/local/man1/mft.1 b/systems/knuth/local/man1/mft.1 new file mode 100644 index 0000000000..36f01b17aa --- /dev/null +++ b/systems/knuth/local/man1/mft.1 @@ -0,0 +1,54 @@ +.TH MFT 1L 10/21/89 +.SH NAME +mft \- translate METAFONT code to TeX code +.SH SYNOPSIS +.B mft +mffile[.mf] [-cs] [changefile[.ch]] [stylefile[.mft]] + +.SH DESCRIPTION +The +.I mft +program is used to create a TeX file for viewing a METAFONT program. +It takes appropriate care of typographic details like page +layout and the use of indentation, italics, boldface, etc., as illustrated +in the book +.I Computer Modern Typefaces. +Special conventions in METAFONT comments allow you to control things that +would not otherwise come out right; section 1 of the MFT documentation +in the +.I METAFONTware +report explains these rules. + +The command line has one required file name and two optional file names. +The required +one is a METAFONT source file; there is also an optional change file +(which works just as the change files to \.{TANGLE} and \.{WEAVE}) +and an optional style file (while is prepended to everything). + +A file name +that doesn't contain a dot is always given an extension, either .mf (METAFONT) +or .ch (change) or .mft (style). If no style file is specified, the style +plain.mft is automatically used. The METAFONT and change file names are +either absolute paths or relative to the current directory; the style file +is either an absolute path or relative to the MFINPUTS environment variable. +.PP +The output TeX file name is formed by using .tex in place of +the extension of the METAFONT file name. +.SH FILES + +/home/tex/dist/lib/mftmac.tex TeX macros used by mft output. +.br +/home/tex/dist/lib/plain.mft Default style file. +.br +/home/tex/dist/lib/cmbase.mft Style file for Computer Modern. +.SH "SEE ALSO" +D. E. Knuth et al., +.I METAFONTware +.PP +mf(1), weave(1) +.SH "AUTHORS" +MFT was written by Donald E. Knuth, and he ported to Unix with the help of +Pierre MacKay and the Unix port of WEAVE by Howard Trickey and Pavel Curtis. +The program is published in the +.I METAFONTware +report (Stanford CS1225), available from TUG (the TeX Users Group). diff --git a/systems/knuth/local/man1/pktype.1 b/systems/knuth/local/man1/pktype.1 new file mode 100644 index 0000000000..d93fca9352 --- /dev/null +++ b/systems/knuth/local/man1/pktype.1 @@ -0,0 +1,34 @@ +.TH PKTYPE 1L 10/21/89 +.SH NAME +pktype - translate a packed font file for humans to read +.SH SYNTAX +.B pktype +pk_file_name [output_file_name] +.SH DESCRIPTION +.I PKtype +translates a \fIpacked font\fR file (output by GFtoPK) to a +file humans can read. It also serves as a PK file-validating +program (i.e., if +.I PKtype +can read it, it's correct) and as an example of a PK-reading +program for other software that wants to read PK files. +.PP +The pk_file_name on the command line must be complete. Because +the resolution is part of the extension, it would not make +sense to add on a default extension as is done with TeX or +DVI-reading software. If no output_file_name is specified, the +output goes to the standard output. +.PP +The output file gives a compact encoding of the packed encoding, using +conventions described in the +.I METAFONTware +report. Run lengths of black pixels alternate with parenthesized run lengths +of white pixels, and brackets are used to indicate when a row should be +repeated. +.SH "SEE ALSO" +gftopk(1) +.br +Donald Knuth et al., +.I METAFONTware +.SH "AUTHORS" +Tom Rokicki wrote the program, and Don Knuth ported it to Unix. diff --git a/systems/knuth/local/man1/pltotf.1 b/systems/knuth/local/man1/pltotf.1 new file mode 100644 index 0000000000..6dd5053178 --- /dev/null +++ b/systems/knuth/local/man1/pltotf.1 @@ -0,0 +1,29 @@ +.TH PLTOTF 1L 10/21/89 +.SH NAME +pltotf - convert property list files to font metric (tfm) +.SH SYNOPSIS +.B pltotf +pl_file_name tfm_file_name +.SH DESCRIPTION +.I PLtoTF +translates a (human-readable) property list file to a +(program-readable) font metric file. Thus, the font metric +file can be edited (although this should not be necessary +since METAFONT84 has been released), and its exact contents +can be displayed mnemonically. +.PP +Both the +.I pl_file_name +and the +.I tfm_file_name +must be complete. No adding of default extensions is done. +.SH "SEE ALSO" +.br +Donald Knuth, +.I TeXware, The METAFONTbook +.SH "AUTHORS" +Donald Knuth wrote the program. It was published as +part of the +.I TeXware +technical report (Stanford CS1097), available from TUG (the TeX Users Group). +Howard Trickey, Pavel Curtis, and Richard Furuta ported it to Unix. diff --git a/systems/knuth/local/man1/pooltype.1 b/systems/knuth/local/man1/pooltype.1 new file mode 100644 index 0000000000..18c65c8361 --- /dev/null +++ b/systems/knuth/local/man1/pooltype.1 @@ -0,0 +1,23 @@ +.TH POOLTYPE 1L 10/21/89 +.SH NAME +pooltype - display a WEB pool file +.SH SYNOPSIS +.B pltotf +pool_file_name +.SH DESCRIPTION +.I POOLtype +translates a (program_readable) string pool file to a +(human-readable) text file. +.PP +The +.I pool_file_name +must be complete. No adding of default extensions is done. +.SH "SEE ALSO" +.br +Donald Knuth, +.I TeXware, The WEB system +.SH "AUTHORS" +Donald Knuth wrote the program and ported it to Unix. It was published as +part of the +.I TeXware +technical report (Stanford CS1097), available from TUG (the TeX Users Group). diff --git a/systems/knuth/local/man1/tangle.1 b/systems/knuth/local/man1/tangle.1 new file mode 100644 index 0000000000..487c354b44 --- /dev/null +++ b/systems/knuth/local/man1/tangle.1 @@ -0,0 +1,107 @@ +.TH WEB 1L 10/19/89 +.SH NAME +tangle, weave \- translate WEB to Pascal and/or TeX +.SH SYNOPSIS +.B tangle +webfile[.web] [changefile[.ch]] +.br +.B weave +[ +.B \-x +] webfile[.web] [changefile[.ch]] + +.SH DESCRIPTION +The +.I tangle +program converts a WEB +source document into a Pascal program that may be compiled in the usual +way with the on-line Pascal compiler (e.g., +.IR pc (1)). +The output file is all in lower case +and packed into lines of 72 characters or less, with the only concession +to readability being the termination of lines at semicolons when this can +be done conveniently. +.PP +WEB is a new language that Don Knuth has created, which +allows you to prepare a single +document containing all the information that is needed both to produce +a compilable Pascal program and to produce a well-formatted document +describing the program in as much detail as the writer may desire. The +user of WEB must be familiar with both TeX and Pascal. +.PP +WEB provides a relatively simple, although adequate, macro facility that +permits a Pascal program to be written in small easily-understood modules. +The +.I tangle +program assembles these modules into a usable Pascal program. +.PP +The command line should have either one or two names on it. +The first is taken as the WEB file (and .web is added if there is no +extension). +If there is another name, it is a change file (and .ch is added if there is +no extension). The change file overrides parts of the WEB file, +as described in the documentation. +.PP +The output files are a Pascal file and a string pool file, +whose names are formed by adding .p and .pool respectively to the +root of the WEB file name. +.PP +The +.I weave +program is used to create a TeX file for viewing the WEB program. +It takes appropriate care of typographic details like page +layout and the use of indentation, italics, boldface, etc.,and it supplies +extensive cross-index information that it gathers automatically. +The command line arguments are the same as for +.I tangle +except for the options. The +.B \-x +option says to omit the index, module name list, and table of contents pages. +(A CONTENTS.tex file will still be written, however, unless some default +macros are redefined.) +.PP +The output TeX file name is formed by using .tex as the extension of the +WEB file name. +.PP +There are several macros in webmac.tex that probably should be redefined by +the user at the beginning of the WEB file. +It is a good idea to set \\title +to the name of the program. +And, to cause output of only changed modules, one can say +\\let\\maybe=\\iffalse (usually as the first change in the +change file). +.PP +.SH FILES + +/home/tex/dist/lib/webmac.tex TeX macros used by weave output. +.SH "SEE ALSO" +.I The WEB System of Structured Documentation +and +.br +.I Literate Programming +by D.E. Knuth. +.br +.I Weaving a Program +by Wayne Sewell +.br +tex(1), pc(1) +.br +pxp(1) (for formatting tangle output when debugging) +.br +pooltype(1) (for symbolic listing of the pool file) +.br +.I TeX: The Program +.br +.I METAFONT: The Program +are by far the largest extant examples of WEB programs. +.br +.SH "AUTHORS" +WEB was designed by Donald E. Knuth, based on an earlier system +called DOC (implemented by Ignacio Zabala). +The +.I tangle +and +.I weave +programs are themselves written in WEB. The system +was ported to Unix at Stanford by Howard Trickey, and at Cornell by Pavel +Curtis. This version combines their work. diff --git a/systems/knuth/local/man1/tex.1 b/systems/knuth/local/man1/tex.1 new file mode 100644 index 0000000000..614af047b8 --- /dev/null +++ b/systems/knuth/local/man1/tex.1 @@ -0,0 +1,219 @@ +.TH TEX 1L 10/19/89 +.SH NAME +tex, initex, virtex \- text formatting and typesetting +.SH SYNOPSIS +.B tex +[ first line ] +.PP +.B initex +[ first line ] +.PP +.B virtex +[ first line ] +.ie t .ds TX \fRT\v'+0.3m'E\v'-0.3m'X\fP \" for troff +.el .ds TX TeX \" for nroff +.\" to use, type \*(TX + +.SH DESCRIPTION +\*(TX +formats the interspersed text and commands contained in the named +files +and outputs a typesetter independent file (called +.I DVI +which is short for +.IR D e V ice +.IR I ndependent ). +\*(TX +capabilities and language are described in +.I The \*(TXbook +by Donald E. Knuth, published by Addison-Wesley. +.PP +Any arguments given on the command line to the +\*(TX +programs are passed to them as the first input line. +(But it is easier to type them as the first input line, since you don't have +to quote any of the symbols.) +As described in +.I The \*(TXbook, +that first line should begin with a file name +or a \\controlsequence. +The normal usage is to say +.RB `` tex +.IR paper '' +to start processing +.I paper.tex. +The name ``paper'' will be the ``jobname'', and is used in forming +output file names. +If \*(TX doesn't get a file name in the first line, the jobname is ``texput''. +The default `.tex' extension can be overridden by specifying an extension +explicitly. +.PP +If there is no paper.tex in the current directory, \*(TX will look +look through a search path of directories to try to find it. +The standard library on the default search path +has the basic format package, plain.tex, described +in the \*(TXbook, as well as several others. +Note that it is hardly ever necessary to \\input plain, since the +.I tex +program has preloaded it. +This means that all of the control sequences discussed in the \*(TXbook +are known to \*(TX. +.PP +The output DVI file is written on +.I name.dvi +where +.I name +is the jobname. +A log of error messages goes into +.I name.log. +.PP +.PP +Several environment variables can be used to set up directory +paths to search when \*(TX opens a file for input. +For example, the +.I csh +command +.br +.in +2 +setenv TEXINPUTS .:/usr/me/mylib:/usr/local/lib/tex/inputs +.in -2 +or the +.I sh +command sequence +.br +.in +4 +TEXINPUTS=.:/usr/me/mylib:/usr/local/lib/tex/inputs +.br +export TEXINPUTS +.in -4 +.br +would cause all invocations of \*(TX and its derivatives to look for +\\input files first in the current directory, then in a hypothetical +user's ``mylib'', and finally in the system library. +Normally, the user will place the command sequence which sets up the +TEXINPUTS environment variable in the +.I .cshrc +or +.I .profile +file. +The Environment section below lists the relevant environment variables, +and their defaults. +.PP +The +.I e +response to \*(TX's error prompt causes the +.I emacs +editor to start up at the current line of the current file. +There is an environment variable, TEXEDIT, that can be used to change the +editor used. It should contain a string with "%s" indicating where the +filename goes and "%d" indicating where the decimal linenumber (if any) goes. +For example, a TEXEDIT string for +.I vi +can be set by: +.br +.ti +2 +setenv TEXEDIT "/usr/bin/vi +%d %s" +.br +.PP +.PP +A convenient file in the library is null.tex, containing nothing. +When \*(TX can't find a file it thinks you want to input, it keeps +asking you for another file name; responding `null' gets you out +of the loop if you don't want to input anything. +.PP +Two other \*(TX programs, +.I initex +and +.IR virtex , +can be used to create fast-loading customized versions of \*(TX. +The +.I initex +program is used to create a +.I format (.fmt) +file that permits fast loading of fonts and macro packages. +After processing the fonts and definitions desired, a \\dump command +will create the format file. +The format file is used by +.I virtex. +It needs to be given a format file name as the first thing it reads. +A format file name is preceded by an &, which needs to be escaped with \\ +if given on the command line. +So, for instance, one could create a file myfmt.fmt using initex, +and then set up a cshell alias with +.br +.ti +2 +alias mytex "virtex \\&myfmt" +.br +to allow the use of ``mytex paper''. A slightly better way, which also works, +is to rename myfmt.fmt as mytex.fmt and then make a symbolic link between +/usr/local/bin/mytex and /usr/local/bin/virtex; virtex looks first to +see if there is a format whose name matches arg0. +.SH ENVIRONMENT +The defaults for all environments are set at the +time of compilation, by reference to a file called /home/tex/localtexpaths.h. +.PP +.IP TEXINPUTS +Search path for \\input and \\openin files. It should be colon-separated, +and start with ``.''. The entire path must be no longer than 700 +characters long. +Default: .:..:/home/tex/local/lib:/home/tex/dist/lib +.IP TEXFONTS +Search path for font metric files. The entire path must be no longer than 100 +characters long. The default doesn't include the current area (".") to +avoid confusing the programs that convert the output for printing on the +various output devices (most of which don't know about the path stuff yet). +Default: /home/fonts +.IP TEXFORMATS +Search path for format files. Default: .:/home/tex/local/tex +.IP TEXPOOL +Search path for INITEX internal strings. Default: .:/home/tex/local/tex +.IP TEXEDIT +Command template for switching to editor. +Default: "emacs +%d %s" + +.SH FILES + +.TP 1.5i +/home/tex/{dist,local}/lib +\*(TX's library areas +.TP +/home/tex/local/tex/tex.pool +Encoded text of \*(TX's messages +.TP +/home/fonts/*.tfm +Width information used by \*(TX (\*(TX Font Metric files) +.TP +/home/fonts/*{gf,pk} +Bit maps for low resolution devices. +.TP +/home/tex/local/tex/*.fmt +\*(TX .fmt files +.TP +/home/tex/dist/lib/plain.tex +The ``default'' macro package +.br +.SH "SEE ALSO" +Donald E. Knuth, +.I The \*(TXbook +.br +Leslie Lamport, +.I The LaTeX Document Preparation System +.br +Michael Spivak, +.I The Joy of \*(TX +.br +.I TUGBOAT +(the publication of the \*(TX Users Group) +.SH "TRIVIA" +\*(TX, pronounced properly, rhymes with ``blecchhh.'' Note that the proper +spelling in typewriter-like output is ``TeX'' and not ``TEX'' or ``tex.'' +.SH "BUGS" +Maybe there should be character other than & to specify format files, +since if you forget the \\ on the command line, it doesn't do what you want! +Also, there is no way to read a \*(TX input file with no filename extension. +.SH "AUTHORS" +\*(TX was designed by Donald E. Knuth, +who implemented it using his WEB system for Pascal programs. +It was ported to Unix at Stanford by Howard Trickey, and +at Cornell by Pavel Curtis. +This version is a combination of their efforts. diff --git a/systems/knuth/local/man1/tftopl.1 b/systems/knuth/local/man1/tftopl.1 new file mode 100644 index 0000000000..034cbe6db5 --- /dev/null +++ b/systems/knuth/local/man1/tftopl.1 @@ -0,0 +1,31 @@ +.TH TFTOPL 1L 10/21/89 +.SH NAME +tftopl - convert font metric (tfm) files to property list +.SH SYNOPSIS +.B tftopl +tfm_file_name pl_file_name +.SH DESCRIPTION +.I TFtoPL +translates a (program-readable) font metric file to +a (human-readable) property list file. Thus, the font metric +file can be edited (although this should not be necessary if it was +prepared by METAFONT), and its exact contents can be displayed mnemonically. +.I TFtoPL +also serves as a TFM-file validating program; if no error messages are given, +the input file is correct. +.PP +Both the +.I tfm_file_name +and the +.I pl_file_name +must be complete. No adding of default extensions is done. +.SH "SEE ALSO" +.br +Donald Knuth, +.I TeXware, The METAFONTbook +.SH "AUTHORS" +Donald Knuth wrote the program. It was published as +part of the +.I TeXware +technical report (Stanford CS1097), available from TUG (the TeX Users +Group). Howard Trickey and Pavel Curtis ported it to Unix. diff --git a/systems/knuth/local/man1/vftovp.1 b/systems/knuth/local/man1/vftovp.1 new file mode 100644 index 0000000000..ce9ee8c1ce --- /dev/null +++ b/systems/knuth/local/man1/vftovp.1 @@ -0,0 +1,26 @@ +.TH VFTOVP 1L 12/30/89 +.SH NAME +vftovp - convert virtual font (vf) files to virtual property list +.SH SYNOPSIS +.B vftovp +vf_file_name tfm_file_name vpl_file_name +.SH DESCRIPTION +.I VFtoVP +translates a (program-readable) virtual font file +and its accompanying font metric file to +a (human-readable) property list file. Thus, the virtual font +can be edited, and its exact contents can be displayed mnemonically. +.I VFtoVP +also serves as a VF-file validating program; if no error messages are given, +the input files are correct. +.PP +All three file names, +.I vf_file_name, +.I tfm_file_name, +and +.I vpl_file_name, +must be complete. No adding of default extensions is done. +.SH "AUTHOR" +Donald Knuth wrote the program, based in part on an idea of David Fuchs, +starting with the code for TFtoPL. + diff --git a/systems/knuth/local/man1/vptovf.1 b/systems/knuth/local/man1/vptovf.1 new file mode 100644 index 0000000000..56c106227f --- /dev/null +++ b/systems/knuth/local/man1/vptovf.1 @@ -0,0 +1,26 @@ +.TH VPTOVF 1L 12/30/89 +.SH NAME +vptovf - convert virtual property list files to virtual fonts +.SH SYNOPSIS +.B vptovf +vpl_file_name vf_file_name tfm_file_name +.SH DESCRIPTION +.I VPtoVF +translates a (human-readable) property list file to a pair of +(program-readable) files in the VF (virtual font) and TFM (Tex font metric) +formats. Thus, a virtual font +file can be edited and its exact contents +can be displayed mnemonically. +New virtual fonts, which map characters as seen by TeX into an arbitrary +sequence of low-level typesetting operations, +can also be easily created in this way. +.PP +All three file names, +.I vpl_file_name, +.I vf_file_name, +and +.I tfm_file_name, +must be complete. No adding of default extensions is done. +.SH "AUTHOR" +Donald Knuth wrote the program, based in part on an idea of David Fuchs, +starting with the code for PLtoTF. diff --git a/systems/knuth/local/man1/weave.1 b/systems/knuth/local/man1/weave.1 new file mode 100644 index 0000000000..487c354b44 --- /dev/null +++ b/systems/knuth/local/man1/weave.1 @@ -0,0 +1,107 @@ +.TH WEB 1L 10/19/89 +.SH NAME +tangle, weave \- translate WEB to Pascal and/or TeX +.SH SYNOPSIS +.B tangle +webfile[.web] [changefile[.ch]] +.br +.B weave +[ +.B \-x +] webfile[.web] [changefile[.ch]] + +.SH DESCRIPTION +The +.I tangle +program converts a WEB +source document into a Pascal program that may be compiled in the usual +way with the on-line Pascal compiler (e.g., +.IR pc (1)). +The output file is all in lower case +and packed into lines of 72 characters or less, with the only concession +to readability being the termination of lines at semicolons when this can +be done conveniently. +.PP +WEB is a new language that Don Knuth has created, which +allows you to prepare a single +document containing all the information that is needed both to produce +a compilable Pascal program and to produce a well-formatted document +describing the program in as much detail as the writer may desire. The +user of WEB must be familiar with both TeX and Pascal. +.PP +WEB provides a relatively simple, although adequate, macro facility that +permits a Pascal program to be written in small easily-understood modules. +The +.I tangle +program assembles these modules into a usable Pascal program. +.PP +The command line should have either one or two names on it. +The first is taken as the WEB file (and .web is added if there is no +extension). +If there is another name, it is a change file (and .ch is added if there is +no extension). The change file overrides parts of the WEB file, +as described in the documentation. +.PP +The output files are a Pascal file and a string pool file, +whose names are formed by adding .p and .pool respectively to the +root of the WEB file name. +.PP +The +.I weave +program is used to create a TeX file for viewing the WEB program. +It takes appropriate care of typographic details like page +layout and the use of indentation, italics, boldface, etc.,and it supplies +extensive cross-index information that it gathers automatically. +The command line arguments are the same as for +.I tangle +except for the options. The +.B \-x +option says to omit the index, module name list, and table of contents pages. +(A CONTENTS.tex file will still be written, however, unless some default +macros are redefined.) +.PP +The output TeX file name is formed by using .tex as the extension of the +WEB file name. +.PP +There are several macros in webmac.tex that probably should be redefined by +the user at the beginning of the WEB file. +It is a good idea to set \\title +to the name of the program. +And, to cause output of only changed modules, one can say +\\let\\maybe=\\iffalse (usually as the first change in the +change file). +.PP +.SH FILES + +/home/tex/dist/lib/webmac.tex TeX macros used by weave output. +.SH "SEE ALSO" +.I The WEB System of Structured Documentation +and +.br +.I Literate Programming +by D.E. Knuth. +.br +.I Weaving a Program +by Wayne Sewell +.br +tex(1), pc(1) +.br +pxp(1) (for formatting tangle output when debugging) +.br +pooltype(1) (for symbolic listing of the pool file) +.br +.I TeX: The Program +.br +.I METAFONT: The Program +are by far the largest extant examples of WEB programs. +.br +.SH "AUTHORS" +WEB was designed by Donald E. Knuth, based on an earlier system +called DOC (implemented by Ignacio Zabala). +The +.I tangle +and +.I weave +programs are themselves written in WEB. The system +was ported to Unix at Stanford by Howard Trickey, and at Cornell by Pavel +Curtis. This version combines their work. diff --git a/systems/knuth/local/man1/web.1 b/systems/knuth/local/man1/web.1 new file mode 100644 index 0000000000..487c354b44 --- /dev/null +++ b/systems/knuth/local/man1/web.1 @@ -0,0 +1,107 @@ +.TH WEB 1L 10/19/89 +.SH NAME +tangle, weave \- translate WEB to Pascal and/or TeX +.SH SYNOPSIS +.B tangle +webfile[.web] [changefile[.ch]] +.br +.B weave +[ +.B \-x +] webfile[.web] [changefile[.ch]] + +.SH DESCRIPTION +The +.I tangle +program converts a WEB +source document into a Pascal program that may be compiled in the usual +way with the on-line Pascal compiler (e.g., +.IR pc (1)). +The output file is all in lower case +and packed into lines of 72 characters or less, with the only concession +to readability being the termination of lines at semicolons when this can +be done conveniently. +.PP +WEB is a new language that Don Knuth has created, which +allows you to prepare a single +document containing all the information that is needed both to produce +a compilable Pascal program and to produce a well-formatted document +describing the program in as much detail as the writer may desire. The +user of WEB must be familiar with both TeX and Pascal. +.PP +WEB provides a relatively simple, although adequate, macro facility that +permits a Pascal program to be written in small easily-understood modules. +The +.I tangle +program assembles these modules into a usable Pascal program. +.PP +The command line should have either one or two names on it. +The first is taken as the WEB file (and .web is added if there is no +extension). +If there is another name, it is a change file (and .ch is added if there is +no extension). The change file overrides parts of the WEB file, +as described in the documentation. +.PP +The output files are a Pascal file and a string pool file, +whose names are formed by adding .p and .pool respectively to the +root of the WEB file name. +.PP +The +.I weave +program is used to create a TeX file for viewing the WEB program. +It takes appropriate care of typographic details like page +layout and the use of indentation, italics, boldface, etc.,and it supplies +extensive cross-index information that it gathers automatically. +The command line arguments are the same as for +.I tangle +except for the options. The +.B \-x +option says to omit the index, module name list, and table of contents pages. +(A CONTENTS.tex file will still be written, however, unless some default +macros are redefined.) +.PP +The output TeX file name is formed by using .tex as the extension of the +WEB file name. +.PP +There are several macros in webmac.tex that probably should be redefined by +the user at the beginning of the WEB file. +It is a good idea to set \\title +to the name of the program. +And, to cause output of only changed modules, one can say +\\let\\maybe=\\iffalse (usually as the first change in the +change file). +.PP +.SH FILES + +/home/tex/dist/lib/webmac.tex TeX macros used by weave output. +.SH "SEE ALSO" +.I The WEB System of Structured Documentation +and +.br +.I Literate Programming +by D.E. Knuth. +.br +.I Weaving a Program +by Wayne Sewell +.br +tex(1), pc(1) +.br +pxp(1) (for formatting tangle output when debugging) +.br +pooltype(1) (for symbolic listing of the pool file) +.br +.I TeX: The Program +.br +.I METAFONT: The Program +are by far the largest extant examples of WEB programs. +.br +.SH "AUTHORS" +WEB was designed by Donald E. Knuth, based on an earlier system +called DOC (implemented by Ignacio Zabala). +The +.I tangle +and +.I weave +programs are themselves written in WEB. The system +was ported to Unix at Stanford by Howard Trickey, and at Cornell by Pavel +Curtis. This version combines their work. diff --git a/systems/knuth/local/mf-sparc/Makefile b/systems/knuth/local/mf-sparc/Makefile new file mode 100644 index 0000000000..2bdb6536d4 --- /dev/null +++ b/systems/knuth/local/mf-sparc/Makefile @@ -0,0 +1,73 @@ +# Make executable files for this workstation, using the master TeX sources + +PFLAGS= -I.. +CFLAGS= -g -I.. -I/usr/openwin/include +#CFLAGS= -O -I.. -I/usr/openwin/include +#LIBS= -lsuntool -lsunwindow -lpixrect +LIBS= -L/usr/openwin/lib -lxview -lolgx -lX11 + +PC= time pc + +all: inimf + +traptest: trapmf + -trapmf < trap1.in + mv trap.log trapin.log + -trapmf < trap2.in | tee trap.fot + gftype trap.72270gf trap.typ < gftype.in + tftopl trap.tfm trap.pl + rm -f *.dif + -diff trapin.log ../../dist/mf/trapin.log > trapin.log.dif + -diff trap.log ../../dist/mf/trap.log > trap.log.dif + -diff trap.fot ../../dist/mf/trap.fot > trap.fot.dif + -diff trap.typ ../../dist/mf/trap.typ > trap.typ.dif + -diff trap.pl ../../dist/mf/trap.pl > trap.pl.dif + more trapin.log.dif trap.log.dif trap.typ.dif trap.fot.dif trap.pl.dif + +%.p: %.ch + tangle ../../dist/mf/mf.web $*.ch + mv ../../dist/mf/mf.pool . + mv ../../dist/mf/mf.p $*.p + +inimf.ch: ../../dist/mf/mf.web + +trapmf.ch: inimf.ch ini_to_trap + ini_to_trap inimf.ch trapmf.ch + +%.o: %.p + ${PC} ${PFLAGS} -c $*.p + +trapmf.o: trapmf.p + ${PC} -g ${PFLAGS} -c trapmf.p + +inimf: inimf.o ext.o mf_arith.o mf_sunwin.o + pc ${PFLAGS} -o inimf inimf.o ext.o mf_arith.o mf_sunwin.o ${LIBS} + +trapmf: trapmf.o ext.o mf_arith.o + pc -g ${PFLAGS} -o trapmf trapmf.o ext.o mf_arith.o + cp ../../dist/mf/trap.mf . + +ext.o: ext.c ext.h ../h00vars.h ../mfpaths.h + cc ${CFLAGS} -c ext.c + +mf_arith.o: mf_arith.c +mf_sunwin.o: mf_sunwin.c + +plain.base: ../../dist/lib/plain.mf ../lib/local.mf + -inimf plain \\input local \\dump + +install: # doit make install + mv inimf /usr/local/bin + rm /usr/local/bin/mf + ln /usr/local/bin/inimf /usr/local/bin/mf + make plain.base + +installtrap: # when the trap test is satisfactory + mv trap.mf trapin.log trap.log trap.fot trap.typ trap.pl ../../dist/mf + +clean: + rm -f *.p *.o *~ *.mf trapmf* trap.* trapin* + @echo "Remaining files should be:" + @echo "Makefile gftype.in mf.pool mf_window.h trap1.in" + @echo "ext.c ini_to_trap* mf_arith.c plain.base trap2.in" + @echo "ext.h inimf.ch mf_sunwin.c plain.log" diff --git a/systems/knuth/local/mf-sparc/ext.c b/systems/knuth/local/mf-sparc/ext.c new file mode 100644 index 0000000000..dfbf0b2bbb --- /dev/null +++ b/systems/knuth/local/mf-sparc/ext.c @@ -0,0 +1,457 @@ +/* external procedures called by MF */ +#include <sys/signal.h> +#include <sys/time.h> +#include "mfpaths.h" /* defines MAXINPATHCHARS, defaultinputpath, etc. */ +#include "h00vars.h" + +/* The following are for closing files */ + +closea(f) + int *f; /* actually, file pointer, but it doesn't matter */ +{ + close1(f); +} + +closeb(f) + int *f; /* actually, file pointer, but it doesn't matter */ +{ + close1(f); +} + +closew(f) + int *f; /* actually, file pointer, but it doesn't matter */ +{ + close1(f); +} + +extern int interrupt; /* To be made nonzero to tell MF about interrupts */ + +/* +** catchint() +** +** Gets called when the user hits his interrupt key. Sets the global +** "interrupt" nonzero, then sets it up so that the next interrupt will +** also be caught here. +** +*/ + +catchint() +{ + interrupt = 1; + signal(SIGINT,catchint); +} + +/* +** dateandtime(time, day, month, year) +** +** Stores minutes since midnight, current day, month and year into +** *time, *day, *month and *year, respectively. +** +** Also, set things up so that catchint() will get control on interrupts. +** +*/ + +dateandtime(minutes, day, month, year) +int *minutes, *day, *month, *year; +{ + long clock; + struct tm *tmptr, *localtime(); + + clock = time(0); + tmptr = localtime(&clock); + + *minutes = tmptr->tm_hour * 60 + tmptr->tm_min; + *day = tmptr->tm_mday; + *month = tmptr->tm_mon + 1; + *year = tmptr->tm_year + 1900; + signal(SIGINT,catchint); +} + + +/* fixed arrays are used to hold the paths, to avoid any possible problems + involving interaction of malloc and undump */ + +char inputpath[MAXINPATHCHARS] = defaultinputpath; +char basepath[MAXOTHPATHCHARS] = defaultbasepath; +char poolpath[MAXOTHPATHCHARS] = defaultpoolpath; + +char *getenv(); + +/* + * setpaths is called to set up the arrays inputpath, basepath, and + * poolpath as follows: if the user's environment has a value for the + * appropriate value, then use it; otherwise, leave the current value of + * the array (which may be the default path, or it may be the result of + * a call to setpaths on a previous run that was made the subject of + * an undump: this will give the maker of a preloaded MF the option of + * providing a new set of "default" paths. + * + * Note that we have to copy the string from the environment area, since + * that will change on the next run (which matters if this is for a + * preloaded MF). + */ +setpaths() +{ + register char *envpath; + + if ((envpath = getenv("MFINPUTS")) != NULL) + excopypath(inputpath,envpath,MAXINPATHCHARS); + if ((envpath = getenv("MFBASES")) != NULL) + excopypath(basepath,envpath,MAXOTHPATHCHARS); + if ((envpath = getenv("MFPOOL")) != NULL) + excopypath(poolpath,envpath,MAXOTHPATHCHARS); +} + +/* + * excopypath(s1,s2,n) copies at most n characters (including the null) + * from string s2 to string s1, giving an error message for paths + * that are too long. + */ +excopypath(s1,s2,n) + register char *s1,*s2; + register int n; +{ + while ((*s1++ = *s2++) != '\0') + if (--n == 0) { + fprintf(stderr, "! Environment search path is too big\n"); + *--s1 = '\0'; + return; /* let user continue with truncated path */ + } +} + +extern short buffer[],xord[]; +extern short last,first; /* pointers into buffer */ + +/* + * lineread reads from the Pascal text file with iorec pointer filep + * into buffer[first], buffer[first+1],..., buffer[last-1] (and + * setting "last"). + * Characters are read until a newline is found (which isn't put in the + * buffer) or until the next character would go into buffer[lastlim]. + * The characters need to be translated, so really xord[c] is put into + * the buffer when c is read. + * If end-of-file is encountered, the funit field of *filep is set + * appropriately. + */ +lineread(filep, lastlim) +struct iorec *filep; +int lastlim; +{ + register c; + register short *cs; /* pointer into buffer where next char goes */ + register FILE *iop; /* stdio-style FILE pointer */ + int l; /* how many more chars are allowed before buffer overflow */ + short *bf; /* hold address of buffer[first] */ + + iop = filep->fbuf; + bf = cs = &(buffer[first]); + l = lastlim-first; + /* overflow when next char would go into buffer[lastlim] */ + while (--l>=0 && (c = getc(iop)) != EOF && c!='\n') + *cs++ = xord[c]; + if (c == EOF) + filep->funit |= EOFF; /* we hit end-of-file */ + last = first+cs-bf; +} + +#define filenamesize 1024 /* should agree with inimf.ch */ +extern char nameoffile[],realnameoffile[]; /* these have size filenamesize */ + +/* + * testaccess(amode,filepath) + * + * Test whether or not the file whose name is in the global nameoffile + * can be opened for reading (if mode=READACCESS) + * or writing (if mode=WRITEACCESS). + * + * The filepath argument is one of the ...FILEPATH constants defined below. + * If the filename given in nameoffile does not begin with '/', we try + * prepending all the ':'-separated areanames in the appropriate path to the + * filename until access can be made, if it ever can. + * + * The realnameoffile global array will contain the name that yielded an + * access success. + */ + +#define READACCESS 4 +#define WRITEACCESS 2 + +#define NOFILEPATH 0 +#define INPUTFILEPATH 1 +#define READFILEPATH 2 +#define BASEFILEPATH 4 +#define POOLFILEPATH 5 + +bool +testaccess(amode,filepath) + int amode,filepath; +{ + register bool ok; + register char *p; + char *curpathplace; + int f; + + switch(filepath) { + case NOFILEPATH: curpathplace = NULL; break; + case INPUTFILEPATH: case READFILEPATH: + curpathplace = inputpath; break; + case BASEFILEPATH: curpathplace = basepath; break; + case POOLFILEPATH: curpathplace = poolpath; break; + } + if (nameoffile[0]=='/') /* file name has absolute path */ + curpathplace = NULL; + do { + packrealnameoffile(&curpathplace); + if (amode==READACCESS) + /* use system call "access" to see if we could read it */ + if (access(realnameoffile,READACCESS)==0) ok = TRUE; + else ok = FALSE; + else { + /* WRITEACCESS: use creat to see if we could create it, but close + the file again if we're OK, to let pc open it for real */ + f = creat(realnameoffile,0666); + if (f>=0) ok = TRUE; + else ok = FALSE; + if (ok) + close(f); + } + } while (!ok && curpathplace != NULL); + if (ok) { /* pad realnameoffile with blanks, as Pascal wants */ + for (p = realnameoffile; *p != '\0'; p++) + /* nothing: find end of string */ ; + while (p < &(realnameoffile[filenamesize])) + *p++ = ' '; + } + return (ok); +} + +/* + * packrealnameoffile(cpp) makes realnameoffile contain the directory at *cpp, + * followed by '/', followed by the characters in nameoffile up until the + * first blank there, and finally a '\0'. The cpp pointer is left pointing + * at the next directory in the path. + * But: if *cpp == NULL, then we are supposed to use nameoffile as is. + */ +packrealnameoffile(cpp) + char **cpp; +{ + register char *p,*realname; + + realname = realnameoffile; + if ((p = *cpp)!=NULL) { + while ((*p != ':') && (*p != '\0')) { + *realname++ = *p++; + if (realname == &(realnameoffile[filenamesize-1])) + break; + } + if (*p == '\0') *cpp = NULL; /* at end of path now */ + else *cpp = p+1; /* else get past ':' */ + *realname++ = '/'; /* separate the area from the name to follow */ + } + /* now append nameoffile to realname... */ + p = nameoffile; + while (*p != ' ') { + if (realname >= &(realnameoffile[filenamesize-1])) { + fprintf(stderr,"! Full file name is too long\n"); + break; + } + *realname++ = *p++; + } + *realname = '\0'; +} + +/* +** testeof(filep) +** +** Test whether or not the Pascal text file with iorec pointer filep +** has reached end-of-file (when the only I/O on it is done with +** lineread, above). +** We may have to read the next character and unget it to see if perhaps +** the end-of-file is next. +*/ + +bool +testeof(filep) +register struct iorec *filep; +{ + register char c; + register FILE *iop; /* stdio-style FILE pointer */ + if (filep->funit & EOFF) + return(TRUE); + else { /* check to see if next is EOF */ + iop = filep->fbuf; + c = getc(iop); + if (c == EOF) + return(TRUE); + else { + ungetc(c,iop); + return(FALSE); + } + } +} + + +/* +** writegf(a,b) +** +** writegf is called to write gfbuf[a..b] to gffile +** Unfortunately, gfbuf is declared as eight_bits, which in our +** implementation means that two bytes are taken by each entry. +** We only want to output the low order (first) byte of each pair. +*/ +extern struct iorec gffile; +extern short gfbuf[]; +writegf (a,b) + int a,b; +{ + register short *ptr,*final; + register FILE *iop; + + iop=gffile.fbuf; + ptr= &(gfbuf[a]); + final= &(gfbuf[b]); + while (ptr<=final) { + putc((char) (*ptr & 0377), iop); + ptr += 1; + } + /* Note: The above code used to be machine dependent. By changing + * the declarations from "char *" to "short *" we get the machine + * to do its own byte ordering of the de-reference of "ptr" above. + * Then we AND off the low bits (now that it's been pulled from + * memory correctly) and cast it into a "char" for putc(). + * --Peter Kessler's idea; explanation, AND, cast a la clp. + */ +} + + +/* +** close1(filep) +** close1 does the proper things to pc's runtime system file data structure +** to close a file +*/ +close1(filep) + + register struct iorec *filep; +{ + register struct iorec *next; + + if (filep->fbuf != 0) { + if ((filep->funit & FDEF) == 0) { + next = (struct iorec *) &_fchain; + while (next->fchain != FILNIL + && next->fchain != filep) + next = next->fchain; + if (next->fchain != FILNIL) + next->fchain = next->fchain->fchain; + + if (filep->fblk > PREDEF) { + fflush(filep->fbuf); + setbuf(filep->fbuf, NULL); + } + fclose(filep->fbuf); + if (ferror(filep->fbuf)) { +/* ERROR("%s: Close failed\n", + filep->pfname); */ + return; + } + filep->fbuf=0; + } + if ((filep->funit & TEMP) != 0 && + unlink(filep->pfname)) { +/* PERROR("Could not remove ", filep->pfname); */ + return; + } + } +} + +/* +** The following procedure is due to sjc@s1-c. +** +** calledit(filename, fnlength, linenumber) +** +** MF84 can call this to implement the 'e' feature in error-recovery +** mode, invoking a text editor on the erroneous source file. +** +** You should pass to "filename" the first character of the packed array +** containing the filename, and to "fnlength" the size of the filename. +** +** Ordinarily, this invokes emacs. If you want a different +** editor, create a shell environment variable MFEDIT containing +** the string that invokes that editor, with "%s" indicating where +** the filename goes and "%d" indicating where the decimal +** linenumber (if any) goes. For example, a MFEDIT string for "vi" might be: +** +** setenv MFEDIT "/usr/bin/vi +%d %s" +** +*/ + + char dvalue[] = "emacs +%d %s"; + char *mfeditvalue = &dvalue[0]; + + calledit(filename, fnlength, linenumber) + char *filename; + int fnlength, linenumber; + { + char *temp, *command, c; + int sdone, ddone, i; + + sdone = ddone = 0; + + /* Replace default with environment variable if possible. */ + if (NULL != (temp = (char *) getenv("MFEDIT"))) + mfeditvalue = temp; + + /* Make command string containing envvalue, filename, and linenumber */ + if (NULL == + (command = (char *) malloc(strlen(mfeditvalue) + fnlength + 25))) { + fprintf(stderr, "! Not enough memory to issue editor command\n"); + exit(1); + } + temp = command; + while ((c = *mfeditvalue++) != '\0') { + if (c == '%') { + switch (c = *mfeditvalue++) { + case 'd': + if (ddone) { + fprintf(stderr, + "! Line number cannot appear twice in editor command\n"); + exit(1); + } + sprintf(temp, "%d", linenumber); + while (*temp != '\0') + temp++; + ddone = 1; + break; + case 's': + if (sdone) { + fprintf(stderr, + "! Filename cannot appear twice in editor command\n"); + exit(1); + } + i = 0; + while (i < fnlength) + *temp++ = filename[i++] ^ 0x80; /* changed for 8-bit MF */ + sdone = 1; + break; + case '\0': + *temp++ = '%'; + mfeditvalue--; /* Back up to \0 to force termination. */ + break; + default: + *temp++ = '%'; + *temp++ = c; + break; + } + } + else + *temp++ = c; + } + *temp = '\0'; + + /* Execute command. */ + if (0 != system(command)) + fprintf(stderr, "! Trouble executing command %s\n", command); + + /* Quit, indicating MF had found an error before you typed "e". */ + exit(1); + } diff --git a/systems/knuth/local/mf-sparc/ext.h b/systems/knuth/local/mf-sparc/ext.h new file mode 100644 index 0000000000..7ff0e3bfdc --- /dev/null +++ b/systems/knuth/local/mf-sparc/ext.h @@ -0,0 +1,38 @@ +procedure exit(x : integer); + external; + +procedure closea(var f:text); + external; + +procedure closeb(var f:bytefile); + external; + +procedure closew(var f:wordfile); + external; + +procedure dateandtime(var minutes, day, month, year : integer); + external; + +procedure setpaths; + external; + +function testaccess(accessmode:integer; filepath:integer): boolean; + external; + +function testeof(var f: text): boolean; + external; + +procedure lineread(var f: text; lastlim: integer); + external; + +procedure writegf(a,b:integer); + external; + +procedure calledit(var filename: packedASCIIcode; fnlength, linenumber: integer); + external; + +function makefraction(p,q:integer):fraction; + external; + +function takefraction(q:integer;f:fraction):integer; + external; diff --git a/systems/knuth/local/mf-sparc/gftype.in b/systems/knuth/local/mf-sparc/gftype.in new file mode 100644 index 0000000000..9b48ee4cf9 --- /dev/null +++ b/systems/knuth/local/mf-sparc/gftype.in @@ -0,0 +1,2 @@ +y +y diff --git a/systems/knuth/local/mf-sparc/ini_to_trap b/systems/knuth/local/mf-sparc/ini_to_trap new file mode 100644 index 0000000000..c18984179f --- /dev/null +++ b/systems/knuth/local/mf-sparc/ini_to_trap @@ -0,0 +1,38 @@ +#! /bin/csh +# A shell script to perform modifications on the changefile for inimf +# to make a changefile for trapmf (used to test mf). +# +# To use it, say +# ini_to_trap inimf.ch trapmf.ch +# +ed - $1 <<edscriptend +/debug=/ +// +s/@{//p +/gubed=/ +s/@t@>@}//p +/@!mem_max=/ +// +s/[0-9][0-9]*/3000/p +/@!error_line=/ +s/[0-9][0-9]*/64/p +/@!half_error_line=/ +s/[0-9][0-9]*/32/p +/@!max_print_line=/ +s/[0-9][0-9]*/72/p +/@!screen_width=/ +s/[0-9][0-9]*/100/p +/@!screen_depth=/ +s/[0-9][0-9]*/200/p +/@!gf_buf_size=/ +s/[0-9][0-9]*/8/p +/@d mem_min=/ +// +s/-[0-9]*/0/p +/@d mem_top==/ +s/[0-9][0-9]*/3000/p +/% BEGIN HOOK FOR THE TRAP TEST/ +.+1,.+5s/%// +.+1,/% END HOOK FOR THE TRAP TEST/d +w $2 +edscriptend diff --git a/systems/knuth/local/mf-sparc/inimf.ch b/systems/knuth/local/mf-sparc/inimf.ch new file mode 100644 index 0000000000..271532c7b6 --- /dev/null +++ b/systems/knuth/local/mf-sparc/inimf.ch @@ -0,0 +1,1505 @@ +% Derived from INITEX.CH for Berkeley Unix TeX 1.1, by Howard Trickey +% and Pavel Curtis + +% Modification History: +% +% brought up to version 2.7182 on 8/8/98 --- don +% brought up to version 2.718 on 3/8/95 --- don +% UNIXexit convention switched 2/21/93 --- don +% tfm_out needed to be corrected for new Pascal compiler 7/18/92 --- don +% brought up to version 2.71 on 9/20/91 --- don +% brought up to version 2.7 on 9/6/90 --- don +% fixed max_buf_stack logic (it was one too high) on 1/22/90 --- don +% brought up to version 1.9 on 12/20/89 --- don +% brought up to version 1.8 on 10/14/89 --- don +% 8-bit modifications made 9/11/89 --- don +% +% don adapted everything for SunOS, MF Version 1.7, on 8/12/89 +% Module numbers changed to match Volume D +% Changes made more consistent with initex.ch +% Window code merged in, with hooks to remove it for the TRAP test +% +% Revision 1.3 87/03/07 21:15:21 mackay +% +% Minor changes found on archive version on SCORE +% (max_in_open increased to 10. -- 88/02/07 PAM) +% +% Revision 1.2 86/09/29 21:46:43 mackay +% +% Made no-debug the default, and changed version number +% to correspond with improved mf.web file +% (Got rid of debug code to avoid bug in range check +% code of VAX4.3 BSD and SUN3 version 3.x Os pc interpreter) +% +% Revision 1.0 86/01/31 15:46:08 richards +% Released for MF 1.0; +% +% Incorporates: New binary I/O library, separate optimized +% arithmetic for takefraction/makefraction, new graphics interface +% +% Revision 0.999999.1.2 86/01/28 19:49:38 richards +% Added: +% variable "dummy" to routine initterm() because SUN PC compiler +% loops with only i,j,k defined. Argh! +% +% Revision 0.999999.1.1 86/01/21 23:05:16 richards +% First cut for MF 1.0 +% +% Revision 0.999999 86/01/13 00:40:25 richards +% Released for 0.999999: +% added OTHERCASES sentinel +% revised WINDOW interface and include files +% +% Revision 0.99999 85/12/09 20:23:35 richards +% Version for 0.99999 +% +% Revision 0.9999 85/10/21 20:48:24 richards +% Released for MF version 0.9999 +% +% Revision 0.999 85/10/18 21:33:44 richards +% Version that works with 0.999 MF (Never released) +% +% Revision 0.91 85/05/16 10:58:13 richards +% Released for MF version 0.91 +% +% Revision 0.81 85/05/05 12:24:08 richards +% Released for MF version 0.81 +% +% Revision 0.77 85/03/11 20:23:37 richards +% Released for MF version 0.77 +% +% Revision 0.6.1.1 85/02/12 20:12:32 richards +% First edit for 0.76 +% +% Revision 0.6 85/02/08 00:52:40 richards +% Distribution version for MF 0.6 +% +% Revision 0.0.2.1 84/12/06 03:43:33 richards +% Edited to work with 0.4 -- still needs to have section numbers re-done +% before release. +% +% Revision 0.0 84/11/05 00:50:38 richards +% Base version (first cut) for MetaFont 0.0 +% +% + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [0] WEAVE: only print changes +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +\def\botofcontents{\vskip 0pt plus 1fil minus 1.5in} +@y +\def\botofcontents{\vskip 0pt plus 1fil minus 1.5in} +\let\maybe=\iffalse +\def\title{{\logo opqrstuq} changes for SunOS} +\def\glob{13}\def\gglob{20, 25} % these are defined in module 1 +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.2] banner line +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d banner=='This is METAFONT, Version 2.7182' {printed when \MF\ starts} +@y +@d banner=='This is METAFONT, Version 2.7182 for SunOS' + {printed when \MF\ starts} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.4] program header, include ext.h for C routine linkage +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +Actually the heading shown here is not quite normal: The |program| line +does not mention any |output| file, because \ph\ would ask the \MF\ user +to specify a file name if |output| were specified here. +@^system dependencies@> + +@d mtype==t@&y@&p@&e {this is a \.{WEB} coding trick:} +@y +@d mtype==t@&y@&p@&e {this is a \.{WEB} coding trick:} +@d standard_input==i@&n@&p@&u@&t {and another} +@z +@x +program MF; {all file names are defined dynamically} +@y +program MF(standard_input,output); {other file names are defined dynamically} +@z +@x +var @<Global variables@>@/ +@y +var @<Global variables@>@/ +@# +@\@=#include "ext.h"@>@\ {declarations for external C procedures} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.7] debug..gubed, stat..tats +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging} +@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging} +@y +@d debug==@{ +@d gubed==@t@>@} +@z +% (I will use the debug code only in the trap test) +@x +@d stat==@{ {change this to `$\\{stat}\equiv\null$' when gathering + usage statistics} +@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$' when gathering + usage statistics} +@y +@d stat== +@d tats== +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.8] init..tini +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d init== {change this to `$\\{init}\equiv\.{@@\{}$' in the production version} +@d tini== {change this to `$\\{tini}\equiv\.{@@\}}$' in the production version} +@y +@d init== +@d tini== +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.9] compiler directives +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead} +@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging} +@y +@=(*$C-*)@> {no range check} +@!debug @=(*$C+*)@> @+ gubed {but turn everything on when debugging} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.10] othercases, feature of Sun Pascal +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d othercases == others: {default for cases not listed explicitly} +@y +@d othercases == otherwise {default for cases not listed explicitly} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.11] compile-time constants +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@<Constants...@>= +@!mem_max=30000; {greatest index in \MF's internal |mem| array; + must be strictly less than |max_halfword|; + must be equal to |mem_top| in \.{INIMF}, otherwise |>=mem_top|} +@!max_internal=100; {maximum number of internal quantities} +@!buf_size=500; {maximum number of characters simultaneously present in + current lines of open files; must not exceed |max_halfword|} +@!error_line=72; {width of context lines on terminal error messages} +@!half_error_line=42; {width of first lines of contexts in terminal + error messages; should be between 30 and |error_line-15|} +@!max_print_line=79; {width of longest text lines output; should be at least 60} +@!screen_width=768; {number of pixels in each row of screen display} +@!screen_depth=1024; {number of pixels in each column of screen display} +@!stack_size=30; {maximum number of simultaneous input sources} +@!max_strings=2000; {maximum number of strings; must not exceed |max_halfword|} +@!string_vacancies=8000; {the minimum number of characters that should be + available for the user's identifier names and strings, + after \MF's own error messages are stored} +@!pool_size=32000; {maximum number of characters in strings, including all + error messages and help texts, and the names of all identifiers; + must exceed |string_vacancies| by the total + length of \MF's own strings, which is currently about 22000} +@!move_size=5000; {space for storing moves in a single octant} +@!max_wiggle=300; {number of autorounded points per cycle} +@!gf_buf_size=800; {size of the output buffer, must be a multiple of 8} +@!file_name_size=40; {file names shouldn't be longer than this} +@!pool_name='MFbases:MF.POOL '; + {string of length |file_name_size|; tells where the string pool appears} +@y +@<Constants...@>= +@!mem_max=30000; {greatest index in \MF's internal |mem| array; + must be strictly less than |max_halfword|; + must be equal to |mem_top| in \.{INIMF}, otherwise |>=mem_top|} +@!max_internal=100; {maximum number of internal quantities} +@!buf_size=500; {maximum number of characters simultaneously present in + current lines of open files; must not exceed |max_halfword|} +@!error_line=79; {width of context lines on terminal error messages} +@!half_error_line=50; {width of first lines of contexts in terminal + error messages; should be between 30 and |error_line-15|} +@!max_print_line=79; {width of longest text lines output; should be at least 60} +@!screen_width=1024; {number of pixels in each row of screen display} +@!screen_depth=800; {number of pixels in each column of screen display} +@!stack_size=30; {maximum number of simultaneous input sources} +@!max_strings=3000; {maximum number of strings; must not exceed |max_halfword|} +@!string_vacancies=18000; {the minimum number of characters that should be + available for the user's identifier names and strings, + after \MF's own error messages are stored} +@!pool_size=42000; {maximum number of characters in strings, including all + error messages and help texts, and the names of all identifiers; + must exceed |string_vacancies| by the total + length of \MF's own strings, which is currently about 22000} +@!move_size=5000; {space for storing moves in a single octant} +@!max_wiggle=300; {number of autorounded points per cycle} +@!gf_buf_size=800; {size of the output buffer, must be a multiple of 8} +@!file_name_size=1024; {file names shouldn't be longer than this} +@!pool_name='mf.pool'; + {string of length |file_name_size|; tells where the string pool appears} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.12] sensitive compile-time constants +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d mem_min=0 {smallest index in the |mem| array, must not be less + than |min_halfword|} +@d mem_top==30000 {largest index in the |mem| array dumped by \.{INIMF}; + must be substantially larger than |mem_min| + and not greater than |mem_max|} +@d hash_size=2100 {maximum number of symbolic tokens, + must be less than |max_halfword-3*param_size|} +@d hash_prime=1777 {a prime number equal to about 85\pct! of |hash_size|} +@d max_in_open=6 {maximum number of input files and error insertions that + can be going on simultaneously} +@d param_size=150 {maximum number of simultaneous macro parameters} +@y +@d mem_min==-30000 {smallest index in the |mem| array, must not be less + than |min_halfword|} +@d mem_top==30000 {largest index in the |mem| array dumped by \.{INIMF}; + must be substantially larger than |mem_min| + and not greater than |mem_max|} +@d hash_size=2100 {maximum number of symbolic tokens, + must be less than |max_halfword-3*param_size|} +@d hash_prime=1777 {a prime number equal to about 85\pct! of |hash_size|} +@d max_in_open=10 {maximum number of input files and error insertions that + can be going on simultaneously. Enlarged for Silvio Levy's Greek} +@d param_size=150 {maximum number of simultaneous macro parameters} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.22] Permissive input +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@^character set dependencies@> +@^system dependencies@> + +@<Set init...@>= +for i:=0 to @'37 do xchr[i]:=' '; +for i:=@'177 to @'377 do xchr[i]:=' '; +@y +@^character set dependencies@> +@^system dependencies@> + +@d tab = @'11 { ASCII horizontal tab } +@d form_feed = @'14 { ASCII form-feed } + +@<Set init...@>= +for i:=0 to @'37 do xchr[i]:=chr(i); +for i:=@'177 to @'377 do xchr[i]:=chr(i); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.24] file types +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +The program actually makes use also of a third kind of file, called a +@y +The pc compiler on Berkeley {\mc UNIX} won't pack a range into one byte unless +the lower bound is |-128| or more, and the upper bound is |127| or less. +This applies to files, too. To make the program work with compiler range +checking turned on, we'll have to adjust |eight_bits| codes by sometimes +adding or subtracting |256|. +Note that |eight_bits| really takes 16 bits here. + +The program actually makes use also of a third kind of file, called a +@z +@x +@!alpha_file=packed file of text_char; {files that contain textual data} +@!byte_file=packed file of eight_bits; {files that contain binary data} +@y +@!alpha_file=t@&e@&x@&t; {files that contain textual data} +@!byte_file=packed file of -128..127; {files that contain binary data} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.25] add real_name_of_file array for search path resolution +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +is crucial for our purposes. We shall assume that |name_of_file| is a variable +of an appropriate type such that the \PASCAL\ run-time system being used to +implement \MF\ can open a file whose external name is specified by +|name_of_file|. +@^system dependencies@> + +@<Glob...@>= +@!name_of_file:packed array[1..file_name_size] of char;@;@/ + {on some systems this may be a \&{record} variable} +@!name_length:0..file_name_size;@/{this many characters are actually + relevant in |name_of_file| (the rest are blank)} +@y +is crucial for our purposes. We shall assume that |name_of_file| is a variable +of an appropriate type such that the \PASCAL\ run-time system being used to +implement \MF\ can open a file whose external name is specified by +|name_of_file|. +The Berkeley {\mc UNIX} version uses search paths to look for files to open. +We use |real_name_of_file| to hold the |name_of_file| with a directory +name from the path in front of it. +@^system dependencies@> + +@<Glob...@>= +@!name_of_file,@!real_name_of_file:packed array[1..file_name_size] of char; +@;@/ +@!name_length:0..file_name_size;@/{this many characters are actually + relevant in |name_of_file| (the rest are blank)} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.26] file opening +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The \ph\ compiler with which the present version of \MF\ was prepared has +extended the rules of \PASCAL\ in a very convenient way. To open file~|f|, +we can write +$$\vbox{\halign{#\hfil\qquad&#\hfil\cr +|reset(f,@t\\{name}@>,'/O')|&for input;\cr +|rewrite(f,@t\\{name}@>,'/O')|&for output.\cr}}$$ +The `\\{name}' parameter, which is of type `\ignorespaces|packed +array[@t\<\\{any}>@>] of text_char|', stands for the name of +the external file that is being opened for input or output. +Blank spaces that might appear in \\{name} are ignored. + +The `\.{/O}' parameter tells the operating system not to issue its own +error messages if something goes wrong. If a file of the specified name +cannot be found, or if such a file cannot be opened for some other reason +(e.g., someone may already be trying to write the same file), we will have +|@!erstat(f)<>0| after an unsuccessful |reset| or |rewrite|. This allows +\MF\ to undertake appropriate corrective action. +@:PASCAL H}{\ph@> +@^system dependencies@> + +\MF's file-opening procedures return |false| if no file identified by +|name_of_file| could be opened. + +@d reset_OK(#)==erstat(#)=0 +@d rewrite_OK(#)==erstat(#)=0 + +@p function a_open_in(var @!f:alpha_file):boolean; + {open a text file for input} +begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f); +end; +@# +function a_open_out(var @!f:alpha_file):boolean; + {open a text file for output} +begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f); +end; +@# +function b_open_out(var @!f:byte_file):boolean; + {open a binary file for output} +begin rewrite(f,name_of_file,'/O'); b_open_out:=rewrite_OK(f); +end; +@# +function w_open_in(var @!f:word_file):boolean; + {open a word file for input} +begin reset(f,name_of_file,'/O'); w_open_in:=reset_OK(f); +end; +@# +function w_open_out(var @!f:word_file):boolean; + {open a word file for output} +begin rewrite(f,name_of_file,'/O'); w_open_out:=rewrite_OK(f); +end; +@y +@ The \ph\ compiler with which the present version of \MF\ was prepared has +extended the rules of \PASCAL\ in a very convenient way for file opening. +Berkeley {\mc UNIX} \PASCAL\ isn't nearly as nice as \ph. +Normally, it bombs out if a file open fails. +An external C procedure, |test_access| is used to check whether or not the +open will work. It is declared in the ``ext.h'' include file, and it returns +|true| or |false|. The |name_of_file| global holds the file name whose access +is to be tested. +The first parameter for |test_access| is the access mode, +one of |read_access_mode| or |write_access_mode|. + +We also implement path searching in |test_access|: its second parameter is +one of the ``file path'' constants defined below. If |name_of_file| +doesn't start with |'/'| then |test_access| tries prepending pathnames +from the appropriate path list until success or the end of path list +is reached. +On return, |real_name_of_file| contains the original name with the path +that succeeded (if any) prepended. It is the name used in the various +open procedures. + +Note that |a_open_in| has been redefined to take an additional argument, +which should be one of the ``file path'' specifiers. +Path searching is not done for output files. + +@d read_access_mode=4 {``read'' mode for |test_access|} +@d write_access_mode=2 {``write'' mode for |test_access|} + +@d no_file_path=0 {no path searching should be done} +@d input_file_path=1 {path specifier for \.{\\input} files} +@d base_file_path=4 {path specifier for base files} +@d pool_file_path=5 {path specifier for the pool file} + +@p function a_open_in(var @!f:alpha_file;@!path_specifier:integer):boolean; + {open a text file for input} +var @!ok:boolean; +begin +if test_access(read_access_mode,path_specifier) then + begin reset(f,real_name_of_file); ok:=true@+end +else + ok:=false; +a_open_in:=ok; +end; +@# +function a_open_out(var @!f:alpha_file):boolean; + {open a text file for output} +var @!ok:boolean; +begin +if test_access(write_access_mode,no_file_path) then + begin rewrite(f,real_name_of_file); ok:=true @+end +else ok:=false; +a_open_out:=ok; +end; +@# +function b_open_out(var f:byte_file):boolean; + {open a binary file for output} +var @!ok:boolean; +begin +if test_access(write_access_mode,no_file_path) then + begin rewrite(f,real_name_of_file); ok:=true @+end +else ok:=false; +b_open_out:=ok; +end; +@# +function w_open_in(var @!f:word_file):boolean; + {open a word file for input} +var @!ok:boolean; +begin +if test_access(read_access_mode,base_file_path) then + begin reset(f,real_name_of_file); ok:=true @+end +else ok:=false; +w_open_in:=ok; +end; +@# +function w_open_out(var @!f:word_file):boolean; + {open a word file for output} +var @!ok:boolean; +begin +if test_access(write_access_mode,no_file_path) then + begin rewrite(f,name_of_file); ok:=true @+end +else ok:=false; +w_open_out:=ok; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.27] file closing +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +This makes |f| available to be opened again, if desired; and if |f| was used for +output, the |close| operation makes the corresponding external file appear +on the user's area, ready to be read. + +@p procedure a_close(var @!f:alpha_file); {close a text file} +begin close(f); +end; +@# +procedure b_close(var @!f:byte_file); {close a binary file} +begin close(f); +end; +@# +procedure w_close(var @!f:word_file); {close a word file} +begin close(f); +end; +@y +This makes |f| available to be opened again, if desired; and if |f| was used for +output, the |close| operation makes the corresponding external file appear +on the user's area, ready to be read. + +With the pc library, files will be automatically closed when the program stops +and when one reopens them. +There is, however, the problem of opening a file and writing it, and then +wanting to read it again, but from a different file variable. +For this purpose we use external procedures |close_a|, |close_b|, and +|close_w|. + +@p procedure a_close(var f:alpha_file); {close a text file} +begin close_a(f); +end; +@# +procedure b_close(var f:byte_file); {close a binary file} +begin close_b(f); +end; +@# +procedure w_close(var f:word_file); {close a word file} +begin close_w(f); +end; + +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.30] faster version of input_ln +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +Standard \PASCAL\ says that a file should have |eoln| immediately +before |eof|, but \MF\ needs only a weaker restriction: If |eof| +occurs in the middle of a line, the system function |eoln| should return +a |true| result (even though |f^| will be undefined). + +@p function input_ln(var @!f:alpha_file;@!bypass_eoln:boolean):boolean; + {inputs the next line or returns |false|} +var @!last_nonblank:0..buf_size; {|last| with trailing blanks removed} +begin if bypass_eoln then if not eof(f) then get(f); + {input the first character of the line into |f^|} +last:=first; {cf.\ Matthew 19\thinspace:\thinspace30} +if eof(f) then input_ln:=false +else begin last_nonblank:=first; + while not eoln(f) do + begin if last>=max_buf_stack then + begin max_buf_stack:=last+1; + if max_buf_stack=buf_size then + @<Report overflow of the input buffer, and abort@>; + end; + buffer[last]:=xord[f^]; get(f); incr(last); + if buffer[last-1]<>" " then last_nonblank:=last; + end; + last:=last_nonblank; input_ln:=true; + end; +end; +@y +Standard \PASCAL\ says that a file should have |eoln| immediately +before |eof|, but \MF\ needs only a weaker restriction: If |eof| +occurs in the middle of a line, the system function |eoln| should return +a |true| result (even though |f^| will be undefined). + +With Berkeley {\mc UNIX} we call an external C procedure, |line_read|. +That routine fills |buffer| from |first| onwards with the |xord|'ed values +of the next line, setting |last| appropriately. It will stop if +|last=buf_size|, and the following will cause an ``overflow'' abort. +We ignore the |bypass_eoln| argument, since the |line_read| procedure +will have handled bypassing the end-of-line in its previous call, if +there was one. + +If one uses |input_ln| on a file, the normal |read| +and |get| routines shouldn't be used, nor the |eof| and |eoln| tests. +End of file can be tested with the external function |test_eof|. + +@p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean; + {inputs the next line or returns |false|} +label done; +begin +last:=first; {cf.\ Matthew 19\thinspace:\thinspace30} +if test_eof(f) then input_ln:=false +else begin last:=first; + line_read(f,buf_size); + if last>max_buf_stack then begin + max_buf_stack:=last; + if max_buf_stack>=buf_size then + @<Report overflow of the input buffer, and abort@>; + end; + loop@+ begin if last=first then goto done; + if buffer[last-1]<>" " then goto done; + decr(last); + end; +done: input_ln:=true; + end; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.31] term_in/out are input,output +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The user's terminal acts essentially like other files of text, except +that it is used both for input and for output. When the terminal is +considered an input file, the file variable is called |term_in|, and when it +is considered an output file the file variable is |term_out|. +@^system dependencies@> + +@<Glob...@>= +@!term_in:alpha_file; {the terminal as an input file} +@!term_out:alpha_file; {the terminal as an output file} +@y +@ The user's terminal acts essentially like other files of text, except +that it is used both for input and for output. When the terminal is +considered an input file, the file is called |term_in|, and when it +is considered an output file the file is |term_out|. +For Berkeley {\mc UNIX} we use |standard_input| and |output| for these +files, as were declared in the program header. The former name +|standard_input| was defined using a web trick so that ``input'' is +produced in the Pascal file. + +@d term_in==standard_input {the terminal as an input file} +@d term_out==output {the terminal as an output file} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.32] don't need to open terminal files +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ Here is how to open the terminal files +in \ph. The `\.{/I}' switch suppresses the first |get|. +@^system dependencies@> + +@d t_open_in==reset(term_in,'TTY:','/O/I') {open the terminal for text input} +@d t_open_out==rewrite(term_out,'TTY:','/O') {open the terminal for text output} +@y +@ Here is how to open the terminal files---do nothing. + +@d t_open_in == {input already open for text input} +@d t_open_out == {output already open for text output} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.33] flushing output +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +these operations can be specified in \ph: +@^system dependencies@> + +@d update_terminal == break(term_out) {empty the terminal output buffer} +@d clear_terminal == break_in(term_in,true) {clear the terminal input buffer} +@d wake_up_terminal == do_nothing {cancel the user's cancellation of output} +@y +these operations can be specified with Berkeley {\mc UNIX}: +@^system dependencies@> + +@d update_terminal == flush(output) +@d clear_terminal == {nothing necessary on UNIX} +@d wake_up_terminal == {nothing necessary on UNIX} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.36] rescanning the command line +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The following program does the required initialization +without retrieving a possible command line. +It should be clear how to modify this routine to deal with command lines, +if the system permits them. +@^system dependencies@> + +@p function init_terminal:boolean; {gets the terminal input started} +label exit; +begin t_open_in; +loop@+begin wake_up_terminal; write(term_out,'**'); update_terminal; +@.**@> + if not input_ln(term_in,true) then {this shouldn't happen} + begin write_ln(term_out); + write(term_out,'! End of file on the terminal... why?'); +@.End of file on the terminal@> + init_terminal:=false; return; + end; + loc:=first; + while (loc<last)and(buffer[loc]=" ") do incr(loc); + if loc<last then + begin init_terminal:=true; + return; {return unless the line was all blank} + end; + write_ln(term_out,'Please type the name of your input file.'); + end; +exit:end; +@y +@ The following program does the required initialization +and also retrieves a possible command line. +@^system dependencies@> + +@p +function init_terminal:boolean; {gets the terminal input started} +label exit; + +var + dummy, i, j, k: integer; + arg: packed array[1..100] of char; + +begin + t_open_in; + if argc > 1 then begin + last := first; + for i := 1 to argc - 1 do begin + argv(i, arg); + j := 1; + k := 100; {find last non-blank char in arg} + while (k > 1) and (arg[k] = ' ') do@/ + decr(k); + while (j <= k) do begin + buffer[last] := xord[arg[j]]; + incr(j); incr(last); + end; + if k > 1 then begin + buffer[last] := xord[' ']; + incr(last); + end; + end; + if last > first then begin + loc := first; + init_terminal := true; + return; + end; + end; + loop@+begin + wake_up_terminal; write(term_out, '**'); update_terminal; +@.**@> + if not input_ln(term_in,true) then begin {this shouldn't happen} + write_ln(term_out); + write_ln(term_out, '! End of file on the terminal... why?'); +@.End of file on the terminal@> + init_terminal:=false; + return; + end; + + loc:=first; + while (loc<last)and(buffer[loc]=" ") do + incr(loc); + + if loc<last then begin + init_terminal:=true; + return; {return unless the line was all blank} + end; + write_ln(term_out, 'Please type the name of your input file.'); +@.Please type the name...@> + end; +exit: +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [4.51] a_open_in of pool file needs path specifier +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +if a_open_in(pool_file) then +@y +if a_open_in(pool_file,pool_file_path) then +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [4.51,52,53] make MF.POOL lowercase in messages +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +else bad_pool('! I can''t read MF.POOL.') +@y +else bad_pool('! I can''t read mf.pool.') +@z +@x +begin if eof(pool_file) then bad_pool('! MF.POOL has no check sum.'); +@y +begin if eof(pool_file) then bad_pool('! mf.pool has no check sum.'); +@z +@x + bad_pool('! MF.POOL line doesn''t begin with two digits.'); +@y + bad_pool('! mf.pool line doesn''t begin with two digits.'); +@z +@x + bad_pool('! MF.POOL check sum doesn''t have nine digits.'); +@y + bad_pool('! mf.pool check sum doesn''t have nine digits.'); +@z +@x +done: if a<>@$ then bad_pool('! MF.POOL doesn''t match; TANGLE me again.'); +@y +done: if a<>@$ then bad_pool('! mf.pool doesn''t match; tangle me again.'); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [6.79] switch-to-editor option +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +line ready to be edited. But such an extension requires some system +wizardry, so the present implementation simply types out the name of the +file that should be +edited and the relevant line number. +@^system dependencies@> + +There is a secret `\.D' option available when the debugging routines haven't +been commented~out. +@^debugging@> +@y +line ready to be edited. +We do this by calling the external procedure |calledit| with a pointer to +the filename, its length, and the line number. +However, here we just set up the variables that will be used as arguments, +since we don't want to do the switch-to-editor until after \MF\ has closed +its files. +@^system dependencies@> + +There is a secret `\.D' option available when the debugging routines have +not been commented out. +@^debugging@> +@d edit_file==input_stack[file_ptr] +@z +@x +"E": if file_ptr>0 then + begin print_nl("You want to edit file "); +@.You want to edit file x@> + slow_print(input_stack[file_ptr].name_field); + print(" at line "); print_int(line);@/ + interaction:=scroll_mode; jump_out; +@y +"E": if file_ptr>0 then + begin + ed_name_start:=str_start[edit_file.name_field]; + ed_name_length:=str_start[edit_file.name_field+1] - + str_start[edit_file.name_field]; + edit_line:=line; + jump_out; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [7.107,108] replace make_fraction with external routine +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p function make_fraction(@!p,@!q:integer):fraction; +var @!f:integer; {the fraction bits, with a leading 1 bit} +@!n:integer; {the integer part of $\vert p/q\vert$} +@!negative:boolean; {should the result be negated?} +@!be_careful:integer; {disables certain compiler optimizations} +begin if p>=0 then negative:=false +else begin negate(p); negative:=true; + end; +if q<=0 then + begin debug if q=0 then confusion("/");@;@+gubed@;@/ +@:this can't happen /}{\quad \./@> + negate(q); negative:=not negative; + end; +n:=p div q; p:=p mod q; +if n>=8 then + begin arith_error:=true; + if negative then make_fraction:=-el_gordo@+else make_fraction:=el_gordo; + end +else begin n:=(n-1)*fraction_one; + @<Compute $f=\lfloor 2^{28}(1+p/q)+{1\over2}\rfloor$@>; + if negative then make_fraction:=-(f+n)@+else make_fraction:=f+n; + end; +end; + +@ The |repeat| loop here preserves the following invariant relations +between |f|, |p|, and~|q|: +(i)~|0<=p<q|; (ii)~$fq+p=2^k(q+p_0)$, where $k$ is an integer and +$p_0$ is the original value of~$p$. + +Notice that the computation specifies +|(p-q)+p| instead of |(p+p)-q|, because the latter could overflow. +Let us hope that optimizing compilers do not miss this point; a +special variable |be_careful| is used to emphasize the necessary +order of computation. Optimizing compilers should keep |be_careful| +in a register, not store it in memory. +@^inner loop@> + +@<Compute $f=\lfloor 2^{28}(1+p/q)+{1\over2}\rfloor$@>= +f:=1; +repeat be_careful:=p-q; p:=be_careful+p; +if p>=0 then f:=f+f+1 +else begin double(f); p:=p+q; + end; +until f>=fraction_one; +be_careful:=p-q; +if be_careful+p>=0 then incr(f) + +@y +Under {\mc UNIX} \MF, we have replaced the \PASCAL\ version of |make_fraction| +with either a C or assembly language equivalent for efficiency. + +@ This section was deleted when |make_fraction| was removed. + +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [7.109,110,111] replace take_fraction with external version +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p function take_fraction(@!q:integer;@!f:fraction):integer; +var @!p:integer; {the fraction so far} +@!negative:boolean; {should the result be negated?} +@!n:integer; {additional multiple of $q$} +@!be_careful:integer; {disables certain compiler optimizations} +begin @<Reduce to the case that |f>=0| and |q>0|@>; +if f<fraction_one then n:=0 +else begin n:=f div fraction_one; f:=f mod fraction_one; + if q<=el_gordo div n then n:=n*q + else begin arith_error:=true; n:=el_gordo; + end; + end; +f:=f+fraction_one; +@<Compute $p=\lfloor qf/2^{28}+{1\over2}\rfloor-q$@>; +be_careful:=n-el_gordo; +if be_careful+p>0 then + begin arith_error:=true; n:=el_gordo-p; + end; +if negative then take_fraction:=-(n+p) +else take_fraction:=n+p; +end; + +@ @<Reduce to the case that |f>=0| and |q>0|@>= +if f>=0 then negative:=false +else begin negate(f); negative:=true; + end; +if q<0 then + begin negate(q); negative:=not negative; + end; + +@ The invariant relations in this case are (i)~$\lfloor(qf+p)/2^k\rfloor +=\lfloor qf_0/2^{28}+{1\over2}\rfloor$, where $k$ is an integer and +$f_0$ is the original value of~$f$; (ii)~$2^k\L f<2^{k+1}$. +@^inner loop@> + +@<Compute $p=\lfloor qf/2^{28}+{1\over2}\rfloor-q$@>= +p:=fraction_half; {that's $2^{27}$; the invariants hold now with $k=28$} +if q<fraction_four then + repeat if odd(f) then p:=half(p+q)@+else p:=half(p); + f:=half(f); + until f=1 +else repeat if odd(f) then p:=p+half(q-p)@+else p:=half(p); + f:=half(f); + until f=1 + +@y +Function |take_fraction| has also been replaced by an external routine. + +@ @<Reduce to the case that |f>=0| and |q>0|@>= +if f>=0 then negative:=false +else begin negate(f); negative:=true; + end; +if q<0 then + begin negate(q); negative:=not negative; + end; + +@ This section was deleted when |take_fraction| was replaced by an +external routine. (But the previous section was left in, because +it is part of |take_scaled|, which follows.) + +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [9.153] ranges for quarter,half words +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +can get 256 values into a quarterword only if the subrange is `|-128..127|'. + +The present implementation tries to accommodate as many variations as possible, +so it makes few assumptions. If integers having the subrange +`|min_quarterword..max_quarterword|' can be packed into a quarterword, +and if integers having the subrange `|min_halfword..max_halfword|' +can be packed into a halfword, everything should work satisfactorily. + +It is usually most efficient to have |min_quarterword=min_halfword=0|, +so one should try to achieve this unless it causes a severe problem. +The values defined here are recommended for most 32-bit computers. + +@d min_quarterword=0 {smallest allowable value in a |quarterword|} +@d max_quarterword=255 {largest allowable value in a |quarterword|} +@d min_halfword==0 {smallest allowable value in a |halfword|} +@d max_halfword==65535 {largest allowable value in a |halfword|} +@y +can get 256 values into a quarterword only if the subrange is `|-128..127|'. + +For Berkeley {\mc UNIX} we need to do the |-128..127| kind of range. + +@d min_quarterword=-128 {smallest allowable value in a |quarterword|} +@d max_quarterword=127 {largest allowable value in a |quarterword|} +@d min_halfword==-32768 {smallest allowable value in a |halfword|} +@d max_halfword==32767 {largest allowable value in a |halfword|} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [11.178] fix the word "free" so that it doesn't conflict with a runtime proc +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +been included. (You may want to decrease the size of |mem| while you +@^debugging@> +are debugging.) +@y +been included. (You may want to decrease the size of |mem| while you +@^debugging@> +are debugging.) + +@d free==free_arr +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [12.194] fix_date_and_time +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The following procedure, which is called just before \MF\ initializes its +input and output, establishes the initial values of the date and time. +@^system dependencies@> +Since standard \PASCAL\ cannot provide such information, something special +is needed. The program here simply specifies July 4, 1776, at noon; but +users probably want a better approximation to the truth. + +Note that the values are |scaled| integers. Hence \MF\ can no longer +be used after the year 32767. + +@p procedure fix_date_and_time; +begin internal[time]:=12*60*unity; {minutes since midnight} +internal[day]:=4*unity; {fourth day of the month} +internal[month]:=7*unity; {seventh month of the year} +internal[year]:=1776*unity; {Anno Domini} +end; +@y +@ The following procedure, which is called just before \MF\ initializes its +input and output, establishes the initial values of the date and time. +It is calls an externally defined |date_and_time|, even though it could +be done from Pascal. +The external procedure also sets up interrupt catching. +@^system dependencies@> + +Note that the values are |scaled| integers. Hence \MF\ can no longer +be used after the year 32767. + +@p procedure fix_date_and_time; +begin + date_and_time(internal[time],internal[day],internal[month],internal[year]); + internal[time] := internal[time] * unity; + internal[day] := internal[day] * unity; + internal[month] := internal[month] * unity; + internal[year] := internal[year] * unity; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [12.199] allow <tab> and <ff> as input +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +for k:=0 to " "-1 do char_class[k]:=invalid_class; +for k:=127 to 255 do char_class[k]:=invalid_class; +@y +for k:=0 to " "-1 do char_class[k]:=invalid_class; +for k:=127 to 255 do char_class[k]:=invalid_class; +char_class[tab]:=space_class; +char_class[form_feed]:=space_class; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [27.564] init_screen and update_screen are external C procs +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% BEGIN HOOK FOR THE TRAP TEST +%@x +%begin init_screen:=false; +%@y +%begin init_screen:=true; +%@z +@x +The \PASCAL\ code here is a minimum version of |init_screen| and +|update_screen|, usable on \MF\ installations that don't +support screen output. If |init_screen| is changed to return |true| +instead of |false|, the other routines will simply log the fact +that they have been called; they won't really display anything. +The standard test routines for \MF\ use this log information to check +that \MF\ is working properly, but the |wlog| instructions should be +removed from production versions of \MF. + +@p function init_screen:boolean; +begin init_screen:=false; +end; +@# +procedure update_screen; {will be called only if |init_screen| returns |true|} +begin @!init wlog_ln('Calling UPDATESCREEN');@+tini {for testing only} +end; + +@y +We declare the screen functions +for the {\mc UNIX} version of \MF\ in the following header file. + +@p +@\@=#include "mf_window.h"@>@\ {declarations for external C procedures} + +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [27.559] blank_rectangle is an external C proc +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +The commented-out code in the following procedure is for illustrative +purposes only. +@^system dependencies@> + +@p procedure blank_rectangle(@!left_col,@!right_col:screen_col; + @!top_row,@!bot_row:screen_row); +var @!r:screen_row; +@!c:screen_col; +begin @{@+for r:=top_row to bot_row-1 do + for c:=left_col to right_col-1 do + screen_pixel[r,c]:=white;@+@}@/ +@!init wlog_cr; {this will be done only after |init_screen=true|} +wlog_ln('Calling BLANKRECTANGLE(',left_col:1,',', + right_col:1,',',top_row:1,',',bot_row:1,')');@+tini +end; + +@y +@^system dependencies@> + +The procedure |blank_rectangle| has been declared an external routine +for the {\mc UNIX} version of \MF\ in the header file above. + +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [27.560] paint_row is an external C proc +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +The general idea is to paint blocks of pixels in alternate colors; +the precise details are best conveyed by means of a \PASCAL\ +program (see the commented-out code below). +@^system dependencies@> + +@p procedure paint_row(@!r:screen_row;@!b:pixel_color;var @!a:trans_spec; + @!n:screen_col); +var @!k:screen_col; {an index into |a|} +@!c:screen_col; {an index into |screen_pixel|} +begin @{ k:=0; c:=a[0]; +repeat incr(k); + repeat screen_pixel[r,c]:=b; incr(c); + until c=a[k]; + b:=black-b; {$|black|\swap|white|$} + until k=n;@+@}@/ +@!init wlog('Calling PAINTROW(',r:1,',',b:1,';'); + {this is done only after |init_screen=true|} +for k:=0 to n do + begin wlog(a[k]:1); if k<>n then wlog(','); + end; +wlog_ln(')');@+tini +end; + +@y +@^system dependencies@> + +|Paint_row| has been declared an external routine in the {\mc UNIX} version +of \MF\ in the header file above. + +@z +% END HOOK FOR THE TRAP TEST +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [38.768] area and extension rules +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The file names we shall deal with for illustrative purposes have the +following structure: If the name contains `\.>' or `\.:', the file area +consists of all characters up to and including the final such character; +otherwise the file area is null. If the remaining file name contains +`\..', the file extension consists of all such characters from the first +remaining `\..' to the end, otherwise the file extension is null. +@^system dependencies@> + +We can scan such file names easily by using two global variables that keep track +of the occurrences of area and extension delimiters: + +@<Glob...@>= +@!area_delimiter:pool_pointer; {the most recent `\.>' or `\.:', if any} +@!ext_delimiter:pool_pointer; {the relevant `\..', if any} +@y +@ The file names we shall deal with for SunOS have the +following structure: If the name contains `\./', the file area +consists of all characters up to and including the final such character; +otherwise the file area is null. If the remaining file name contains +`\..', the file extension consists of all such characters from the first +remaining `\..' to the end, otherwise the file extension is null. +@^system dependencies@> + +We can scan such file names easily by using two global variables that keep +track of the occurrences of area and extension delimiters: + +@<Glob...@>= +@!area_delimiter:pool_pointer; {the most recent `\./', if any} +@!ext_delimiter:pool_pointer; {the most recent `\..', if any} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [38.769] MF area directories +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d MF_area=="MFinputs:" +@.MFinputs@> +@y +Under Berkeley {\mc UNIX}, the default paths are specified in a seprate +file, `\.{mfpaths.h}'. The file opening procedures do path searching +based either on those default paths, or on paths given by the user +in ``environment'' variables. +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [38.771] more_name +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +begin if c=" " then more_name:=false +else begin if (c=">")or(c=":") then +@y +begin if (c=" ")or(c=tab) then more_name:=false +else begin if (c="/") then +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [38.775] default base +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d base_default_length=18 {length of the |MF_base_default| string} +@d base_area_length=8 {length of its area part} +@d base_ext_length=5 {length of its `\.{.base}' part} +@y +Under Berkeley {\mc UNIX} we don't give the area part, instead depending +on the path searching that will happen during file opening. + +@d base_default_length=10 {length of the |MF_base_default| string} +@d base_area_length=0 {length of its area part} +@d base_ext_length=5 {length of its `\.{.base}' part} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [38.776] plain base location +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +MF_base_default:='MFbases:plain.base'; +@y +MF_base_default:='plain.base'; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [38.779] w_open_in of base file needs to be called only once +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x + pack_buffered_name(0,loc,j-1); {try first without the system file area} + if w_open_in(base_file) then goto found; + pack_buffered_name(base_area_length,loc,j-1); + {now try the system base file area} + if w_open_in(base_file) then goto found; +@y + pack_buffered_name(0,loc,j-1); + if w_open_in(base_file) then goto found; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [38.780] make_name_string +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +which simply makes a \MF\ string from the value of |name_of_file|, should +ideally be changed to deduce the full name of file~|f|, which is the file +most recently opened, if it is possible to do this in a \PASCAL\ program. +@^system dependencies@> + +This routine might be called after string memory has overflowed, hence +we dare not use `|str_room|'. + +@p function make_name_string:str_number; +var @!k:1..file_name_size; {index into |name_of_file|} +begin if (pool_ptr+name_length>pool_size)or(str_ptr=max_strings) then + make_name_string:="?" +else begin for k:=1 to name_length do append_char(xord[name_of_file[k]]); + make_name_string:=make_string; + end; +end; +@y +which simply makes a \MF\ string from the value of |name_of_file|, should +ideally be changed to deduce the full name of file~|f|, which is the file +most recently opened, if it is possible to do this in a \PASCAL\ program. +With the Berkeley {\mc UNIX} version, we know that |real_name_of_file| +contains |name_of_file| prepended with the directory name that was found +by path searching. +If |real_name_of_file| starts with |'./'|, we don't use that part of the +name, since {\mc UNIX} users understand that. +@^system dependencies@> + +This routine might be called after string memory has overflowed, hence +we dare not use `|str_room|'. + +@p function make_name_string:str_number; +var @!k,@!kstart:1..file_name_size; {index into |name_of_file|} +begin +k:=1; +while (k<file_name_size) and (xord[real_name_of_file[k]]<>" ") do + incr(k); +name_length:=k-1; {the real |name_length|} +if (pool_ptr+name_length>pool_size)or(str_ptr=max_strings) then + make_name_string:="?" +else begin + if (xord[real_name_of_file[1]]=".") and (xord[real_name_of_file[2]]="/") then + kstart:=3 + else + kstart:=1; + for k:=kstart to name_length do append_char(xord[real_name_of_file[k]]); + make_name_string:=make_string; + end; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [38.781] scan_file_name ignore leading tabs as well as spaces +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p procedure scan_file_name; +label done; +begin begin_name; +while buffer[loc]=" " do incr(loc); +@y +@p procedure scan_file_name; +label done; +begin begin_name; +while (buffer[loc]=" ")or(buffer[loc]=tab) do incr(loc); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [38.787] <Scan_file_name...> needs similar leading tab treatment +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ @<Scan file name in the buffer@>= +begin begin_name; k:=first; +while (buffer[k]=" ")and(k<last) do incr(k); +@y +@ @<Scan file name in the buffer@>= +begin begin_name; k:=first; +while ((buffer[k]=" ")or(buffer[k]=tab))and(k<last) do incr(k); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [38.793] a_open_in of input file needs path selector +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x + if a_open_in(cur_file) then goto done; + if cur_area="" then + begin pack_file_name(cur_name,MF_area,cur_ext); + if a_open_in(cur_file) then goto done; + end; +@y + if a_open_in(cur_file,input_file_path) then goto done; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [38.793] get rid of return of name to string pool +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +if name=str_ptr-1 then {we can conserve string pool space now} + begin flush_string(name); name:=cur_name; + end; +@y +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [45.1133] writing the tfm file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d tfm_out(#)==write(tfm_file,#) {output one byte to |tfm_file|} +@y +@d tfm_out(#) ==write(tfm_file,((#+128) mod 256)-128) +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [47.1154] write_gf +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@<Declare generic font output procedures@>= +procedure write_gf(@!a,@!b:gf_index); +var k:gf_index; +begin for k:=a to b do write(gf_file,gf_buf[k]); +end; +@y +For Berkeley {\mc UNIX}, this is going to be handled by an external procedure, +|writegf|, which will do the output using |fwrite|. +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [49.1204] Delete ready_already; also add call to set_paths; +% also add call to exit() depending upon value of `history' +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ Now this is really it: \MF\ starts and ends here. + +The initial test involving |ready_already| should be deleted if the +\PASCAL\ runtime system is smart enough to detect such a ``mistake.'' +@y +@ Now this is really it: \MF\ starts and ends here. + +Instead of testing |ready_already|, we give up the idea of a preloaded +core image in favor of silently loading a format file based on the +name by which this program has been invoked. For example, if the +program is being called \.{mf}, we will load the \.{plain} base; +if \.{cmmf}, we will load \.{cmmf.base}. On my machine the +loading of a format isn't too slow. (I use the new string capabilities +of Sun Pascal here; |my_name| will be declared {\bf varying} [100] +{\bf of\/} |char|.) + +At the end of the job, we look at |history| to decide the correct +exit code. We use 1 if |history <= warning_issued| and 0 otherwise. + +@d UNIXexit==e@&x@&i@&t +@z + +@x +t_open_out; {open the terminal for output} +if ready_already=314159 then goto start_of_MF; +@y +t_open_out; {open the terminal for output} +set_paths; +@z +@x +start_of_MF: @<Initialize the output routines@>; +@y +start_of_MF: argv(0,my_name); +if (my_name<>'inimf')and(my_name<>'trapmf') then + begin if my_name = 'mf' then name_of_file:='plain.base' + else name_of_file:=my_name+'.base'; + if w_open_in(base_file) then + if not load_base_file then + begin w_close(base_file); goto final_end; + end + else w_close(base_file); + end; +@<Initialize the output routines@>; +@z + +@x +final_end: ready_already:=0; +@y +final_end: ready_already:=0; +if (history <= warning_issued) then + UNIXexit(0) +else + UNIXexit(1); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [49.1204] print new line before termination; switch to editor if nec. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x + slow_print(log_name); print_char("."); + end; + end; +@y + slow_print(log_name); print_char("."); + end; + end; +print_ln; +if (ed_name_start<>0) and (interaction>batch_mode) then + calledit(str_pool[ed_name_start],ed_name_length,edit_line); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [51.1214] add editor-switch variable to globals +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@* \[51] System-dependent changes. +This section should be replaced, if necessary, by any special +modifications of the program +that are necessary to make \MF\ work at a particular installation. +It is usually best to design your change file so that all changes to +previous sections preserve the section numbering; then everybody's version +will be consistent with the published program. More extensive changes, +which introduce new sections, can be inserted here; then only the index +itself will get a new section number. +@^system dependencies@> +@y +@* \[51] System-dependent changes. +Here are the variables used to hold ``switch-to-editor'' information. +And the omphaloskeptic variable too. +@^system dependencies@> + +@<Global...@>= +@!ed_name_start: pool_pointer; +@!ed_name_length,@!edit_line: integer; +@!my_name:varying [100] of char; + +@ The |ed_name_start| will be set to point into |str_pool| somewhere after +its beginning if \MF\ is supposed to switch to an editor on exit. + +@<Set init...@>= +ed_name_start:=0; +@z + diff --git a/systems/knuth/local/mf-sparc/mf.pool b/systems/knuth/local/mf-sparc/mf.pool new file mode 100644 index 0000000000..4f1478cac2 --- /dev/null +++ b/systems/knuth/local/mf-sparc/mf.pool @@ -0,0 +1,824 @@ +11buffer size +09pool size +17number of strings +03??? +28End of file on the terminal! +02! +42(That makes 100 errors; please try again.) +02? +60Type <return> to proceed, S to scroll future error messages, +44R to run without stopping, Q to run quietly, +23I to insert something, +20E to edit your file, +561 or ... or 9 to ignore the next 1 to 9 tokens of input, +22H for help, X to quit. +13OK, entering +09batchmode +11nonstopmode +10scrollmode +03... +07insert> +44I have just deleted some text, as you asked. +48You can now delete more, or insert, or whatever. +50Sorry, I don't know how to help in this situation. +36Maybe you should try asking a human? +42Sorry, I already gave what help I could... +59An error might have occurred before I noticed any problems. +45``If all else fails, read the instructions.'' +00 +14Emergency stop +35METAFONT capacity exceeded, sorry [ +44If you really absolutely need more capacity, +35you can ask a wizard to enlarge me. +19This can't happen ( +59I'm broken. Please show this to someone who can fix can fix +35I can't go on meeting you like this +55One of your faux pas seems to have wounded me deeply... +59in fact, I'm barely conscious. Please fix it and try again. +12Interruption +09You rang? +57Try to insert some instructions for me (e.g.,`I show x'), +43unless you just want to quit by typing `X'. +09Missing ` +19' has been inserted +19Arithmetic overflow +59Uh, oh. A little while ago one of the quantities that I was +59computing got too large, so I'm afraid your answers will be +55somewhat askew. You'll probably have to adopt different +54tactics next time. But I shall try to carry on anyway. +15Square root of +23 has been replaced by 0 +52Since I don't take square roots of negative numbers, +52I'm zeroing this one. Proceed, with fingers crossed. +24Pythagorean subtraction +03+-+ +13Logarithm of +48Since I don't take logs of non-positive numbers, +27angle(0,0) is taken as zero +54The `angle' between two identical points is undefined. +16main memory size +24AVAIL list clobbered at +31Double-AVAIL list clobbered at +24Doubly free location at +12Bad flag at +14New busy locs: +05LINK( +05INFO( +07vacuous +07boolean +15unknown boolean +06string +14unknown string +03pen +11unknown pen +10future pen +04path +12unknown path +07picture +15unknown picture +09transform +04pair +13known numeric +09dependent +15proto-dependent +07numeric +11independent +10token list +10structured +16unsuffixed macro +14suffixed macro +09undefined +04true +05false +11nullpicture +07nullpen +07jobname +10readstring +09pencircle +13normaldeviate +03odd +05known +07unknown +03not +07decimal +07reverse +08makepath +07makepen +11totalweight +03oct +03hex +05ASCII +04char +06length +13turningnumber +05xpart +05ypart +06xxpart +06xypart +06yxpart +06yypart +04sqrt +04mexp +04mlog +04sind +04cosd +05floor +14uniformdeviate +10charexists +05angle +05cycle +02++ +02or +03and +02<= +02>= +02<> +07rotated +07slanted +06scaled +07shifted +11transformed +07xscaled +07yscaled +07zscaled +17intersectiontimes +09substring +07subpath +13directiontime +05point +10precontrol +11postcontrol +09penoffset +02.. +13tracingtitles +16tracingequations +15tracingcapsules +14tracingchoices +12tracingspecs +11tracingpens +15tracingcommands +15tracingrestores +13tracingmacros +12tracingedges +13tracingoutput +12tracingstats +13tracingonline +04year +05month +03day +04time +08charcode +07charext +06charwd +06charht +06chardp +06charic +06chardx +06chardy +10designsize +04hppp +04vppp +07xoffset +07yoffset +07pausing +12showstopping +10fontmaking +08proofing +09smoothing +12autorounding +11granularity +06fillin +12turningcheck +12warningcheck +12boundarychar +09 at line +14a bad variable +02fi +08endgroup +06enddef +06endfor +13 INACCESSIBLE +09hash size +06EQUIV( +02:: +03||: +02:= +05addto +02at +07atleast +10begingroup +08controls +04cull +04curl +10delimiters +07display +08everyjob +06exitif +11expandafter +04from +08inwindow +07interim +03let +11newinternal +02of +10openwindow +10randomseed +04save +10scantokens +07shipout +06skipto +04step +03str +07tension +02to +05until +05token +05 ETC. +10 CLOBBERED +11 IMPOSSIBLE +12 NONEXISTENT +04 BAD +02[] +05(EXPR +07(SUFFIX +05(TEXT +02-> +03>-> +08<expr>-> +19<expr>of<primary>-> +10<suffix>-> +08<text>-> +07(SAVED) +03var +02xx +02xy +02yx +02yy +08%CAPSULE +05part +06struct +11{restoring +04Path +07{open?} +10..control? +03 .. +06{curl +10..tension +05 and +11..controls +02?? +16, before choices +15, after choices +23Some number got too big +46The path that I just computed is out of range. +53So it will probably look funny. Proceed, for a laugh. +09path size +14Edge structure +04row +02 | +31Scaled picture would be too big +50I can't yscale the picture as requested---it would +45make some coordinates too large or too small. +42Proceed, and I'll omit the transformation. +50I can't xscale the picture as requested---it would +15move table size +13Tracing edges +09 (weight +21(No new edges added.) +10Cycle spec +24 % beginning in octant ` +19% entering octant ` +08 & cycle +03ENE +03NNE +03NNW +03WNW +03WSW +03SSW +03SSE +03ESE +14 ..controls +11 % segment +02 ( +33, before subdivision into octants +19, after subdivision +43, after subdivision and double autorounding +36, after subdivision and autorounding +18Curve out of range +56At least one of the coordinates in the path I'm about to +56digitize was really huge (potentially bigger than 4095). +40So I've cut it back to the maximum size. +41The results will probably be pretty wild. +19rounding table size +11Pen polygon +09 .. cycle +04 .. +16 (newly created) +13Pen too large +59The cycle you specified has a coordinate of 4095.5 or more. +55So I've replaced it by the trivial path `(0,0)..cycle'. +24Pen cycle must be convex +59The cycle you specified either has consecutive equal points +54or turns right or turns through more than 360 degrees. +16pen polygon size +09@ Octant +07 offset +08), from +04 to +23@ retrograde line from +18@ transition line +07, from +03dep +02*4 +20Value is too large ( +53The equation I just processed has given some variable +54a value of 4096 or more. Continue and I'll try to cope +47with that big value; but it might be dangerous. +47(Set warningcheck:=0 to suppress this message.) +05#### +03## +15Bad PREVDEP at +16Out of order at +18Redundant equation +43I already knew that this equation was true. +50But perhaps no harm has been done; let's continue. +23[unknown command code!] +03<*> +08<insert> +12<scantokens> +02l. +10<forever> +11<argument> +16<recently read> +19<to be read again> +16<inserted text> +05<for( +03)> +16input stack size +17text input levels +08endinput +47Incomplete if; all text was ignored after line +51A forbidden `outer' token occurred in skipped text. +58This kind of error happens when you say `if...' and forget +57the matching `fi'. I've inserted a `fi'; this might work. +53The file ended while I was skipping conditional text. +10File ended +21Forbidden token found +16 while scanning +41I suspect you have forgotten an `enddef', +52causing me to read past where you wanted me to stop. +49I'll try to recover; but if the error is serious, +51you'd better type `E' or `X' now and fix your file. +27to the end of the statement +42A previous error seems to have propagated, +15a text argument +45It seems that a right delimiter was left out, +18the definition of +14the text of a +05 loop +41I suspect you have forgotten an `endfor', +08Runaway +05text? +11definition? +05loop? +39Text line contains an invalid character +53A funny symbol that I can't read has just been input. +48Continue, and I'll forget that it ever happened. +40Incomplete string token has been flushed +53Strings should finish on the same line as they began. +50I've deleted the partial string; you might want to +48insert another by typing, e.g., `I"new string"'. +32Enormous number has been reduced +52I can't handle numbers bigger than about 4095.99998; +53so I've changed your constant to that maximum amount. +36(Please type a command or say `end') +37*** (job aborted, no legal end found) +02=> +03def +06vardef +10primarydef +12secondarydef +11tertiarydef +03for +11forsuffixes +07forever +05quote +02#@ +02@# +31Missing symbolic token inserted +52Sorry: You can't redefine a number, string, or expr. +49I've inserted an inaccessible symbol so that your +60definition will be completed without mixing me up too badly. +51Sorry: You can't redefine my error-recovery tokens. +50The next thing in this `def' should have been `=', +54because I've already looked at the definition heading. +49But don't worry; I'll pretend that an equals sign +45was present. Everything from here to `enddef' +43will be the replacement text of this macro. +04expr +06suffix +04text +07primary +09secondary +08tertiary +41This variable already starts with a macro +44After `vardef a' you can't say `vardef a.b'. +40So I'll have to discard this definition. +46Missing parameter type; `expr' will be assumed +52You should've had `expr' or `suffix' or `text' here. +20parameter stack size +14Extra `endfor' +40I'm not currently working on a for loop, +40so I had better not try to end anything. +05input +09Lost loop +53I'm confused; after exiting from a loop, I still seem +53to want to repeat it. I'll try to forget the problem. +22No loop is in progress +51Why say `exitif' when there's nothing to exit from? +57After `exitif <boolean exp>' I expect to see a semicolon. +35I shall pretend that one was there. +20*** (loop confusion) +12Not a string +41I'm going to flush this expression, since +48scantokens should be followed by a known string. +03)<- +22Too many arguments to +11 Missing ` +52I'm going to assume that the comma I just read was a +57right delimiter, and then I'll begin expanding the macro. +55You might want to delete some tokens before continuing. +20Missing argument to +48That macro has more parameters than you thought. +54I'll continue by pretending that each missing argument +23is either zero or null. +54I've finished reading a macro argument and am about to +56read another; the arguments weren't delimited correctly. +51I've gotten to the end of the macro parameter list. +05 for +57I've got the first argument; will look now for the other. +02if +04else +06elseif +49There should've been a colon after the condition. +06{true} +07{false} +06Extra +43I'm ignoring this; it doesn't match any if. +09Improper +38When you say `for x=a step b until c', +43the initial value `a' and the step size `b' +55and the final value `c' must have known numeric values. +57The next thing in this loop should have been `=' or `:='. +47was present, and I'll look for the values next. +51The next thing in this loop should have been a `:'. +41So I'll pretend that a colon was present; +50everything from here to `endfor' will be iterated. +07 ENDFOR +12{loop value= +13initial value +09step size +47I assume you meant to say `until' after `step'. +48So I'll look for the final value and colon next. +11final value +05.base +15input file name +19I can't find file ` +23I can't write on file ` +02'. +03.mf +20Please type another +45*** (job aborted, file error in nonstop mode) +02: +05mfput +04.log +02** +20transcript file name +02 +20file name for output +37File names can't appear within macros +46Sorry...I've converted what follows to tokens, +37possibly garbaging the name you gave. +51Please delete the tokens and insert the name again. +03exp +26 (see the transcript file) +13 (future pen) +10linearform +03>> +07recycle +04### +03 = +09A primary +30 expression can't begin with ` +58I'm afraid I need some sort of value in order to continue, +49so I've tentatively inserted `0'. You may want to +43delete this zero and insert something else; +50see Chapter 27 of The METAFONTbook for an example. +39Nonnumeric ypart has been replaced by 0 +48I thought you were giving me a pair `(x,y)'; but +50after finding a nice xpart `x' I found a ypart `y' +54that isn't of numeric type. So I've changed y to zero. +59(The y that I didn't like appears above the error message.) +22A group begun on line +12 never ended +56I saw a `begingroup' back there that hasn't been matched +47by `endgroup'. So I've inserted `endgroup' now. +16Division by zero +43I'll pretend that you meant to divide by 1. +44Improper subscript has been replaced by zero +54A bracketed subscript must have a known numeric value; +59unfortunately, what I found was the value that appears just +55above this error message. So I'll try a zero subscript. +09Variable +21 has been obliterated +54It seems you did a nasty thing---probably by accident, +46but nevertheless you nearly hornswoggled me... +50While I was evaluating the right-hand side of this +51command, something happened, and the left-hand side +52is no longer a variable! So I won't change anything. +51While I was evaluating the suffix of this variable, +55something was redefined, and it's no longer a variable! +59In order to get back on my feet, I've inserted `0' instead. +04copy +47I've scanned an expression of the form `a[b,c', +41so a right bracket should have come next. +51I've seen a `[' and a subscript value, in a suffix, +11A secondary +10A tertiary +24Pen path must be a cycle +39I can't make a pen from the given path. +02An +49Undefined coordinates have been replaced by (0,0) +49I need x and y numbers for this part of the path. +42The value I found (see above) was no good; +48so I'll try to keep going by using zero instead. +45(Chapter 27 of The METAFONTbook explains that +36you might want to type `I ???' now.) +45Undefined x coordinate has been replaced by 0 +51I need a `known' x value for this part of the path. +45Undefined y coordinate has been replaced by 0 +51I need a `known' y value for this part of the path. +49I've scanned a direction spec for part of a path, +39so a right brace should have come next. +36Improper curl has been replaced by 1 +43A curl must be a known, nonnegative number. +46I've got the x coordinate of a path direction; +36will look for the y coordinate next. +45A path join command should end with two dots. +34Improper tension has been set to 1 +53The expression above should have been a number >=3/4. +46Paths don't touch; `&' will be changed to `..' +48When you join paths `p&q', the ending point of p +49must be exactly equal to the starting point of q. +53So I'm going to pretend that you said `p..q' instead. +46Undefined condition will be treated as `false' +53The expression shown above should have had a definite +48true-or-false value. I'm changing it to `false'. +40*** (cannot readstring in nonstop modes) +12unknown pair +15unknown numeric +17Not implemented: +59I'm afraid I don't know how to apply that operation to that +53particular type. Continue, and I'll simply return the +54argument (shown above) as the result of the operation. +02)} +30String contains illegal digits +55I zeroed out characters that weren't in the range 0..7. +48I zeroed out characters that weren't hex digits. +18Number too large ( +57I have trouble with numbers greater than 4095; watch out. +58combination of types. Continue, and I'll return the second +52argument (see above) as the result of the operation. +02{( +49The quantities shown above have not been equated. +60Oh dear. I can't decide if the expression above is positive, +59negative, or zero. So this comparison test won't be `true'. +41Unknown relation will be considered false +03)*( +58You're trying to divide the quantity shown above the error +55message by zero. I'm going to divide it by one instead. +32Improper transformation argument +46The expression shown above has the wrong type, +39so I can't transform anything using it. +37Transform components aren't all known +56I'm unable to apply a partially specified transformation +42except to a fully known pair or transform. +31That transformation is too hard +49I can apply complicated transformations to paths, +49but I can only do integer operations on pictures. +16Too far to shift +49I can't shift the picture as requested---it would +30A statement can't begin with ` +51I was looking for the beginning of a new statement. +58If you just proceed without changing anything, I'll ignore +56everything up to the next `;'. Please insert a semicolon +58now in front of anything that you don't want me to delete. +52(See Chapter 27 of The METAFONTbook for an example.) +28Extra tokens will be flushed +59I've just read as much of that statement as I could fathom, +59so a semicolon should have been next. It's very puzzling... +53but I'll try to get myself back together, by ignoring +19Isolated expression +40I couldn't find an `=' or `:=' after the +50expression that is shown above this error message, +44so I guess I'll just ignore it and carry on. +36Improper `:=' will be changed to `=' +54I didn't find a variable name at the left of the `:=', +50so I'm going to pretend that you said `=' instead. +03)=( +19Internal quantity ` +28' must receive a known value +56I can't set an internal quantity to anything but a known +54numeric value, so I'll have to ignore this assignment. +30Equation cannot be performed ( +58I'm sorry, but I don't know how to make such things equal. +55(See the two expressions just above the error message.) +34Redundant or inconsistent equation +56An equation between already-known quantities can't help. +50But don't worry; continue and I'll just ignore it. +21Inconsistent equation +58The equation I just read contradicts what was said before. +09 (off by +48Declared variable conflicts with previous vardef +56You can't use, e.g., `numeric foo[]' after `vardef foo'. +51Proceed, and I'll ignore the illegal redeclaration. +51Illegal suffix of declared variable will be flushed +50Variables in declarations must consist entirely of +46names and collective subscripts, e.g., `x[]a'. +57Are you trying to use a reserved word in a variable name? +43I'm going to discard the junk I found here, +51up to the next comma or the end of the declaration. +49Explicit subscripts like `x15a' aren't permitted. +16Extra `endgroup' +44I'm not currently working on a `begingroup', +03end +04dump +46Always say `randomseed:=<numeric expression>'. +29Unknown value will be ignored +48Your expression was too random for me to handle, +43so I won't change the random seed just now. +13{randomseed:= +13errorstopmode +05inner +05outer +55I found no right delimiter to match a left one. So I've +56put one in, behind the scenes; this may fix the problem. +11The token ` +32' is no longer a right delimiter +48Strange: This token has lost its former meaning! +44I'll read it as a right delimiter this time; +43but watch out, I'll probably miss it later. +10(%CAPSULE) +28' isn't an internal quantity +55Something like `tracingonline' should follow `interim'. +46You should have said `let symbol = something'. +55was present. The next token I read will be `something'. +19number of internals +09showtoken +09showstats +04show +12showvariable +16showdependencies +02> +08(outer) +03lef +04righ +25t delimiter that matches +03tag +08variable +06macro: +09'd macro: +17[repeat the loop] +13Memory usage +17 still untouched) +13String usage +07=macro: +02OK +56This isn't an error message; I'm just showing something. +07contour +10doublepath +04also +07withpen +10withweight +08dropping +07keeping +13Improper type +54Next time say `withweight <known numeric expression>'; +55I'll ignore the bad `with' clause and look for another. +47Next time say `withpen <known pen expression>'; +40Weight must be -3, -2, -1, +1, +2, or +3 +20 is the wrong type ( +45I was looking for a "known" picture variable. +37So I'll not change anything just now. +23Not a suitable variable +61At this point I needed to see the name of a picture variable. +58(Or perhaps you have indeed presented me with one; I might +59have missed it, if it wasn't followed by the proper token.) +16Improper `addto' +54This expression should have specified a known picture. +46This expression should have been a known path. +11Not a cycle +58That contour should have ended with `..cycle' or `&cycle'. +37Strange path (turning number is zero) +43Backwards path (turning number is negative) +53The path doesn't have a counterclockwise orientation, +41so I'll probably have trouble drawing it. +51(See Chapter 27 of The METAFONTbook for more help.) +17Bad window number +42It should be the number of an open window. +21Improper `openwindow' +52Say `openwindow k from (r0,c0) to (r1,c1) at (x,y)', +57where all quantities are known and k is between 0 and 15. +19Bad culling amounts +44Always cull by known amounts that exclude 0. +07message +10errmessage +07errhelp +46A message should be a known string expression. +32(That was another `errmessage'.) +51This error message was generated by an `errmessage' +43command, so I can't give any explicit help. +51Pretend that you're Miss Marple: Examine all clues, +41and deduce the truth by inspired guesses. +09Enormous +17 has been reduced +48Font metric dimensions must be less than 2048pt. +08charlist +08ligtable +10extensible +10headerbyte +09fontdimen +35Invalid code has been replaced by 0 +54I was looking for a number between 0 and 255, or for a +55string of length 1. Didn't find it; will use 0 instead. +10Character +02|| +05code +12 is already +13in a ligtable +13in a charlist +51It's not legal to label a character more than once. +17Improper location +43I was looking for a known, positive number. +50For safety's sake I'll ignore the present command. +56A colon should follow a headerbyte or fontinfo location. +21Illegal ligtable step +38I was looking for `=:' or `kern' here. +13ligtable size +02=: +03=:| +04=:|> +03|=: +04|=:> +04|=:| +05|=:|> +06|=:|>> +04kern +15Too far to skip +57At most 127 lig/kern steps can separate skipto1 from 1::. +13Improper kern +51The amount of kern should be a known numeric value. +39I'm processing `extensible c: t,m,b,r'. +23Improper font parameter +06(some +41 values had to be adjusted by as much as +03pt) +47(illegal design size has been changed to 128pt) +04.tfm +26file name for font metrics +24Font metrics written on +13(local label +15:: was missing) +24(a font metric dimension +23 font metric dimensions +21 had to be decreased) +17 METAFONT output +03.gf +02gf +19 (just shipped out) +51(There's unbounded black in character shipped out!) +07special +10numspecial +21Unsuitable expression +59The expression shown above has the wrong type to be output. +06title +18Output written on +10 character +02, +08 bytes). +08 (INIMF) +25 strings of total length +43 memory locations dumped; current usage is +16 symbolic tokens +17 (preloaded base= +14base file name +26Beginning to dump on file +22Transcript written on +02 ) +19(end occurred when +09 on line +16 was incomplete) +52(see the transcript file for additional information) +33(dump is performed only by INIMF) +21debug # (-1 to exit): +*415546872 diff --git a/systems/knuth/local/mf-sparc/mf_arith.c b/systems/knuth/local/mf-sparc/mf_arith.c new file mode 100644 index 0000000000..5347107e81 --- /dev/null +++ b/systems/knuth/local/mf-sparc/mf_arith.c @@ -0,0 +1,142 @@ +/* + * mf_arith.c -- optimized arithmetic routines for UNIX METAFONT 84 + * + * These functions account for a significant percentage of the processing + * time used by METAFONT, and have been recoded in assembly language for + * some classes of machines. + * + * As yet I don't have code for SPARC, so I'm just using a C version + * by richards, in hopes that cc does better than pc on the brute-force + * algorithm found in mf.web. + * + * function makefraction(p, q: integer): fraction; + * { Calculate the function floor( (p * 2^28) / q + 0.5 ) } + * { if both p and q are positive. If not, then the value } + * { of makefraction is calculated as though both *were* } + * { positive, then the result sign adjusted. } + * { (e.g. makefraction ALWAYS rounds away from zero) } + * { In case of an overflow, return the largest possible } + * { value (2^32-1) with the correct sign, and set global } + * { variable "aritherror" to 1. Note that -2^32 is } + * { considered to be an illegal product for this type of } + * { arithmetic! } + * + * function takefraction(f: fraction; q: integer): integer; + * { Calculate the function floor( (p * q) / 2^28 + 0.5 ) } + * { takefraction() rounds in a similar manner as } + * { makefraction() above. } + * + */ + +#include "h00vars.h" + +extern bool aritherror; /* to be set on overflow */ + +#define EL_GORDO 0x7fffffff /* 2^31-1 */ +#define FRACTION_ONE 0x10000000 /* 2^28 */ +#define FRACTION_HALF 0x08000000 /* 2^27 */ +#define FRACTION_FOUR 0x40000000 /* 2^30 */ + +int makefraction(p, q) + register int p, q; +{ + int negative; + register int be_careful; + register int f; + int n; + + if (p < 0) { + negative = 1; + p = -p; + } else negative = 0; + + if (q < 0) { + negative = !negative; + q = -q; + } + + n = p / q; + p = p % q; + + if (n >= 8) { + aritherror = TRUE; + return (negative? -EL_GORDO : EL_GORDO); + } + + n = (n-1)*FRACTION_ONE; + f = 1; + do { + be_careful = p - q; + p = be_careful + p; + if (p >= 0) { + f = f + f + 1; + } else { + f <<= 1; + p += q; + } + } while (f < FRACTION_ONE); + + be_careful = p - q; + if ((be_careful + p) >= 0) + f += 1; + return (negative? -(f+n) : (f+n)); + +} + +int takefraction(q, f) + register int q; + register int f; +{ + int n, negative; + register int p, be_careful; + + if (f < 0) { + negative = 1; + f = -f; + } else negative = 0; + if (q < 0) { + negative = !negative; + q = -q; + } + if (f < FRACTION_ONE) + n = 0; + else { + n = f / FRACTION_ONE; + f = f % FRACTION_ONE; + if (q < (EL_GORDO / n)) + n = n * q; + else { + aritherror = TRUE; + n = EL_GORDO; + } + } + + f += FRACTION_ONE; + p = FRACTION_HALF; + if (q < FRACTION_FOUR) + do { + if (f & 0x1) + p = (p+q) >> 1; + else + p >>= 1; + f >>= 1; + } while (f > 1); + else + do { + if (f & 0x1) + p = p + ((q-p) >> 1); + else + p >>= 1; + f >>= 1; + } while (f > 1); + + be_careful = n - EL_GORDO; + if ((be_careful + p) > 0) { + aritherror = TRUE; + n = EL_GORDO - p; + } + + return(negative? -(n+p) : (n+p)); +} + + diff --git a/systems/knuth/local/mf-sparc/mf_sunwin.c b/systems/knuth/local/mf-sparc/mf_sunwin.c new file mode 100644 index 0000000000..f1e9fa9b39 --- /dev/null +++ b/systems/knuth/local/mf-sparc/mf_sunwin.c @@ -0,0 +1,90 @@ +/* + * XView interface to MetaFont + * (written hastily and without much understanding...) + */ +#define SCREENWIDTH 1024 /* must match the constant in inimf.ch */ +#define SCREENDEPTH 800 /* must match the constant in inimf.ch */ + +#include <stdio.h> +#include <xview/xview.h> +#include <xview/canvas.h> +#include <X11/Xlib.h> + +static Frame frame; /* container */ +static Canvas canvas; /* the viewing and imaging area */ +static Xv_Window canvas_paintwin; /* image component of |canvas| */ +static Display *display; /* handle to X server */ +static Visual *screen; /* where the X server paints */ +static Window xcanvas; /* the X11 ``drawable'' component of our canvas */ +static GC gc; /* X graphic context */ +static XGCValues GCvalues; /* changes to a graphic context */ + +/* + * updatescreen; -- make sure screen display is current + */ + +updatescreen() +{ + notify_dispatch(); + XFlush(display); +} + +/* + * init_screen: boolean; return true if window operations legal + */ + +initscreen() +{ + if (xv_init(NULL)==NULL) return 0; + frame=(Frame)xv_create(NULL,FRAME,XV_WIDTH,700,XV_HEIGHT,600, + FRAME_SHOW_HEADER,FALSE, + XV_SHOW,TRUE,NULL); + canvas=(Canvas)xv_create(frame,CANVAS,CANVAS_REPAINT_PROC,updatescreen, + CANVAS_X_PAINT_WINDOW,TRUE, + XV_HEIGHT,SCREENDEPTH,XV_WIDTH,SCREENWIDTH, + CANVAS_AUTO_EXPAND,FALSE,CANVAS_AUTO_SHRINK,FALSE, + NULL); + canvas_paintwin=(Xv_window)xv_get(canvas,CANVAS_NTH_PAINT_WINDOW,0); + xcanvas=(Window)xv_get(canvas_paintwin,XV_XID); + display=(Display*)xv_get(frame,XV_DISPLAY); + screen=(Visual*)xv_get(frame,XV_VISUAL); + gc=XCreateGC(display,DefaultRootWindow(display),0,GCvalues); + notify_do_dispatch(); /* this should allow terminal input */ + return 1; +} + +/* + * blankrectangle: reset rectangle bounded by ([left,right],[top,bottom]) + * to background color + */ + +blankrectangle(left, right, top, bottom) + short left, right; + short top, bottom; +{ + XSetFunction(display,gc,GXclear); + XFillRectangle(display,xcanvas,gc,left,top,right-left,bottom-top); +} + +/* + * paintrow -- paint row r starting with color b, up to next + * transition specified by vector a, switch colors, + * and continue for n transitions. + */ + +paintrow(r, b, a, n) + short r; + short b; + short a[]; + short n; +{ + register short *p,*q=&a[n]; + XSetFunction(display,gc,b?GXset:GXclear); + for (p=a;p<q;p+=2) + XFillRectangle(display,xcanvas,gc,*p,r,*(p+1)-*p,1); + XSetFunction(display,gc,b?GXclear:GXset); + for (p=a+1;p<q;p+=2) + XFillRectangle(display,xcanvas,gc,*p,r,*(p+1)-*p,1); + notify_dispatch(); /* without this, the Notifier queue overflows */ +} + diff --git a/systems/knuth/local/mf-sparc/mf_window.h b/systems/knuth/local/mf-sparc/mf_window.h new file mode 100644 index 0000000000..761cf006c9 --- /dev/null +++ b/systems/knuth/local/mf-sparc/mf_window.h @@ -0,0 +1,15 @@ +{ $Header: mf_window.h,v 0.999999 86/01/13 00:43:56 richards Released $ } + +{ External procedures for UNIX MetaFont VIRMF for display graphics } + +function initscreen: boolean; + external; + +procedure updatescreen; + external; + +procedure blankrectangle(leftcol, rightcol: screencol; toprow, botrow: screenrow); + external; + +procedure paintrow(r: screenrow; b: pixelcolor; var a: transspec; n: screencol); + external; diff --git a/systems/knuth/local/mf-sparc/plain.base b/systems/knuth/local/mf-sparc/plain.base Binary files differnew file mode 100644 index 0000000000..8aff956dc2 --- /dev/null +++ b/systems/knuth/local/mf-sparc/plain.base diff --git a/systems/knuth/local/mf-sparc/plain.log b/systems/knuth/local/mf-sparc/plain.log new file mode 100644 index 0000000000..41d972df4f --- /dev/null +++ b/systems/knuth/local/mf-sparc/plain.log @@ -0,0 +1,16 @@ +This is METAFONT, Version 2.7182 for SunOS (INIMF) 8 AUG 1998 21:30 +**plain \input local \dump +(/home/tex/dist/lib/plain.mf +Preloading the plain base, version 2.71: preliminaries, + basic constants and mathematical macros, + macros for converting from device-independent units to pixels, + macros and tables for various modes of operation, + macros for drawing and filling, + macros for proof labels and rules, + macros for character and font administration, +and a few last-minute items.) (/home/tex/local/lib/local.mf) +Beginning to dump on file plain.base + (preloaded base=plain 98.8.8) +1407 strings of total length 23104 +5273 memory locations dumped; current usage is 1450&3664 +525 symbolic tokens diff --git a/systems/knuth/local/mf-sparc/trap1.in b/systems/knuth/local/mf-sparc/trap1.in new file mode 100644 index 0000000000..1e7b96cab3 --- /dev/null +++ b/systems/knuth/local/mf-sparc/trap1.in @@ -0,0 +1,3 @@ + +\input trap + diff --git a/systems/knuth/local/mf-sparc/trap2.in b/systems/knuth/local/mf-sparc/trap2.in new file mode 100644 index 0000000000..d3dba8ac65 --- /dev/null +++ b/systems/knuth/local/mf-sparc/trap2.in @@ -0,0 +1 @@ + &trap trap diff --git a/systems/knuth/local/mf/Makefile b/systems/knuth/local/mf/Makefile new file mode 100644 index 0000000000..445d028a47 --- /dev/null +++ b/systems/knuth/local/mf/Makefile @@ -0,0 +1,74 @@ +# Make executable files for this workstation, using the master TeX sources + +PFLAGS= -I.. +CFLAGS= -g -I.. -I/usr/openwin/include +#CFLAGS= -O -I.. -I/usr/openwin/include +#LIBS= -lsuntool -lsunwindow -lpixrect +LIBS= -L/usr/openwin/lib -lxview -lolgx -lX11 + +PC= time pc + +all: inimf + +traptest: trapmf + -trapmf < trap1.in + mv trap.log trapin.log + -trapmf < trap2.in | tee trap.fot + gftype trap.72270gf trap.typ < gftype.in + tftopl trap.tfm trap.pl + rm -f *.dif + -diff trapin.log ../../dist/mf/trapin.log > trapin.log.dif + -diff trap.log ../../dist/mf/trap.log > trap.log.dif + -diff trap.fot ../../dist/mf/trap.fot > trap.fot.dif + -diff trap.typ ../../dist/mf/trap.typ > trap.typ.dif + -diff trap.pl ../../dist/mf/trap.pl > trap.pl.dif + more trapin.log.dif trap.log.dif trap.typ.dif trap.fot.dif trap.pl.dif + +%.p: %.ch + tangle ../../dist/mf/mf.web $*.ch + mv ../../dist/mf/mf.pool . + mv ../../dist/mf/mf.p $*.p + +inimf.ch: ../../dist/mf/mf.web + +trapmf.ch: inimf.ch ini_to_trap + ini_to_trap inimf.ch trapmf.ch + +%.o: %.p + ${PC} ${PFLAGS} -c $*.p + +trapmf.o: trapmf.p + ${PC} -g ${PFLAGS} -c trapmf.p + +inimf: inimf.o ext.o mf_arith.o mf_sunwin.o + pc ${PFLAGS} -o inimf inimf.o ext.o mf_arith.o mf_sunwin.o ${LIBS} + +trapmf: trapmf.o ext.o mf_arith.o + pc -g ${PFLAGS} -o trapmf trapmf.o ext.o mf_arith.o + cp ../../dist/mf/trap.mf . + +ext.o: ext.c ext.h ../h00vars.h ../mfpaths.h + cc ${CFLAGS} -c ext.c + +mf_arith.o: mf_arith.c +mf_sunwin.o: mf_sunwin.c + +plain.base: ../../dist/lib/plain.mf ../lib/local.mf + -inimf plain \\input local \\dump + +install: # doit make install + mv inimf /usr/local/bin + rm /usr/local/bin/mf + ln /usr/local/bin/inimf /usr/local/bin/mf + make plain.base + +installtrap: # when the trap test is satisfactory + mv trap.mf trapin.log trap.log trap.fot trap.typ trap.pl + trap.72270gf trap.tfm ../../dist/mf + +clean: + rm -f *.p *.o *~ *.mf trapmf* trap.* trapin* + @echo "Remaining files should be:" + @echo "Makefile gftype.in mf.pool mf_window.h trap1.in" + @echo "ext.c ini_to_trap* mf_arith.c plain.base trap2.in" + @echo "ext.h inimf.ch mf_sunwin.c plain.log" diff --git a/systems/knuth/local/mf/ext.c b/systems/knuth/local/mf/ext.c new file mode 100644 index 0000000000..dfbf0b2bbb --- /dev/null +++ b/systems/knuth/local/mf/ext.c @@ -0,0 +1,457 @@ +/* external procedures called by MF */ +#include <sys/signal.h> +#include <sys/time.h> +#include "mfpaths.h" /* defines MAXINPATHCHARS, defaultinputpath, etc. */ +#include "h00vars.h" + +/* The following are for closing files */ + +closea(f) + int *f; /* actually, file pointer, but it doesn't matter */ +{ + close1(f); +} + +closeb(f) + int *f; /* actually, file pointer, but it doesn't matter */ +{ + close1(f); +} + +closew(f) + int *f; /* actually, file pointer, but it doesn't matter */ +{ + close1(f); +} + +extern int interrupt; /* To be made nonzero to tell MF about interrupts */ + +/* +** catchint() +** +** Gets called when the user hits his interrupt key. Sets the global +** "interrupt" nonzero, then sets it up so that the next interrupt will +** also be caught here. +** +*/ + +catchint() +{ + interrupt = 1; + signal(SIGINT,catchint); +} + +/* +** dateandtime(time, day, month, year) +** +** Stores minutes since midnight, current day, month and year into +** *time, *day, *month and *year, respectively. +** +** Also, set things up so that catchint() will get control on interrupts. +** +*/ + +dateandtime(minutes, day, month, year) +int *minutes, *day, *month, *year; +{ + long clock; + struct tm *tmptr, *localtime(); + + clock = time(0); + tmptr = localtime(&clock); + + *minutes = tmptr->tm_hour * 60 + tmptr->tm_min; + *day = tmptr->tm_mday; + *month = tmptr->tm_mon + 1; + *year = tmptr->tm_year + 1900; + signal(SIGINT,catchint); +} + + +/* fixed arrays are used to hold the paths, to avoid any possible problems + involving interaction of malloc and undump */ + +char inputpath[MAXINPATHCHARS] = defaultinputpath; +char basepath[MAXOTHPATHCHARS] = defaultbasepath; +char poolpath[MAXOTHPATHCHARS] = defaultpoolpath; + +char *getenv(); + +/* + * setpaths is called to set up the arrays inputpath, basepath, and + * poolpath as follows: if the user's environment has a value for the + * appropriate value, then use it; otherwise, leave the current value of + * the array (which may be the default path, or it may be the result of + * a call to setpaths on a previous run that was made the subject of + * an undump: this will give the maker of a preloaded MF the option of + * providing a new set of "default" paths. + * + * Note that we have to copy the string from the environment area, since + * that will change on the next run (which matters if this is for a + * preloaded MF). + */ +setpaths() +{ + register char *envpath; + + if ((envpath = getenv("MFINPUTS")) != NULL) + excopypath(inputpath,envpath,MAXINPATHCHARS); + if ((envpath = getenv("MFBASES")) != NULL) + excopypath(basepath,envpath,MAXOTHPATHCHARS); + if ((envpath = getenv("MFPOOL")) != NULL) + excopypath(poolpath,envpath,MAXOTHPATHCHARS); +} + +/* + * excopypath(s1,s2,n) copies at most n characters (including the null) + * from string s2 to string s1, giving an error message for paths + * that are too long. + */ +excopypath(s1,s2,n) + register char *s1,*s2; + register int n; +{ + while ((*s1++ = *s2++) != '\0') + if (--n == 0) { + fprintf(stderr, "! Environment search path is too big\n"); + *--s1 = '\0'; + return; /* let user continue with truncated path */ + } +} + +extern short buffer[],xord[]; +extern short last,first; /* pointers into buffer */ + +/* + * lineread reads from the Pascal text file with iorec pointer filep + * into buffer[first], buffer[first+1],..., buffer[last-1] (and + * setting "last"). + * Characters are read until a newline is found (which isn't put in the + * buffer) or until the next character would go into buffer[lastlim]. + * The characters need to be translated, so really xord[c] is put into + * the buffer when c is read. + * If end-of-file is encountered, the funit field of *filep is set + * appropriately. + */ +lineread(filep, lastlim) +struct iorec *filep; +int lastlim; +{ + register c; + register short *cs; /* pointer into buffer where next char goes */ + register FILE *iop; /* stdio-style FILE pointer */ + int l; /* how many more chars are allowed before buffer overflow */ + short *bf; /* hold address of buffer[first] */ + + iop = filep->fbuf; + bf = cs = &(buffer[first]); + l = lastlim-first; + /* overflow when next char would go into buffer[lastlim] */ + while (--l>=0 && (c = getc(iop)) != EOF && c!='\n') + *cs++ = xord[c]; + if (c == EOF) + filep->funit |= EOFF; /* we hit end-of-file */ + last = first+cs-bf; +} + +#define filenamesize 1024 /* should agree with inimf.ch */ +extern char nameoffile[],realnameoffile[]; /* these have size filenamesize */ + +/* + * testaccess(amode,filepath) + * + * Test whether or not the file whose name is in the global nameoffile + * can be opened for reading (if mode=READACCESS) + * or writing (if mode=WRITEACCESS). + * + * The filepath argument is one of the ...FILEPATH constants defined below. + * If the filename given in nameoffile does not begin with '/', we try + * prepending all the ':'-separated areanames in the appropriate path to the + * filename until access can be made, if it ever can. + * + * The realnameoffile global array will contain the name that yielded an + * access success. + */ + +#define READACCESS 4 +#define WRITEACCESS 2 + +#define NOFILEPATH 0 +#define INPUTFILEPATH 1 +#define READFILEPATH 2 +#define BASEFILEPATH 4 +#define POOLFILEPATH 5 + +bool +testaccess(amode,filepath) + int amode,filepath; +{ + register bool ok; + register char *p; + char *curpathplace; + int f; + + switch(filepath) { + case NOFILEPATH: curpathplace = NULL; break; + case INPUTFILEPATH: case READFILEPATH: + curpathplace = inputpath; break; + case BASEFILEPATH: curpathplace = basepath; break; + case POOLFILEPATH: curpathplace = poolpath; break; + } + if (nameoffile[0]=='/') /* file name has absolute path */ + curpathplace = NULL; + do { + packrealnameoffile(&curpathplace); + if (amode==READACCESS) + /* use system call "access" to see if we could read it */ + if (access(realnameoffile,READACCESS)==0) ok = TRUE; + else ok = FALSE; + else { + /* WRITEACCESS: use creat to see if we could create it, but close + the file again if we're OK, to let pc open it for real */ + f = creat(realnameoffile,0666); + if (f>=0) ok = TRUE; + else ok = FALSE; + if (ok) + close(f); + } + } while (!ok && curpathplace != NULL); + if (ok) { /* pad realnameoffile with blanks, as Pascal wants */ + for (p = realnameoffile; *p != '\0'; p++) + /* nothing: find end of string */ ; + while (p < &(realnameoffile[filenamesize])) + *p++ = ' '; + } + return (ok); +} + +/* + * packrealnameoffile(cpp) makes realnameoffile contain the directory at *cpp, + * followed by '/', followed by the characters in nameoffile up until the + * first blank there, and finally a '\0'. The cpp pointer is left pointing + * at the next directory in the path. + * But: if *cpp == NULL, then we are supposed to use nameoffile as is. + */ +packrealnameoffile(cpp) + char **cpp; +{ + register char *p,*realname; + + realname = realnameoffile; + if ((p = *cpp)!=NULL) { + while ((*p != ':') && (*p != '\0')) { + *realname++ = *p++; + if (realname == &(realnameoffile[filenamesize-1])) + break; + } + if (*p == '\0') *cpp = NULL; /* at end of path now */ + else *cpp = p+1; /* else get past ':' */ + *realname++ = '/'; /* separate the area from the name to follow */ + } + /* now append nameoffile to realname... */ + p = nameoffile; + while (*p != ' ') { + if (realname >= &(realnameoffile[filenamesize-1])) { + fprintf(stderr,"! Full file name is too long\n"); + break; + } + *realname++ = *p++; + } + *realname = '\0'; +} + +/* +** testeof(filep) +** +** Test whether or not the Pascal text file with iorec pointer filep +** has reached end-of-file (when the only I/O on it is done with +** lineread, above). +** We may have to read the next character and unget it to see if perhaps +** the end-of-file is next. +*/ + +bool +testeof(filep) +register struct iorec *filep; +{ + register char c; + register FILE *iop; /* stdio-style FILE pointer */ + if (filep->funit & EOFF) + return(TRUE); + else { /* check to see if next is EOF */ + iop = filep->fbuf; + c = getc(iop); + if (c == EOF) + return(TRUE); + else { + ungetc(c,iop); + return(FALSE); + } + } +} + + +/* +** writegf(a,b) +** +** writegf is called to write gfbuf[a..b] to gffile +** Unfortunately, gfbuf is declared as eight_bits, which in our +** implementation means that two bytes are taken by each entry. +** We only want to output the low order (first) byte of each pair. +*/ +extern struct iorec gffile; +extern short gfbuf[]; +writegf (a,b) + int a,b; +{ + register short *ptr,*final; + register FILE *iop; + + iop=gffile.fbuf; + ptr= &(gfbuf[a]); + final= &(gfbuf[b]); + while (ptr<=final) { + putc((char) (*ptr & 0377), iop); + ptr += 1; + } + /* Note: The above code used to be machine dependent. By changing + * the declarations from "char *" to "short *" we get the machine + * to do its own byte ordering of the de-reference of "ptr" above. + * Then we AND off the low bits (now that it's been pulled from + * memory correctly) and cast it into a "char" for putc(). + * --Peter Kessler's idea; explanation, AND, cast a la clp. + */ +} + + +/* +** close1(filep) +** close1 does the proper things to pc's runtime system file data structure +** to close a file +*/ +close1(filep) + + register struct iorec *filep; +{ + register struct iorec *next; + + if (filep->fbuf != 0) { + if ((filep->funit & FDEF) == 0) { + next = (struct iorec *) &_fchain; + while (next->fchain != FILNIL + && next->fchain != filep) + next = next->fchain; + if (next->fchain != FILNIL) + next->fchain = next->fchain->fchain; + + if (filep->fblk > PREDEF) { + fflush(filep->fbuf); + setbuf(filep->fbuf, NULL); + } + fclose(filep->fbuf); + if (ferror(filep->fbuf)) { +/* ERROR("%s: Close failed\n", + filep->pfname); */ + return; + } + filep->fbuf=0; + } + if ((filep->funit & TEMP) != 0 && + unlink(filep->pfname)) { +/* PERROR("Could not remove ", filep->pfname); */ + return; + } + } +} + +/* +** The following procedure is due to sjc@s1-c. +** +** calledit(filename, fnlength, linenumber) +** +** MF84 can call this to implement the 'e' feature in error-recovery +** mode, invoking a text editor on the erroneous source file. +** +** You should pass to "filename" the first character of the packed array +** containing the filename, and to "fnlength" the size of the filename. +** +** Ordinarily, this invokes emacs. If you want a different +** editor, create a shell environment variable MFEDIT containing +** the string that invokes that editor, with "%s" indicating where +** the filename goes and "%d" indicating where the decimal +** linenumber (if any) goes. For example, a MFEDIT string for "vi" might be: +** +** setenv MFEDIT "/usr/bin/vi +%d %s" +** +*/ + + char dvalue[] = "emacs +%d %s"; + char *mfeditvalue = &dvalue[0]; + + calledit(filename, fnlength, linenumber) + char *filename; + int fnlength, linenumber; + { + char *temp, *command, c; + int sdone, ddone, i; + + sdone = ddone = 0; + + /* Replace default with environment variable if possible. */ + if (NULL != (temp = (char *) getenv("MFEDIT"))) + mfeditvalue = temp; + + /* Make command string containing envvalue, filename, and linenumber */ + if (NULL == + (command = (char *) malloc(strlen(mfeditvalue) + fnlength + 25))) { + fprintf(stderr, "! Not enough memory to issue editor command\n"); + exit(1); + } + temp = command; + while ((c = *mfeditvalue++) != '\0') { + if (c == '%') { + switch (c = *mfeditvalue++) { + case 'd': + if (ddone) { + fprintf(stderr, + "! Line number cannot appear twice in editor command\n"); + exit(1); + } + sprintf(temp, "%d", linenumber); + while (*temp != '\0') + temp++; + ddone = 1; + break; + case 's': + if (sdone) { + fprintf(stderr, + "! Filename cannot appear twice in editor command\n"); + exit(1); + } + i = 0; + while (i < fnlength) + *temp++ = filename[i++] ^ 0x80; /* changed for 8-bit MF */ + sdone = 1; + break; + case '\0': + *temp++ = '%'; + mfeditvalue--; /* Back up to \0 to force termination. */ + break; + default: + *temp++ = '%'; + *temp++ = c; + break; + } + } + else + *temp++ = c; + } + *temp = '\0'; + + /* Execute command. */ + if (0 != system(command)) + fprintf(stderr, "! Trouble executing command %s\n", command); + + /* Quit, indicating MF had found an error before you typed "e". */ + exit(1); + } diff --git a/systems/knuth/local/mf/ext.h b/systems/knuth/local/mf/ext.h new file mode 100644 index 0000000000..7ff0e3bfdc --- /dev/null +++ b/systems/knuth/local/mf/ext.h @@ -0,0 +1,38 @@ +procedure exit(x : integer); + external; + +procedure closea(var f:text); + external; + +procedure closeb(var f:bytefile); + external; + +procedure closew(var f:wordfile); + external; + +procedure dateandtime(var minutes, day, month, year : integer); + external; + +procedure setpaths; + external; + +function testaccess(accessmode:integer; filepath:integer): boolean; + external; + +function testeof(var f: text): boolean; + external; + +procedure lineread(var f: text; lastlim: integer); + external; + +procedure writegf(a,b:integer); + external; + +procedure calledit(var filename: packedASCIIcode; fnlength, linenumber: integer); + external; + +function makefraction(p,q:integer):fraction; + external; + +function takefraction(q:integer;f:fraction):integer; + external; diff --git a/systems/knuth/local/mf/gftype.in b/systems/knuth/local/mf/gftype.in new file mode 100644 index 0000000000..9b48ee4cf9 --- /dev/null +++ b/systems/knuth/local/mf/gftype.in @@ -0,0 +1,2 @@ +y +y diff --git a/systems/knuth/local/mf/ini_to_trap b/systems/knuth/local/mf/ini_to_trap new file mode 100644 index 0000000000..c18984179f --- /dev/null +++ b/systems/knuth/local/mf/ini_to_trap @@ -0,0 +1,38 @@ +#! /bin/csh +# A shell script to perform modifications on the changefile for inimf +# to make a changefile for trapmf (used to test mf). +# +# To use it, say +# ini_to_trap inimf.ch trapmf.ch +# +ed - $1 <<edscriptend +/debug=/ +// +s/@{//p +/gubed=/ +s/@t@>@}//p +/@!mem_max=/ +// +s/[0-9][0-9]*/3000/p +/@!error_line=/ +s/[0-9][0-9]*/64/p +/@!half_error_line=/ +s/[0-9][0-9]*/32/p +/@!max_print_line=/ +s/[0-9][0-9]*/72/p +/@!screen_width=/ +s/[0-9][0-9]*/100/p +/@!screen_depth=/ +s/[0-9][0-9]*/200/p +/@!gf_buf_size=/ +s/[0-9][0-9]*/8/p +/@d mem_min=/ +// +s/-[0-9]*/0/p +/@d mem_top==/ +s/[0-9][0-9]*/3000/p +/% BEGIN HOOK FOR THE TRAP TEST/ +.+1,.+5s/%// +.+1,/% END HOOK FOR THE TRAP TEST/d +w $2 +edscriptend diff --git a/systems/knuth/local/mf/inimf.ch b/systems/knuth/local/mf/inimf.ch new file mode 100644 index 0000000000..271532c7b6 --- /dev/null +++ b/systems/knuth/local/mf/inimf.ch @@ -0,0 +1,1505 @@ +% Derived from INITEX.CH for Berkeley Unix TeX 1.1, by Howard Trickey +% and Pavel Curtis + +% Modification History: +% +% brought up to version 2.7182 on 8/8/98 --- don +% brought up to version 2.718 on 3/8/95 --- don +% UNIXexit convention switched 2/21/93 --- don +% tfm_out needed to be corrected for new Pascal compiler 7/18/92 --- don +% brought up to version 2.71 on 9/20/91 --- don +% brought up to version 2.7 on 9/6/90 --- don +% fixed max_buf_stack logic (it was one too high) on 1/22/90 --- don +% brought up to version 1.9 on 12/20/89 --- don +% brought up to version 1.8 on 10/14/89 --- don +% 8-bit modifications made 9/11/89 --- don +% +% don adapted everything for SunOS, MF Version 1.7, on 8/12/89 +% Module numbers changed to match Volume D +% Changes made more consistent with initex.ch +% Window code merged in, with hooks to remove it for the TRAP test +% +% Revision 1.3 87/03/07 21:15:21 mackay +% +% Minor changes found on archive version on SCORE +% (max_in_open increased to 10. -- 88/02/07 PAM) +% +% Revision 1.2 86/09/29 21:46:43 mackay +% +% Made no-debug the default, and changed version number +% to correspond with improved mf.web file +% (Got rid of debug code to avoid bug in range check +% code of VAX4.3 BSD and SUN3 version 3.x Os pc interpreter) +% +% Revision 1.0 86/01/31 15:46:08 richards +% Released for MF 1.0; +% +% Incorporates: New binary I/O library, separate optimized +% arithmetic for takefraction/makefraction, new graphics interface +% +% Revision 0.999999.1.2 86/01/28 19:49:38 richards +% Added: +% variable "dummy" to routine initterm() because SUN PC compiler +% loops with only i,j,k defined. Argh! +% +% Revision 0.999999.1.1 86/01/21 23:05:16 richards +% First cut for MF 1.0 +% +% Revision 0.999999 86/01/13 00:40:25 richards +% Released for 0.999999: +% added OTHERCASES sentinel +% revised WINDOW interface and include files +% +% Revision 0.99999 85/12/09 20:23:35 richards +% Version for 0.99999 +% +% Revision 0.9999 85/10/21 20:48:24 richards +% Released for MF version 0.9999 +% +% Revision 0.999 85/10/18 21:33:44 richards +% Version that works with 0.999 MF (Never released) +% +% Revision 0.91 85/05/16 10:58:13 richards +% Released for MF version 0.91 +% +% Revision 0.81 85/05/05 12:24:08 richards +% Released for MF version 0.81 +% +% Revision 0.77 85/03/11 20:23:37 richards +% Released for MF version 0.77 +% +% Revision 0.6.1.1 85/02/12 20:12:32 richards +% First edit for 0.76 +% +% Revision 0.6 85/02/08 00:52:40 richards +% Distribution version for MF 0.6 +% +% Revision 0.0.2.1 84/12/06 03:43:33 richards +% Edited to work with 0.4 -- still needs to have section numbers re-done +% before release. +% +% Revision 0.0 84/11/05 00:50:38 richards +% Base version (first cut) for MetaFont 0.0 +% +% + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [0] WEAVE: only print changes +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +\def\botofcontents{\vskip 0pt plus 1fil minus 1.5in} +@y +\def\botofcontents{\vskip 0pt plus 1fil minus 1.5in} +\let\maybe=\iffalse +\def\title{{\logo opqrstuq} changes for SunOS} +\def\glob{13}\def\gglob{20, 25} % these are defined in module 1 +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.2] banner line +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d banner=='This is METAFONT, Version 2.7182' {printed when \MF\ starts} +@y +@d banner=='This is METAFONT, Version 2.7182 for SunOS' + {printed when \MF\ starts} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.4] program header, include ext.h for C routine linkage +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +Actually the heading shown here is not quite normal: The |program| line +does not mention any |output| file, because \ph\ would ask the \MF\ user +to specify a file name if |output| were specified here. +@^system dependencies@> + +@d mtype==t@&y@&p@&e {this is a \.{WEB} coding trick:} +@y +@d mtype==t@&y@&p@&e {this is a \.{WEB} coding trick:} +@d standard_input==i@&n@&p@&u@&t {and another} +@z +@x +program MF; {all file names are defined dynamically} +@y +program MF(standard_input,output); {other file names are defined dynamically} +@z +@x +var @<Global variables@>@/ +@y +var @<Global variables@>@/ +@# +@\@=#include "ext.h"@>@\ {declarations for external C procedures} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.7] debug..gubed, stat..tats +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging} +@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging} +@y +@d debug==@{ +@d gubed==@t@>@} +@z +% (I will use the debug code only in the trap test) +@x +@d stat==@{ {change this to `$\\{stat}\equiv\null$' when gathering + usage statistics} +@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$' when gathering + usage statistics} +@y +@d stat== +@d tats== +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.8] init..tini +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d init== {change this to `$\\{init}\equiv\.{@@\{}$' in the production version} +@d tini== {change this to `$\\{tini}\equiv\.{@@\}}$' in the production version} +@y +@d init== +@d tini== +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.9] compiler directives +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead} +@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging} +@y +@=(*$C-*)@> {no range check} +@!debug @=(*$C+*)@> @+ gubed {but turn everything on when debugging} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.10] othercases, feature of Sun Pascal +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d othercases == others: {default for cases not listed explicitly} +@y +@d othercases == otherwise {default for cases not listed explicitly} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.11] compile-time constants +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@<Constants...@>= +@!mem_max=30000; {greatest index in \MF's internal |mem| array; + must be strictly less than |max_halfword|; + must be equal to |mem_top| in \.{INIMF}, otherwise |>=mem_top|} +@!max_internal=100; {maximum number of internal quantities} +@!buf_size=500; {maximum number of characters simultaneously present in + current lines of open files; must not exceed |max_halfword|} +@!error_line=72; {width of context lines on terminal error messages} +@!half_error_line=42; {width of first lines of contexts in terminal + error messages; should be between 30 and |error_line-15|} +@!max_print_line=79; {width of longest text lines output; should be at least 60} +@!screen_width=768; {number of pixels in each row of screen display} +@!screen_depth=1024; {number of pixels in each column of screen display} +@!stack_size=30; {maximum number of simultaneous input sources} +@!max_strings=2000; {maximum number of strings; must not exceed |max_halfword|} +@!string_vacancies=8000; {the minimum number of characters that should be + available for the user's identifier names and strings, + after \MF's own error messages are stored} +@!pool_size=32000; {maximum number of characters in strings, including all + error messages and help texts, and the names of all identifiers; + must exceed |string_vacancies| by the total + length of \MF's own strings, which is currently about 22000} +@!move_size=5000; {space for storing moves in a single octant} +@!max_wiggle=300; {number of autorounded points per cycle} +@!gf_buf_size=800; {size of the output buffer, must be a multiple of 8} +@!file_name_size=40; {file names shouldn't be longer than this} +@!pool_name='MFbases:MF.POOL '; + {string of length |file_name_size|; tells where the string pool appears} +@y +@<Constants...@>= +@!mem_max=30000; {greatest index in \MF's internal |mem| array; + must be strictly less than |max_halfword|; + must be equal to |mem_top| in \.{INIMF}, otherwise |>=mem_top|} +@!max_internal=100; {maximum number of internal quantities} +@!buf_size=500; {maximum number of characters simultaneously present in + current lines of open files; must not exceed |max_halfword|} +@!error_line=79; {width of context lines on terminal error messages} +@!half_error_line=50; {width of first lines of contexts in terminal + error messages; should be between 30 and |error_line-15|} +@!max_print_line=79; {width of longest text lines output; should be at least 60} +@!screen_width=1024; {number of pixels in each row of screen display} +@!screen_depth=800; {number of pixels in each column of screen display} +@!stack_size=30; {maximum number of simultaneous input sources} +@!max_strings=3000; {maximum number of strings; must not exceed |max_halfword|} +@!string_vacancies=18000; {the minimum number of characters that should be + available for the user's identifier names and strings, + after \MF's own error messages are stored} +@!pool_size=42000; {maximum number of characters in strings, including all + error messages and help texts, and the names of all identifiers; + must exceed |string_vacancies| by the total + length of \MF's own strings, which is currently about 22000} +@!move_size=5000; {space for storing moves in a single octant} +@!max_wiggle=300; {number of autorounded points per cycle} +@!gf_buf_size=800; {size of the output buffer, must be a multiple of 8} +@!file_name_size=1024; {file names shouldn't be longer than this} +@!pool_name='mf.pool'; + {string of length |file_name_size|; tells where the string pool appears} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.12] sensitive compile-time constants +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d mem_min=0 {smallest index in the |mem| array, must not be less + than |min_halfword|} +@d mem_top==30000 {largest index in the |mem| array dumped by \.{INIMF}; + must be substantially larger than |mem_min| + and not greater than |mem_max|} +@d hash_size=2100 {maximum number of symbolic tokens, + must be less than |max_halfword-3*param_size|} +@d hash_prime=1777 {a prime number equal to about 85\pct! of |hash_size|} +@d max_in_open=6 {maximum number of input files and error insertions that + can be going on simultaneously} +@d param_size=150 {maximum number of simultaneous macro parameters} +@y +@d mem_min==-30000 {smallest index in the |mem| array, must not be less + than |min_halfword|} +@d mem_top==30000 {largest index in the |mem| array dumped by \.{INIMF}; + must be substantially larger than |mem_min| + and not greater than |mem_max|} +@d hash_size=2100 {maximum number of symbolic tokens, + must be less than |max_halfword-3*param_size|} +@d hash_prime=1777 {a prime number equal to about 85\pct! of |hash_size|} +@d max_in_open=10 {maximum number of input files and error insertions that + can be going on simultaneously. Enlarged for Silvio Levy's Greek} +@d param_size=150 {maximum number of simultaneous macro parameters} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.22] Permissive input +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@^character set dependencies@> +@^system dependencies@> + +@<Set init...@>= +for i:=0 to @'37 do xchr[i]:=' '; +for i:=@'177 to @'377 do xchr[i]:=' '; +@y +@^character set dependencies@> +@^system dependencies@> + +@d tab = @'11 { ASCII horizontal tab } +@d form_feed = @'14 { ASCII form-feed } + +@<Set init...@>= +for i:=0 to @'37 do xchr[i]:=chr(i); +for i:=@'177 to @'377 do xchr[i]:=chr(i); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.24] file types +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +The program actually makes use also of a third kind of file, called a +@y +The pc compiler on Berkeley {\mc UNIX} won't pack a range into one byte unless +the lower bound is |-128| or more, and the upper bound is |127| or less. +This applies to files, too. To make the program work with compiler range +checking turned on, we'll have to adjust |eight_bits| codes by sometimes +adding or subtracting |256|. +Note that |eight_bits| really takes 16 bits here. + +The program actually makes use also of a third kind of file, called a +@z +@x +@!alpha_file=packed file of text_char; {files that contain textual data} +@!byte_file=packed file of eight_bits; {files that contain binary data} +@y +@!alpha_file=t@&e@&x@&t; {files that contain textual data} +@!byte_file=packed file of -128..127; {files that contain binary data} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.25] add real_name_of_file array for search path resolution +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +is crucial for our purposes. We shall assume that |name_of_file| is a variable +of an appropriate type such that the \PASCAL\ run-time system being used to +implement \MF\ can open a file whose external name is specified by +|name_of_file|. +@^system dependencies@> + +@<Glob...@>= +@!name_of_file:packed array[1..file_name_size] of char;@;@/ + {on some systems this may be a \&{record} variable} +@!name_length:0..file_name_size;@/{this many characters are actually + relevant in |name_of_file| (the rest are blank)} +@y +is crucial for our purposes. We shall assume that |name_of_file| is a variable +of an appropriate type such that the \PASCAL\ run-time system being used to +implement \MF\ can open a file whose external name is specified by +|name_of_file|. +The Berkeley {\mc UNIX} version uses search paths to look for files to open. +We use |real_name_of_file| to hold the |name_of_file| with a directory +name from the path in front of it. +@^system dependencies@> + +@<Glob...@>= +@!name_of_file,@!real_name_of_file:packed array[1..file_name_size] of char; +@;@/ +@!name_length:0..file_name_size;@/{this many characters are actually + relevant in |name_of_file| (the rest are blank)} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.26] file opening +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The \ph\ compiler with which the present version of \MF\ was prepared has +extended the rules of \PASCAL\ in a very convenient way. To open file~|f|, +we can write +$$\vbox{\halign{#\hfil\qquad&#\hfil\cr +|reset(f,@t\\{name}@>,'/O')|&for input;\cr +|rewrite(f,@t\\{name}@>,'/O')|&for output.\cr}}$$ +The `\\{name}' parameter, which is of type `\ignorespaces|packed +array[@t\<\\{any}>@>] of text_char|', stands for the name of +the external file that is being opened for input or output. +Blank spaces that might appear in \\{name} are ignored. + +The `\.{/O}' parameter tells the operating system not to issue its own +error messages if something goes wrong. If a file of the specified name +cannot be found, or if such a file cannot be opened for some other reason +(e.g., someone may already be trying to write the same file), we will have +|@!erstat(f)<>0| after an unsuccessful |reset| or |rewrite|. This allows +\MF\ to undertake appropriate corrective action. +@:PASCAL H}{\ph@> +@^system dependencies@> + +\MF's file-opening procedures return |false| if no file identified by +|name_of_file| could be opened. + +@d reset_OK(#)==erstat(#)=0 +@d rewrite_OK(#)==erstat(#)=0 + +@p function a_open_in(var @!f:alpha_file):boolean; + {open a text file for input} +begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f); +end; +@# +function a_open_out(var @!f:alpha_file):boolean; + {open a text file for output} +begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f); +end; +@# +function b_open_out(var @!f:byte_file):boolean; + {open a binary file for output} +begin rewrite(f,name_of_file,'/O'); b_open_out:=rewrite_OK(f); +end; +@# +function w_open_in(var @!f:word_file):boolean; + {open a word file for input} +begin reset(f,name_of_file,'/O'); w_open_in:=reset_OK(f); +end; +@# +function w_open_out(var @!f:word_file):boolean; + {open a word file for output} +begin rewrite(f,name_of_file,'/O'); w_open_out:=rewrite_OK(f); +end; +@y +@ The \ph\ compiler with which the present version of \MF\ was prepared has +extended the rules of \PASCAL\ in a very convenient way for file opening. +Berkeley {\mc UNIX} \PASCAL\ isn't nearly as nice as \ph. +Normally, it bombs out if a file open fails. +An external C procedure, |test_access| is used to check whether or not the +open will work. It is declared in the ``ext.h'' include file, and it returns +|true| or |false|. The |name_of_file| global holds the file name whose access +is to be tested. +The first parameter for |test_access| is the access mode, +one of |read_access_mode| or |write_access_mode|. + +We also implement path searching in |test_access|: its second parameter is +one of the ``file path'' constants defined below. If |name_of_file| +doesn't start with |'/'| then |test_access| tries prepending pathnames +from the appropriate path list until success or the end of path list +is reached. +On return, |real_name_of_file| contains the original name with the path +that succeeded (if any) prepended. It is the name used in the various +open procedures. + +Note that |a_open_in| has been redefined to take an additional argument, +which should be one of the ``file path'' specifiers. +Path searching is not done for output files. + +@d read_access_mode=4 {``read'' mode for |test_access|} +@d write_access_mode=2 {``write'' mode for |test_access|} + +@d no_file_path=0 {no path searching should be done} +@d input_file_path=1 {path specifier for \.{\\input} files} +@d base_file_path=4 {path specifier for base files} +@d pool_file_path=5 {path specifier for the pool file} + +@p function a_open_in(var @!f:alpha_file;@!path_specifier:integer):boolean; + {open a text file for input} +var @!ok:boolean; +begin +if test_access(read_access_mode,path_specifier) then + begin reset(f,real_name_of_file); ok:=true@+end +else + ok:=false; +a_open_in:=ok; +end; +@# +function a_open_out(var @!f:alpha_file):boolean; + {open a text file for output} +var @!ok:boolean; +begin +if test_access(write_access_mode,no_file_path) then + begin rewrite(f,real_name_of_file); ok:=true @+end +else ok:=false; +a_open_out:=ok; +end; +@# +function b_open_out(var f:byte_file):boolean; + {open a binary file for output} +var @!ok:boolean; +begin +if test_access(write_access_mode,no_file_path) then + begin rewrite(f,real_name_of_file); ok:=true @+end +else ok:=false; +b_open_out:=ok; +end; +@# +function w_open_in(var @!f:word_file):boolean; + {open a word file for input} +var @!ok:boolean; +begin +if test_access(read_access_mode,base_file_path) then + begin reset(f,real_name_of_file); ok:=true @+end +else ok:=false; +w_open_in:=ok; +end; +@# +function w_open_out(var @!f:word_file):boolean; + {open a word file for output} +var @!ok:boolean; +begin +if test_access(write_access_mode,no_file_path) then + begin rewrite(f,name_of_file); ok:=true @+end +else ok:=false; +w_open_out:=ok; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.27] file closing +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +This makes |f| available to be opened again, if desired; and if |f| was used for +output, the |close| operation makes the corresponding external file appear +on the user's area, ready to be read. + +@p procedure a_close(var @!f:alpha_file); {close a text file} +begin close(f); +end; +@# +procedure b_close(var @!f:byte_file); {close a binary file} +begin close(f); +end; +@# +procedure w_close(var @!f:word_file); {close a word file} +begin close(f); +end; +@y +This makes |f| available to be opened again, if desired; and if |f| was used for +output, the |close| operation makes the corresponding external file appear +on the user's area, ready to be read. + +With the pc library, files will be automatically closed when the program stops +and when one reopens them. +There is, however, the problem of opening a file and writing it, and then +wanting to read it again, but from a different file variable. +For this purpose we use external procedures |close_a|, |close_b|, and +|close_w|. + +@p procedure a_close(var f:alpha_file); {close a text file} +begin close_a(f); +end; +@# +procedure b_close(var f:byte_file); {close a binary file} +begin close_b(f); +end; +@# +procedure w_close(var f:word_file); {close a word file} +begin close_w(f); +end; + +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.30] faster version of input_ln +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +Standard \PASCAL\ says that a file should have |eoln| immediately +before |eof|, but \MF\ needs only a weaker restriction: If |eof| +occurs in the middle of a line, the system function |eoln| should return +a |true| result (even though |f^| will be undefined). + +@p function input_ln(var @!f:alpha_file;@!bypass_eoln:boolean):boolean; + {inputs the next line or returns |false|} +var @!last_nonblank:0..buf_size; {|last| with trailing blanks removed} +begin if bypass_eoln then if not eof(f) then get(f); + {input the first character of the line into |f^|} +last:=first; {cf.\ Matthew 19\thinspace:\thinspace30} +if eof(f) then input_ln:=false +else begin last_nonblank:=first; + while not eoln(f) do + begin if last>=max_buf_stack then + begin max_buf_stack:=last+1; + if max_buf_stack=buf_size then + @<Report overflow of the input buffer, and abort@>; + end; + buffer[last]:=xord[f^]; get(f); incr(last); + if buffer[last-1]<>" " then last_nonblank:=last; + end; + last:=last_nonblank; input_ln:=true; + end; +end; +@y +Standard \PASCAL\ says that a file should have |eoln| immediately +before |eof|, but \MF\ needs only a weaker restriction: If |eof| +occurs in the middle of a line, the system function |eoln| should return +a |true| result (even though |f^| will be undefined). + +With Berkeley {\mc UNIX} we call an external C procedure, |line_read|. +That routine fills |buffer| from |first| onwards with the |xord|'ed values +of the next line, setting |last| appropriately. It will stop if +|last=buf_size|, and the following will cause an ``overflow'' abort. +We ignore the |bypass_eoln| argument, since the |line_read| procedure +will have handled bypassing the end-of-line in its previous call, if +there was one. + +If one uses |input_ln| on a file, the normal |read| +and |get| routines shouldn't be used, nor the |eof| and |eoln| tests. +End of file can be tested with the external function |test_eof|. + +@p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean; + {inputs the next line or returns |false|} +label done; +begin +last:=first; {cf.\ Matthew 19\thinspace:\thinspace30} +if test_eof(f) then input_ln:=false +else begin last:=first; + line_read(f,buf_size); + if last>max_buf_stack then begin + max_buf_stack:=last; + if max_buf_stack>=buf_size then + @<Report overflow of the input buffer, and abort@>; + end; + loop@+ begin if last=first then goto done; + if buffer[last-1]<>" " then goto done; + decr(last); + end; +done: input_ln:=true; + end; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.31] term_in/out are input,output +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The user's terminal acts essentially like other files of text, except +that it is used both for input and for output. When the terminal is +considered an input file, the file variable is called |term_in|, and when it +is considered an output file the file variable is |term_out|. +@^system dependencies@> + +@<Glob...@>= +@!term_in:alpha_file; {the terminal as an input file} +@!term_out:alpha_file; {the terminal as an output file} +@y +@ The user's terminal acts essentially like other files of text, except +that it is used both for input and for output. When the terminal is +considered an input file, the file is called |term_in|, and when it +is considered an output file the file is |term_out|. +For Berkeley {\mc UNIX} we use |standard_input| and |output| for these +files, as were declared in the program header. The former name +|standard_input| was defined using a web trick so that ``input'' is +produced in the Pascal file. + +@d term_in==standard_input {the terminal as an input file} +@d term_out==output {the terminal as an output file} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.32] don't need to open terminal files +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ Here is how to open the terminal files +in \ph. The `\.{/I}' switch suppresses the first |get|. +@^system dependencies@> + +@d t_open_in==reset(term_in,'TTY:','/O/I') {open the terminal for text input} +@d t_open_out==rewrite(term_out,'TTY:','/O') {open the terminal for text output} +@y +@ Here is how to open the terminal files---do nothing. + +@d t_open_in == {input already open for text input} +@d t_open_out == {output already open for text output} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.33] flushing output +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +these operations can be specified in \ph: +@^system dependencies@> + +@d update_terminal == break(term_out) {empty the terminal output buffer} +@d clear_terminal == break_in(term_in,true) {clear the terminal input buffer} +@d wake_up_terminal == do_nothing {cancel the user's cancellation of output} +@y +these operations can be specified with Berkeley {\mc UNIX}: +@^system dependencies@> + +@d update_terminal == flush(output) +@d clear_terminal == {nothing necessary on UNIX} +@d wake_up_terminal == {nothing necessary on UNIX} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.36] rescanning the command line +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The following program does the required initialization +without retrieving a possible command line. +It should be clear how to modify this routine to deal with command lines, +if the system permits them. +@^system dependencies@> + +@p function init_terminal:boolean; {gets the terminal input started} +label exit; +begin t_open_in; +loop@+begin wake_up_terminal; write(term_out,'**'); update_terminal; +@.**@> + if not input_ln(term_in,true) then {this shouldn't happen} + begin write_ln(term_out); + write(term_out,'! End of file on the terminal... why?'); +@.End of file on the terminal@> + init_terminal:=false; return; + end; + loc:=first; + while (loc<last)and(buffer[loc]=" ") do incr(loc); + if loc<last then + begin init_terminal:=true; + return; {return unless the line was all blank} + end; + write_ln(term_out,'Please type the name of your input file.'); + end; +exit:end; +@y +@ The following program does the required initialization +and also retrieves a possible command line. +@^system dependencies@> + +@p +function init_terminal:boolean; {gets the terminal input started} +label exit; + +var + dummy, i, j, k: integer; + arg: packed array[1..100] of char; + +begin + t_open_in; + if argc > 1 then begin + last := first; + for i := 1 to argc - 1 do begin + argv(i, arg); + j := 1; + k := 100; {find last non-blank char in arg} + while (k > 1) and (arg[k] = ' ') do@/ + decr(k); + while (j <= k) do begin + buffer[last] := xord[arg[j]]; + incr(j); incr(last); + end; + if k > 1 then begin + buffer[last] := xord[' ']; + incr(last); + end; + end; + if last > first then begin + loc := first; + init_terminal := true; + return; + end; + end; + loop@+begin + wake_up_terminal; write(term_out, '**'); update_terminal; +@.**@> + if not input_ln(term_in,true) then begin {this shouldn't happen} + write_ln(term_out); + write_ln(term_out, '! End of file on the terminal... why?'); +@.End of file on the terminal@> + init_terminal:=false; + return; + end; + + loc:=first; + while (loc<last)and(buffer[loc]=" ") do + incr(loc); + + if loc<last then begin + init_terminal:=true; + return; {return unless the line was all blank} + end; + write_ln(term_out, 'Please type the name of your input file.'); +@.Please type the name...@> + end; +exit: +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [4.51] a_open_in of pool file needs path specifier +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +if a_open_in(pool_file) then +@y +if a_open_in(pool_file,pool_file_path) then +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [4.51,52,53] make MF.POOL lowercase in messages +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +else bad_pool('! I can''t read MF.POOL.') +@y +else bad_pool('! I can''t read mf.pool.') +@z +@x +begin if eof(pool_file) then bad_pool('! MF.POOL has no check sum.'); +@y +begin if eof(pool_file) then bad_pool('! mf.pool has no check sum.'); +@z +@x + bad_pool('! MF.POOL line doesn''t begin with two digits.'); +@y + bad_pool('! mf.pool line doesn''t begin with two digits.'); +@z +@x + bad_pool('! MF.POOL check sum doesn''t have nine digits.'); +@y + bad_pool('! mf.pool check sum doesn''t have nine digits.'); +@z +@x +done: if a<>@$ then bad_pool('! MF.POOL doesn''t match; TANGLE me again.'); +@y +done: if a<>@$ then bad_pool('! mf.pool doesn''t match; tangle me again.'); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [6.79] switch-to-editor option +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +line ready to be edited. But such an extension requires some system +wizardry, so the present implementation simply types out the name of the +file that should be +edited and the relevant line number. +@^system dependencies@> + +There is a secret `\.D' option available when the debugging routines haven't +been commented~out. +@^debugging@> +@y +line ready to be edited. +We do this by calling the external procedure |calledit| with a pointer to +the filename, its length, and the line number. +However, here we just set up the variables that will be used as arguments, +since we don't want to do the switch-to-editor until after \MF\ has closed +its files. +@^system dependencies@> + +There is a secret `\.D' option available when the debugging routines have +not been commented out. +@^debugging@> +@d edit_file==input_stack[file_ptr] +@z +@x +"E": if file_ptr>0 then + begin print_nl("You want to edit file "); +@.You want to edit file x@> + slow_print(input_stack[file_ptr].name_field); + print(" at line "); print_int(line);@/ + interaction:=scroll_mode; jump_out; +@y +"E": if file_ptr>0 then + begin + ed_name_start:=str_start[edit_file.name_field]; + ed_name_length:=str_start[edit_file.name_field+1] - + str_start[edit_file.name_field]; + edit_line:=line; + jump_out; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [7.107,108] replace make_fraction with external routine +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p function make_fraction(@!p,@!q:integer):fraction; +var @!f:integer; {the fraction bits, with a leading 1 bit} +@!n:integer; {the integer part of $\vert p/q\vert$} +@!negative:boolean; {should the result be negated?} +@!be_careful:integer; {disables certain compiler optimizations} +begin if p>=0 then negative:=false +else begin negate(p); negative:=true; + end; +if q<=0 then + begin debug if q=0 then confusion("/");@;@+gubed@;@/ +@:this can't happen /}{\quad \./@> + negate(q); negative:=not negative; + end; +n:=p div q; p:=p mod q; +if n>=8 then + begin arith_error:=true; + if negative then make_fraction:=-el_gordo@+else make_fraction:=el_gordo; + end +else begin n:=(n-1)*fraction_one; + @<Compute $f=\lfloor 2^{28}(1+p/q)+{1\over2}\rfloor$@>; + if negative then make_fraction:=-(f+n)@+else make_fraction:=f+n; + end; +end; + +@ The |repeat| loop here preserves the following invariant relations +between |f|, |p|, and~|q|: +(i)~|0<=p<q|; (ii)~$fq+p=2^k(q+p_0)$, where $k$ is an integer and +$p_0$ is the original value of~$p$. + +Notice that the computation specifies +|(p-q)+p| instead of |(p+p)-q|, because the latter could overflow. +Let us hope that optimizing compilers do not miss this point; a +special variable |be_careful| is used to emphasize the necessary +order of computation. Optimizing compilers should keep |be_careful| +in a register, not store it in memory. +@^inner loop@> + +@<Compute $f=\lfloor 2^{28}(1+p/q)+{1\over2}\rfloor$@>= +f:=1; +repeat be_careful:=p-q; p:=be_careful+p; +if p>=0 then f:=f+f+1 +else begin double(f); p:=p+q; + end; +until f>=fraction_one; +be_careful:=p-q; +if be_careful+p>=0 then incr(f) + +@y +Under {\mc UNIX} \MF, we have replaced the \PASCAL\ version of |make_fraction| +with either a C or assembly language equivalent for efficiency. + +@ This section was deleted when |make_fraction| was removed. + +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [7.109,110,111] replace take_fraction with external version +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p function take_fraction(@!q:integer;@!f:fraction):integer; +var @!p:integer; {the fraction so far} +@!negative:boolean; {should the result be negated?} +@!n:integer; {additional multiple of $q$} +@!be_careful:integer; {disables certain compiler optimizations} +begin @<Reduce to the case that |f>=0| and |q>0|@>; +if f<fraction_one then n:=0 +else begin n:=f div fraction_one; f:=f mod fraction_one; + if q<=el_gordo div n then n:=n*q + else begin arith_error:=true; n:=el_gordo; + end; + end; +f:=f+fraction_one; +@<Compute $p=\lfloor qf/2^{28}+{1\over2}\rfloor-q$@>; +be_careful:=n-el_gordo; +if be_careful+p>0 then + begin arith_error:=true; n:=el_gordo-p; + end; +if negative then take_fraction:=-(n+p) +else take_fraction:=n+p; +end; + +@ @<Reduce to the case that |f>=0| and |q>0|@>= +if f>=0 then negative:=false +else begin negate(f); negative:=true; + end; +if q<0 then + begin negate(q); negative:=not negative; + end; + +@ The invariant relations in this case are (i)~$\lfloor(qf+p)/2^k\rfloor +=\lfloor qf_0/2^{28}+{1\over2}\rfloor$, where $k$ is an integer and +$f_0$ is the original value of~$f$; (ii)~$2^k\L f<2^{k+1}$. +@^inner loop@> + +@<Compute $p=\lfloor qf/2^{28}+{1\over2}\rfloor-q$@>= +p:=fraction_half; {that's $2^{27}$; the invariants hold now with $k=28$} +if q<fraction_four then + repeat if odd(f) then p:=half(p+q)@+else p:=half(p); + f:=half(f); + until f=1 +else repeat if odd(f) then p:=p+half(q-p)@+else p:=half(p); + f:=half(f); + until f=1 + +@y +Function |take_fraction| has also been replaced by an external routine. + +@ @<Reduce to the case that |f>=0| and |q>0|@>= +if f>=0 then negative:=false +else begin negate(f); negative:=true; + end; +if q<0 then + begin negate(q); negative:=not negative; + end; + +@ This section was deleted when |take_fraction| was replaced by an +external routine. (But the previous section was left in, because +it is part of |take_scaled|, which follows.) + +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [9.153] ranges for quarter,half words +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +can get 256 values into a quarterword only if the subrange is `|-128..127|'. + +The present implementation tries to accommodate as many variations as possible, +so it makes few assumptions. If integers having the subrange +`|min_quarterword..max_quarterword|' can be packed into a quarterword, +and if integers having the subrange `|min_halfword..max_halfword|' +can be packed into a halfword, everything should work satisfactorily. + +It is usually most efficient to have |min_quarterword=min_halfword=0|, +so one should try to achieve this unless it causes a severe problem. +The values defined here are recommended for most 32-bit computers. + +@d min_quarterword=0 {smallest allowable value in a |quarterword|} +@d max_quarterword=255 {largest allowable value in a |quarterword|} +@d min_halfword==0 {smallest allowable value in a |halfword|} +@d max_halfword==65535 {largest allowable value in a |halfword|} +@y +can get 256 values into a quarterword only if the subrange is `|-128..127|'. + +For Berkeley {\mc UNIX} we need to do the |-128..127| kind of range. + +@d min_quarterword=-128 {smallest allowable value in a |quarterword|} +@d max_quarterword=127 {largest allowable value in a |quarterword|} +@d min_halfword==-32768 {smallest allowable value in a |halfword|} +@d max_halfword==32767 {largest allowable value in a |halfword|} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [11.178] fix the word "free" so that it doesn't conflict with a runtime proc +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +been included. (You may want to decrease the size of |mem| while you +@^debugging@> +are debugging.) +@y +been included. (You may want to decrease the size of |mem| while you +@^debugging@> +are debugging.) + +@d free==free_arr +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [12.194] fix_date_and_time +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The following procedure, which is called just before \MF\ initializes its +input and output, establishes the initial values of the date and time. +@^system dependencies@> +Since standard \PASCAL\ cannot provide such information, something special +is needed. The program here simply specifies July 4, 1776, at noon; but +users probably want a better approximation to the truth. + +Note that the values are |scaled| integers. Hence \MF\ can no longer +be used after the year 32767. + +@p procedure fix_date_and_time; +begin internal[time]:=12*60*unity; {minutes since midnight} +internal[day]:=4*unity; {fourth day of the month} +internal[month]:=7*unity; {seventh month of the year} +internal[year]:=1776*unity; {Anno Domini} +end; +@y +@ The following procedure, which is called just before \MF\ initializes its +input and output, establishes the initial values of the date and time. +It is calls an externally defined |date_and_time|, even though it could +be done from Pascal. +The external procedure also sets up interrupt catching. +@^system dependencies@> + +Note that the values are |scaled| integers. Hence \MF\ can no longer +be used after the year 32767. + +@p procedure fix_date_and_time; +begin + date_and_time(internal[time],internal[day],internal[month],internal[year]); + internal[time] := internal[time] * unity; + internal[day] := internal[day] * unity; + internal[month] := internal[month] * unity; + internal[year] := internal[year] * unity; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [12.199] allow <tab> and <ff> as input +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +for k:=0 to " "-1 do char_class[k]:=invalid_class; +for k:=127 to 255 do char_class[k]:=invalid_class; +@y +for k:=0 to " "-1 do char_class[k]:=invalid_class; +for k:=127 to 255 do char_class[k]:=invalid_class; +char_class[tab]:=space_class; +char_class[form_feed]:=space_class; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [27.564] init_screen and update_screen are external C procs +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% BEGIN HOOK FOR THE TRAP TEST +%@x +%begin init_screen:=false; +%@y +%begin init_screen:=true; +%@z +@x +The \PASCAL\ code here is a minimum version of |init_screen| and +|update_screen|, usable on \MF\ installations that don't +support screen output. If |init_screen| is changed to return |true| +instead of |false|, the other routines will simply log the fact +that they have been called; they won't really display anything. +The standard test routines for \MF\ use this log information to check +that \MF\ is working properly, but the |wlog| instructions should be +removed from production versions of \MF. + +@p function init_screen:boolean; +begin init_screen:=false; +end; +@# +procedure update_screen; {will be called only if |init_screen| returns |true|} +begin @!init wlog_ln('Calling UPDATESCREEN');@+tini {for testing only} +end; + +@y +We declare the screen functions +for the {\mc UNIX} version of \MF\ in the following header file. + +@p +@\@=#include "mf_window.h"@>@\ {declarations for external C procedures} + +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [27.559] blank_rectangle is an external C proc +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +The commented-out code in the following procedure is for illustrative +purposes only. +@^system dependencies@> + +@p procedure blank_rectangle(@!left_col,@!right_col:screen_col; + @!top_row,@!bot_row:screen_row); +var @!r:screen_row; +@!c:screen_col; +begin @{@+for r:=top_row to bot_row-1 do + for c:=left_col to right_col-1 do + screen_pixel[r,c]:=white;@+@}@/ +@!init wlog_cr; {this will be done only after |init_screen=true|} +wlog_ln('Calling BLANKRECTANGLE(',left_col:1,',', + right_col:1,',',top_row:1,',',bot_row:1,')');@+tini +end; + +@y +@^system dependencies@> + +The procedure |blank_rectangle| has been declared an external routine +for the {\mc UNIX} version of \MF\ in the header file above. + +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [27.560] paint_row is an external C proc +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +The general idea is to paint blocks of pixels in alternate colors; +the precise details are best conveyed by means of a \PASCAL\ +program (see the commented-out code below). +@^system dependencies@> + +@p procedure paint_row(@!r:screen_row;@!b:pixel_color;var @!a:trans_spec; + @!n:screen_col); +var @!k:screen_col; {an index into |a|} +@!c:screen_col; {an index into |screen_pixel|} +begin @{ k:=0; c:=a[0]; +repeat incr(k); + repeat screen_pixel[r,c]:=b; incr(c); + until c=a[k]; + b:=black-b; {$|black|\swap|white|$} + until k=n;@+@}@/ +@!init wlog('Calling PAINTROW(',r:1,',',b:1,';'); + {this is done only after |init_screen=true|} +for k:=0 to n do + begin wlog(a[k]:1); if k<>n then wlog(','); + end; +wlog_ln(')');@+tini +end; + +@y +@^system dependencies@> + +|Paint_row| has been declared an external routine in the {\mc UNIX} version +of \MF\ in the header file above. + +@z +% END HOOK FOR THE TRAP TEST +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [38.768] area and extension rules +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The file names we shall deal with for illustrative purposes have the +following structure: If the name contains `\.>' or `\.:', the file area +consists of all characters up to and including the final such character; +otherwise the file area is null. If the remaining file name contains +`\..', the file extension consists of all such characters from the first +remaining `\..' to the end, otherwise the file extension is null. +@^system dependencies@> + +We can scan such file names easily by using two global variables that keep track +of the occurrences of area and extension delimiters: + +@<Glob...@>= +@!area_delimiter:pool_pointer; {the most recent `\.>' or `\.:', if any} +@!ext_delimiter:pool_pointer; {the relevant `\..', if any} +@y +@ The file names we shall deal with for SunOS have the +following structure: If the name contains `\./', the file area +consists of all characters up to and including the final such character; +otherwise the file area is null. If the remaining file name contains +`\..', the file extension consists of all such characters from the first +remaining `\..' to the end, otherwise the file extension is null. +@^system dependencies@> + +We can scan such file names easily by using two global variables that keep +track of the occurrences of area and extension delimiters: + +@<Glob...@>= +@!area_delimiter:pool_pointer; {the most recent `\./', if any} +@!ext_delimiter:pool_pointer; {the most recent `\..', if any} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [38.769] MF area directories +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d MF_area=="MFinputs:" +@.MFinputs@> +@y +Under Berkeley {\mc UNIX}, the default paths are specified in a seprate +file, `\.{mfpaths.h}'. The file opening procedures do path searching +based either on those default paths, or on paths given by the user +in ``environment'' variables. +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [38.771] more_name +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +begin if c=" " then more_name:=false +else begin if (c=">")or(c=":") then +@y +begin if (c=" ")or(c=tab) then more_name:=false +else begin if (c="/") then +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [38.775] default base +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d base_default_length=18 {length of the |MF_base_default| string} +@d base_area_length=8 {length of its area part} +@d base_ext_length=5 {length of its `\.{.base}' part} +@y +Under Berkeley {\mc UNIX} we don't give the area part, instead depending +on the path searching that will happen during file opening. + +@d base_default_length=10 {length of the |MF_base_default| string} +@d base_area_length=0 {length of its area part} +@d base_ext_length=5 {length of its `\.{.base}' part} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [38.776] plain base location +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +MF_base_default:='MFbases:plain.base'; +@y +MF_base_default:='plain.base'; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [38.779] w_open_in of base file needs to be called only once +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x + pack_buffered_name(0,loc,j-1); {try first without the system file area} + if w_open_in(base_file) then goto found; + pack_buffered_name(base_area_length,loc,j-1); + {now try the system base file area} + if w_open_in(base_file) then goto found; +@y + pack_buffered_name(0,loc,j-1); + if w_open_in(base_file) then goto found; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [38.780] make_name_string +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +which simply makes a \MF\ string from the value of |name_of_file|, should +ideally be changed to deduce the full name of file~|f|, which is the file +most recently opened, if it is possible to do this in a \PASCAL\ program. +@^system dependencies@> + +This routine might be called after string memory has overflowed, hence +we dare not use `|str_room|'. + +@p function make_name_string:str_number; +var @!k:1..file_name_size; {index into |name_of_file|} +begin if (pool_ptr+name_length>pool_size)or(str_ptr=max_strings) then + make_name_string:="?" +else begin for k:=1 to name_length do append_char(xord[name_of_file[k]]); + make_name_string:=make_string; + end; +end; +@y +which simply makes a \MF\ string from the value of |name_of_file|, should +ideally be changed to deduce the full name of file~|f|, which is the file +most recently opened, if it is possible to do this in a \PASCAL\ program. +With the Berkeley {\mc UNIX} version, we know that |real_name_of_file| +contains |name_of_file| prepended with the directory name that was found +by path searching. +If |real_name_of_file| starts with |'./'|, we don't use that part of the +name, since {\mc UNIX} users understand that. +@^system dependencies@> + +This routine might be called after string memory has overflowed, hence +we dare not use `|str_room|'. + +@p function make_name_string:str_number; +var @!k,@!kstart:1..file_name_size; {index into |name_of_file|} +begin +k:=1; +while (k<file_name_size) and (xord[real_name_of_file[k]]<>" ") do + incr(k); +name_length:=k-1; {the real |name_length|} +if (pool_ptr+name_length>pool_size)or(str_ptr=max_strings) then + make_name_string:="?" +else begin + if (xord[real_name_of_file[1]]=".") and (xord[real_name_of_file[2]]="/") then + kstart:=3 + else + kstart:=1; + for k:=kstart to name_length do append_char(xord[real_name_of_file[k]]); + make_name_string:=make_string; + end; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [38.781] scan_file_name ignore leading tabs as well as spaces +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p procedure scan_file_name; +label done; +begin begin_name; +while buffer[loc]=" " do incr(loc); +@y +@p procedure scan_file_name; +label done; +begin begin_name; +while (buffer[loc]=" ")or(buffer[loc]=tab) do incr(loc); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [38.787] <Scan_file_name...> needs similar leading tab treatment +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ @<Scan file name in the buffer@>= +begin begin_name; k:=first; +while (buffer[k]=" ")and(k<last) do incr(k); +@y +@ @<Scan file name in the buffer@>= +begin begin_name; k:=first; +while ((buffer[k]=" ")or(buffer[k]=tab))and(k<last) do incr(k); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [38.793] a_open_in of input file needs path selector +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x + if a_open_in(cur_file) then goto done; + if cur_area="" then + begin pack_file_name(cur_name,MF_area,cur_ext); + if a_open_in(cur_file) then goto done; + end; +@y + if a_open_in(cur_file,input_file_path) then goto done; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [38.793] get rid of return of name to string pool +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +if name=str_ptr-1 then {we can conserve string pool space now} + begin flush_string(name); name:=cur_name; + end; +@y +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [45.1133] writing the tfm file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d tfm_out(#)==write(tfm_file,#) {output one byte to |tfm_file|} +@y +@d tfm_out(#) ==write(tfm_file,((#+128) mod 256)-128) +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [47.1154] write_gf +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@<Declare generic font output procedures@>= +procedure write_gf(@!a,@!b:gf_index); +var k:gf_index; +begin for k:=a to b do write(gf_file,gf_buf[k]); +end; +@y +For Berkeley {\mc UNIX}, this is going to be handled by an external procedure, +|writegf|, which will do the output using |fwrite|. +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [49.1204] Delete ready_already; also add call to set_paths; +% also add call to exit() depending upon value of `history' +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ Now this is really it: \MF\ starts and ends here. + +The initial test involving |ready_already| should be deleted if the +\PASCAL\ runtime system is smart enough to detect such a ``mistake.'' +@y +@ Now this is really it: \MF\ starts and ends here. + +Instead of testing |ready_already|, we give up the idea of a preloaded +core image in favor of silently loading a format file based on the +name by which this program has been invoked. For example, if the +program is being called \.{mf}, we will load the \.{plain} base; +if \.{cmmf}, we will load \.{cmmf.base}. On my machine the +loading of a format isn't too slow. (I use the new string capabilities +of Sun Pascal here; |my_name| will be declared {\bf varying} [100] +{\bf of\/} |char|.) + +At the end of the job, we look at |history| to decide the correct +exit code. We use 1 if |history <= warning_issued| and 0 otherwise. + +@d UNIXexit==e@&x@&i@&t +@z + +@x +t_open_out; {open the terminal for output} +if ready_already=314159 then goto start_of_MF; +@y +t_open_out; {open the terminal for output} +set_paths; +@z +@x +start_of_MF: @<Initialize the output routines@>; +@y +start_of_MF: argv(0,my_name); +if (my_name<>'inimf')and(my_name<>'trapmf') then + begin if my_name = 'mf' then name_of_file:='plain.base' + else name_of_file:=my_name+'.base'; + if w_open_in(base_file) then + if not load_base_file then + begin w_close(base_file); goto final_end; + end + else w_close(base_file); + end; +@<Initialize the output routines@>; +@z + +@x +final_end: ready_already:=0; +@y +final_end: ready_already:=0; +if (history <= warning_issued) then + UNIXexit(0) +else + UNIXexit(1); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [49.1204] print new line before termination; switch to editor if nec. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x + slow_print(log_name); print_char("."); + end; + end; +@y + slow_print(log_name); print_char("."); + end; + end; +print_ln; +if (ed_name_start<>0) and (interaction>batch_mode) then + calledit(str_pool[ed_name_start],ed_name_length,edit_line); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [51.1214] add editor-switch variable to globals +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@* \[51] System-dependent changes. +This section should be replaced, if necessary, by any special +modifications of the program +that are necessary to make \MF\ work at a particular installation. +It is usually best to design your change file so that all changes to +previous sections preserve the section numbering; then everybody's version +will be consistent with the published program. More extensive changes, +which introduce new sections, can be inserted here; then only the index +itself will get a new section number. +@^system dependencies@> +@y +@* \[51] System-dependent changes. +Here are the variables used to hold ``switch-to-editor'' information. +And the omphaloskeptic variable too. +@^system dependencies@> + +@<Global...@>= +@!ed_name_start: pool_pointer; +@!ed_name_length,@!edit_line: integer; +@!my_name:varying [100] of char; + +@ The |ed_name_start| will be set to point into |str_pool| somewhere after +its beginning if \MF\ is supposed to switch to an editor on exit. + +@<Set init...@>= +ed_name_start:=0; +@z + diff --git a/systems/knuth/local/mf/mf.pool b/systems/knuth/local/mf/mf.pool new file mode 100644 index 0000000000..4f1478cac2 --- /dev/null +++ b/systems/knuth/local/mf/mf.pool @@ -0,0 +1,824 @@ +11buffer size +09pool size +17number of strings +03??? +28End of file on the terminal! +02! +42(That makes 100 errors; please try again.) +02? +60Type <return> to proceed, S to scroll future error messages, +44R to run without stopping, Q to run quietly, +23I to insert something, +20E to edit your file, +561 or ... or 9 to ignore the next 1 to 9 tokens of input, +22H for help, X to quit. +13OK, entering +09batchmode +11nonstopmode +10scrollmode +03... +07insert> +44I have just deleted some text, as you asked. +48You can now delete more, or insert, or whatever. +50Sorry, I don't know how to help in this situation. +36Maybe you should try asking a human? +42Sorry, I already gave what help I could... +59An error might have occurred before I noticed any problems. +45``If all else fails, read the instructions.'' +00 +14Emergency stop +35METAFONT capacity exceeded, sorry [ +44If you really absolutely need more capacity, +35you can ask a wizard to enlarge me. +19This can't happen ( +59I'm broken. Please show this to someone who can fix can fix +35I can't go on meeting you like this +55One of your faux pas seems to have wounded me deeply... +59in fact, I'm barely conscious. Please fix it and try again. +12Interruption +09You rang? +57Try to insert some instructions for me (e.g.,`I show x'), +43unless you just want to quit by typing `X'. +09Missing ` +19' has been inserted +19Arithmetic overflow +59Uh, oh. A little while ago one of the quantities that I was +59computing got too large, so I'm afraid your answers will be +55somewhat askew. You'll probably have to adopt different +54tactics next time. But I shall try to carry on anyway. +15Square root of +23 has been replaced by 0 +52Since I don't take square roots of negative numbers, +52I'm zeroing this one. Proceed, with fingers crossed. +24Pythagorean subtraction +03+-+ +13Logarithm of +48Since I don't take logs of non-positive numbers, +27angle(0,0) is taken as zero +54The `angle' between two identical points is undefined. +16main memory size +24AVAIL list clobbered at +31Double-AVAIL list clobbered at +24Doubly free location at +12Bad flag at +14New busy locs: +05LINK( +05INFO( +07vacuous +07boolean +15unknown boolean +06string +14unknown string +03pen +11unknown pen +10future pen +04path +12unknown path +07picture +15unknown picture +09transform +04pair +13known numeric +09dependent +15proto-dependent +07numeric +11independent +10token list +10structured +16unsuffixed macro +14suffixed macro +09undefined +04true +05false +11nullpicture +07nullpen +07jobname +10readstring +09pencircle +13normaldeviate +03odd +05known +07unknown +03not +07decimal +07reverse +08makepath +07makepen +11totalweight +03oct +03hex +05ASCII +04char +06length +13turningnumber +05xpart +05ypart +06xxpart +06xypart +06yxpart +06yypart +04sqrt +04mexp +04mlog +04sind +04cosd +05floor +14uniformdeviate +10charexists +05angle +05cycle +02++ +02or +03and +02<= +02>= +02<> +07rotated +07slanted +06scaled +07shifted +11transformed +07xscaled +07yscaled +07zscaled +17intersectiontimes +09substring +07subpath +13directiontime +05point +10precontrol +11postcontrol +09penoffset +02.. +13tracingtitles +16tracingequations +15tracingcapsules +14tracingchoices +12tracingspecs +11tracingpens +15tracingcommands +15tracingrestores +13tracingmacros +12tracingedges +13tracingoutput +12tracingstats +13tracingonline +04year +05month +03day +04time +08charcode +07charext +06charwd +06charht +06chardp +06charic +06chardx +06chardy +10designsize +04hppp +04vppp +07xoffset +07yoffset +07pausing +12showstopping +10fontmaking +08proofing +09smoothing +12autorounding +11granularity +06fillin +12turningcheck +12warningcheck +12boundarychar +09 at line +14a bad variable +02fi +08endgroup +06enddef +06endfor +13 INACCESSIBLE +09hash size +06EQUIV( +02:: +03||: +02:= +05addto +02at +07atleast +10begingroup +08controls +04cull +04curl +10delimiters +07display +08everyjob +06exitif +11expandafter +04from +08inwindow +07interim +03let +11newinternal +02of +10openwindow +10randomseed +04save +10scantokens +07shipout +06skipto +04step +03str +07tension +02to +05until +05token +05 ETC. +10 CLOBBERED +11 IMPOSSIBLE +12 NONEXISTENT +04 BAD +02[] +05(EXPR +07(SUFFIX +05(TEXT +02-> +03>-> +08<expr>-> +19<expr>of<primary>-> +10<suffix>-> +08<text>-> +07(SAVED) +03var +02xx +02xy +02yx +02yy +08%CAPSULE +05part +06struct +11{restoring +04Path +07{open?} +10..control? +03 .. +06{curl +10..tension +05 and +11..controls +02?? +16, before choices +15, after choices +23Some number got too big +46The path that I just computed is out of range. +53So it will probably look funny. Proceed, for a laugh. +09path size +14Edge structure +04row +02 | +31Scaled picture would be too big +50I can't yscale the picture as requested---it would +45make some coordinates too large or too small. +42Proceed, and I'll omit the transformation. +50I can't xscale the picture as requested---it would +15move table size +13Tracing edges +09 (weight +21(No new edges added.) +10Cycle spec +24 % beginning in octant ` +19% entering octant ` +08 & cycle +03ENE +03NNE +03NNW +03WNW +03WSW +03SSW +03SSE +03ESE +14 ..controls +11 % segment +02 ( +33, before subdivision into octants +19, after subdivision +43, after subdivision and double autorounding +36, after subdivision and autorounding +18Curve out of range +56At least one of the coordinates in the path I'm about to +56digitize was really huge (potentially bigger than 4095). +40So I've cut it back to the maximum size. +41The results will probably be pretty wild. +19rounding table size +11Pen polygon +09 .. cycle +04 .. +16 (newly created) +13Pen too large +59The cycle you specified has a coordinate of 4095.5 or more. +55So I've replaced it by the trivial path `(0,0)..cycle'. +24Pen cycle must be convex +59The cycle you specified either has consecutive equal points +54or turns right or turns through more than 360 degrees. +16pen polygon size +09@ Octant +07 offset +08), from +04 to +23@ retrograde line from +18@ transition line +07, from +03dep +02*4 +20Value is too large ( +53The equation I just processed has given some variable +54a value of 4096 or more. Continue and I'll try to cope +47with that big value; but it might be dangerous. +47(Set warningcheck:=0 to suppress this message.) +05#### +03## +15Bad PREVDEP at +16Out of order at +18Redundant equation +43I already knew that this equation was true. +50But perhaps no harm has been done; let's continue. +23[unknown command code!] +03<*> +08<insert> +12<scantokens> +02l. +10<forever> +11<argument> +16<recently read> +19<to be read again> +16<inserted text> +05<for( +03)> +16input stack size +17text input levels +08endinput +47Incomplete if; all text was ignored after line +51A forbidden `outer' token occurred in skipped text. +58This kind of error happens when you say `if...' and forget +57the matching `fi'. I've inserted a `fi'; this might work. +53The file ended while I was skipping conditional text. +10File ended +21Forbidden token found +16 while scanning +41I suspect you have forgotten an `enddef', +52causing me to read past where you wanted me to stop. +49I'll try to recover; but if the error is serious, +51you'd better type `E' or `X' now and fix your file. +27to the end of the statement +42A previous error seems to have propagated, +15a text argument +45It seems that a right delimiter was left out, +18the definition of +14the text of a +05 loop +41I suspect you have forgotten an `endfor', +08Runaway +05text? +11definition? +05loop? +39Text line contains an invalid character +53A funny symbol that I can't read has just been input. +48Continue, and I'll forget that it ever happened. +40Incomplete string token has been flushed +53Strings should finish on the same line as they began. +50I've deleted the partial string; you might want to +48insert another by typing, e.g., `I"new string"'. +32Enormous number has been reduced +52I can't handle numbers bigger than about 4095.99998; +53so I've changed your constant to that maximum amount. +36(Please type a command or say `end') +37*** (job aborted, no legal end found) +02=> +03def +06vardef +10primarydef +12secondarydef +11tertiarydef +03for +11forsuffixes +07forever +05quote +02#@ +02@# +31Missing symbolic token inserted +52Sorry: You can't redefine a number, string, or expr. +49I've inserted an inaccessible symbol so that your +60definition will be completed without mixing me up too badly. +51Sorry: You can't redefine my error-recovery tokens. +50The next thing in this `def' should have been `=', +54because I've already looked at the definition heading. +49But don't worry; I'll pretend that an equals sign +45was present. Everything from here to `enddef' +43will be the replacement text of this macro. +04expr +06suffix +04text +07primary +09secondary +08tertiary +41This variable already starts with a macro +44After `vardef a' you can't say `vardef a.b'. +40So I'll have to discard this definition. +46Missing parameter type; `expr' will be assumed +52You should've had `expr' or `suffix' or `text' here. +20parameter stack size +14Extra `endfor' +40I'm not currently working on a for loop, +40so I had better not try to end anything. +05input +09Lost loop +53I'm confused; after exiting from a loop, I still seem +53to want to repeat it. I'll try to forget the problem. +22No loop is in progress +51Why say `exitif' when there's nothing to exit from? +57After `exitif <boolean exp>' I expect to see a semicolon. +35I shall pretend that one was there. +20*** (loop confusion) +12Not a string +41I'm going to flush this expression, since +48scantokens should be followed by a known string. +03)<- +22Too many arguments to +11 Missing ` +52I'm going to assume that the comma I just read was a +57right delimiter, and then I'll begin expanding the macro. +55You might want to delete some tokens before continuing. +20Missing argument to +48That macro has more parameters than you thought. +54I'll continue by pretending that each missing argument +23is either zero or null. +54I've finished reading a macro argument and am about to +56read another; the arguments weren't delimited correctly. +51I've gotten to the end of the macro parameter list. +05 for +57I've got the first argument; will look now for the other. +02if +04else +06elseif +49There should've been a colon after the condition. +06{true} +07{false} +06Extra +43I'm ignoring this; it doesn't match any if. +09Improper +38When you say `for x=a step b until c', +43the initial value `a' and the step size `b' +55and the final value `c' must have known numeric values. +57The next thing in this loop should have been `=' or `:='. +47was present, and I'll look for the values next. +51The next thing in this loop should have been a `:'. +41So I'll pretend that a colon was present; +50everything from here to `endfor' will be iterated. +07 ENDFOR +12{loop value= +13initial value +09step size +47I assume you meant to say `until' after `step'. +48So I'll look for the final value and colon next. +11final value +05.base +15input file name +19I can't find file ` +23I can't write on file ` +02'. +03.mf +20Please type another +45*** (job aborted, file error in nonstop mode) +02: +05mfput +04.log +02** +20transcript file name +02 +20file name for output +37File names can't appear within macros +46Sorry...I've converted what follows to tokens, +37possibly garbaging the name you gave. +51Please delete the tokens and insert the name again. +03exp +26 (see the transcript file) +13 (future pen) +10linearform +03>> +07recycle +04### +03 = +09A primary +30 expression can't begin with ` +58I'm afraid I need some sort of value in order to continue, +49so I've tentatively inserted `0'. You may want to +43delete this zero and insert something else; +50see Chapter 27 of The METAFONTbook for an example. +39Nonnumeric ypart has been replaced by 0 +48I thought you were giving me a pair `(x,y)'; but +50after finding a nice xpart `x' I found a ypart `y' +54that isn't of numeric type. So I've changed y to zero. +59(The y that I didn't like appears above the error message.) +22A group begun on line +12 never ended +56I saw a `begingroup' back there that hasn't been matched +47by `endgroup'. So I've inserted `endgroup' now. +16Division by zero +43I'll pretend that you meant to divide by 1. +44Improper subscript has been replaced by zero +54A bracketed subscript must have a known numeric value; +59unfortunately, what I found was the value that appears just +55above this error message. So I'll try a zero subscript. +09Variable +21 has been obliterated +54It seems you did a nasty thing---probably by accident, +46but nevertheless you nearly hornswoggled me... +50While I was evaluating the right-hand side of this +51command, something happened, and the left-hand side +52is no longer a variable! So I won't change anything. +51While I was evaluating the suffix of this variable, +55something was redefined, and it's no longer a variable! +59In order to get back on my feet, I've inserted `0' instead. +04copy +47I've scanned an expression of the form `a[b,c', +41so a right bracket should have come next. +51I've seen a `[' and a subscript value, in a suffix, +11A secondary +10A tertiary +24Pen path must be a cycle +39I can't make a pen from the given path. +02An +49Undefined coordinates have been replaced by (0,0) +49I need x and y numbers for this part of the path. +42The value I found (see above) was no good; +48so I'll try to keep going by using zero instead. +45(Chapter 27 of The METAFONTbook explains that +36you might want to type `I ???' now.) +45Undefined x coordinate has been replaced by 0 +51I need a `known' x value for this part of the path. +45Undefined y coordinate has been replaced by 0 +51I need a `known' y value for this part of the path. +49I've scanned a direction spec for part of a path, +39so a right brace should have come next. +36Improper curl has been replaced by 1 +43A curl must be a known, nonnegative number. +46I've got the x coordinate of a path direction; +36will look for the y coordinate next. +45A path join command should end with two dots. +34Improper tension has been set to 1 +53The expression above should have been a number >=3/4. +46Paths don't touch; `&' will be changed to `..' +48When you join paths `p&q', the ending point of p +49must be exactly equal to the starting point of q. +53So I'm going to pretend that you said `p..q' instead. +46Undefined condition will be treated as `false' +53The expression shown above should have had a definite +48true-or-false value. I'm changing it to `false'. +40*** (cannot readstring in nonstop modes) +12unknown pair +15unknown numeric +17Not implemented: +59I'm afraid I don't know how to apply that operation to that +53particular type. Continue, and I'll simply return the +54argument (shown above) as the result of the operation. +02)} +30String contains illegal digits +55I zeroed out characters that weren't in the range 0..7. +48I zeroed out characters that weren't hex digits. +18Number too large ( +57I have trouble with numbers greater than 4095; watch out. +58combination of types. Continue, and I'll return the second +52argument (see above) as the result of the operation. +02{( +49The quantities shown above have not been equated. +60Oh dear. I can't decide if the expression above is positive, +59negative, or zero. So this comparison test won't be `true'. +41Unknown relation will be considered false +03)*( +58You're trying to divide the quantity shown above the error +55message by zero. I'm going to divide it by one instead. +32Improper transformation argument +46The expression shown above has the wrong type, +39so I can't transform anything using it. +37Transform components aren't all known +56I'm unable to apply a partially specified transformation +42except to a fully known pair or transform. +31That transformation is too hard +49I can apply complicated transformations to paths, +49but I can only do integer operations on pictures. +16Too far to shift +49I can't shift the picture as requested---it would +30A statement can't begin with ` +51I was looking for the beginning of a new statement. +58If you just proceed without changing anything, I'll ignore +56everything up to the next `;'. Please insert a semicolon +58now in front of anything that you don't want me to delete. +52(See Chapter 27 of The METAFONTbook for an example.) +28Extra tokens will be flushed +59I've just read as much of that statement as I could fathom, +59so a semicolon should have been next. It's very puzzling... +53but I'll try to get myself back together, by ignoring +19Isolated expression +40I couldn't find an `=' or `:=' after the +50expression that is shown above this error message, +44so I guess I'll just ignore it and carry on. +36Improper `:=' will be changed to `=' +54I didn't find a variable name at the left of the `:=', +50so I'm going to pretend that you said `=' instead. +03)=( +19Internal quantity ` +28' must receive a known value +56I can't set an internal quantity to anything but a known +54numeric value, so I'll have to ignore this assignment. +30Equation cannot be performed ( +58I'm sorry, but I don't know how to make such things equal. +55(See the two expressions just above the error message.) +34Redundant or inconsistent equation +56An equation between already-known quantities can't help. +50But don't worry; continue and I'll just ignore it. +21Inconsistent equation +58The equation I just read contradicts what was said before. +09 (off by +48Declared variable conflicts with previous vardef +56You can't use, e.g., `numeric foo[]' after `vardef foo'. +51Proceed, and I'll ignore the illegal redeclaration. +51Illegal suffix of declared variable will be flushed +50Variables in declarations must consist entirely of +46names and collective subscripts, e.g., `x[]a'. +57Are you trying to use a reserved word in a variable name? +43I'm going to discard the junk I found here, +51up to the next comma or the end of the declaration. +49Explicit subscripts like `x15a' aren't permitted. +16Extra `endgroup' +44I'm not currently working on a `begingroup', +03end +04dump +46Always say `randomseed:=<numeric expression>'. +29Unknown value will be ignored +48Your expression was too random for me to handle, +43so I won't change the random seed just now. +13{randomseed:= +13errorstopmode +05inner +05outer +55I found no right delimiter to match a left one. So I've +56put one in, behind the scenes; this may fix the problem. +11The token ` +32' is no longer a right delimiter +48Strange: This token has lost its former meaning! +44I'll read it as a right delimiter this time; +43but watch out, I'll probably miss it later. +10(%CAPSULE) +28' isn't an internal quantity +55Something like `tracingonline' should follow `interim'. +46You should have said `let symbol = something'. +55was present. The next token I read will be `something'. +19number of internals +09showtoken +09showstats +04show +12showvariable +16showdependencies +02> +08(outer) +03lef +04righ +25t delimiter that matches +03tag +08variable +06macro: +09'd macro: +17[repeat the loop] +13Memory usage +17 still untouched) +13String usage +07=macro: +02OK +56This isn't an error message; I'm just showing something. +07contour +10doublepath +04also +07withpen +10withweight +08dropping +07keeping +13Improper type +54Next time say `withweight <known numeric expression>'; +55I'll ignore the bad `with' clause and look for another. +47Next time say `withpen <known pen expression>'; +40Weight must be -3, -2, -1, +1, +2, or +3 +20 is the wrong type ( +45I was looking for a "known" picture variable. +37So I'll not change anything just now. +23Not a suitable variable +61At this point I needed to see the name of a picture variable. +58(Or perhaps you have indeed presented me with one; I might +59have missed it, if it wasn't followed by the proper token.) +16Improper `addto' +54This expression should have specified a known picture. +46This expression should have been a known path. +11Not a cycle +58That contour should have ended with `..cycle' or `&cycle'. +37Strange path (turning number is zero) +43Backwards path (turning number is negative) +53The path doesn't have a counterclockwise orientation, +41so I'll probably have trouble drawing it. +51(See Chapter 27 of The METAFONTbook for more help.) +17Bad window number +42It should be the number of an open window. +21Improper `openwindow' +52Say `openwindow k from (r0,c0) to (r1,c1) at (x,y)', +57where all quantities are known and k is between 0 and 15. +19Bad culling amounts +44Always cull by known amounts that exclude 0. +07message +10errmessage +07errhelp +46A message should be a known string expression. +32(That was another `errmessage'.) +51This error message was generated by an `errmessage' +43command, so I can't give any explicit help. +51Pretend that you're Miss Marple: Examine all clues, +41and deduce the truth by inspired guesses. +09Enormous +17 has been reduced +48Font metric dimensions must be less than 2048pt. +08charlist +08ligtable +10extensible +10headerbyte +09fontdimen +35Invalid code has been replaced by 0 +54I was looking for a number between 0 and 255, or for a +55string of length 1. Didn't find it; will use 0 instead. +10Character +02|| +05code +12 is already +13in a ligtable +13in a charlist +51It's not legal to label a character more than once. +17Improper location +43I was looking for a known, positive number. +50For safety's sake I'll ignore the present command. +56A colon should follow a headerbyte or fontinfo location. +21Illegal ligtable step +38I was looking for `=:' or `kern' here. +13ligtable size +02=: +03=:| +04=:|> +03|=: +04|=:> +04|=:| +05|=:|> +06|=:|>> +04kern +15Too far to skip +57At most 127 lig/kern steps can separate skipto1 from 1::. +13Improper kern +51The amount of kern should be a known numeric value. +39I'm processing `extensible c: t,m,b,r'. +23Improper font parameter +06(some +41 values had to be adjusted by as much as +03pt) +47(illegal design size has been changed to 128pt) +04.tfm +26file name for font metrics +24Font metrics written on +13(local label +15:: was missing) +24(a font metric dimension +23 font metric dimensions +21 had to be decreased) +17 METAFONT output +03.gf +02gf +19 (just shipped out) +51(There's unbounded black in character shipped out!) +07special +10numspecial +21Unsuitable expression +59The expression shown above has the wrong type to be output. +06title +18Output written on +10 character +02, +08 bytes). +08 (INIMF) +25 strings of total length +43 memory locations dumped; current usage is +16 symbolic tokens +17 (preloaded base= +14base file name +26Beginning to dump on file +22Transcript written on +02 ) +19(end occurred when +09 on line +16 was incomplete) +52(see the transcript file for additional information) +33(dump is performed only by INIMF) +21debug # (-1 to exit): +*415546872 diff --git a/systems/knuth/local/mf/mf_arith.c b/systems/knuth/local/mf/mf_arith.c new file mode 100644 index 0000000000..5347107e81 --- /dev/null +++ b/systems/knuth/local/mf/mf_arith.c @@ -0,0 +1,142 @@ +/* + * mf_arith.c -- optimized arithmetic routines for UNIX METAFONT 84 + * + * These functions account for a significant percentage of the processing + * time used by METAFONT, and have been recoded in assembly language for + * some classes of machines. + * + * As yet I don't have code for SPARC, so I'm just using a C version + * by richards, in hopes that cc does better than pc on the brute-force + * algorithm found in mf.web. + * + * function makefraction(p, q: integer): fraction; + * { Calculate the function floor( (p * 2^28) / q + 0.5 ) } + * { if both p and q are positive. If not, then the value } + * { of makefraction is calculated as though both *were* } + * { positive, then the result sign adjusted. } + * { (e.g. makefraction ALWAYS rounds away from zero) } + * { In case of an overflow, return the largest possible } + * { value (2^32-1) with the correct sign, and set global } + * { variable "aritherror" to 1. Note that -2^32 is } + * { considered to be an illegal product for this type of } + * { arithmetic! } + * + * function takefraction(f: fraction; q: integer): integer; + * { Calculate the function floor( (p * q) / 2^28 + 0.5 ) } + * { takefraction() rounds in a similar manner as } + * { makefraction() above. } + * + */ + +#include "h00vars.h" + +extern bool aritherror; /* to be set on overflow */ + +#define EL_GORDO 0x7fffffff /* 2^31-1 */ +#define FRACTION_ONE 0x10000000 /* 2^28 */ +#define FRACTION_HALF 0x08000000 /* 2^27 */ +#define FRACTION_FOUR 0x40000000 /* 2^30 */ + +int makefraction(p, q) + register int p, q; +{ + int negative; + register int be_careful; + register int f; + int n; + + if (p < 0) { + negative = 1; + p = -p; + } else negative = 0; + + if (q < 0) { + negative = !negative; + q = -q; + } + + n = p / q; + p = p % q; + + if (n >= 8) { + aritherror = TRUE; + return (negative? -EL_GORDO : EL_GORDO); + } + + n = (n-1)*FRACTION_ONE; + f = 1; + do { + be_careful = p - q; + p = be_careful + p; + if (p >= 0) { + f = f + f + 1; + } else { + f <<= 1; + p += q; + } + } while (f < FRACTION_ONE); + + be_careful = p - q; + if ((be_careful + p) >= 0) + f += 1; + return (negative? -(f+n) : (f+n)); + +} + +int takefraction(q, f) + register int q; + register int f; +{ + int n, negative; + register int p, be_careful; + + if (f < 0) { + negative = 1; + f = -f; + } else negative = 0; + if (q < 0) { + negative = !negative; + q = -q; + } + if (f < FRACTION_ONE) + n = 0; + else { + n = f / FRACTION_ONE; + f = f % FRACTION_ONE; + if (q < (EL_GORDO / n)) + n = n * q; + else { + aritherror = TRUE; + n = EL_GORDO; + } + } + + f += FRACTION_ONE; + p = FRACTION_HALF; + if (q < FRACTION_FOUR) + do { + if (f & 0x1) + p = (p+q) >> 1; + else + p >>= 1; + f >>= 1; + } while (f > 1); + else + do { + if (f & 0x1) + p = p + ((q-p) >> 1); + else + p >>= 1; + f >>= 1; + } while (f > 1); + + be_careful = n - EL_GORDO; + if ((be_careful + p) > 0) { + aritherror = TRUE; + n = EL_GORDO - p; + } + + return(negative? -(n+p) : (n+p)); +} + + diff --git a/systems/knuth/local/mf/mf_sunwin.c b/systems/knuth/local/mf/mf_sunwin.c new file mode 100644 index 0000000000..f1e9fa9b39 --- /dev/null +++ b/systems/knuth/local/mf/mf_sunwin.c @@ -0,0 +1,90 @@ +/* + * XView interface to MetaFont + * (written hastily and without much understanding...) + */ +#define SCREENWIDTH 1024 /* must match the constant in inimf.ch */ +#define SCREENDEPTH 800 /* must match the constant in inimf.ch */ + +#include <stdio.h> +#include <xview/xview.h> +#include <xview/canvas.h> +#include <X11/Xlib.h> + +static Frame frame; /* container */ +static Canvas canvas; /* the viewing and imaging area */ +static Xv_Window canvas_paintwin; /* image component of |canvas| */ +static Display *display; /* handle to X server */ +static Visual *screen; /* where the X server paints */ +static Window xcanvas; /* the X11 ``drawable'' component of our canvas */ +static GC gc; /* X graphic context */ +static XGCValues GCvalues; /* changes to a graphic context */ + +/* + * updatescreen; -- make sure screen display is current + */ + +updatescreen() +{ + notify_dispatch(); + XFlush(display); +} + +/* + * init_screen: boolean; return true if window operations legal + */ + +initscreen() +{ + if (xv_init(NULL)==NULL) return 0; + frame=(Frame)xv_create(NULL,FRAME,XV_WIDTH,700,XV_HEIGHT,600, + FRAME_SHOW_HEADER,FALSE, + XV_SHOW,TRUE,NULL); + canvas=(Canvas)xv_create(frame,CANVAS,CANVAS_REPAINT_PROC,updatescreen, + CANVAS_X_PAINT_WINDOW,TRUE, + XV_HEIGHT,SCREENDEPTH,XV_WIDTH,SCREENWIDTH, + CANVAS_AUTO_EXPAND,FALSE,CANVAS_AUTO_SHRINK,FALSE, + NULL); + canvas_paintwin=(Xv_window)xv_get(canvas,CANVAS_NTH_PAINT_WINDOW,0); + xcanvas=(Window)xv_get(canvas_paintwin,XV_XID); + display=(Display*)xv_get(frame,XV_DISPLAY); + screen=(Visual*)xv_get(frame,XV_VISUAL); + gc=XCreateGC(display,DefaultRootWindow(display),0,GCvalues); + notify_do_dispatch(); /* this should allow terminal input */ + return 1; +} + +/* + * blankrectangle: reset rectangle bounded by ([left,right],[top,bottom]) + * to background color + */ + +blankrectangle(left, right, top, bottom) + short left, right; + short top, bottom; +{ + XSetFunction(display,gc,GXclear); + XFillRectangle(display,xcanvas,gc,left,top,right-left,bottom-top); +} + +/* + * paintrow -- paint row r starting with color b, up to next + * transition specified by vector a, switch colors, + * and continue for n transitions. + */ + +paintrow(r, b, a, n) + short r; + short b; + short a[]; + short n; +{ + register short *p,*q=&a[n]; + XSetFunction(display,gc,b?GXset:GXclear); + for (p=a;p<q;p+=2) + XFillRectangle(display,xcanvas,gc,*p,r,*(p+1)-*p,1); + XSetFunction(display,gc,b?GXclear:GXset); + for (p=a+1;p<q;p+=2) + XFillRectangle(display,xcanvas,gc,*p,r,*(p+1)-*p,1); + notify_dispatch(); /* without this, the Notifier queue overflows */ +} + diff --git a/systems/knuth/local/mf/mf_window.h b/systems/knuth/local/mf/mf_window.h new file mode 100644 index 0000000000..761cf006c9 --- /dev/null +++ b/systems/knuth/local/mf/mf_window.h @@ -0,0 +1,15 @@ +{ $Header: mf_window.h,v 0.999999 86/01/13 00:43:56 richards Released $ } + +{ External procedures for UNIX MetaFont VIRMF for display graphics } + +function initscreen: boolean; + external; + +procedure updatescreen; + external; + +procedure blankrectangle(leftcol, rightcol: screencol; toprow, botrow: screenrow); + external; + +procedure paintrow(r: screenrow; b: pixelcolor; var a: transspec; n: screencol); + external; diff --git a/systems/knuth/local/mf/plain.base b/systems/knuth/local/mf/plain.base Binary files differnew file mode 100644 index 0000000000..8aff956dc2 --- /dev/null +++ b/systems/knuth/local/mf/plain.base diff --git a/systems/knuth/local/mf/plain.log b/systems/knuth/local/mf/plain.log new file mode 100644 index 0000000000..41d972df4f --- /dev/null +++ b/systems/knuth/local/mf/plain.log @@ -0,0 +1,16 @@ +This is METAFONT, Version 2.7182 for SunOS (INIMF) 8 AUG 1998 21:30 +**plain \input local \dump +(/home/tex/dist/lib/plain.mf +Preloading the plain base, version 2.71: preliminaries, + basic constants and mathematical macros, + macros for converting from device-independent units to pixels, + macros and tables for various modes of operation, + macros for drawing and filling, + macros for proof labels and rules, + macros for character and font administration, +and a few last-minute items.) (/home/tex/local/lib/local.mf) +Beginning to dump on file plain.base + (preloaded base=plain 98.8.8) +1407 strings of total length 23104 +5273 memory locations dumped; current usage is 1450&3664 +525 symbolic tokens diff --git a/systems/knuth/local/mf/trap1.in b/systems/knuth/local/mf/trap1.in new file mode 100644 index 0000000000..1e7b96cab3 --- /dev/null +++ b/systems/knuth/local/mf/trap1.in @@ -0,0 +1,3 @@ + +\input trap + diff --git a/systems/knuth/local/mf/trap2.in b/systems/knuth/local/mf/trap2.in new file mode 100644 index 0000000000..d3dba8ac65 --- /dev/null +++ b/systems/knuth/local/mf/trap2.in @@ -0,0 +1 @@ + &trap trap diff --git a/systems/knuth/local/mfpaths.h b/systems/knuth/local/mfpaths.h new file mode 100644 index 0000000000..a582bd4c0d --- /dev/null +++ b/systems/knuth/local/mfpaths.h @@ -0,0 +1,21 @@ +/* + * This file defines the default paths that will be used for MF software. + * (These paths are used if the user's environment doesn't specify paths + * in MFINPUTS, MFBASES, or MFPOOL.) + * + * Paths should be colon-separated and no longer than MAXINPATHCHARS-1 + * (for defaultinputpath) or MAXOTHPATHCHARS (for other default paths). + */ + +#define MAXINPATHCHARS 700 /* maximum number of chars in an input path */ + +#define defaultinputpath ".:/home/tex/local/lib:/home/tex/dist/cm:/home/tex/dist/lib:/home/tex/local/cm:/home/src/ams:/home/src/mf" + /* this should always start with "." */ + +#define MAXOTHPATHCHARS 100 /* other paths should be much shorter */ + +#define defaultbasepath ".:/home/tex/local/mf" + +#define defaultpoolpath ".:/home/tex/local/mf" + + diff --git a/systems/knuth/local/mfware-sparc/Makefile b/systems/knuth/local/mfware-sparc/Makefile new file mode 100644 index 0000000000..8560035fde --- /dev/null +++ b/systems/knuth/local/mfware-sparc/Makefile @@ -0,0 +1,54 @@ +# Make executable files for this workstation, using the master TeX sources + +PFLAGS= -O -I.. -temp=. +CFLAGS= -O -I.. +PC= time pc + +all: gftype gftopk gftodvi mft pktype + +%.p: %.ch + tangle ../../dist/mfware/$*.web $*.ch + mv ../../dist/mfware/$*.p . + +pktype.p: pktype.ch + tangle pktype.web pktype.ch + +%.ch: ../../dist/mfware/%.web + touch $*.ch + +%.o: %.p + ${PC} ${PFLAGS} -c $*.p + +gftype: gftype.o gftopk_ext.h gftopk_ext.o + pc ${PFLAGS} -o gftype gftype.o gftopk_ext.o + +gftopk: gftopk.o gftopk_ext.o gftopk_ext.h + pc ${PFLAGS} -o gftopk gftopk.o gftopk_ext.o + +pktype: pktype.o gftopk_ext.h gftopk_ext.o + pc ${PFLAGS} -o pktype pktype.o gftopk_ext.o + +gftodvi: gftodvi.o ext.o ../tex/ext.h + pc ${PFLAGS} -o gftodvi gftodvi.o ext.o + +gf2dvi.p: gf2dvi.ch + cp ../../dist/mfware/gftodvi.web gf2dvi.web + tangle gf2dvi.web gf2dvi.ch + rm gf2dvi.web + +gf2dvi: gf2dvi.o ext.o ../tex/ext.h + pc $(PFLAGS) -o gf2dvi gf2dvi.o ext.o + +ext.o: ../tex/ext.c + cc ${CFLAGS} -c ../tex/ext.c + +gftopk_ext.o: gftopk_ext.c + +mft: mft.o weavext.o mft_ext.h mft_ext.o + pc ${PFLAGS} -o mft mft.o mft_ext.o + +install: # doit make install "PROG=gftype" + mv $(PROG) /usr/local/bin/$(PROG) + +clean: + rm -f *.p *.o *~ ../../dist/mfware/*.pool diff --git a/systems/knuth/local/mfware-sparc/gf2dvi.ch b/systems/knuth/local/mfware-sparc/gf2dvi.ch new file mode 100644 index 0000000000..364123df5d --- /dev/null +++ b/systems/knuth/local/mfware-sparc/gf2dvi.ch @@ -0,0 +1,836 @@ +% Change file for the GF2DVI processor, for use on Berkeley UNIX systems. +% [A "color separation" variant of gftodvi, for illustrations in Vols C, E] + +% History: +% +% Created by don on 92/6/8, based on original SAIL version (circa 1965) +% I started with gftodvi.ch and edited in changes corresponding to +% the changes previously installed at SAIL ages ago + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [0] WEAVE: print changes only +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +\pageno=\contentspagenumber \advance\pageno by 1 +@y +\pageno=\contentspagenumber \advance\pageno by 1 +\let\maybe=\iffalse +\def\title{GF\lowercase{to}DVI changes for Berkeley {\mc UNIX}} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1] Change banner string +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d banner=='This is GFtoDVI, Version 3.0' {printed when the program starts} +@y +@d banner=='This is GF2DVI [double separation], Version 3.0 for SunOS' + {printed when the program starts} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [2] Use default case statement feature of SunOS Pascal +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d othercases == others: {default for cases not listed explicitly} +@y +@d othercases == otherwise {default for cases not listed explicitly} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3] Add inclusion of ext.h and standard input to program header +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p program GF_to_DVI(@!output); +label @<Labels in the outer block@>@/ +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +procedure initialize; {this procedure gets things started properly} + var @!i,@!j,@!m,@!n:integer; {loop indices for initializations} + begin print_ln(banner);@/ + @<Set initial values@>@/ + end; +@y +@p program GF_to_DVI(@!input,@!output); +label @<Labels in the outer block@>@/ +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +@\@=#include "../tex/ext.h"@>@\ {declarations for external C procedures} +procedure initialize; {this procedure gets things started properly} + var @!i,@!j,@!m,@!n:integer; {loop indices for initializations} + begin print_ln(banner);@/ + @<Set initial values@>@/ + first_input:=true; + end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [4] Distinguish two brands of finality +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d final_end=9999 {label for the end of it all} + +@<Labels...@>=final_end; +@y +@d final_final_end=9999 {label for the end of it all} +@d final_end=9998 {lable for the end of a pass} + +@<Labels...@>=final_end,final_final_end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [5] Enlarge file_name_size to 1024 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@<Constants...@>= +@!max_labels=2000; {maximum number of labels and dots and rules per character} +@!pool_size=10000; {maximum total length of labels and other strings} +@!max_strings=1100; {maximum number of labels and other strings} +@!terminal_line_length=150; {maximum number of characters input in a single + line of input from the terminal} +@!file_name_size=50; {a file name shouldn't be longer than this} +@!font_mem_size=2000; {space for font metric data} +@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8} +@!widest_row=8192; {maximum number of pixels per row} +@!lig_lookahead=20; {size of stack used when inserting ligature characters} +@y +@<Constants...@>= +@!max_labels=2000; {maximum number of labels and dots per character} +@!pool_size=10000; {maximum total length of labels and other strings} +@!max_strings=1100; {maximum number of labels and other strings} +@!terminal_line_length=150; {maximum number of characters input in a single + line of input from the terminal} +@!file_name_size=1024; {a file name shouldn't be longer than this} +@!font_mem_size=2000; {space for font metric data} +@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8} +@!widest_row=8192; {maximum number of pixels per row} +@!lig_lookahead=20; {size of stack used when inserting ligature characters} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [8] Add <nl> to end of abort() message; jump way out +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d abort(#)==@+begin print(' ',#); jump_out;@+end +@y +@d abort(#)==@+begin print_ln(' ',#); jump_out;@+end +@z +@x +begin goto final_end; +@y +begin goto final_final_end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [was15,now16] change update_terminal to flush(), change def'n of term_in +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +Since the terminal is being used for both input and output, some systems +need a special routine to make sure that the user can see a prompt message +before waiting for input based on that message. (Otherwise the message +may just be sitting in a hidden buffer somewhere, and the user will have +no idea what the program is waiting for.) We shall call a system-dependent +subroutine |update_terminal| in order to avoid this problem. + +@d update_terminal == break(output) {empty the terminal output buffer} + +@<Glob...@>= +@!buffer:array[0..terminal_line_length] of 0..255; +@!term_in:text_file; {the terminal, considered as an input file} +@y +Since the terminal is being used for both input and output, some systems +need a special routine to make sure that the user can see a prompt message +before waiting for input based on that message. (Otherwise the message +may just be sitting in a hidden buffer somewhere, and the user will have +no idea what the program is waiting for.) We shall call a system-dependent +subroutine |update_terminal| in order to avoid this problem. +@^system dependencies@> + +@d update_terminal == flush(output) {empty the terminal output buffer} +@d term_in == input {standard input} + +@<Glob...@>= +@!buffer:array[0..terminal_line_length] of 0..255; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [was16,now17] Remove reset(term_in) from input_ln +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ A global variable |line_length| records the first buffer position after +the line just read. +@^system dependencies@> + +@p procedure input_ln; {inputs a line from the terminal} +begin update_terminal; reset(term_in); +if eoln(term_in) then read_ln(term_in); +line_length:=0; +while (line_length<terminal_line_length)and not eoln(term_in) do + begin buffer[line_length]:=xord[term_in^]; incr(line_length); get(term_in); + end; +end; + +@y +@ A global variable |line_length| records the first buffer position after +the line just read. Another one, |first_input|, tells if such a line exists. +@^system dependencies@> + +@p procedure input_ln; {inputs a line from the terminal} +begin update_terminal; +if first_input then first_input:=false +else if eoln(term_in) then read_ln(term_in); +line_length:=0; +while (line_length<terminal_line_length)and not eoln(term_in) do + begin buffer[line_length]:=xord[term_in^]; incr(line_length); get(term_in); + end; +end; + +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [45] Change type of binary file for binary (byte) files +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +We shall stick to simple \PASCAL\ in this program, for reasons of clarity, +even if such simplicity is sometimes unrealistic. + +@<Types ...@>= +@!eight_bits=0..255; {unsigned one-byte quantity} +@!byte_file=packed file of eight_bits; {files that contain binary data} +@y +For Berkeley Pascal, we need to use `|packed file of -128..127|' to read and +write binary bytes. + +@<Types ...@>= +@!eight_bits=0..255; {unsigned one-byte quantity} +@!byte_file=packed file of -128..127; {files that contain binary data} +@!packed_ASCII_code=-128..127; {declaration needed only because of \.{ext.h}} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [47] Modify file open routines to match binary I/O library +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +variable that specifies the file name. +@^system dependencies@> + +@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|} +begin reset(gf_file,name_of_file); +cur_loc:=0; +end; +@# +procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|} +begin reset(tfm_file,name_of_file); +end; +@# +procedure open_dvi_file; {prepares to write packed bytes in |dvi_file|} +begin rewrite(dvi_file,name_of_file); +end; +@y +variable that specifies the file name. + +An external C procedure, |test_access| is used to check whether or not the +open will work. It is declared in the \.{ext.h} include file, and it returns +|true| or |false|. The |name_of_file| global holds the file name whose access +is to be tested. +The first parameter for |test_access| is the access mode, +one of |read_access_mode| or |write_access_mode|. + +We also implement path searching in |test_access|: its second parameter is +one of the ``file path'' constants defined below. If |name_of_file| +doesn't start with |'/'| then |test_access| tries prepending pathnames +from the appropriate path list until success or the end of path list +is reached. +On return, |real_name_of_file| contains the original name with the path +that succeeded (if any) prepended. It is the name used in the various +open procedures. + +@d read_access_mode=4 {``read'' mode for |test_access|} +@d write_access_mode=2 {``write'' mode for |test_access|} + +@d no_file_path=0 {do no path searching} +@d font_file_path=3 {path specifier for \.{TFM} files} + +@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|} +var@!i: 1..file_name_size; +begin if test_access(read_access_mode,no_file_path) then + begin reset(gf_file,real_name_of_file); cur_loc:=0; + end +else begin i:=1; + while (real_name_of_file[i] <> chr(0)) do@+incr(i); + abort('Can''t open GF file ',real_name_of_file:i); + end; +end; +@# +procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|} +var@!i: 1..file_name_size; +begin if test_access(read_access_mode,font_file_path) then + begin reset(tfm_file,real_name_of_file); cur_loc:=0; + temp_int:=tfm_file^; {prime the pump} + if temp_int<0 then temp_int:=temp_int+256; + end +else begin i:=1; + while (real_name_of_file[i] <> chr(0)) do@+incr(i); + abort('Can''t open TFM file ',real_name_of_file:i); + end; +end; +@# +procedure open_dvi_file; {prepares to write packed bytes in |dvi_file|} +var@!i: 1..file_name_size; +begin if test_access(write_access_mode,no_file_path) then + rewrite(dvi_file,real_name_of_file) +else begin i:=1; + while (real_name_of_file[i] <> chr(0)) do@+incr(i); + abort('Can''t write on DVI file ',real_name_of_file:i); + end; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [48] Declare real_name_of_file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +be read next, and the string |name_of_file| will be set to the current +file name before the file-opening procedures are called. + +@<Glob...@>= +@!cur_loc:integer; {current byte number in |gf_file|} +@!name_of_file:packed array[1..file_name_size] of char; {external file name} +@y +be read next, and the string |name_of_file| will be set to the current +file name before the file-opening procedures are called. +Under UNIX, we also have a |real_name_of_file| string, that gets +set by the external |test_access| procedure after path searching. + +@<Glob...@>= +@!cur_loc:integer; {current byte number in |gf_file|} +@!name_of_file,@!real_name_of_file,@!gf_file_name: + packed array[1..file_name_size] of char; {external name} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [50] Use modified routines to access tfm_file using b_read_unsigned() +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p procedure read_tfm_word; +begin read(tfm_file,b0); read(tfm_file,b1); +read(tfm_file,b2); read(tfm_file,b3); +end; +@y +For Berkeley {\mc UNIX} we had to make the |byte_file| type have data in the +range |-128..127|. +If the file byte contains |@'377|, we want to regard this as 255 in decimal. +However if we do |i:=tfm_file^| on that byte, where i is a signed integer, +then the result is |i=-1|. +File bytes with values |<@'200| are read properly. +The solution is to do the assignment as shown, and then add 256 to values +less than 0. +We could also assign to |eight_bits| values, but this causes an error if +runtime checking is turned on. +The integer |temp_int| will be added to global variables at the end, +where it won't disturb module numbering. + +@d fget==begin get(tfm_file); + temp_int:=tfm_file^; + if temp_int<0 then temp_int:=temp_int+256; + end + +@p procedure read_tfm_word; +begin b0:=temp_int; fget; b1:=temp_int; +fget; b2:=temp_int; fget; b3:=temp_int; fget; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [51] Use modified routines to access gf_file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ We shall use another set of simple functions to read the next byte or +bytes from |gf_file|. There are four possibilities, each of which is +treated as a separate function in order to minimize the overhead for +subroutine calls. +@^system dependencies@> + +@p function get_byte:integer; {returns the next byte, unsigned} +var b:eight_bits; +begin if eof(gf_file) then get_byte:=0 +else begin read(gf_file,b); incr(cur_loc); get_byte:=b; + end; +end; +@# +function get_two_bytes:integer; {returns the next two bytes, unsigned} +var a,@!b:eight_bits; +begin read(gf_file,a); read(gf_file,b); +cur_loc:=cur_loc+2; +get_two_bytes:=a*256+b; +end; +@# +function get_three_bytes:integer; {returns the next three bytes, unsigned} +var a,@!b,@!c:eight_bits; +begin read(gf_file,a); read(gf_file,b); read(gf_file,c); +cur_loc:=cur_loc+3; +get_three_bytes:=(a*256+b)*256+c; +end; +@# +function signed_quad:integer; {returns the next four bytes, signed} +var a,@!b,@!c,@!d:eight_bits; +begin read(gf_file,a); read(gf_file,b); read(gf_file,c); read(gf_file,d); +cur_loc:=cur_loc+4; +if a<128 then signed_quad:=((a*256+b)*256+c)*256+d +else signed_quad:=(((a-256)*256+b)*256+c)*256+d; +end; +@y +@ We shall use another set of simple functions to read the next byte or +bytes from |gf_file|. There are four possibilities, each of which is +treated as a separate function in order to minimize the overhead for +subroutine calls. +@^system dependencies@> + +@p function get_byte:integer; {returns the next byte, unsigned} +var b:-128..127; +begin if eof(gf_file) then get_byte:=0 +else begin read(gf_file,b); incr(cur_loc); + if b < 0 then get_byte := b + 256 else get_byte:=b; + end; +end; +@# +function signed_byte:integer; {returns the next byte, signed} +var b:-128..127; +begin read(gf_file,b); incr(cur_loc); +signed_byte:=b; +end; +@# +function get_two_bytes:integer; {returns the next two bytes, unsigned} +var a,b:integer; +begin a := get_byte; b := get_byte; +get_two_bytes:=a*256+b; +end; +@# +function get_three_bytes:integer; {returns the next three bytes, unsigned} +var a,@!b,@!c:integer; +begin a := get_byte; b := get_byte; c := get_byte; +get_three_bytes:=(a*256+b)*256+c; +end; +@# +function signed_quad:integer; {returns the next four bytes, signed} +var a,@!b,@!c,@!d:integer; +begin a := signed_byte; b := get_byte; c := get_byte; d := get_byte; +signed_quad:=((a*256+b)*256+c)*256+d +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [52] change definition of min/max_quarterword +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +the more general memory words of \TeX. On some machines it is necessary to +define |min_quarterword=-128| and |max_quarterword=127| in order to pack +four quarterwords into a single word.) +@^system dependencies@> + +@d min_quarterword=0 {change this to allow efficient packing, if necessary} +@d max_quarterword=255 {ditto} +@y +the more general memory words of \TeX. +With Berkeley {\mc UNIX} Pascal, we need to use the |-128..127| range to pack +an integer subrange into a byte. +@^system dependencies@> + +@d min_quarterword=-128 {change this to allow efficient packing, if necessary} +@d max_quarterword=127 {ditto} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [78] change default extension to ".2602gf" +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +l:=3; init_str3(".")("g")("f")(gf_ext);@/ +@y +l:=7; init_str7(".")("2")("6")("0")("2")("g")("f")(gf_ext);@/ +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [78] change default gray font to "black" +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +l:=4; init_str4("g")("r")("a")("y")(default_gray_font);@/ +@y +l:=5; init_str5("b")("l")("a")("c")("k")(default_gray_font);@/ +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [87] change ">" and ":" to "/" in file name scanning +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The file names we shall deal with for illustrative purposes have the +following structure: If the name contains `\.>' or `\.:', the file area +consists of all characters up to and including the final such character; +otherwise the file area is null. If the remaining file name contains +`\..', the file extension consists of all such characters from the first +remaining `\..' to the end, otherwise the file extension is null. +@^system dependencies@> + +We can scan such file names easily by using two global variables that keep track +of the occurrences of area and extension delimiters: + +@<Glob...@>= +@!area_delimiter:pool_pointer; {the most recent `\.>' or `\.:', if any} +@!ext_delimiter:pool_pointer; {the relevant `\..', if any} +@y +@ The file names we shall deal with for SunOS have the +following structure: If the name contains `\./', the file area +consists of all characters up to and including the final such character; +otherwise the file area is null. If the remaining file name contains +`\..', the file extension consists of all such characters from the first +remaining `\..' to the end, otherwise the file extension is null. +@^system dependencies@> + +We can scan such file names easily by using two global variables that keep track +of the occurrences of area and extension delimiters: + +@<Glob...@>= +@!area_delimiter:pool_pointer; {the most recent `\./', if any} +@!ext_delimiter:pool_pointer; {the relevant `\..', if any} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [88] change home_font_area to null_string (open_tfm provides path) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ Font metric files whose areas are not given +explicitly are assumed to appear in a standard system area called +|home_font_area|. This system area name will, of course, vary from place +to place. The program here sets it to `\.{TeXfonts:}'. +@^system dependencies@> +@.TeXfonts@> + +@<Initialize the strings@>= +l:=9; init_str9("T")("e")("X")("f")("o")("n")("t")("s")(":")(home_font_area);@/ +@y +@ Font metric files whose areas are not given +explicitly are assumed to appear in a standard system area called +|home_font_area|. This system area name will, of course, vary from place +to place. Under the Berkeley {\mc UNIX} version, we set |home_font_area| +to |null_string| because the default areas to search for \.{TFM} files +are built into the routine |test_access|. +@^system dependencies@> + +@<Initialize the strings@>= +l:=0; init_str0(home_font_area);@/ +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [90] change more_name to understand UNIX file name paths +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p function more_name(@!c:ASCII_code):boolean; +begin if c=" " then more_name:=false +else begin if (c=">")or(c=":") then + begin area_delimiter:=pool_ptr; ext_delimiter:=0; + end + else if (c=".")and(ext_delimiter=0) then ext_delimiter:=pool_ptr; + str_room(1); append_char(c); {contribute |c| to the current string} + more_name:=true; + end; +end; +@y +@p function more_name(@!c:ASCII_code):boolean; +begin if c=" " then more_name:=false +else begin if (c="/") then + begin area_delimiter:=pool_ptr; ext_delimiter:=0; + end + else if (c=".")and(ext_delimiter=0) then ext_delimiter:=pool_ptr; + str_room(1); append_char(c); {contribute |c| to the current string} + more_name:=true; + end; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [94] change start_gf to get file name from command line arguments +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The |start_gf| procedure prompts the user for the name of the generic +font file to be input. It opens the file, making sure that some input is +present; then it opens the output file. + +Although this routine is system-independent, it should probably be +modified to take the file name from the command line (without an initial +prompt), on systems that permit such things. + +@p procedure start_gf; +label found,done; +begin loop@+begin print_nl('GF file name: '); input_ln; +@.GF file name@> + buf_ptr:=0; buffer[line_length]:="?"; + while buffer[buf_ptr]=" " do incr(buf_ptr); + if buf_ptr<line_length then + begin @<Scan the file name in the buffer@>; + if cur_ext=null_string then cur_ext:=gf_ext; + pack_file_name(cur_name,cur_area,cur_ext); open_gf_file; + if not eof(gf_file) then goto found; + print_nl('Oops... I can''t find file '); print(name_of_file); +@.Oops...@> +@.I can't find...@> + end; + end; +found:job_name:=cur_name; pack_file_name(job_name,null_string,dvi_ext); +open_dvi_file; +end; +@y +@ The |start_gf| procedure obtains the name of the generic font file to +be input from the command line. +It opens the file, making sure that some input is +present; then it opens the output file. + +@p procedure start_gf; +label done; +var + arg_buffer: packed array [1..file_name_size] of char; + arg_buf_ptr: 1..file_name_size; +begin if (argc > 2) then abort('Usage: gftodvi [GF-file]'); +if argc = 1 then begin + print_nl('GF file name: '); input_ln; +@.GF file name@> + end +else begin + argv(1, arg_buffer); + arg_buf_ptr := 1; + line_length := 0; + while (arg_buf_ptr < file_name_size) + and (arg_buffer[arg_buf_ptr] = ' ') do + incr(arg_buf_ptr); + while (arg_buf_ptr < file_name_size) + and (line_length < terminal_line_length) + and (arg_buffer[arg_buf_ptr] <> ' ') do + begin + buffer[line_length] := xord[arg_buffer[arg_buf_ptr]]; + incr(line_length); + incr(arg_buf_ptr); + end; +end; + buf_ptr:=0; buffer[line_length]:="?"; + while buffer[buf_ptr]=" " do incr(buf_ptr); + if buf_ptr<line_length then + begin @<Scan the file name in the buffer@>; + if cur_ext=null_string then cur_ext:=gf_ext; + pack_file_name(cur_name,cur_area,cur_ext); + gf_file_name:=name_of_file; + open_gf_file; + end; +job_name:=cur_name; pack_file_name(job_name,null_string,dvi_ext); +open_dvi_file; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [98] load_fonts: +% KLUDGE: SUN Pascal compiler incorrectly aligns four_quarters data +% item on stack, which causes long reference to odd address. +% FIX: rearrange four_quarter data to follow aligned long (int) data. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@<Declare the procedure called |load_fonts|@>= +procedure load_fonts; +label done,continue,found,not_found; +var @!f:internal_font_number; +@!i:four_quarters; {font information word} +@!j,@!k,@!v:integer; {registers for initializing font tables} +@!m:title_font..slant_font+area_code; {keyword found} +@!n1:0..longest_keyword; {buffered character being checked} +@y +@<Declare the procedure called |load_fonts|@>= +procedure load_fonts; +label done,continue,found,not_found; +var @!f:internal_font_number; +@!j,@!k,@!v:integer; {registers for initializing font tables} +@!i:four_quarters; {font information word} +@!m:title_font..slant_font+area_code; {keyword found} +@!n1:0..longest_keyword; {buffered character being checked} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [107] write_dvi is now an external C routine +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p procedure write_dvi(@!a,@!b:dvi_index); +var k:dvi_index; +begin for k:=a to b do write(dvi_file,dvi_buf[k]); +end; +@y +For Berkeley {\mc UNIX}, this is going to be handled by an external procedure, +which will do the output using |fwrite|. +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [115] double the page count in the DVI file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +dvi_out(total_pages div 256); dvi_out(total_pages mod 256);@/ +@y +total_pages:=total_pages+total_pages; +dvi_out(total_pages div 256); dvi_out(total_pages mod 256);@/ +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [154] avoid spurious error message +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x + else print_nl('(Tardy font change will be ignored (byte ', +@y + else if pass=1 then print_nl('(Tardy font change will be ignored (byte ', +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [164] do the color separation +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@<Output all rules for the current character@>; +@<Output all labels for the current character@>; +do_pixels; +@y +cross(-655360,-655360); +cross(-655360,page_height+655360); +cross(page_width+655360,-655360); +cross(page_width+655360,page_height+655360); +if pass=1 then + begin @<Output all rules for the current character@>; + @<Output all labels for the current character@>; + skip_pixels; + end +else do_pixels; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [172] supply a secondary page number +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +for k:=3 to 9 do dvi_four(0); +@y +dvi_four(pass); for k:=4 to 9 do dvi_four(0); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [was188,now191] Avoid `oct', a reserved word in SunOS Pascal(!) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d octant==xr {octant code for nearest dot, plus 8 for coincident dots} +@y +@d octant==xr {octant code for nearest dot, plus 8 for coincident dots} +@d oct==octnt {changes variable name since |oct| is reserved word in SunOS} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [was216,now219] call set_paths before gf_start to initialize paths +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p begin initialize; {get all variables initialized} +@<Initialize the strings@>; +start_gf; {open the input and output files} +@<Process the preamble@>; +cur_gf:=get_byte; init_str_ptr:=str_ptr; +loop@+ begin @<Initialize variables for the next character@>; + while (cur_gf>=xxx1)and(cur_gf<=no_op) do @<Process a no-op command@>; + if cur_gf=post then @<Finish the \.{DVI} file and |goto final_end|@>; +@y +@p @<Last-minute procedures@>@; +begin initialize; {get all variables initialized} +@<Initialize the strings@>; +set_paths; {initialize paths for \.{TFM} files from environment if needed} +for pass:=1 to 2 do + begin if pass=1 then + begin start_gf; {open the input and output files} + @<Process the preamble@>; + init_str_ptr:=str_ptr; + end + else begin total_pages:=0; name_of_file:=gf_file_name; open_gf_file; + q:=get_byte; q:=get_byte; k:=get_byte; for m:=1 to k do q:=get_byte; + end; +cur_gf:=get_byte; +loop@+ begin @<Initialize variables for the next character@>; + while (cur_gf>=xxx1)and(cur_gf<=no_op) do @<Process a no-op command@>; + if cur_gf=post then + if pass=1 then goto final_end + else @<Finish the \.{DVI} file and |goto final_end|@>; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [was216,now219] finish normal end with <nl> on terminal; add another `end' +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x + cur_gf:=get_byte; str_ptr:=init_str_ptr; pool_ptr:=str_start[str_ptr]; + end; +final_end:end. +@y + cur_gf:=get_byte; str_ptr:=init_str_ptr; pool_ptr:=str_start[str_ptr]; + end; +final_end:end; +final_final_end:print_ln(' '); +end. +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [was219,now222] declare special globals and procedures +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@* System-dependent changes. +This section should be replaced, if necessary, by changes to the program +that are necessary to make \.{GFtoDVI} work at a particular installation. +It is usually best to design your change file so that all changes to +previous sections preserve the section numbering; then everybody's version +will be consistent with the printed program. More extensive changes, +which introduce new sections, can be inserted here; then only the index +itself will get a new section number. +@^system dependencies@> +@y +@* System-dependent changes. +This section should be replaced, if necessary, by changes to the program +that are necessary to make \.{GFtoDVI} work at a particular installation. +It is usually best to design your change file so that all changes to +previous sections preserve the section numbering; then everybody's version +will be consistent with the printed program. More extensive changes, +which introduce new sections, can be inserted here; then only the index +itself will get a new section number. +@^system dependencies@> + +@<Glob...@>= +@!pass:1..2; {are we doing the first pass (rules) or the second (pixels)?} +@!temp_int:integer; {used for TFM input} +@!last,@!first:0..terminal_line_length; {needed in \.{ext.c}} +@!interrupt:integer; {ditto} +@!first_input:boolean; {true before the first call to |input_ln|} + +@ @<Types in...@>= +@!word_file=file of memory_word; {needed in \.{ext.c}} + +@ Finally, here is a subroutine that draws cross-reference marks. +@<Last-minute...@>= +procedure cross(@!x,@!y:scaled); +begin dvi_goto(x-655360,y+13107); +dvi_out(put_rule); +dvi_four(26214); dvi_four(1310720); +dvi_out(pop);@/ +dvi_goto(x-13107,y+655360); +dvi_out(put_rule); +dvi_four(1310720); dvi_four(26214); +dvi_out(pop); +end; + +@ And still more finally, a subroutine that skips over +the meaty part of a ``character'' in the \.{GF} file. +@<Last-min...@>= +procedure skip_pixels; +label done; +var @!k:integer; {garbage} +begin while cur_gf<>eoc do + begin case cur_gf of + paint1,skip1:k:=get_byte; + paint2,skip2:k:=get_two_bytes; + paint3,skip3:k:=get_three_bytes; + xxx1,xxx2,xxx3,xxx4,yyy,no_op: begin skip_nop; goto done; end; + othercases do_nothing + endcases;@/ + cur_gf:=get_byte; +done: end; +end; +@z diff --git a/systems/knuth/local/mfware-sparc/gftodvi.ch b/systems/knuth/local/mfware-sparc/gftodvi.ch new file mode 100644 index 0000000000..29a85a5e12 --- /dev/null +++ b/systems/knuth/local/mfware-sparc/gftodvi.ch @@ -0,0 +1,757 @@ +% Change file for the GFtoDVI processor, for use on Berkeley UNIX systems. + +% History: +% +% Revised by don on 91/1/5, default extension is now .2602gf +% +% Revised by don on 89/10/16 for version 3.0 (extended ligatures) +% +% Revised by don on 89/08/14 for version 2.0 and SunOS +% with simplications based on initex.ch +% +% Revision 1.7.1.5 86/02/01 15:29:58 richards +% Released again for MF 1.0 package +% +% Revision 1.7.1.4 86/02/01 15:06:50 richards +% Added: +% <nl> at end of successful run +% +% Revision 1.7.1.3 86/01/27 16:39:48 richards +% Fixed: +% syntax error in previous edits +% +% Revision 1.7.1.2 86/01/27 15:55:58 richards +% Added: +% dvi_buf_type declaration and redefined dvi_buf[] in +% terms of it, so we can use it as a parameter to b_write_buf() +% +% Revision 1.7.1.1 86/01/27 15:39:10 richards +% First edit to use new binary I/O routines +% +% Revision 1.7 85/10/21 21:55:50 richards +% Released for GFtoDVI 1.7 +% +% Revision 1.3.7.1 85/10/18 22:59:01 richards +% Updated for GFtoDVI Version 1.7 (Distributed w/ MF84 Version 0.9999) +% +% Revision 1.3.5.1 85/10/09 17:02:35 richards +% First draft to run at 1.5 level +% +% Revision 1.3 85/05/27 21:15:30 richards +% Updated for GFtoDVI Version 1.3 (Distributed w/ MF84 Version 0.91) +% +% Revision 1.2 85/04/25 19:33:30 richards +% Updated to GFtoDVI Version 1.2 (Distributed w/ MF84 Version 0.81) +% +% Revision 1.1 85/03/03 21:47:17 richards +% Updated for GF utilities distributed with MF Version 0.77 +% +% Revision 1.0 84/12/16 22:38:22 richards +% Updated for GFtoDVI Version 1.0 (New GF file format) +% +% Revision 0.6 84/12/05 13:32:01 richards +% Updated for GFtoDVI Version 0.6; merged in changes from sdcarl!rusty +% +% Note: still has BUGFIX in section 199 to keep GFtoDVI from trying +% to use non-existant characters in a gray font +% +% Revision 0.3 84/11/17 23:51:56 richards +% Base version for GFtoDVI Version 0.3 +% + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [0] WEAVE: print changes only +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +\pageno=\contentspagenumber \advance\pageno by 1 +@y +\pageno=\contentspagenumber \advance\pageno by 1 +\let\maybe=\iffalse +\def\title{GF\lowercase{to}DVI changes for Berkeley {\mc UNIX}} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1] Change banner string +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d banner=='This is GFtoDVI, Version 3.0' {printed when the program starts} +@y +@d banner=='This is GFtoDVI, Version 3.0 for SunOS' + {printed when the program starts} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [2] Use default case statement feature of SunOS Pascal +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d othercases == others: {default for cases not listed explicitly} +@y +@d othercases == otherwise {default for cases not listed explicitly} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3] Add inclusion of ext.h and standard input to program header +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p program GF_to_DVI(@!output); +label @<Labels in the outer block@>@/ +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +procedure initialize; {this procedure gets things started properly} + var @!i,@!j,@!m,@!n:integer; {loop indices for initializations} + begin print_ln(banner);@/ + @<Set initial values@>@/ + end; +@y +@p program GF_to_DVI(@!input,@!output); +label @<Labels in the outer block@>@/ +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +@\@=#include "../tex/ext.h"@>@\ {declarations for external C procedures} +procedure initialize; {this procedure gets things started properly} + var @!i,@!j,@!m,@!n:integer; {loop indices for initializations} + begin print_ln(banner);@/ + @<Set initial values@>@/ + first_input:=true; + end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [5] Enlarge file_name_size to 1024 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@<Constants...@>= +@!max_labels=2000; {maximum number of labels and dots and rules per character} +@!pool_size=10000; {maximum total length of labels and other strings} +@!max_strings=1100; {maximum number of labels and other strings} +@!terminal_line_length=150; {maximum number of characters input in a single + line of input from the terminal} +@!file_name_size=50; {a file name shouldn't be longer than this} +@!font_mem_size=2000; {space for font metric data} +@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8} +@!widest_row=8192; {maximum number of pixels per row} +@!lig_lookahead=20; {size of stack used when inserting ligature characters} +@y +@<Constants...@>= +@!max_labels=2000; {maximum number of labels and dots per character} +@!pool_size=10000; {maximum total length of labels and other strings} +@!max_strings=1100; {maximum number of labels and other strings} +@!terminal_line_length=150; {maximum number of characters input in a single + line of input from the terminal} +@!file_name_size=1024; {a file name shouldn't be longer than this} +@!font_mem_size=2000; {space for font metric data} +@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8} +@!widest_row=8192; {maximum number of pixels per row} +@!lig_lookahead=20; {size of stack used when inserting ligature characters} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [8] Add <nl> to end of abort() message +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d abort(#)==@+begin print(' ',#); jump_out;@+end +@y +@d abort(#)==@+begin print_ln(' ',#); jump_out;@+end +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [was15,now16] change update_terminal to flush(), change def'n of term_in +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +Since the terminal is being used for both input and output, some systems +need a special routine to make sure that the user can see a prompt message +before waiting for input based on that message. (Otherwise the message +may just be sitting in a hidden buffer somewhere, and the user will have +no idea what the program is waiting for.) We shall call a system-dependent +subroutine |update_terminal| in order to avoid this problem. + +@d update_terminal == break(output) {empty the terminal output buffer} + +@<Glob...@>= +@!buffer:array[0..terminal_line_length] of 0..255; +@!term_in:text_file; {the terminal, considered as an input file} +@y +Since the terminal is being used for both input and output, some systems +need a special routine to make sure that the user can see a prompt message +before waiting for input based on that message. (Otherwise the message +may just be sitting in a hidden buffer somewhere, and the user will have +no idea what the program is waiting for.) We shall call a system-dependent +subroutine |update_terminal| in order to avoid this problem. +@^system dependencies@> + +@d update_terminal == flush(output) {empty the terminal output buffer} +@d term_in == input {standard input} + +@<Glob...@>= +@!buffer:array[0..terminal_line_length] of 0..255; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [was16,now17] Remove reset(term_in) from input_ln +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ A global variable |line_length| records the first buffer position after +the line just read. +@^system dependencies@> + +@p procedure input_ln; {inputs a line from the terminal} +begin update_terminal; reset(term_in); +if eoln(term_in) then read_ln(term_in); +line_length:=0; +while (line_length<terminal_line_length)and not eoln(term_in) do + begin buffer[line_length]:=xord[term_in^]; incr(line_length); get(term_in); + end; +end; + +@y +@ A global variable |line_length| records the first buffer position after +the line just read. Another one, |first_input|, tells if such a line exists. +@^system dependencies@> + +@p procedure input_ln; {inputs a line from the terminal} +begin update_terminal; +if first_input then first_input:=false +else if eoln(term_in) then read_ln(term_in); +line_length:=0; +while (line_length<terminal_line_length)and not eoln(term_in) do + begin buffer[line_length]:=xord[term_in^]; incr(line_length); get(term_in); + end; +end; + +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [45] Change type of binary file for binary (byte) files +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +We shall stick to simple \PASCAL\ in this program, for reasons of clarity, +even if such simplicity is sometimes unrealistic. + +@<Types ...@>= +@!eight_bits=0..255; {unsigned one-byte quantity} +@!byte_file=packed file of eight_bits; {files that contain binary data} +@y +For Berkeley Pascal, we need to use `|packed file of -128..127|' to read and +write binary bytes. + +@<Types ...@>= +@!eight_bits=0..255; {unsigned one-byte quantity} +@!byte_file=packed file of -128..127; {files that contain binary data} +@!packed_ASCII_code=-128..127; {declaration needed only because of \.{ext.h}} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [47] Modify file open routines to match binary I/O library +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +variable that specifies the file name. +@^system dependencies@> + +@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|} +begin reset(gf_file,name_of_file); +cur_loc:=0; +end; +@# +procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|} +begin reset(tfm_file,name_of_file); +end; +@# +procedure open_dvi_file; {prepares to write packed bytes in |dvi_file|} +begin rewrite(dvi_file,name_of_file); +end; +@y +variable that specifies the file name. + +An external C procedure, |test_access| is used to check whether or not the +open will work. It is declared in the \.{ext.h} include file, and it returns +|true| or |false|. The |name_of_file| global holds the file name whose access +is to be tested. +The first parameter for |test_access| is the access mode, +one of |read_access_mode| or |write_access_mode|. + +We also implement path searching in |test_access|: its second parameter is +one of the ``file path'' constants defined below. If |name_of_file| +doesn't start with |'/'| then |test_access| tries prepending pathnames +from the appropriate path list until success or the end of path list +is reached. +On return, |real_name_of_file| contains the original name with the path +that succeeded (if any) prepended. It is the name used in the various +open procedures. + +@d read_access_mode=4 {``read'' mode for |test_access|} +@d write_access_mode=2 {``write'' mode for |test_access|} + +@d no_file_path=0 {do no path searching} +@d font_file_path=3 {path specifier for \.{TFM} files} + +@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|} +var@!i: 1..file_name_size; +begin if test_access(read_access_mode,no_file_path) then + begin reset(gf_file,real_name_of_file); cur_loc:=0; + end +else begin i:=1; + while (real_name_of_file[i] <> chr(0)) do@+incr(i); + abort('Can''t open GF file ',real_name_of_file:i); + end; +end; +@# +procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|} +var@!i: 1..file_name_size; +begin if test_access(read_access_mode,font_file_path) then + begin reset(tfm_file,real_name_of_file); cur_loc:=0; + temp_int:=tfm_file^; {prime the pump} + if temp_int<0 then temp_int:=temp_int+256; + end +else begin i:=1; + while (real_name_of_file[i] <> chr(0)) do@+incr(i); + abort('Can''t open TFM file ',real_name_of_file:i); + end; +end; +@# +procedure open_dvi_file; {prepares to write packed bytes in |dvi_file|} +var@!i: 1..file_name_size; +begin if test_access(write_access_mode,no_file_path) then + rewrite(dvi_file,real_name_of_file) +else begin i:=1; + while (real_name_of_file[i] <> chr(0)) do@+incr(i); + abort('Can''t write on DVI file ',real_name_of_file:i); + end; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [48] Declare real_name_of_file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +be read next, and the string |name_of_file| will be set to the current +file name before the file-opening procedures are called. + +@<Glob...@>= +@!cur_loc:integer; {current byte number in |gf_file|} +@!name_of_file:packed array[1..file_name_size] of char; {external file name} +@y +be read next, and the string |name_of_file| will be set to the current +file name before the file-opening procedures are called. +Under UNIX, we also have a |real_name_of_file| string, that gets +set by the external |test_access| procedure after path searching. + +@<Glob...@>= +@!cur_loc:integer; {current byte number in |gf_file|} +@!name_of_file,@!real_name_of_file:packed array[1..file_name_size] of char; + {external name} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [50] Use modified routines to access tfm_file using b_read_unsigned() +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p procedure read_tfm_word; +begin read(tfm_file,b0); read(tfm_file,b1); +read(tfm_file,b2); read(tfm_file,b3); +end; +@y +For Berkeley {\mc UNIX} we had to make the |byte_file| type have data in the +range |-128..127|. +If the file byte contains |@'377|, we want to regard this as 255 in decimal. +However if we do |i:=tfm_file^| on that byte, where i is a signed integer, +then the result is |i=-1|. +File bytes with values |<@'200| are read properly. +The solution is to do the assignment as shown, and then add 256 to values +less than 0. +We could also assign to |eight_bits| values, but this causes an error if +runtime checking is turned on. +The integer |temp_int| will be added to global variables at the end, +where it won't disturb module numbering. + +@d fget==begin get(tfm_file); + temp_int:=tfm_file^; + if temp_int<0 then temp_int:=temp_int+256; + end + +@p procedure read_tfm_word; +begin b0:=temp_int; fget; b1:=temp_int; +fget; b2:=temp_int; fget; b3:=temp_int; fget; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [51] Use modified routines to access gf_file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ We shall use another set of simple functions to read the next byte or +bytes from |gf_file|. There are four possibilities, each of which is +treated as a separate function in order to minimize the overhead for +subroutine calls. +@^system dependencies@> + +@p function get_byte:integer; {returns the next byte, unsigned} +var b:eight_bits; +begin if eof(gf_file) then get_byte:=0 +else begin read(gf_file,b); incr(cur_loc); get_byte:=b; + end; +end; +@# +function get_two_bytes:integer; {returns the next two bytes, unsigned} +var a,@!b:eight_bits; +begin read(gf_file,a); read(gf_file,b); +cur_loc:=cur_loc+2; +get_two_bytes:=a*256+b; +end; +@# +function get_three_bytes:integer; {returns the next three bytes, unsigned} +var a,@!b,@!c:eight_bits; +begin read(gf_file,a); read(gf_file,b); read(gf_file,c); +cur_loc:=cur_loc+3; +get_three_bytes:=(a*256+b)*256+c; +end; +@# +function signed_quad:integer; {returns the next four bytes, signed} +var a,@!b,@!c,@!d:eight_bits; +begin read(gf_file,a); read(gf_file,b); read(gf_file,c); read(gf_file,d); +cur_loc:=cur_loc+4; +if a<128 then signed_quad:=((a*256+b)*256+c)*256+d +else signed_quad:=(((a-256)*256+b)*256+c)*256+d; +end; +@y +@ We shall use another set of simple functions to read the next byte or +bytes from |gf_file|. There are four possibilities, each of which is +treated as a separate function in order to minimize the overhead for +subroutine calls. +@^system dependencies@> + +@p function get_byte:integer; {returns the next byte, unsigned} +var b:-128..127; +begin if eof(gf_file) then get_byte:=0 +else begin read(gf_file,b); incr(cur_loc); + if b < 0 then get_byte := b + 256 else get_byte:=b; + end; +end; +@# +function signed_byte:integer; {returns the next byte, signed} +var b:-128..127; +begin read(gf_file,b); incr(cur_loc); +signed_byte:=b; +end; +@# +function get_two_bytes:integer; {returns the next two bytes, unsigned} +var a,b:integer; +begin a := get_byte; b := get_byte; +get_two_bytes:=a*256+b; +end; +@# +function get_three_bytes:integer; {returns the next three bytes, unsigned} +var a,@!b,@!c:integer; +begin a := get_byte; b := get_byte; c := get_byte; +get_three_bytes:=(a*256+b)*256+c; +end; +@# +function signed_quad:integer; {returns the next four bytes, signed} +var a,@!b,@!c,@!d:integer; +begin a := signed_byte; b := get_byte; c := get_byte; d := get_byte; +signed_quad:=((a*256+b)*256+c)*256+d +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [52] change definition of min/max_quarterword +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +the more general memory words of \TeX. On some machines it is necessary to +define |min_quarterword=-128| and |max_quarterword=127| in order to pack +four quarterwords into a single word.) +@^system dependencies@> + +@d min_quarterword=0 {change this to allow efficient packing, if necessary} +@d max_quarterword=255 {ditto} +@y +the more general memory words of \TeX. +With Berkeley {\mc UNIX} Pascal, we need to use the |-128..127| range to pack +an integer subrange into a byte. +@^system dependencies@> + +@d min_quarterword=-128 {change this to allow efficient packing, if necessary} +@d max_quarterword=127 {ditto} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [78] change default extension to ".2602gf" +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +l:=3; init_str3(".")("g")("f")(gf_ext);@/ +@y +l:=7; init_str7(".")("2")("6")("0")("2")("g")("f")(gf_ext);@/ +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [87] change ">" and ":" to "/" in file name scanning +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The file names we shall deal with for illustrative purposes have the +following structure: If the name contains `\.>' or `\.:', the file area +consists of all characters up to and including the final such character; +otherwise the file area is null. If the remaining file name contains +`\..', the file extension consists of all such characters from the first +remaining `\..' to the end, otherwise the file extension is null. +@^system dependencies@> + +We can scan such file names easily by using two global variables that keep track +of the occurrences of area and extension delimiters: + +@<Glob...@>= +@!area_delimiter:pool_pointer; {the most recent `\.>' or `\.:', if any} +@!ext_delimiter:pool_pointer; {the relevant `\..', if any} +@y +@ The file names we shall deal with for SunOS have the +following structure: If the name contains `\./', the file area +consists of all characters up to and including the final such character; +otherwise the file area is null. If the remaining file name contains +`\..', the file extension consists of all such characters from the first +remaining `\..' to the end, otherwise the file extension is null. +@^system dependencies@> + +We can scan such file names easily by using two global variables that keep track +of the occurrences of area and extension delimiters: + +@<Glob...@>= +@!area_delimiter:pool_pointer; {the most recent `\./', if any} +@!ext_delimiter:pool_pointer; {the relevant `\..', if any} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [88] change home_font_area to null_string (open_tfm provides path) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ Font metric files whose areas are not given +explicitly are assumed to appear in a standard system area called +|home_font_area|. This system area name will, of course, vary from place +to place. The program here sets it to `\.{TeXfonts:}'. +@^system dependencies@> +@.TeXfonts@> + +@<Initialize the strings@>= +l:=9; init_str9("T")("e")("X")("f")("o")("n")("t")("s")(":")(home_font_area);@/ +@y +@ Font metric files whose areas are not given +explicitly are assumed to appear in a standard system area called +|home_font_area|. This system area name will, of course, vary from place +to place. Under the Berkeley {\mc UNIX} version, we set |home_font_area| +to |null_string| because the default areas to search for \.{TFM} files +are built into the routine |test_access|. +@^system dependencies@> + +@<Initialize the strings@>= +l:=0; init_str0(home_font_area);@/ +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [90] change more_name to understand UNIX file name paths +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p function more_name(@!c:ASCII_code):boolean; +begin if c=" " then more_name:=false +else begin if (c=">")or(c=":") then + begin area_delimiter:=pool_ptr; ext_delimiter:=0; + end + else if (c=".")and(ext_delimiter=0) then ext_delimiter:=pool_ptr; + str_room(1); append_char(c); {contribute |c| to the current string} + more_name:=true; + end; +end; +@y +@p function more_name(@!c:ASCII_code):boolean; +begin if c=" " then more_name:=false +else begin if (c="/") then + begin area_delimiter:=pool_ptr; ext_delimiter:=0; + end + else if (c=".")and(ext_delimiter=0) then ext_delimiter:=pool_ptr; + str_room(1); append_char(c); {contribute |c| to the current string} + more_name:=true; + end; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [94] change start_gf to get file name from command line arguments +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The |start_gf| procedure prompts the user for the name of the generic +font file to be input. It opens the file, making sure that some input is +present; then it opens the output file. + +Although this routine is system-independent, it should probably be +modified to take the file name from the command line (without an initial +prompt), on systems that permit such things. + +@p procedure start_gf; +label found,done; +begin loop@+begin print_nl('GF file name: '); input_ln; +@.GF file name@> + buf_ptr:=0; buffer[line_length]:="?"; + while buffer[buf_ptr]=" " do incr(buf_ptr); + if buf_ptr<line_length then + begin @<Scan the file name in the buffer@>; + if cur_ext=null_string then cur_ext:=gf_ext; + pack_file_name(cur_name,cur_area,cur_ext); open_gf_file; + if not eof(gf_file) then goto found; + print_nl('Oops... I can''t find file '); print(name_of_file); +@.Oops...@> +@.I can't find...@> + end; + end; +found:job_name:=cur_name; pack_file_name(job_name,null_string,dvi_ext); +open_dvi_file; +end; +@y +@ The |start_gf| procedure obtains the name of the generic font file to +be input from the command line. +It opens the file, making sure that some input is +present; then it opens the output file. + +@p procedure start_gf; +label done; +var + arg_buffer: packed array [1..file_name_size] of char; + arg_buf_ptr: 1..file_name_size; +begin if (argc > 2) then abort('Usage: gftodvi [GF-file]'); +if argc = 1 then begin + print_nl('GF file name: '); input_ln; +@.GF file name@> + end +else begin + argv(1, arg_buffer); + arg_buf_ptr := 1; + line_length := 0; + while (arg_buf_ptr < file_name_size) + and (arg_buffer[arg_buf_ptr] = ' ') do + incr(arg_buf_ptr); + while (arg_buf_ptr < file_name_size) + and (line_length < terminal_line_length) + and (arg_buffer[arg_buf_ptr] <> ' ') do + begin + buffer[line_length] := xord[arg_buffer[arg_buf_ptr]]; + incr(line_length); + incr(arg_buf_ptr); + end; +end; + buf_ptr:=0; buffer[line_length]:="?"; + while buffer[buf_ptr]=" " do incr(buf_ptr); + if buf_ptr<line_length then + begin @<Scan the file name in the buffer@>; + if cur_ext=null_string then cur_ext:=gf_ext; + pack_file_name(cur_name,cur_area,cur_ext); open_gf_file; + end; +job_name:=cur_name; pack_file_name(job_name,null_string,dvi_ext); +open_dvi_file; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [98] load_fonts: +% KLUDGE: SUN Pascal compiler incorrectly aligns four_quarters data +% item on stack, which causes long reference to odd address. +% FIX: rearrange four_quarter data to follow aligned long (int) data. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@<Declare the procedure called |load_fonts|@>= +procedure load_fonts; +label done,continue,found,not_found; +var @!f:internal_font_number; +@!i:four_quarters; {font information word} +@!j,@!k,@!v:integer; {registers for initializing font tables} +@!m:title_font..slant_font+area_code; {keyword found} +@!n1:0..longest_keyword; {buffered character being checked} +@y +@<Declare the procedure called |load_fonts|@>= +procedure load_fonts; +label done,continue,found,not_found; +var @!f:internal_font_number; +@!j,@!k,@!v:integer; {registers for initializing font tables} +@!i:four_quarters; {font information word} +@!m:title_font..slant_font+area_code; {keyword found} +@!n1:0..longest_keyword; {buffered character being checked} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [107] write_dvi is now an external C routine +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p procedure write_dvi(@!a,@!b:dvi_index); +var k:dvi_index; +begin for k:=a to b do write(dvi_file,dvi_buf[k]); +end; +@y +For Berkeley {\mc UNIX}, this is going to be handled by an external procedure, +which will do the output using |fwrite|. +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [was188,now191] Avoid `oct', a reserved word in SunOS Pascal(!) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d octant==xr {octant code for nearest dot, plus 8 for coincident dots} +@y +@d octant==xr {octant code for nearest dot, plus 8 for coincident dots} +@d oct==octnt {changes variable name since |oct| is reserved word in SunOS} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [was216,now219] call set_paths before gf_start to initialize paths +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p begin initialize; {get all variables initialized} +@<Initialize the strings@>; +start_gf; {open the input and output files} +@y +@p begin initialize; {get all variables initialized} +@<Initialize the strings@>; +set_paths; {initialize paths for \.{TFM} files from environment if needed} +start_gf; {open the input and output files} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [was216,now219] finish normal end with <nl> on terminal +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x + cur_gf:=get_byte; str_ptr:=init_str_ptr; pool_ptr:=str_start[str_ptr]; + end; +final_end:end. +@y + cur_gf:=get_byte; str_ptr:=init_str_ptr; pool_ptr:=str_start[str_ptr]; + end; +final_end:print_ln(' '); +end. +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [was219,now222] declare special global +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@* System-dependent changes. +This section should be replaced, if necessary, by changes to the program +that are necessary to make \.{GFtoDVI} work at a particular installation. +It is usually best to design your change file so that all changes to +previous sections preserve the section numbering; then everybody's version +will be consistent with the printed program. More extensive changes, +which introduce new sections, can be inserted here; then only the index +itself will get a new section number. +@^system dependencies@> +@y +@* System-dependent changes. +This section should be replaced, if necessary, by changes to the program +that are necessary to make \.{GFtoDVI} work at a particular installation. +It is usually best to design your change file so that all changes to +previous sections preserve the section numbering; then everybody's version +will be consistent with the printed program. More extensive changes, +which introduce new sections, can be inserted here; then only the index +itself will get a new section number. +@^system dependencies@> + +@<Glob...@>= +@!temp_int:integer; {used for TFM input} +@!last,@!first:0..terminal_line_length; {needed in \.{ext.c}} +@!interrupt:integer; {ditto} +@!first_input:boolean; {true before the first call to |input_ln|} + +@ @<Types in...@>= +@!word_file=file of memory_word; {needed in \.{ext.c}} +@z diff --git a/systems/knuth/local/mfware-sparc/gftopk.ch b/systems/knuth/local/mfware-sparc/gftopk.ch new file mode 100644 index 0000000000..4ed4b64ddf --- /dev/null +++ b/systems/knuth/local/mfware-sparc/gftopk.ch @@ -0,0 +1,367 @@ +% $Header: gftopk.ch,v 1.4 87/12/05 10:40:15 mackay Released $ + +% Change file for the GFtoPK processor, for use on Berkeley UNIX systems. + +% History: +% +% don upped max_rows on 90/8/30 +% don upgraded to version 2.3 on 90/8/6 +% don upgraded to version 2.2 on 89/11/21 +% +% don made changes for version 2 and SunOS on 89/8/12 +% (I simplified things by borrowing from texware change files) +% +% $Log: gftopk.ch,v $ +% Revision 1.4 87/12/05 10:40:15 mackay +% Released for GFtoPK 1.4; +% +% Revision 1.3 86/12/08 20:20:15 mackay +% Released for GFtoPK 1.3; +% +% Revision 1.2 86/02/01 14:45:21 richards +% Released for GFtoPK 1.2; +% +% +% Revision 1.1 86/01/30 19:56:05 richards +% Initial revision +% + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [0] WEAVE: print changes only +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +\pageno=\contentspagenumber \advance\pageno by 1 +@y +\pageno=\contentspagenumber \advance\pageno by 1 +\let\maybe=\iffalse +\def\title{GF\lowercase{to}PK changes for Berkeley {\mc UNIX}} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1] Change banner string +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d banner=='This is GFtoPK, Version 2.3' {printed when the program starts} +@y +@d banner=='This is GFtoPK, Version 2.3 for SunOS' + {printed when the program starts} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3] Fix others: +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d othercases == others: {default for cases not listed explicitly} +@y +@d othercases == otherwise {SunOS Pascal default cases} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [4] Redefine program header, eliminate gf_file and pxl_file +% add <Parse command line> section to initialize +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p program GFtoPK(@!gf_file,@!pk_file,@!output); +label @<Labels in the outer block@>@/ +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +procedure initialize; {this procedure gets things started properly} + var i:integer; {loop index for initializations} + begin print_ln(banner);@/ + @<Set initial values@>@/ + end; +@y +@p program GFtoPK(@!input,@!output); +label @<Labels in the outer block@>@/ +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +@\@=#include "gftopk_ext.h"@>@\ +procedure initialize; {this procedure gets things started properly} + var i:integer; {loop index for initializations} + begin print_ln(banner);@/ + @<Set initial values@>;@/ + @<Parse command line arguments@>@/ + end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [6] add file_name_size to constants in the outer block +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!line_length=79; {bracketed lines of output will be at most this long} +@!max_row=16000; {largest index in the main |row| array} +@y +@!line_length=79; {bracketed lines of output will be at most this long} +@!max_row=60000; {largest index in the main |row| array} +@!file_name_size=256; {maximum length of a file name} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [8] have abort() add <nl> to end of message +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d abort(#)==begin print(' ',#); jump_out; +@y +@d abort(#)==begin print_ln(' ',#); jump_out; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [37] Add UNIX_file_name type, redefine byte_file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!eight_bits=0..255; {unsigned one-byte quantity} +@!byte_file=packed file of eight_bits; {files that contain binary data} +@y +@!eight_bits=0..255; {unsigned one-byte quantity} +@!UNIX_file_name=packed array [1..file_name_size] of char; +@!byte_file=packed file of -128..127; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [38] add gf_name and pk_name to global vars +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!gf_file:byte_file; {the stuff we are \.{GFtoPK}ing} +@!pk_file:byte_file; {the stuff we have \.{GFtoPK}ed} +@y +@!gf_file:byte_file; {the stuff we are \.{GFtoPK}ing} +@!gf_name: UNIX_file_name; {the name of |gf_file|} +@!pk_file:byte_file; {the stuff we have \.{GFtoPK}ed} +@!pk_name: UNIX_file_name; {the name of |pk_file|} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [39] open_gf_file with extended reset command (can dump core!) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +begin reset(gf_file); +@y +begin if testreadaccess(gf_name) then reset(gf_file,gf_name) +else abort('Can''t open the GF file'); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [40] and open_pk_file... +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +begin rewrite(pk_file); +@y +var j,k,size:integer; startednumber:boolean; +begin +if argc < 3 then begin@/ + @<Generate |pk_name| from |gf_name| and |h_mag|@>@/ + end; +rewrite(pk_file,pk_name); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [43] replace gf_byte and gf_signed_quad +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p function gf_byte:integer; {returns the next byte, unsigned} +var b:eight_bits; +begin if eof(gf_file) then bad_gf('Unexpected end of file!') +@.Unexpected end of file@> +else begin read(gf_file,b); gf_byte:=b; + end; +incr(gf_loc); +end; +@# +function gf_signed_quad:integer; {returns the next four bytes, signed} +var a,@!b,@!c,@!d:eight_bits; +begin read(gf_file,a); read(gf_file,b); read(gf_file,c); read(gf_file,d); +if a<128 then gf_signed_quad:=((a*256+b)*256+c)*256+d +else gf_signed_quad:=(((a-256)*256+b)*256+c)*256+d; +gf_loc := gf_loc + 4 ; +end; +@y +@p function gf_byte:integer; {returns the next byte, unsigned} +var b:-128..127; +begin if eof(gf_file) then bad_gf('Unexpected end of file!') +else begin read(gf_file,b); + if b < 0 then gf_byte := b + 256 else gf_byte:=b; + end; +incr(gf_loc); +end; +@# +function gf_signed_quad:integer; {returns the next four bytes, signed} +var a,@!b,@!c,@!d:integer; +begin read(gf_file,a); b := gf_byte; c := gf_byte; d := gf_byte; +gf_signed_quad:=((a*256+b)*256+c)*256+d +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [44] redefine pk_byte, pk_halfword, pk_three_bytes, and pk_word +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p procedure pk_byte(a:integer) ; +begin + if pk_open then begin + if a < 0 then a := a + 256 ; + write(pk_file, a) ; + incr(pk_loc) ; + end ; +end ; +@# +procedure pk_halfword(a:integer) ; +begin + if a < 0 then a := a + 65536 ; + write(pk_file, a div 256) ; + write(pk_file, a mod 256) ; + pk_loc := pk_loc + 2 ; +end ; +@# +procedure pk_three_bytes(a:integer); +begin + write(pk_file, a div 65536 mod 256) ; + write(pk_file, a div 256 mod 256) ; + write(pk_file, a mod 256) ; + pk_loc := pk_loc + 3 ; +end ; +@# +procedure pk_word(a:integer) ; +var b : integer ; +begin + if pk_open then begin + if a < 0 then begin + a := a + @'10000000000 ; + a := a + @'10000000000 ; + b := 128 + a div 16777216 ; + end else b := a div 16777216 ; + write(pk_file, b) ; + write(pk_file, a div 65536 mod 256) ; + write(pk_file, a div 256 mod 256) ; + write(pk_file, a mod 256) ; + pk_loc := pk_loc + 4 ; + end ; +end ; +@y +@p procedure pk_byte(a:integer) ; +begin + if pk_open then begin + if a < 0 then a := a + 256 ; + if a > 127 then a := a-256; + write(pk_file, a) ; + incr(pk_loc) ; + end ; +end ; +@# +procedure pk_halfword(a:integer) ; +begin + if a < 0 then a := a + 65536 ; + pk_byte(a div 256); pk_byte(a mod 256); +end ; +@# +procedure pk_three_bytes(a:integer); +begin + pk_byte(a div 65536 mod 256) ; + pk_byte(a div 256 mod 256) ; + pk_byte(a mod 256) ; + end ; +@# +procedure pk_word(a:integer) ; +var b : integer ; +begin + if a < 0 then begin + a := a + @'10000000000 ; + a := a + @'10000000000 ; + b := 128 + a div 16777216 ; + end else b := a div 16777216 ; + pk_byte(b) ; + pk_byte(a div 65536 mod 256) ; + pk_byte(a div 256 mod 256) ; + pk_byte(a mod 256) ; + end ; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [46] redefine find_gf_length and move_to_byte +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p procedure find_gf_length ; +begin + set_pos(gf_file, -1) ; gf_len := cur_pos(gf_file) ; +end ; +@# +procedure move_to_byte(@!n : integer) ; +begin + set_pos(gf_file, n); gf_loc := n ; +end ; +@y +@p procedure find_gf_length ; +begin + gf_len := flength(gf_file); +end ; +@# +procedure move_to_byte(@!n : integer) ; +begin + b_seek(gf_file, n); gf_loc := n ; +end ; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [88+] add <Parse command line arguments> section and needed subsections +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@* System-dependent changes. +This section should be replaced, if necessary, by changes to the program +that are necessary to make \.{GFtoPK} work at a particular installation. +It is usually best to design your change file so that all changes to +previous sections preserve the section numbering; then everybody's version +will be consistent with the printed program. More extensive changes, +which introduce new sections, can be inserted here; then only the index +itself will get a new section number. +@^system dependencies@> +@y +@* System-dependent changes. +This section contains additions needed to make \.{GFtoPK} work under +{\mc UNIX}. The additions all deal with obtaining file names from +the invoking command line and if not all arguments are provided, +devising defaults for them. +@^system dependencies@> + +@<Parse command line arguments@>= +if (argc < 2) or (argc > 3) then begin@/ + write_ln('Usage: gftopk GF-file [PK-file]');@/ + goto final_end;@/ + end; +argv(1, gf_name);@/ +if (argc > 2) then@/ + argv(2, pk_name);@/ + +@ Here's a section to construct |pk_name| from |gf_name|, tacking on the +right extension from the magnification of the file. + +@<Generate |pk_name| ...@>= +j:=file_name_size;@/ +while (j > 1) and (gf_name[j] <> '/') do@/ + decr(j); +i:=j; +while (j > 1) do begin@/ + decr(j); pk_name[j] := gf_name[j]; + end; +while (i < file_name_size) and (gf_name[i] <> '.') and (gf_name[i] <> ' ') do begin@/ + pk_name[i] := gf_name[i];@/ + incr(i);@/ + end; +pk_name[i]:='.'; incr(i);@/ +size:=h_mag;@/ +j :=10000;@/ +startednumber:=false;@/ +while (j > 0) do begin@/ + k:=size div j;@/ + size := size mod j;@/ + j:=j div 10; + if startednumber or (k <> 0) or (j = 0) then begin@/ + pk_name[i] := chr(ord('0') + k); incr(i);@/ + startednumber := true;@/ + end;@/ + end;@/ +pk_name[i] := 'p'; incr(i);@/ +pk_name[i] := 'k'; incr(i);@/ +pk_name[i] := ' ';@/ +print_ln('[Output file named ''', pk_name:i-1, ''']');@/ + +@z + diff --git a/systems/knuth/local/mfware-sparc/gftopk_ext.c b/systems/knuth/local/mfware-sparc/gftopk_ext.c new file mode 100644 index 0000000000..5301fc90be --- /dev/null +++ b/systems/knuth/local/mfware-sparc/gftopk_ext.c @@ -0,0 +1,43 @@ +#include "h00vars.h" /* defines Pascal I/O structure */ + +#define namelength 100 /* should agree with gftopk.ch and gftype.ch */ + +bseek(filep,cnt) + register struct iorec *filep; + int cnt; +{ + register FILE *iop; /* stdio-style FILE pointer */ + + iop = filep->fbuf; + fseek(iop,(long)cnt,0); +} + +bool testreadaccess(fn) + char *fn; +{ + register char *p; + + fn[namelength-1] = ' '; + p = fn; + while (*p++ != ' '); + p--; + *p = '\0'; + if (access(fn,4)==0) { + *p = ' '; return(TRUE);} + else {*p = ' '; return(FALSE);} +} + +int flength(filep) + register struct iorec *filep; +{ + register FILE *iop; /* stdio-style FILE pointer */ + register long pos; /* current file position */ + register int len; /* the file length */ + + iop = filep->fbuf; + pos = ftell(iop); + fseek(iop,0L,2); + len = ftell(iop); + fseek(iop,pos,0); + return(len); +} diff --git a/systems/knuth/local/mfware-sparc/gftopk_ext.h b/systems/knuth/local/mfware-sparc/gftopk_ext.h new file mode 100644 index 0000000000..cd063b1cf1 --- /dev/null +++ b/systems/knuth/local/mfware-sparc/gftopk_ext.h @@ -0,0 +1,6 @@ +function flength(var f: bytefile):integer; + external; +procedure bseek(var f: bytefile; loc: integer); + external; +function testreadaccess(var fn: UNIXfilename):boolean; + external; diff --git a/systems/knuth/local/mfware-sparc/gftype.ch b/systems/knuth/local/mfware-sparc/gftype.ch new file mode 100644 index 0000000000..dc63dad049 --- /dev/null +++ b/systems/knuth/local/mfware-sparc/gftype.ch @@ -0,0 +1,430 @@ +% $Header: gftype.ch,v 2.2.1.4 86/01/27 15:43:41 richards Released $ + +% Change file for the GFtype processor, for use on Berkeley UNIX systems. + +% History: +% +% don upgraded to version 3.1 on 3/15/91 +% +% don added testreadaccess (to avoid core dump on bad GF file name) on 89/10/18 +% +% don made changes for version 3 and SunOS on 89/08/12 +% (I simplified things by borrowing from dvitype.ch) +% +% $Log: gftype.ch,v $ +% Revision 2.2.1.4 86/01/27 15:43:41 richards +% Changed: +% text_file type to "text" for Pyramid compiler, +% who doesn't believe packed array of char == text, and +% won't allow write('strings') to it! +% +% Revision 2.2.1.3 86/01/21 22:04:30 richards +% Changed: +% file_name_size and byte_file declaration to agree with binary I/O +% library updates; b_open_in() call to include path specifier +% +% Revision 2.2.1.2 86/01/21 15:54:21 richards +% Changed: +% interface to byte I/O again; now cur_loc is back to a variable, +% and b_set_ptr() saves addr of cur_loc so it can be kept in +% sync with files. b_file_loc() was called more frequently than +% I thought... +% +% Revision 2.2.1.1 86/01/20 22:06:53 richards +% Incorporate new Byte-I/O routines in place of fudging Pascal into +% reading bytes; for Pyramid .... +% +% Revision 2.2 85/10/18 23:31:09 richards +% Updated for GFtype Version 2.2 +% +% Revision 2.1 85/03/03 21:41:49 richards +% Updated to GF utilities distributed with MF Version 0.77 +% (New GF file format) +% +% Revision 2.0 84/12/16 22:42:52 richards +% Updated for GFtype Version 2.0 (New GF file format) +% +% Revision 1.2 84/12/06 02:35:40 richards +% Updated to GFtype Version 1.2; merged in changes from sdcarl!rusty +% +% Revision 0.0 84/11/10 02:13:19 richards +% Base version for GFtype 0.0 +% +% + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [0] WEAVE: print changes only +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +\pageno=\contentspagenumber \advance\pageno by 1 +@y +\pageno=\contentspagenumber \advance\pageno by 1 +\let\maybe=\iffalse +\def\title{GF$\,$\lowercase{type} changes for Berkeley {\mc UNIX}} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1] Change banner string +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d banner=='This is GFtype, Version 3.1' {printed when the program starts} +@y +@d banner=='This is GFtype, Version 3.1 for SunOS' + {printed when the program starts} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [2] Case statement default feature of SunOS Pascal +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d othercases == others: {default for cases not listed explicitly} +@y +@d othercases == otherwise {default for cases not listed explicitly} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3] Redirect GFtype output to correct output file +% depending on gfout_active value +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d print(#)==write(#) +@d print_ln(#)==write_ln(#) +@d print_nl==write_ln +@y +@d print(#)==begin if gfout_active then write(gftyout,#) else write(#) end +@d print_ln(#)==begin if gfout_active then write_ln(gftyout,#) + else write_ln(#) end +@d print_nl==begin if gfout_active then write_ln(gftyout) else write_ln end +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3] Change program header to standard input/output; include external header +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p program GF_type(@!gf_file,@!output); +label @<Labels in the outer block@>@/ +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +procedure initialize; {this procedure gets things started properly} + var i:integer; {loop index for initializations} + begin print_ln(banner);@/ + @<Set initial values@>@/ + end; +@y +@p program GF_type(@!input,@!output); +label @<Labels in the outer block@>@/ +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +@\@=#include "gftopk_ext.h"@>@\ +procedure initialize; {this procedure gets things started properly} + var i:integer; {loop index for initializations} + begin @<Set initial values@>@/ + @<Parse command line arguments@>; + end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [5] Add file_name_size to constants +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@<Constants...@>= +@!terminal_line_length=150; {maximum number of characters input in a single + line of input from the terminal} +@!line_length=79; {\\{xxx} strings will not produce lines longer than this} +@!max_row=79; {vertical extent of pixel image array} +@!max_col=79; {horizontal extent of pixel image array} +@y +@<Constants...@>= +@!terminal_line_length=150; {maximum number of characters input in a single + line of input from the terminal} +@!line_length=79; {\\{xxx} strings will not produce lines longer than this} +@!max_row=79; {vertical extent of pixel image array} +@!max_col=79; {horizontal extent of pixel image array} +@!file_name_size=100; {max length of file name on command line} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [7] Have abort append <nl> to end of msg +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d abort(#)==begin print(' ',#); jump_out; +@y +@d abort(#)==begin print_ln(' ',#); jump_out; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [20] Change definition of 'byte_file' to correct subrange +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +We shall stick to simple \PASCAL\ in this program, for reasons of clarity, +even if such simplicity is sometimes unrealistic. + +@<Types...@>= +@!eight_bits=0..255; {unsigned one-byte quantity} +@!byte_file=packed file of eight_bits; {files that contain binary data} +@y +On Berkeley {\mc UNIX}, we have to use |-128..127| for byte files, as +explained in the \TeX\ changes. + +@<Types...@>= +@!eight_bits=0..255; {unsigned one-byte quantity} +@!byte_file=packed file of -128..127; {files that contain binary data} +@!UNIX_file_name=packed array[1..file_name_size] of char; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [21] Add gf_name declaration +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The program deals with one binary file variable: |gf_file| is the main +input file that we are translating into symbolic form. + +@<Glob...@>= +@!gf_file:byte_file; {the stuff we are \.{GF}typing} +@y +@ The program deals with one binary file variable: |gf_file| is the main +input file that we are translating into symbolic form. +We also declare array |gf_name|, used to hold the name of |gf_file|. + +@<Glob...@>= +@!gf_file:byte_file; {the stuff we are \.{GF}typing} +@!gf_name: UNIX_file_name; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [22] Change to file opening +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|} +begin reset(gf_file); +@y +The local /PASCAL/ runtimes will dump core if the file isn't present. +We avoid that by using an external procedure. + +@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|} +begin if testreadaccess(gf_name) then reset(gf_file,gf_name) +else abort('Can''t read the GF file'); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [24] Use modified routines to access gf_file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p function get_byte:integer; {returns the next byte, unsigned} +var b:eight_bits; +begin if eof(gf_file) then get_byte:=0 +else begin read(gf_file,b); incr(cur_loc); get_byte:=b; + end; +end; +@# +function get_two_bytes:integer; {returns the next two bytes, unsigned} +var a,@!b:eight_bits; +begin read(gf_file,a); read(gf_file,b); +cur_loc:=cur_loc+2; +get_two_bytes:=a*256+b; +end; +@# +function get_three_bytes:integer; {returns the next three bytes, unsigned} +var a,@!b,@!c:eight_bits; +begin read(gf_file,a); read(gf_file,b); read(gf_file,c); +cur_loc:=cur_loc+3; +get_three_bytes:=(a*256+b)*256+c; +end; +@# +function signed_quad:integer; {returns the next four bytes, signed} +var a,@!b,@!c,@!d:eight_bits; +begin read(gf_file,a); read(gf_file,b); read(gf_file,c); read(gf_file,d); +cur_loc:=cur_loc+4; +if a<128 then signed_quad:=((a*256+b)*256+c)*256+d +else signed_quad:=(((a-256)*256+b)*256+c)*256+d; +end; +@y +@p function get_byte:integer; {returns the next byte, unsigned} +var b:-128..127; +begin if eof(gf_file) then get_byte:=0 +else begin read(gf_file,b); incr(cur_loc); + if b < 0 then get_byte := b + 256 else get_byte:=b; + end; +end; +@# +function signed_byte:integer; {returns the next byte, signed} +var b:-128..127; +begin read(gf_file,b); incr(cur_loc); +signed_byte:=b; +end; +@# +function get_two_bytes:integer; {returns the next two bytes, unsigned} +var a,b:integer; +begin a := get_byte; b := get_byte; +get_two_bytes:=a*256+b; +end; +@# +function get_three_bytes:integer; {returns the next three bytes, unsigned} +var a,@!b,@!c:integer; +begin a := get_byte; b := get_byte; c := get_byte; +get_three_bytes:=(a*256+b)*256+c; +end; +@# +function signed_quad:integer; {returns the next four bytes, signed} +var a,@!b,@!c,@!d:integer; +begin a := signed_byte; b := get_byte; c := get_byte; d := get_byte; +signed_quad:=((a*256+b)*256+c)*256+d +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [27] Set term_in and term_out to standard input/output +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The |input_ln| routine waits for the user to type a line at his or her +terminal; then it puts ASCII-code equivalents for the characters on that line +into the |buffer| array. The |term_in| file is used for terminal input, +and |term_out| for terminal output. +@^system dependencies@> + +@<Glob...@>= +@!buffer:array[0..terminal_line_length] of ASCII_code; +@!term_in:text_file; {the terminal, considered as an input file} +@!term_out:text_file; {the terminal, considered as an output file} +@y +@ The |input_ln| routine waits for the user to type a line at his or her +terminal; then it puts ASCII-code equivalents for the characters on that line +into the |buffer| array. The |term_in| file is used for terminal input, +and |term_out| for terminal output. +@^system dependencies@> + +@d term_in == input {standard input} +@d term_out == output {standard output} + +@<Glob...@>= +@!buffer:array[0..terminal_line_length] of ASCII_code; +@!gftyout: text_file; {output from program} +@!gfout_name: packed array[1..file_name_size] of char; {file name} +@!gfout_active: boolean; {true if |gftyout| is open and ready to write} +@!first_input: boolean; {true before the first call of |input_ln|} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [28] update_terminal becomes flush() +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d update_terminal == break(term_out) {empty the terminal output buffer} +@y +@d update_terminal == flush(term_out) {empty the terminal output buffer} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [29] eliminate reset() from input_ln +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p procedure input_ln; {inputs a line from the terminal} +var k:0..terminal_line_length; +begin update_terminal; reset(term_in); +if eoln(term_in) then read_ln(term_in); +k:=0; +while (k<terminal_line_length)and not eoln(term_in) do + begin buffer[k]:=xord[term_in^]; incr(k); get(term_in); + end; +buffer[k]:=" "; +end; +@y +@p procedure input_ln; {inputs a line from the terminal} +var k:0..terminal_line_length; +begin update_terminal; +if first_input then first_input:=false +else if eoln(term_in) then read_ln(term_in); +k:=0; +while (k<terminal_line_length)and not eoln(term_in) do + begin buffer[k]:=xord[term_in^]; incr(k); get(term_in); + end; +buffer[k]:=" "; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [31] eliminate rewrite() from dialog +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p procedure dialog; +label 1,2; +begin rewrite(term_out); {prepare the terminal for output} +write_ln(term_out,banner);@/ +@<Determine whether the user |wants_mnemonics|@>; +@<Determine whether the user |wants_pixels|@>; +@<Print all the selected options@>; +end; +@y +@p procedure dialog; +label 1,2; +begin +write_ln(term_out,banner);@/ +@<Determine whether the user |wants_mnemonics|@>; +@<Determine whether the user |wants_pixels|@>; +@<Print all the selected options@>; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [65] finish last line written to statistics (stdout) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +print('The file had ',total_chars:1,' character'); +if total_chars<>1 then print('s'); +print(' altogether.'); +@.The file had n characters...@> +final_end:end. +@y +print('The file had ',total_chars:1,' character'); +if total_chars<>1 then print('s'); +print_ln(' altogether.'); +@.The file had n characters...@> +final_end:end. +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [74,75,76] Add new code to parse command line arguments +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@* System-dependent changes. +This section should be replaced, if necessary, by changes to the program +that are necessary to make \.{GFtype} work at a particular installation. +It is usually best to design your change file so that all changes to +previous sections preserve the section numbering; then everybody's version +will be consistent with the printed program. More extensive changes, +which introduce new sections, can be inserted here; then only the index +itself will get a new section number. +@^system dependencies@> +@y +@* System-dependent changes. +This section contains additions to \.{GFtype} necessary to integrate it +into the {\mc UNIX} environment. The primary addition is a section to +parse command line arguments and put file names into their correct +variables, if needed. +@^system dependencies@> + +@ The command line issued to start \.{GFtype} should also contain the +names of the input (GF) file, and optionally, the name of an output +file to receive the output from \.{GFtype}. This segment decodes +the command line, and saves the file names in the appropriate variables. +@^system dependencies@> + +@<Parse command...@>= +if (argc < 2) or (argc > 3) then + begin print_ln('Usage: gftype GFfile [outputfile]');@/ + goto final_end; { we will be unstructured just this once } + end; +argv(1, gf_name); +if argc > 2 then + begin argv(2, gfout_name);@/ + rewrite(gftyout, gfout_name);@/ + gfout_active := true;@/ + print_ln(banner);@/ + end + +@ We also need to initialize the values of the new boolean variables +we introduced. + +@<Set initial ...@>= +gfout_active:=false; +first_input:=true; +@z + diff --git a/systems/knuth/local/mfware-sparc/mft.ch b/systems/knuth/local/mfware-sparc/mft.ch new file mode 100644 index 0000000000..9f4d1e0821 --- /dev/null +++ b/systems/knuth/local/mfware-sparc/mft.ch @@ -0,0 +1,534 @@ +% Change file for the MFT processor, for use on Berkeley UNIX systems. +% This file was created by Pierre MacKay, and is based on the +% change file for WEAVE written by Howard Trickey and Pavel Curtis. + +% History: +% 6/09/86--WEAVE change file copied in entirety and renamed to +% refer to MFT. +% +% 10/16/89 modified by don for SunOS, brought up to version 2.0 +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [0] MFT: print changes only +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +\pageno=\contentspagenumber \advance\pageno by 1 +@y +\pageno=\contentspagenumber \advance\pageno by 1 +\let\maybe=\iffalse +\def\title{MFT changes for Berkeley {\mc UNIX}} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [2] Change banner message +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d banner=='This is MFT, Version 2.0' +@y +@d banner=='This is MFT, Version 2.0 for SunOS' +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3] add input and output, remove other files, add ref to scan_args, +% [3] and #include external definition for exit(), etc. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +program MFT(@!mf_file,@!change_file,@!style_file,@!tex_file); +label end_of_MFT; {go here to finish} +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +@<Error handling procedures@>@/ +@y +program MFT(@!input,@!output); +label end_of_MFT; {go here to finish} +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +@\ +@=#include "mft_ext.h"@> +@\@/ +@<Error handling procedures@>@/ +@<|scan_args| procedure@>@/ +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [4] compiler options +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@{@&$C+,A+,D-@} {range check, catch arithmetic overflow, no debug overhead} +@y +@=(*$C-*)@> {no range check} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [7] Fix others: +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d othercases == others: {default for cases not listed explicitly} +@y +@d othercases == otherwise {SunOS Pascal default cases} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [13] declare UNIX_file_name type +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!text_file=packed file of text_char; +@y +@!text_file=packed file of text_char; +@!UNIX_file_name = packed array[1..max_file_name_length] of char; +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [20] terminal output: use standard i/o +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d print(#)==write(term_out,#) {`|print|' means write on the terminal} +@y +@d term_out==output +@d print(#)==write(term_out,#) {`|print|' means write on the terminal} +@z + +@x +@<Globals...@>= +@!term_out:text_file; {the terminal as an output file} +@y + +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [21] init terminal +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ Different systems have different ways of specifying that the output on a +certain file will appear on the user's terminal. Here is one way to do this +on the \PASCAL\ system that was used in \.{WEAVE}'s initial development: +@^system dependencies@> + +@<Set init...@>= +rewrite(term_out,'TTY:'); {send |term_out| output to the terminal} +@y +@ Different systems have different ways of specifying that the output on a +certain file will appear on the user's terminal. +@^system dependencies@> + +@<Set init...@>= +; {nothing need be done} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [22] flush terminal buffer +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d update_terminal == break(term_out) {empty the terminal output buffer} +@y +@d update_terminal == flush(term_out) {empty the terminal output buffer} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [24] open input files +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The following code opens the input files. Since these files were listed +in the program header, we assume that the \PASCAL\ runtime system has +already checked that suitable file names have been given; therefore no +additional error checking needs to be done. +@^system dependencies@> + +@p procedure open_input; {prepare to read the inputs} +begin reset(mf_file); reset(change_file); reset(style_file); +end; +@y +@ The following code opens the input files. +This is called after |scan_args| has filled the file name variables +appropriately. +We use this opportunity, to define some constants related to file opening +and the use of paths. These constants are repeated in mft_ext.c and +must match the values given there. + +@d read_access_mode=4 {``read'' mode for |test_access|} +@d write_access_mode=2 {``write'' mode for |test_access|} + +@d no_file_path=0 {no path searching should be done} +@d good_file_path=3 {path specifier for style files} + +@^system dependencies@>@^changes for Berkeley {\mc UNIX}@> + +@p procedure open_input; {prepare to read inputs} +var i:integer; +begin if test_read_access(mf_name) then + begin reset(mf_file,mf_name); + if test_read_access(change_name) then + begin reset(change_file,change_name); + if test_access(read_access_mode,good_file_path) then + reset(style_file,real_name_of_file) + else begin i:=1; + while real_name_of_file[i]<>chr(0) do incr(i); + print_nl('! Can''t open the style file ',real_name_of_file:i); + mark_fatal; + jump_out; + end; + end + else begin i:=1; change_name[max_file_name_length]:=' '; + while change_name[i]<>' ' do incr(i); + print_nl('! Can''t open the change file ',change_name:i); + mark_fatal; jump_out; + end; + end +else begin i:=1; mf_name[max_file_name_length]:=' '; + while mf_name[i]<>' ' do incr(i); + print_nl('! Can''t open the METAFONT source file ',mf_name:i); + mark_fatal; jump_out; + end; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [26] opening \TeX\ file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The following code opens |tex_file|. +Since this file was listed in the program header, we assume that the +\PASCAL\ runtime system has checked that a suitable external file name has +been given. +@^system dependencies@> + +@<Set init...@>= +rewrite(tex_file); +@y +@ The following code opens |tex_file|. +The |scan_args| procedure is used to set up |tex_name| as required. +@^system dependencies@> + +@<Set init...@>= +scan_args; +rewrite(tex_file,tex_name); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [28] faster input_ln +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p function input_ln(var f:text_file):boolean; + {inputs a line or returns |false|} +var final_limit:0..buf_size; {|limit| without trailing blanks} +begin limit:=0; final_limit:=0; +if eof(f) then input_ln:=false +else begin while not eoln(f) do + begin buffer[limit]:=xord[f^]; get(f); + incr(limit); + if buffer[limit-1]<>" " then final_limit:=limit; + if limit=buf_size then + begin while not eoln(f) do get(f); + decr(limit); {keep |buffer[buf_size]| empty} + if final_limit>limit then final_limit:=limit; + print_nl('! Input line too long'); loc:=0; error; +@.Input line too long@> + end; + end; + read_ln(f); limit:=final_limit; input_ln:=true; + end; +end; +@y +With Berkeley {\mc UNIX} we call an external C procedure, |line_read|. +That routine fills |buffer| from 0 onwards with the |xord|'ed values +of the next line, setting |limit| appropriately (ignoring trailing +blanks). +It will stop if |limit=buf_size|, and the following will cause an error +message. +Note: for bootstrapping purposes it is all right to use the original form +of |input_ln|; it will just run slower. + +@p function input_ln(var f:text_file):boolean; + {inputs a line or returns |false|} +begin limit:=0; +if test_eof(f) then input_ln:=false +else begin line_read(f); + if limit=buf_size then + begin + decr(limit); {keep |buffer[buf_size]| empty} + print_nl('! Input line too long'); loc:=0; error; +@.Input line too long@> + end; + input_ln:=true; + end; +end; +@z + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [87] faster flush_buffer +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +done: for k:=1 to j do write(tex_file,xchr[out_buf[k]]); +@y +done: linewrite(tex_file,j); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [112] print newline at end of run and exit based upon value of history +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +Let's put it all together now: \.{MFT} starts and ends here. +@^system dependencies@> + +@y +Let's put it all together now: \.{MFT} starts and ends here. +@^system dependencies@> + +@d UNIXexit==e@&x@&i@&t + +@z + +@x +end. +@y +new_line; +if (history <> spotless) and (history <> harmless_message) then + UNIXexit(1) +else + UNIXexit(0); +end. +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [114] system dependent changes--the scan_args procedure +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@* System-dependent changes. +This module should be replaced, if necessary, by changes to the program +that are necessary to make \.{MFT} work at a particular installation. +It is usually best to design your change file so that all changes to +previous modules preserve the module numbering; then everybody's version +will be consistent with the printed program. More extensive changes, +which introduce new modules, can be inserted here; then only the index +itself will get a new module number. +@^system dependencies@> +@y +@* System-dependent changes. +The user calls \.{MFT} with arguments on the command line. +These are either file names or flags (beginning with '-'). +The following globals are for communicating the user's desires to the rest +of the program. The various |file_name| variables contain strings with +the full names of those files, as UNIX knows them. + +The only flags that affect \.{MFT} are |'-c'| and |'-s'| whose +status is kept in |no_change| and |no_style|. + +@d max_file_name_length==100 + +@<Globals...@>= +@!mf_name,@!change_name,@!style_name,@!tex_name, + @!real_name_of_file: UNIX_file_name; +@!no_change,no_style:boolean; + +@ The |scan_args| procedure looks at the command line arguments and sets +the |file_name| variables accordingly. + +At least one file name must be present as the first argument: +the \.{mf} file. It may have +an extension, or it may omit it to get |'.mf'| added. +If there is only one file name, the output file name is formed by replacing +the \.{mf} file name extension by |'.tex'|. +Thus, the command line \.{mft foo} implies the use of the \METAFONT\ +input file \.{foo.mf} and the output file \.{foo.tex}. +If this style of command line, with only one argument is used, +the default style file, |plain.mft|, will be used to provide +minimal formatting. + +An argument beginning with a minus sign is a flag. +Any letters following the minus sign may cause global +flag variables to be set. +Currently, a |c| means that there is a change file, and an |s| means +that there is a style file. The auxiliary files must +of course appear in the same order as the flags. For example, +the flag -sc must be followed by the name of the |style_file| first, +and then the name of the |change_file|. + +@<|scan_args|...@>= +procedure scan_args; +var dot_pos,i,a: integer; {indices} +@!which_file_next: char; +@!fname: array[1..max_file_name_length-5] of char; {temporary argument holder} +@!found_mf,@!found_change,found_style: boolean; {|true| when those + file names have been seen} +begin +setpaths; {Get path for style file from \.{MFINPUTS}} +found_mf:=false; +@<Set up null change file@>; found_change:=true; {Default to no change file} +@<Set up plain style file@>; found_style:=true; {Default to plain style file} +for a:=1 to argc-1 do begin + argv(a,fname); {put argument number |a| into |fname|} + if fname[1]<>'-' then begin + if not found_mf then + @<Get |mf_name| from |fname|, and set up |tex_name@> + else + if not found_change then begin + if which_file_next <> 's' then begin + @<Get |change_name| from |fname|@>; + which_file_next := 's' + end + else @<Get |style_name| from |fname|@> + end + else if not found_style then begin + if which_file_next = 's' then begin + @<Get |style_name| from |fname|@>; + which_file_next := 'c' + end; + end + else @<Print usage error message and quit@>; + end + else @<Handle flag argument in |fname|@>; + end; +if not found_mf then @<Print usage error message and quit@>; +end; + +@ Use all of |fname| for the |mf_name| if there is a |'.'| in it, +otherwise add |'.mf'|. +The \TeX\ file name comes from adding things after the dot. +The |argv| procedure will not put more than |max_file_name_length-5| +characters into |fname|, and this leaves enough room in the |file_name| +variables to add the extensions. + +The end of a file name is marked with a |' '|, the convention assumed by +the |reset| and |rewrite| procedures. + +@<Get |mf_name|...@>= +begin +dot_pos:=-1; +i:=1; +while (fname[i]<>' ') and (i<=max_file_name_length-5) do begin + mf_name[i]:=fname[i]; + if fname[i]='.' then dot_pos:=i; + incr(i); + end; +if dot_pos=-1 then begin + dot_pos:=i; + mf_name[dot_pos]:='.'; + mf_name[dot_pos+1]:='m'; + mf_name[dot_pos+2]:='f'; + mf_name[dot_pos+3]:=' '; + end +else mf_name[i]:=' '; +for i:=1 to dot_pos do begin + tex_name[i]:=mf_name[i]; + end; +tex_name[dot_pos+1]:='t'; +tex_name[dot_pos+2]:='e'; +tex_name[dot_pos+3]:='x'; +tex_name[dot_pos+4]:=' '; +which_file_next := 'z'; +found_mf:=true; +end + +@ Use all of |fname| for the |change_name| if there is a |'.'| in it, +otherwise add |'.ch'|. + +@<Get |change_name|...@>= +begin +dot_pos:=-1; +i:=1; +while (fname[i]<>' ') and (i<=max_file_name_length-5) +do begin + change_name[i]:=fname[i]; + if fname[i]='.' then dot_pos:=i; + incr(i); + end; +if dot_pos=-1 then begin + dot_pos:=i; + change_name[dot_pos]:='.'; + change_name[dot_pos+1]:='c'; + change_name[dot_pos+2]:='h'; + change_name[dot_pos+3]:=' '; + end +else change_name[i]:=' '; +which_file_next := 'z'; +found_change:=true; +end + +@ Use all of |fname| for the |style_name| if there is a |'.'| in it, +otherwise add |'.mft'|. + + +@<Get |style_name|...@>= +begin +dot_pos:=-1; +i:=1; +while (fname[i]<>' ') and (i<=max_file_name_length-5) +do begin + style_name[i]:=fname[i]; + if fname[i]='.' then dot_pos:=i; + incr(i); + end; +if dot_pos=-1 then begin + dot_pos:=i; + style_name[dot_pos]:='.'; + style_name[dot_pos+1]:='m'; + style_name[dot_pos+2]:='f'; + style_name[dot_pos+3]:='t'; + style_name[dot_pos+4]:=' '; + end +else style_name[i]:=' '; +which_file_next := 'z'; +found_style:=true; +end + +@ + +@<Set up null change file@>= +begin + change_name[1]:='/'; + change_name[2]:='d'; + change_name[3]:='e'; + change_name[4]:='v'; + change_name[5]:='/'; + change_name[6]:='n'; + change_name[7]:='u'; + change_name[8]:='l'; + change_name[9]:='l'; + change_name[10]:=' '; +end + +@ + +@<Set up plain style file@>= +begin + style_name[1]:='p'; + style_name[2]:='l'; + style_name[3]:='a'; + style_name[4]:='i'; + style_name[5]:='n'; + style_name[6]:='.'; + style_name[7]:='m'; + style_name[8]:='f'; + style_name[9]:='t'; + style_name[10]:=' '; +end + +@ + +@<Handle flag...@>= +begin +i:=2; +while (fname[i]<>' ') and (i<=max_file_name_length-5) do begin + if fname[i]='c' then begin found_change:=false; + if which_file_next <> 's' then which_file_next := 'c' + end + else if fname[i]='s' then begin found_style:=false; + if which_file_next <> 'c' then which_file_next := 's' + end + else print_nl('Invalid flag ',xchr[xord[fname[i]]]); + incr(i); + end; +end + +@ + +@<Print usage error message and quit@>= +begin +print_nl('! Usage: mft file[.mf] [-cs] [change[.ch]] [style[.mft]] '); +error; mark_fatal; +jump_out; +end + +@z diff --git a/systems/knuth/local/mfware-sparc/mft_ext.c b/systems/knuth/local/mfware-sparc/mft_ext.c new file mode 100644 index 0000000000..b8fe8d31e6 --- /dev/null +++ b/systems/knuth/local/mfware-sparc/mft_ext.c @@ -0,0 +1,249 @@ +/* External procedures for MFT*/ +/* (culled from weavext.c and ext.c for WEAVE and TeX) */ +/* Written by: H. Trickey, 11/17/83 */ +/* (modified for 8-bit input by don on 10/16/89) */ + +/* Note: these procedures aren't necessary; the default input_ln and + * flush_buffer routines in tangle/weave work fine on UNIX. + * However a very big time improvement is achieved by using these. + * + * These procedures are the same as for tangle, except for a slight offset + * in which characters are output from outbuf in linewrite. + */ + +#define BUF_SIZE 100 /* should agree with mft.web */ + +#include "mfpaths.h" /* defines default MFINPUTS path */ +#include "h00vars.h" /* defines Pascal I/O structure */ + +extern short buffer[]; /* 0..BUF_SIZE. Input goes here */ +extern short outbuf[]; /* 0..OUT_BUF_SIZE. Output from here */ +extern short xord[]; +extern char xchr[]; /* character translation arrays */ +extern char limit; /* index into buffer. Note that limit + is 0..buf_size (= 0..100) in mft.web; this + differs from the definition in weave.web */ + +/* + * lineread reads from the Pascal text file with iorec pointer filep + * into buffer[0], buffer[1],..., buffer[limit-1] (and + * setting "limit"). + * Characters are read until a newline is found (which isn't put in the + * buffer) or until the next character would go into buffer[BUF_SIZE]. + * And trailing blanks are to be ignored, so limit is really set to + * one past the last non-blank. + * The characters need to be translated, so really xord[c] is put into + * the buffer when c is read. + * If end-of-file is encountered, the funit field of *filep is set + * appropriately. + */ +lineread(filep) +struct iorec *filep; +{ + register c; + register short *cs; /* pointer into buffer where next char goes */ + register short *cnb; /* last non-blank character input */ + register FILE *iop; /* stdio-style FILE pointer */ + register int l; /* how many chars allowed before buffer overflow */ + + iop = filep->fbuf; + cnb = cs = &(buffer[0]); + l = BUF_SIZE; + /* overflow when next char would go into buffer[BUF_SIZE] */ + while (--l>=0 && (c = getc(iop)) != EOF && c!='\n') + if((*cs++ = xord[c])!=' ') cnb = cs; + if (c == EOF) + filep->funit |= EOFF; /* we hit end-of-file */ + limit = cnb-&(buffer[0]); +} + +/* + * linewrite writes to the Pascal text file with iorec pointer filep + * from outbuf[1], outbuf[1],..., outbuf[cnt]. + * (Note the offset of indices vis a vis the tangext version of this.) + * Translation is done, so that xchr[c] is output instead of c. + */ + linewrite(filep,cnt) + struct iorec *filep; + int cnt; + { + register FILE *iop; /* stdio-style FILE pointer */ + register short *cs; /* pointer to next character to output */ + register int l; /* how many characters left to output */ + + iop = filep->fbuf; + cs = &(outbuf[1]); + l = cnt; + while (--l>=0) putc(xchr[*cs++],iop); +} + +/* +** testeof(filep) +** +** Test whether or not the Pascal text file with iorec pointer filep +** has reached end-of-file (when the only I/O on it is done with +** lineread, above). +** We may have to read the next character and unget it to see if perhaps +** the end-of-file is next. +*/ + +bool +testeof(filep) +register struct iorec *filep; +{ + register char c; + register FILE *iop; /* stdio-style FILE pointer */ + if (filep->funit & EOFF) + return(TRUE); + else { /* check to see if next is EOF */ + iop = filep->fbuf; + c = getc(iop); + if (c == EOF) + return(TRUE); + else { + ungetc(c,iop); + return(FALSE); + } + } +} +/* and now, some routines to implement paths for file names. These routines + are taken from Howard Trickey's port of dvitype (2/19/84). Howard + adapted them from his port of TeX, ext.c */ + +char *inputpath; + +char *getenv(); + +/* + * setpaths is called to set up the pointer inputpath + * as follows: if the user's environment has a value for TEXINPUTS + * then use it; otherwise, use defaultinputpath. + */ +setpaths() +{ + register char *envpath; + + if ((envpath = getenv("TEXINPUTS")) != NULL) + inputpath = envpath; + else + inputpath = defaultinputpath; +} + +#define maxfilenamelength 100 /* should agree with mft.ch */ +extern char stylename[],realnameoffile[]; /* these have size namelength */ + +/* + * testaccess(amode,filepath) + * + * Test whether or not the file whose name is in the global curname + * can be opened for reading (if mode=READACCESS) + * or writing (if mode=WRITEACCESS). +* [the code here isn't as general as it should be ... it assumes that stylefile +* is the only file name of interest! Maybe I'll fix this some day -- don] + * + * The filepath argument is one of the ...FILEPATH constants defined below. + * If the filename given in curname does not begin with '/', we try + * prepending all the ':'-separated areanames in the appropriate path to the + * filename until access can be made, if it ever can. + * + * The realnameoffile global array will contain the name that yielded an + * access success. + */ + +/* note that corresponding constants are defined in mft.ch */ + +#define READACCESS 4 +#define WRITEACCESS 2 + +#define NOFILEPATH 0 +#define GOODFILEPATH 3 + +bool +testaccess(amode,filepath) + int amode,filepath; +{ + register bool ok; + register char *p; + char *curpathplace; + int f; + + switch(filepath) { + case NOFILEPATH: curpathplace = NULL; break; + case GOODFILEPATH: curpathplace = inputpath; break; + } + if (stylename[0]=='/') /* file name has absolute path */ + curpathplace = NULL; + do { + packrealnameoffile(&curpathplace); + if (amode==READACCESS) + /* use system call "access" to see if we could read it */ + if (access(realnameoffile,READACCESS)==0) ok = TRUE; + else ok = FALSE; + else { + /* WRITEACCESS: use creat to see if we could create it, but close + the file again if we're OK, to let pc open it for real */ + f = creat(realnameoffile,0666); + if (f>=0) ok = TRUE; + else ok = FALSE; + if (ok) + close(f); + } + } while (!ok && curpathplace != NULL); + if (ok) { /* pad realnameoffile with blanks, as Pascal wants */ + for (p = realnameoffile; *p != '\0'; p++) + /* nothing: find end of string */ ; + while (p < &(realnameoffile[maxfilenamelength])) + *p++ = ' '; + } + return (ok); +} + +/* + * packrealnameoffile(cpp) makes realnameoffile contain the directory at *cpp, + * followed by '/', followed by the characters in stylename up until the + * first blank there, and finally a '\0'. The cpp pointer is left pointing + * at the next directory in the path. + * But: if *cpp == NULL, then we are supposed to use stylename as is. + */ +packrealnameoffile(cpp) + char **cpp; +{ + register char *p,*realname; + + realname = realnameoffile; + if ((p = *cpp)!=NULL) { + while ((*p != ':') && (*p != '\0')) { + *realname++ = *p++; + if (realname == &(realnameoffile[maxfilenamelength-1])) + break; + } + if (*p == '\0') *cpp = NULL; /* at end of path now */ + else *cpp = p+1; /* else get past ':' */ + *realname++ = '/'; /* separate the area from the name to follow */ + } + /* now append stylename to realname... */ + p = stylename; + while (*p != ' ') { + if (realname >= &(realnameoffile[maxfilenamelength-1])) { + fprintf(stderr,"! Full file name is too long\n"); + break; + } + *realname++ = *p++; + } + *realname = '\0'; +} + +bool testreadaccess(fn) + char *fn; +{ + register char *p; + + fn[maxfilenamelength-1] = ' '; + p = fn; + while (*p++ != ' '); + p--; + *p = '\0'; + if (access(fn,4)==0) { + *p = ' '; return(TRUE);} + else {*p = ' '; return(FALSE);} +} diff --git a/systems/knuth/local/mfware-sparc/mft_ext.h b/systems/knuth/local/mfware-sparc/mft_ext.h new file mode 100644 index 0000000000..85090d43e6 --- /dev/null +++ b/systems/knuth/local/mfware-sparc/mft_ext.h @@ -0,0 +1,16 @@ +procedure exit(x : integer); + external; +procedure lineread(var f:textfile); + external; +procedure linewrite(var f:textfile; cnt:integer); + external; +function testeof(var f:textfile):boolean; + external; +(* now, some routines to implement paths for file names. These are borrowed + from Howard Trickey's dvitype *) +procedure setpaths; + external; +function testaccess(accessmode:integer; filepath:integer): boolean; + external; +function testreadaccess(var f:UNIXfilename):boolean; + external; diff --git a/systems/knuth/local/mfware-sparc/pktype.ch b/systems/knuth/local/mfware-sparc/pktype.ch new file mode 100644 index 0000000000..0d8e605ca1 --- /dev/null +++ b/systems/knuth/local/mfware-sparc/pktype.ch @@ -0,0 +1,241 @@ +% Change file for the PKtype processor, for use on Berkeley UNIX systems. + +% created by don on 21 Oct 1989 based on GFtype.ch +% brought up to version 2.3 by don on 18 Nov 89 + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [0] WEAVE: print changes only +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +\pageno=\contentspagenumber \advance\pageno by 1 +@y +\pageno=\contentspagenumber \advance\pageno by 1 +\let\maybe=\iffalse +\def\title{PK$\,$\lowercase{type} changes for Berkeley {\mc UNIX}} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [2] Change banner string +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d banner=='This is PKtype, Version 2.3' {printed when the program starts} +@y +@d banner=='This is PKtype, Version 2.3 for SunOS' + {printed when the program starts} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3] Case statement default feature of SunOS Pascal +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d othercases == others: {default for cases not listed explicitly} +@y +@d othercases == otherwise {default for cases not listed explicitly} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [4] Redirect PKtype output to correct output file +% depending on pkout_active value (consistent with GFtype) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d print_ln(#)==write_ln(output,#) +@d print(#)==write(output,#) +@d t_print_ln(#)==write_ln(typ_file,#) +@d t_print(#)==write(typ_file,#) +@y +@d print_ln(#)==if pkout_active then write_ln(typ_file,#)@+else write_ln(#) +@d print(#)==if pkout_active then write(typ_file,#)@+else write(#) +@d t_print_ln==print_ln +@d t_print==print +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [4] Include external header and parse the command line +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +var @<Globals in the outer block@>@/ +procedure initialize; {this procedure gets things started properly} + var i:integer; {loop index for initializations} + begin print_ln(banner);@/ + @<Set initial values@>@/ + end; +@y +var @<Globals in the outer block@>@/ +@\@=#include "gftopk_ext.h"@>@\ +procedure initialize; {this procedure gets things started properly} + var i:integer; {loop index for initializations} + begin @<Set initial values@>@/ + @<Parse command line arguments@>; + end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [6] Make name_size match the external C routine +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!name_length=80; {maximum length of a file name} +@y +@!name_length=100; {maximum length of a file name} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [7] Have abort print only once +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d abort(#)==begin print_ln(' ',#); t_print_ln(' ',#); jump_out; end +@y +@d abort(#)==begin print_ln(' ',#); jump_out; end +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [30] Change definition of 'byte_file' to correct subrange +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!byte_file=packed file of eight_bits ; {for packed file words} +@y +@!byte_file=packed file of -128..127; {files that contain binary data} +@!UNIX_file_name=packed array[1..name_length] of char; +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [32] Change to file opening +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +specifies the file name. If |eof(f)| is true immediately after +|reset(f,s)| has acted, we assume that no file named |s| is accessible. +@^system dependencies@> + +@p procedure open_pk_file; {prepares the input for reading} +begin reset(pk_file,pk_name); +@y +specifies the file name. + +The local /PASCAL/ runtimes will dump core if the file isn't present. +We avoid that by using an external procedure. +@^system dependencies@> + +@p procedure open_pk_file; {prepares the input for reading} +begin if testreadaccess(pk_name) then reset(pk_file,pk_name) +else abort('Can''t read the PK file'); +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [33] Slight change needed by fussy Pascal compiler +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!pk_name,@!typ_name:packed array[1..name_length] of char; {name of input + and output files} +@y +@!pk_name,@!typ_name:UNIX_file_name; {name of input and output files} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [34] Use modified routine to access pk_file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p function pk_byte : eight_bits ; +var temp : eight_bits ; +begin + temp := pk_file^ ; + get(pk_file) ; + incr(pk_loc) ; + pk_byte := temp ; +@y +@p function pk_byte : eight_bits ; +var temp : -128..127; +begin + temp := pk_file^ ; + get(pk_file) ; + incr(pk_loc) ; + if temp<0 then pk_byte:=temp+256 @+else pk_byte := temp ; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [35] Don't open the output file twice +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +open_typ_file ; +t_print_ln(banner) ; +@y +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [53--54] Use command line instead of dialog +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@* Terminal communication. +We must get the file names and determine whether input is to be in +hexadecimal or binary. To do this, we use the standard input path +name. We need a procedure to flush the input buffer. For most systems, +this will be an empty statement. For other systems, a |print_ln| will +provide a quick fix. We also need a routine to get a line of input from +the terminal. On some systems, a simple |read_ln| will do. Finally, +a macro to print a string to the first blank is required. + +@d flush_buffer == begin end +@d get_line(#) == if eoln(input) then read_ln(input) ; + i := 1 ; + while not (eoln(input) or eof(input)) do begin + #[i] := input^ ; + incr(i) ; + get(input) ; + end ; + #[i] := ' ' + +@ @p procedure dialog ; +var i : integer ; {index variable} +buffer : packed array [1..name_length] of char; {input buffer} +begin + for i := 1 to name_length do begin + typ_name[i] := ' ' ; + pk_name[i] := ' ' ; + end; + print('Input file name: ') ; + flush_buffer ; + get_line(pk_name) ; + print('Output file name: ') ; + flush_buffer ; + get_line(typ_name) ; +end ; +@y +@* Command line parsing. +The command line issued to start \.{PKtype} should also contain the +names of the input (PK) file, and optionally, the name of an output +file to receive the output from \.{PKtype}. This segment decodes +the command line, and saves the file names in the appropriate variables. +@^system dependencies@> + +@d dialog== {we omit the dialog} + +@<Parse command...@>= +if (argc < 2) or (argc > 3) then + begin print_ln('Usage: pktype PKfile [outputfile]');@/ + goto final_end; { we will be unstructured just this once } + end; +argv(1, pk_name); +if argc > 2 then + begin argv(2, typ_name);@/ + rewrite(typ_file,typ_name);@/ + pkout_active := true;@/ + write_ln(banner); {standard output gets only this} + end; +print_ln(banner) + +@ @<Glob...@>= +@!pkout_active: boolean; {has the |typ_file| been opened?} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [56] Final touchup +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@* System-dependent changes. +This section should be replaced, if necessary, by changes to the program +that are necessary to make \.{PKtype} work at a particular installation. +Any additional routines should be inserted here. +@^system dependencies@> +@y +@* System-dependent changes. +This section should be replaced, if necessary, by changes to the program +that are necessary to make \.{PKtype} work at a particular installation. +Any additional routines should be inserted here. +@^system dependencies@> + +We need to initialize the value of the new boolean variable that +we introduced. + +@<Set initial ...@>= +pkout_active:=false; +@z + diff --git a/systems/knuth/local/mfware-sparc/pktype.web b/systems/knuth/local/mfware-sparc/pktype.web new file mode 100644 index 0000000000..eac85ee36f --- /dev/null +++ b/systems/knuth/local/mfware-sparc/pktype.web @@ -0,0 +1,1158 @@ +% PKtype.web +% +% PKtype verifies the correctness of a PK file. +% +% Preliminary 0.0 version: May, 1985 +% First release, 0.9 version: 8 May 1985 +% Updated to reflect new pk format, 2.0 version: 25 July 1985 +% Updated again for new pk format, 2.1 version: 15 August 1985 +% Docmentation updated, 2.2 version: 17 November 1987 +% +% slight editing to correspond with MFware report -- don, 21 Oct 89 +% additional editing suggested by P Breitenlohner -- don, 18 Nov 89 +% Corrected two typos -- 21 Dec 96 (don) + +\def\versiondate{18 November 1989} +% +\def\hang{\hangindent 3em\noindent\ignorespaces} +\font\ninerm=cmr9 +\font\logo=logo10 % font used for the METAFONT logo +\def\MF{{\logo META}\-{\logo FONT}} +\def\PASCAL{Pascal} +\def\tamu{Texas A\char38 M} +\def\(#1){} % this is used to make section names sort themselves better +\def\9#1{} % this is used for sort keys in the index +\def\title{PKtype} +\def\contentspagenumber{0} +\def\topofcontents{\null + \def\titlepage{F} % include headline on the contents page + \def\rheader{\mainfont\hfil \contentspagenumber} + \vfill + \centerline{\titlefont The {\ttitlefont PKtype} processor} + \vskip 15pt + \centerline{(Version 2.3, \versiondate)} + \vfill} +\def\botofcontents{\vfill + \centerline{\hsize 5in\baselineskip9pt + \vbox{\ninerm\noindent + The preparation of this report + was supported in part by the National Science + Foundation under grants IST-8201926 and MCS-8300984, + and by the System Development Foundation. `\TeX' is a + trademark of the American Mathematical Society.}}} +\pageno=\contentspagenumber \advance\pageno by 1 + +@* Introduction. +This program reads a \.{PK} file, verifies that it is in the correct +format, and writes it in textual format. + +@ The |banner| string defined here should be changed whenever \.{PKtype} +gets modified. + +@d banner=='This is PKtype, Version 2.3' {printed when the program starts} + +@ This program is written in standard \PASCAL, except where it is necessary +to use extensions; for example, \.{PKtype} must read files whose names +are dynamically specified, and that would be impossible in pure \PASCAL. + +@d othercases == others: {default for cases not listed explicitly} +@d endcases == @+end {follows the default case in an extended |case| statement} +@f othercases == else +@f endcases == end + +@ Both the input and output come from binary files. On line interaction +is handled through \PASCAL's standard |input| and |output| files. Two macros +are used to write to the type file, so this output can easily be redirected. + +@d print_ln(#)==write_ln(output,#) +@d print(#)==write(output,#) +@d t_print_ln(#)==write_ln(typ_file,#) +@d t_print(#)==write(typ_file,#) + +@p program PKtype(@!input,@!output); +label @<Labels in the outer block@>@/ +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +procedure initialize; {this procedure gets things started properly} + var i:integer; {loop index for initializations} + begin print_ln(banner);@/ + @<Set initial values@>@/ + end; + +@ If the program has to stop prematurely, it goes to the +`|final_end|'. + +@d final_end=9999 {label for the end of it all} + +@<Labels...@>=final_end; + +@ These constants determine the maximum length of a file name and the length +of the terminal line, as well as the widest character that can be translated. +@^system dependencies@> + +@<Constants...@>= +@!name_length=80; {maximum length of a file name} +@!terminal_line_length=132; {maximum length of an input line} + +@ Here are some macros for common programming idioms. + +@d incr(#) == #:=#+1 {increase a variable by unity} +@d decr(#) == #:=#-1 {decrease a variable by unity} +@d do_nothing == {empty statement} + +@ It is possible that a malformed packed file (heaven forbid!) or some other +error might be detected by this program. Such errors might occur in a deeply +nested procedure, so the procedure called |jump_out| has been added to transfer +to the very end of the program with an error message. + +@d abort(#)==begin print_ln(' ',#); t_print_ln(' ',#); jump_out; end + +@p procedure jump_out; +begin goto final_end; +end; + +@* The character set. +Like all programs written with the \.{WEB} system, \.{PKtype} can be +used with any character set. But it uses ASCII code internally, because +the programming for portable input-output is easier when a fixed internal +code is used. + +The next few sections of \.{PKtype} have therefore been copied from the +analogous ones in the \.{WEB} system routines. They have been considerably +simplified, since \.{PKtype} need not deal with the controversial +ASCII codes less than @'40 or greater than @'176. + +@<Types...@>= +@!ASCII_code=" ".."~"; {a subrange of the integers} + +@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit +character sets were common, so it did not make provision for lower case +letters. Nowadays, of course, we need to deal with both upper and lower case +alphabets in a convenient way, especially in a program like \.{PKtype}. +So we shall assume that the \PASCAL\ system being used for \.{PKtype} +has a character set containing at least the standard visible characters +of ASCII code (|"!"| through |"~"|). + +Some \PASCAL\ compilers use the original name |char| for the data type +associated with the characters in text files, while other \PASCAL s +consider |char| to be a 64-element subrange of a larger data type that has +some other name. In order to accommodate this difference, we shall use +the name |text_char| to stand for the data type of the characters in the +output file. We shall also assume that |text_char| consists of +the elements |chr(first_text_char)| through |chr(last_text_char)|, +inclusive. The following definitions should be adjusted if necessary. +@^system dependencies@> + +@d text_char == char {the data type of characters in text files} +@d first_text_char=0 {ordinal number of the smallest element of |text_char|} +@d last_text_char=127 {ordinal number of the largest element of |text_char|} + +@<Types...@>= +@!text_file=packed file of text_char; + +@ The \.{PKtype} processor converts between ASCII code and +the user's external character set by means of arrays |xord| and |xchr| +that are analogous to \PASCAL's |ord| and |chr| functions. + +@<Globals...@>= +@!xord: array [text_char] of ASCII_code; + {specifies conversion of input characters} +@!xchr: array [0..255] of text_char; + {specifies conversion of output characters} + +@ Under our assumption that the visible characters of standard ASCII are +all present, the following assignment statements initialize the +|xchr| array properly, without needing any system-dependent changes. + +@<Set init...@>= +for i:=0 to @'37 do xchr[i]:='?'; +xchr[@'40]:=' '; +xchr[@'41]:='!'; +xchr[@'42]:='"'; +xchr[@'43]:='#'; +xchr[@'44]:='$'; +xchr[@'45]:='%'; +xchr[@'46]:='&'; +xchr[@'47]:='''';@/ +xchr[@'50]:='('; +xchr[@'51]:=')'; +xchr[@'52]:='*'; +xchr[@'53]:='+'; +xchr[@'54]:=','; +xchr[@'55]:='-'; +xchr[@'56]:='.'; +xchr[@'57]:='/';@/ +xchr[@'60]:='0'; +xchr[@'61]:='1'; +xchr[@'62]:='2'; +xchr[@'63]:='3'; +xchr[@'64]:='4'; +xchr[@'65]:='5'; +xchr[@'66]:='6'; +xchr[@'67]:='7';@/ +xchr[@'70]:='8'; +xchr[@'71]:='9'; +xchr[@'72]:=':'; +xchr[@'73]:=';'; +xchr[@'74]:='<'; +xchr[@'75]:='='; +xchr[@'76]:='>'; +xchr[@'77]:='?';@/ +xchr[@'100]:='@@'; +xchr[@'101]:='A'; +xchr[@'102]:='B'; +xchr[@'103]:='C'; +xchr[@'104]:='D'; +xchr[@'105]:='E'; +xchr[@'106]:='F'; +xchr[@'107]:='G';@/ +xchr[@'110]:='H'; +xchr[@'111]:='I'; +xchr[@'112]:='J'; +xchr[@'113]:='K'; +xchr[@'114]:='L'; +xchr[@'115]:='M'; +xchr[@'116]:='N'; +xchr[@'117]:='O';@/ +xchr[@'120]:='P'; +xchr[@'121]:='Q'; +xchr[@'122]:='R'; +xchr[@'123]:='S'; +xchr[@'124]:='T'; +xchr[@'125]:='U'; +xchr[@'126]:='V'; +xchr[@'127]:='W';@/ +xchr[@'130]:='X'; +xchr[@'131]:='Y'; +xchr[@'132]:='Z'; +xchr[@'133]:='['; +xchr[@'134]:='\'; +xchr[@'135]:=']'; +xchr[@'136]:='^'; +xchr[@'137]:='_';@/ +xchr[@'140]:='`'; +xchr[@'141]:='a'; +xchr[@'142]:='b'; +xchr[@'143]:='c'; +xchr[@'144]:='d'; +xchr[@'145]:='e'; +xchr[@'146]:='f'; +xchr[@'147]:='g';@/ +xchr[@'150]:='h'; +xchr[@'151]:='i'; +xchr[@'152]:='j'; +xchr[@'153]:='k'; +xchr[@'154]:='l'; +xchr[@'155]:='m'; +xchr[@'156]:='n'; +xchr[@'157]:='o';@/ +xchr[@'160]:='p'; +xchr[@'161]:='q'; +xchr[@'162]:='r'; +xchr[@'163]:='s'; +xchr[@'164]:='t'; +xchr[@'165]:='u'; +xchr[@'166]:='v'; +xchr[@'167]:='w';@/ +xchr[@'170]:='x'; +xchr[@'171]:='y'; +xchr[@'172]:='z'; +xchr[@'173]:='{'; +xchr[@'174]:='|'; +xchr[@'175]:='}'; +xchr[@'176]:='~'; +for i:=@'177 to 255 do xchr[i]:='?'; + +@ The following system-independent code makes the |xord| array contain a +suitable inverse to the information in |xchr|. + +@<Set init...@>= +for i:=first_text_char to last_text_char do xord[chr(i)]:=@'40; +for i:=" " to "~" do xord[xchr[i]]:=i; + +@* Packed file format. +The packed file format is a compact representation of the data contained in a +\.{GF} file. The information content is the same, but packed (\.{PK}) files +are almost always less than half the size of their \.{GF} counterparts. They +are also easier to convert into a raster representation because they do not +have a profusion of \\{paint}, \\{skip}, and \\{new\_row} commands to be +separately interpreted. In addition, the \.{PK} format expressly forbids +\&{special} commands within a character. The minimum bounding box for each +character is explicit in the format, and does not need to be scanned for as in +the \.{GF} format. Finally, the width and escapement values are combined with +the raster information into character ``packets'', making it simpler in many +cases to process a character. + +A \.{PK} file is organized as a stream of 8-bit bytes. At times, these bytes +might be split into 4-bit nybbles or single bits, or combined into multiple +byte parameters. When bytes are split into smaller pieces, the `first' piece +is always the most significant of the byte. For instance, the first bit of +a byte is the bit with value 128; the first nybble can be found by dividing +a byte by 16. Similarly, when bytes are combined into multiple byte +parameters, the first byte is the most significant of the parameter. If the +parameter is signed, it is represented by two's-complement notation. + +The set of possible eight-bit values is separated into two sets, those that +introduce a character definition, and those that do not. The values that +introduce a character definition range from 0 to 239; byte values +above 239 are interpreted as commands. Bytes that introduce character +definitions are called flag bytes, and various fields within the byte indicate +various things about how the character definition is encoded. Command bytes +have zero or more parameters, and can never appear within a character +definition or between parameters of another command, where they would be +interpeted as data. + +A \.{PK} file consists of a preamble, followed by a sequence of one or more +character definitions, followed by a postamble. The preamble command must +be the first byte in the file, followed immediately by its parameters. +Any number of character definitions may follow, and any command but the +preamble command and the postamble command may occur between character +definitions. The very last command in the file must be the postamble. + +@ The packed file format is intended to be easy to read and interpret by +device drivers. The small size of the file reduces the input/output overhead +each time a font is loaded. For those drivers that load and save each font +file into memory, the small size also helps reduce the memory requirements. +The length of each character packet is specified, allowing the character raster +data to be loaded into memory by simply counting bytes, rather than +interpreting each command; then, each character can be interpreted on a demand +basis. This also makes it possible for a driver to skip a particular +character quickly if it knows that the character is unused. + +@ First, the command bytes will be presented; then the format of the +character definitions will be defined. Eight of the possible sixteen +commands (values 240 through 255) are currently defined; the others are +reserved for future extensions. The commands are listed below. Each command +is specified by its symbolic name (e.g., \\{pk\_no\_op}), its opcode byte, +and any parameters. The parameters are followed by a bracketed number +telling how many bytes they occupy, with the number preceded by a plus sign if +it is a signed quantity. (Four byte quantities are always signed, however.) + +\yskip\hang|pk_xxx1| 240 |k[1]| |x[k]|. This command is undefined in general; +it functions as a $(k+2)$-byte \\{no\_op} unless special \.{PK}-reading +programs are being used. \MF\ generates \\{xxx} commands when encountering +a \&{special} string. It is recommended that |x| be a string having the form +of a keyword followed by possible parameters relevant to that keyword. + +\yskip\hang\\{pk\_xxx2} 241 |k[2]| |x[k]|. Like |pk_xxx1|, but |0<=k<65536|. + +\yskip\hang\\{pk\_xxx3} 242 |k[3]| |x[k]|. Like |pk_xxx1|, but +|0<=k<@t$2^{24}$@>|. \MF\ uses this when sending a \&{special} string whose +length exceeds~255. + +\yskip\hang\\{pk\_xxx4} 243 |k[4]| |x[k]|. Like |pk_xxx1|, but |k| can be +ridiculously large; |k| musn't be negative. + +\yskip\hang|pk_yyy| 244 |y[4]|. This command is undefined in general; it +functions as a five-byte \\{no\_op} unless special \.{PK} reading programs +are being used. \MF\ puts |scaled| numbers into |yyy|'s, as a result of +\&{numspecial} commands; the intent is to provide numeric parameters to +\\{xxx} commands that immediately precede. + +\yskip\hang|pk_post| 245. Beginning of the postamble. This command is +followed by enough |pk_no_op| commands to make the file a multiple +of four bytes long. Zero through three bytes are usual, but any number +is allowed. +This should make the file easy to read on machines that pack four bytes to +a word. + +\yskip\hang|pk_no_op| 246. No operation, do nothing. Any number of +|pk_no_op|'s may appear between \.{PK} commands, but a |pk_no_op| cannot be +inserted between a command and its parameters, between two parameters, or +inside a character definition. + +\yskip\hang|pk_pre| 247 |i[1]| |k[1]| |x[k]| |ds[4]| |cs[4]| |hppp[4]| +|vppp[4]|. Preamble command. Here, |i| is the identification byte of the +file, currently equal to 89. The string |x| is merely a comment, usually +indicating the source of the \.{PK} file. The parameters |ds| and |cs| are +the design size of the file in $1/2^{20}$ points, and the checksum of the +file, respectively. The checksum should match the \.{TFM} file and the +\.{GF} files for this font. Parameters |hppp| and |vppp| are the ratios +of pixels per point, horizontally and vertically, multiplied by $2^{16}$; they +can be used to correlate the font with specific device resolutions, +magnifications, and ``at sizes''. Usually, the name of the \.{PK} file is +formed by concatenating the font name (e.g., cmr10) with the resolution at +which the font is prepared in pixels per inch multiplied by the magnification +factor, and the letters \.{pk}. For instance, cmr10 at 300 dots per inch +should be named \.{cmr10.300pk}; at one thousand dots per inch and magstephalf, +it should be named \.{cmr10.1095pk}. + +@ We put a few of the above opcodes into definitions for symbolic use by +this program. + +@d pk_id = 89 {the version of \.{PK} file described} +@d pk_xxx1 = 240 {\&{special} commands} +@d pk_yyy = 244 {\&{numspecial} commands} +@d pk_post = 245 {postamble} +@d pk_no_op = 246 {no operation} +@d pk_pre = 247 {preamble} +@d pk_undefined == 248, 249, 250, 251, 252, 253, 254, 255 + +@ The \.{PK} format has two conflicting goals: to pack character raster and +size information as compactly as possible, while retaining ease of translation +into raster and other forms. A suitable compromise was found in the use of +run-encoding of the raster information. Instead of packing the individual +bits of the character, we instead count the number of consecutive `black' or +`white' pixels in a horizontal raster row, and then encode this number. Run +counts are found for each row from left to right, traversing rows from the +top to bottom. This is essentially the way the \.{GF} format works. +Instead of presenting each row individually, however, we concatenate all +of the horizontal raster rows into one long string of pixels, and encode this +row. With knowledge of the width of the bit-map, the original character glyph +can easily be reconstructed. In addition, we do not need special commands to +mark the end of one row and the beginning of the next. + +Next, we place the burden of finding the minimum bounding box on the part +of the font generator, since the characters will usually be used much more +often than they are generated. The minimum bounding box is the smallest +rectangle that encloses all `black' pixels of a character. We also +eliminate the need for a special end of character marker, by supplying +exactly as many bits as are required to fill the minimum bounding box, from +which the end of the character is implicit. + +Let us next consider the distribution of the run counts. Analysis of several +dozen pixel files at 300 dots per inch yields a distribution peaking at four, +falling off slowly until ten, then a bit more steeply until twenty, and then +asymptotically approaching the horizontal. Thus, the great majority of our +run counts will fit in a four-bit nybble. The eight-bit byte is attractive for +our run-counts, as it is the standard on many systems; however, the wasted four +bits in the majority of cases seem a high price to pay. Another possibility +is to use a Huffman-type encoding scheme with a variable number of bits for +each run-count; this was rejected because of the overhead in fetching and +examining individual bits in the file. Thus, the character raster definitions +in the \.{PK} file format are based on the four-bit nybble. + +@ An analysis of typical pixel files yielded another interesting statistic: +Fully 37\char`\%\ +of the raster rows were duplicates of the previous row. Thus, the \.{PK} +format allows the specification of repeat counts, which indicate how many times +a horizontal raster row is to be repeated. These repeated rows are taken out +of the character glyph before individual rows are concatenated into the long +string of pixels. + +For elegance, we disallow a run count of zero. The case of a null raster +description should be gleaned from the character width and height being equal +to zero, and no raster data should be read. No other zero counts are ever +necessary. Also, in the absence of repeat counts, the repeat value is set to +be zero (only the original row is sent.) If a repeat count is seen, it takes +effect on the current row. The current row is defined as the row on which the +first pixel of the next run count will lie. The repeat count is set back to +zero when the last pixel in the current row is seen, and the row is sent out. + +This poses a problem for entirely black and entirely white rows, however. Let +us say that the current row ends with four white pixels, and then we have five +entirely empty rows, followed by a black pixel at the beginning of the next +row, and the character width is ten pixels. We would like to use a repeat +count, but there is no legal place to put it. If we put it before the white +run count, it will apply to the current row. If we put it after, it applies +to the row with the black pixel at the beginning. Thus, entirely white or +entirely black repeated rows are always packed as large run counts (in this +case, a white run count of 54) rather than repeat counts. + +@ Now we turn our attention to the actual packing of the run counts and +repeat counts into nybbles. There are only sixteen possible nybble values. +We need to indicate run counts and repeat counts. Since the run counts are +much more common, we will devote the majority of the nybble values to them. +We therefore indicate a repeat count by a nybble of 14 followed by a packed +number, where a packed number will be explained later. Since the repeat +count value of one is so common, we indicate a repeat one command by a single +nybble of 15. A 14 followed by the packed number 1 is still legal for a +repeat one count. The run counts are coded directly as packed +numbers. + +For packed numbers, therefore, we have the nybble values 0 through 13. We +need to represent the positive integers up to, say, $2^{31}-1$. We would +like the more common smaller numbers to take only one or two nybbles, and +the infrequent large numbers to take three or more. We could therefore +allocate one nybble value to indicate a large run count taking three or more +nybbles. We do this with the value 0. + +@ We are left with the values 1 through 13. We can allocate some of these, say +|dyn_f|, to be one-nybble run counts. +These will work for the run counts |1..dyn_f|. For subsequent run +counts, we will use a nybble greater than |dyn_f|, followed by a second nybble, +whose value can run from 0 through 15. Thus, the two-nybble values will +run from |dyn_f+1..(13-dyn_f)*16+dyn_f|. We have our definition of large run +count values now, being all counts greater than |(13-dyn_f)*16+dyn_f|. + +We can analyze our several dozen pixel files and determine an optimal value of +|dyn_f|, and use this value for all of the characters. Unfortunately, values +of |dyn_f| that pack small characters well tend to pack the large characters +poorly, and values that pack large characters well are not efficient for the +smaller characters. Thus, we choose the optimal |dyn_f| on a character basis, +picking the value that will pack each individual character in the smallest +number of nybbles. Legal values of |dyn_f| run from 0 (with no one-nybble run +counts) to 13 (with no two-nybble run counts). + +@ Our only remaining task in the coding of packed numbers is the large run +counts. We use a scheme suggested by D.~E.~Knuth +@^Knuth, Donald Ervin@> +that simply and elegantly represents arbitrarily large values. The +general scheme to represent an integer |i| is to write its hexadecimal +representation, with leading zeros removed. Then we count the number of +digits, and prepend one less than that many zeros before the hexadecimal +representation. Thus, the values from one to fifteen occupy one nybble; +the values sixteen through 255 occupy three, the values 256 through 4095 +require five, etc. + +For our purposes, however, we have already represented the numbers one +through |(13-dyn_f)*16+dyn_f|. In addition, the one-nybble values have +already been taken by our other commands, which means that only the values +from sixteen up are available to us for long run counts. Thus, we simply +normalize our long run counts, by subtracting |(13-dyn_f)*16+dyn_f+1| and +adding 16, and then we represent the result according to the scheme above. + +@ The final algorithm for decoding the run counts based on the above scheme +looks like this, assuming that a procedure called \\{get\_nyb} is available +to get the next nybble from the file, and assuming that the global +|repeat_count| indicates whether a row needs to be repeated. Note that this +routine is recursive, but since a repeat count can never directly follow +another repeat count, it can only be recursive to one level. + +@<Packed number procedure@>= +function pk_packed_num : integer ; +var i, @!j : integer ; +begin + i := get_nyb ; + if i = 0 then begin + repeat j := get_nyb ; incr(i) ; until j <> 0 ; + while i > 0 do begin j := j * 16 + get_nyb ; decr(i) ; end ; + pk_packed_num := j - 15 + (13-dyn_f)*16 + dyn_f ; + end else if i <= dyn_f then + pk_packed_num := i + else if i < 14 then + pk_packed_num := (i-dyn_f-1)*16+get_nyb+dyn_f+1 + else begin + if repeat_count <> 0 then abort('Second repeat count for this row!') ; +@.Second repeat count...@> + repeat_count := 1; {prevent recursion more than one level} + if i = 14 then repeat_count := pk_packed_num; + send_out(true, repeat_count) ; + pk_packed_num := pk_packed_num ; + end ; +end ; + +@ For low resolution fonts, or characters with `gray' areas, run encoding can +often make the character many times larger. Therefore, for those characters +that cannot be encoded efficiently with run counts, the \.{PK} format allows +bit-mapping of the characters. This is indicated by a |dyn_f| value of +14. The bits are packed tightly, by concatenating all of the horizontal raster +rows into one long string, and then packing this string eight bits to a byte. +The number of bytes required can be calculated by |(width*height+7) div 8|. +This format should only be used when packing the character by run counts takes +more bytes than this, although, of course, it is legal for any character. +Any extra bits in the last byte should be set to zero. + +@ At this point, we are ready to introduce the format for a character +descriptor. It consists of three parts: a flag byte, a character preamble, +and the raster data. The most significant four bits of the flag byte +yield the |dyn_f| value for that character. (Notice that only values of +0 through 14 are legal for |dyn_f|, with 14 indicating a bit mapped character; +thus, the flag bytes do not conflict with the command bytes, whose upper nybble +is always 15.) The next bit (with weight 8) indicates whether the first run +count is a black count or a white count, with a one indicating a black count. +For bit-mapped characters, this bit should be set to a zero. The next bit +(with weight 4) indicates whether certain later parameters (referred to as size +parameters) are given in one-byte or two-byte quantities, with a one indicating +that they are in two-byte quantities. The last two bits are concatenated on to +the beginning of the packet-length parameter in the character preamble, +which will be explained below. + +However, if the last three bits of the flag byte are all set (normally +indicating that the size parameters are two-byte values and that a 3 should be +prepended to the length parameter), then a long format of the character +preamble should be used instead of one of the short forms. + +Therefore, there are three formats for the character preamble; the one that +is used depends on the least significant three bits of the flag byte. If the +least significant three bits are in the range zero through three, the short +format is used. If they are in the range four through six, the extended short +format is used. Otherwise, if the least significant bits are all set, then +the long form of the character preamble is used. The preamble formats are +explained below. + +\yskip\hang Short form: |flag[1]| |pl[1]| |cc[1]| |tfm[3]| |dm[1]| |w[1]| +|h[1]| |hoff[+1]| |voff[+1]|. +If this format of the character preamble is used, the above +parameters must all fit in the indicated number of bytes, signed or unsigned +as indicated. Almost all of the standard \TeX\ font characters fit; the few +exceptions are fonts such as \.{cminch}. + +\yskip\hang Extended short form: |flag[1]| |pl[2]| |cc[1]| |tfm[3]| |dm[2]| +|w[2]| |h[2]| |hoff[+2]| |voff[+2]|. Larger characters use this extended +format. + +\yskip\hang Long form: |flag[1]| |pl[4]| |cc[4]| |tfm[4]| |dx[4]| |dy[4]| +|w[4]| |h[4]| |hoff[4]| |voff[4]|. This is the general format that +allows all of the +parameters of the \.{GF} file format, including vertical escapement. +\vskip\baselineskip +The |flag| parameter is the flag byte. The parameter |pl| (packet length) +contains the offset +of the byte following this character descriptor, with respect to the beginning +of the |tfm| width parameter. This is given so a \.{PK} reading program can, +once it has read the flag byte, packet length, and character code (|cc|), skip +over the character by simply reading this many more bytes. For the two short +forms of the character preamble, the last two bits of the flag byte should be +considered the two most-significant bits of the packet length. For the short +format, the true packet length might be calculated as |(flag mod 4)*256+pl|; +for the short extended format, it might be calculated as +|(flag mod 4)*65536+pl|. + +The |w| parameter is the width and the |h| parameter is the height in pixels +of the minimum bounding box. The |dx| and |dy| parameters are the horizontal +and vertical escapements, respectively. In the short formats, |dy| is assumed +to be zero and |dm| is |dx| but in pixels; +in the long format, |dx| and |dy| are both +in pixels multiplied by $2^{16}$. The |hoff| is the horizontal offset from the +upper left pixel to the reference pixel; the |voff| is the vertical offset. +They are both given in pixels, with right and down being positive. The +reference pixel is the pixel that occupies the unit square in \MF; the +\MF\ reference point is the lower left hand corner of this pixel. (See the +example below.) + +@ \TeX\ requires all characters that have the same character codes +modulo 256 to have also the same |tfm| widths and escapement values. The \.{PK} +format does not itself make this a requirement, but in order for the font to +work correctly with the \TeX\ software, this constraint should be observed. +(The standard version of \TeX\ cannot output character codes greater +than 255, but extended versions do exist.) + +Following the character preamble is the raster information for the +character, packed by run counts or by bits, as indicated by the flag byte. +If the character is packed by run counts and the required number of nybbles +is odd, then the last byte of the raster description should have a zero +for its least significant nybble. + +@ As an illustration of the \.{PK} format, the character \char4\ from the font +amr10 at 300 dots per inch will be encoded. This character was chosen +because it illustrates some +of the borderline cases. The raster for the character looks like this (the +row numbers are chosen for convenience, and are not \MF's row numbers.) + +\vskip\baselineskip +{\def\smbox{\vrule height 7pt width 7pt depth 0pt \hskip 3pt}% +\catcode`\*=\active \let*=\smbox +\centerline{\vbox{\baselineskip=10pt +\halign{\hfil#\quad&&\hfil#\hfil\cr +0& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr +1& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr +2& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr +3& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr +4& & &*&*& & & & & & & & & & & & & & & & &*&*\cr +5& & &*&*& & & & & & & & & & & & & & & & &*&*\cr +6& & &*&*& & & & & & & & & & & & & & & & &*&*\cr +7\cr +8\cr +9& & & & &*&*& & & & & & & & & & & & &*&*& & \cr +10& & & & &*&*& & & & & & & & & & & & &*&*& & \cr +11& & & & &*&*& & & & & & & & & & & & &*&*& & \cr +12& & & & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& & \cr +13& & & & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& & \cr +14& & & & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& & \cr +15& & & & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& & \cr +16& & & & &*&*& & & & & & & & & & & & &*&*& & \cr +17& & & & &*&*& & & & & & & & & & & & &*&*& & \cr +18& & & & &*&*& & & & & & & & & & & & &*&*& & \cr +19\cr +20\cr +21\cr +22& & &*&*& & & & & & & & & & & & & & & & &*&*\cr +23& & &*&*& & & & & & & & & & & & & & & & &*&*\cr +24& & &*&*& & & & & & & & & & & & & & & & &*&*\cr +25& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr +26& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr +27& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr +28&+& &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr +&\hphantom{*}&\hphantom{*}\cr +}}}} +The width of the minimum bounding box for this character is 20; its height +is 29. The `+' represents the reference pixel; notice how it lies outside the +minimum bounding box. The |hoff| value is $-2$, and the |voff| is~28. + +The first task is to calculate the run counts and repeat counts. The repeat +counts are placed at the first transition (black to white or white to black) +in a row, and are enclosed in brackets. White counts are enclosed in +parentheses. It is relatively easy to generate the counts list: +\vskip\baselineskip +\centerline{82 [2] (16) 2 (42) [2] 2 (12) 2 (4) [3]} +\centerline{16 (4) [2] 2 (12) 2 (62) [2] 2 (16) 82} +\vskip\baselineskip +Note that any duplicated rows that are not all white or all black are removed +before the run counts are calculated. The rows thus removed are rows 5, 6, +10, 11, 13, 14, 15, 17, 18, 23, and 24. + +@ The next step in the encoding of this character is to calculate the optimal +value of |dyn_f|. The details of how this calculation is done are not +important here; suffice it to say that there is a simple algorithm that can +determine the best value of |dyn_f| in one pass over the count list. For this +character, the optimal value turns out to be 8 (atypically low). Thus, all +count values less than or equal to 8 are packed in one nybble; those from +nine to $(13-8)*16+8$ or 88 are packed in two nybbles. The run encoded values +now become (in hex, separated according to the above list): +\vskip\baselineskip +\centerline{\tt D9 E2 97 2 B1 E2 2 93 2 4 E3} +\centerline{\tt 97 4 E2 2 93 2 C5 E2 2 97 D9} +\vskip\baselineskip\noindent +which comes to 36 nybbles, or 18 bytes. This is shorter than the 73 bytes +required for the bit map, so we use the run count packing. + +@ The short form of the character preamble is used because all of the +parameters fit in their respective lengths. The packet length is therefore +18 bytes for the raster, plus +eight bytes for the character preamble parameters following the character +code, or 26. The |tfm| width for this character is 640796, or {\tt 9C71C} in +hexadecimal. The horizontal escapement is 25 pixels. The flag byte is +88 hex, indicating the short preamble, the black first count, and the +|dyn_f| value of 8. The final total character packet, in hexadecimal, is: +\vskip\baselineskip +$$\vbox{\halign{\hfil #\quad&&{\tt #\ }\cr +Flag byte&88\cr +Packet length&1A\cr +Character code&04\cr +|tfm| width&09&C7&1C\cr +Horizontal escapement (pixels)&19\cr +Width of bit map&14\cr +Height of bit map&1D\cr +Horizontal offset (signed)&FE\cr +Vertical offset&1C\cr +Raster data&D9&E2&97\cr +&2B&1E&22\cr +&93&24&E3\cr +&97&4E&22\cr +&93&2C&5E\cr +&22&97&D9\cr}}$$ + +@* Input and output. +There are two types of files that this program must deal with---standard +text files and files of bytes (packed files.) +For our purposes, we shall consider an eight-bit byte to consist of the +values |0..255|. If your system does not pack these values to a byte, it is +no major difficulty; you must only insure that the input function +|pk_byte| can read packed bytes. + +@<Types...@>= +@!eight_bits=0..255; {packed file byte} +@!byte_file=packed file of eight_bits ; {for packed file words} +@^system dependencies@> + +@ @<Glob...@>= +@!pk_file:byte_file; {where the input comes from} +@!typ_file:text_file; {where the final output goes} +@^system dependencies@> + +@ To prepare these files for input and output, we |reset| and |rewrite| them. +An extension of \PASCAL\ is needed, since we want to associate files +with external names that are specified dynamically (i.e., not +known at compile time). The following code assumes that `|reset(f,s)|' +does this, when |f| is a file variable and |s| is a string variable that +specifies the file name. If |eof(f)| is true immediately after +|reset(f,s)| has acted, we assume that no file named |s| is accessible. +@^system dependencies@> + +@p procedure open_pk_file; {prepares the input for reading} +begin reset(pk_file,pk_name); +pk_loc := 0 ; +end; +@# +procedure open_typ_file; {prepares to write text data to the |typ_file|} +begin rewrite(typ_file,typ_name); +end; + +@ We need a place to store the names of the input and output file, as well +as a byte counter for the output file. + +@<Glob...@>= +@!pk_name,@!typ_name:packed array[1..name_length] of char; {name of input + and output files} +@!pk_loc:integer; {how many bytes have we read?} + +@ We also need a function that will get a single byte from the \.{pk} file. + +@p function pk_byte : eight_bits ; +var temp : eight_bits ; +begin + temp := pk_file^ ; + get(pk_file) ; + incr(pk_loc) ; + pk_byte := temp ; +end ; + +@ Now we are ready to open the files. + +@<Open files@>= +open_pk_file ; +open_typ_file ; +t_print_ln(banner) ; +t_print('Input file: ') ; +i := 1 ; +while pk_name[i] <> ' ' do begin + t_print(pk_name[i]) ; incr(i) ; +end ; +t_print_ln(' ') + +@ As we are reading the packed file, we often need to fetch 16 and 32 bit +quantities. Here we have two procedures to do this. + +@p function get_16 : integer ; +var a : integer ; +begin a := pk_byte ; get_16 := a * 256 + pk_byte ; end ; +@# +function get_32 : integer ; +var a : integer ; +begin a := get_16 ; if a > 32767 then a := a - 65536 ; +get_32 := a * 65536 + get_16 ; end ; + +@ We still need the |term_pos| variable. + +@<Glob...@>= +@!term_pos : integer ; {current terminal position} + +@ Now we read and check the preamble of the \.{PK} file. In the preamble, we +find the |hppp|, |design_size|, |checksum|. + +@<Read preamble@>= +if pk_byte <> pk_pre then abort('Bad PK file: pre command missing!') ; +@.pre command missing@> +if pk_byte <> pk_id then abort('Wrong version of PK file!') ; +@.Wrong version of PK file@> +j := pk_byte ; +t_print('''') ; +for i := 1 to j do t_print(xchr[pk_byte]) ; +t_print_ln('''') ; +design_size := get_32 ; +t_print_ln('Design size = ',design_size:1) ; +checksum := get_32 ; +t_print_ln('Checksum = ',checksum:1) ; +hppp := get_32 ; vppp := get_32 ; +t_print('Resolution: horizontal = ',hppp:1,' vertical = ',vppp:1) ; +magnification := round(hppp * 72.27 / 65536) ; +t_print_ln(' (',magnification:1,' dpi)') ; +if hppp <> vppp then print_ln('Warning: aspect ratio not 1:1!') + +@ Of course, we need to define the above variables. + +@<Glob...@>= +@!magnification : integer ; {resolution at which pixel file is prepared} +@!design_size : integer ; {design size in FIXes} +@!checksum : integer ; {checksum of pixel file} +@!hppp, @!vppp : integer ; {horizontal and vertical points per inch} + +@* Character unpacking. +Here we simply unpack the character, writing the information we glean to the +|typ_file|. + +@<Unpack and write character@>= +t_print((pk_loc-1):1,': Flag byte = ',flag_byte:1) ; +dyn_f := flag_byte div 16 ; +flag_byte := flag_byte mod 16 ; +turn_on := flag_byte >= 8 ; +if turn_on then flag_byte := flag_byte - 8 ; +if flag_byte = 7 then + @<Read long character preamble@> +else if flag_byte > 3 then + @<Read extended short character preamble@> +else + @<Read short character preamble@> ; +t_print_ln(' Character = ',car:1,' Packet length = ', + packet_length:1) ; +t_print_ln(' Dynamic packing variable = ',dyn_f:1) ; +t_print(' TFM width = ',tfm_width:1,' dx = ',dx:1) ; +if dy <> 0 then t_print_ln(' dy = ',dy:1) else t_print_ln(' ') ; +t_print_ln(' Height = ',height:1,' Width = ',width:1,' X-offset = ', + x_off:1, ' Y-offset = ',y_off:1) ; +@<Read and translate raster description@> ; +if end_of_packet <> pk_loc then abort('Bad PK file: Bad packet length!') +@.Bad packet length@> + +@ We need a whole lot of globals used but not defined up there. + +@<Glob...@>= +@!i, @!j : integer ; {index pointers} +@!flag_byte : integer ; {the byte that introduces the character definition} +@!end_of_packet : integer ; {where we expect the end of the packet to be} +@!width, @!height : integer ; {width and height of character} +@!x_off, @!y_off : integer ; {x and y offsets of character} +@!tfm_width : integer ; {character tfm width} +@!tfms : array [0..255] of integer ; {character tfm widths} +@!dx, @!dy : integer ; {escapement values} +@!dxs, @!dys : array [0..255] of integer ; {escapement values} +@!status : array[0..255] of boolean ; {has the character been seen?} +@!dyn_f : integer ; {dynamic packing variable} +@!car : integer ; {the character we are reading} +@!packet_length : integer ; {the length of the character packet} + +@ Now, the preamble reading modules. First, we have the general case: the +long character preamble format. + +@<Read long character preamble@>= +begin + packet_length := get_32 ; car := get_32 ; + end_of_packet := packet_length + pk_loc ; + packet_length := packet_length + 9 ; + tfm_width := get_32 ; + dx := get_32 ; dy := get_32 ; + width := get_32 ; + height := get_32 ; + x_off := get_32 ; y_off := get_32 ; +end + +@ This module reads the character preamble with double byte parameters. + +@<Read extended short character preamble@>= +begin + packet_length := (flag_byte - 4) * 65536 + get_16 ; + car := pk_byte ; + end_of_packet := packet_length + pk_loc ; + packet_length := packet_length + 4 ; + i := pk_byte ; + tfm_width := i * 65536 + get_16 ; + dx := get_16 * 65536 ; + dy := 0 ; + width := get_16 ; + height := get_16 ; + x_off := get_16 ; y_off := get_16 ; + if x_off > 32767 then x_off := x_off - 65536 ; + if y_off > 32767 then y_off := y_off - 65536 ; +end + +@ Here we read the most common character preamble, that with single byte +parameters. + +@<Read short character preamble@>= +begin + packet_length := flag_byte * 256 + pk_byte ; + car := pk_byte ; + end_of_packet := packet_length + pk_loc ; + packet_length := packet_length + 3 ; + i := pk_byte ; + tfm_width := i * 65536 + get_16 ; + dx := pk_byte * 65536 ; + dy := 0 ; + width := pk_byte ; + height := pk_byte ; + x_off := pk_byte ; y_off := pk_byte ; + if x_off > 127 then x_off := x_off - 256 ; + if y_off > 127 then y_off := y_off - 256 ; +end + +@ Now we have the most important part of the program, where we actually +interpret the commands in the raster description. First of all, we need +a procedure to get a single nybble from the file, as well as one to get +a single bit. + +@p function get_nyb : integer ; +var temp : eight_bits ; +begin + if bit_weight = 0 then begin + input_byte := pk_byte ; + bit_weight := 16 ; + end ; + temp := input_byte div bit_weight ; + input_byte := input_byte - temp * bit_weight ; + bit_weight := bit_weight div 16 ; + get_nyb := temp ; +end ; +@# +function get_bit : boolean ; +var temp : boolean ; +begin + bit_weight := bit_weight div 2 ; + if bit_weight = 0 then begin + input_byte := pk_byte ; + bit_weight := 128 ; + end ; + temp := input_byte >= bit_weight ; + if temp then + input_byte := input_byte - bit_weight ; + get_bit := temp ; +end ; + +@ We also need a function to write output to the screen. We put as many +counts on a line as possible, to reduce the volume of output. Each count +will appear as a number, with white counts enclosed by parentheses and repeat +counts by brackets. + +@p procedure send_out(@!repeat_count: boolean ; @!value : integer ) ; +var i, len : integer ; +begin + i := 10 ; len := 1 ; + while value >= i do begin incr(len) ; i := i * 10 ; end ; + if repeat_count or not turn_on then len := len + 2 ; + if term_pos + len > 78 then begin + term_pos := len + 2 ; t_print_ln(' ') ; t_print(' ') ; + end else term_pos := term_pos + len ; + if repeat_count then t_print('[', value:1, ']') + else if turn_on then t_print(value:1) + else t_print('(', value:1, ')') ; +end ; +@<Packed number procedure@> + +@ Now, the globals to help communication between these procedures. + +@<Glob...@>= +@!input_byte : eight_bits ; {the byte we are currently decimating} +@!bit_weight : eight_bits ; {weight of the current bit} +@!nybble : eight_bits ; {the current nybble} + +@ And the main procedure. + +@<Read and translate raster description@>= +bit_weight := 0 ; +if dyn_f = 14 then + @<Get raster by bits@> +else @<Create normally packed raster@> + +@ If |dyn_f=14|, then we need to get the raster representation +one bit at a time. + +@<Get raster by bits@>= +begin +for i := 1 to height do begin + t_print(' ') ; + for j := 1 to width do + if get_bit then t_print('*') + else t_print('.') ; + t_print_ln(' ') ; +end; +end + +@ Otherwise, we translate the bit counts into the raster rows. |count| +contains the number of bits of the current color, and |turn_on| indicates +whether or not they should be black. |rows_left| contains the number of +rows to be sent. + +@<Create normally packed raster@>= +begin +term_pos := 2 ; +t_print(' ') ; +rows_left := height ; +h_bit := width ; +repeat_count := 0 ; +while rows_left > 0 do begin + count := pk_packed_num ; + send_out(false, count) ; + if count >= h_bit then begin + rows_left := rows_left - repeat_count - 1 ; + repeat_count := 0 ; + count := count - h_bit ; + h_bit := width ; + rows_left := rows_left - count div width ; + count := count mod width ; + end ; + h_bit := h_bit - count ; + turn_on := not turn_on ; +end ; +t_print_ln(' ') ; +if (rows_left <> 0) or (h_bit <> width) then + abort('Bad PK file: More bits than required!'); +@.More bits than required@> +end + +@ We need to declare the repeat flag, bit counter, and color flag here. + +@<Glob...@>= +@!repeat_count : integer ; {how many times to repeat the next row?} +@!rows_left : integer ; {how many rows left?} +@!turn_on : boolean ; {are we black here?} +@!h_bit : integer ; {what is our horizontal position?} +@!count : integer ; {how many bits of current color left?} + +@ If any specials are found, we write them out here. + +@d four_cases(#)==#,#+1,#+2,#+3 + +@p procedure skip_specials ; +var @!i, @!j: integer ; +begin + repeat + flag_byte := pk_byte ; + if flag_byte >= 240 then + case flag_byte of + four_cases(pk_xxx1): +begin + t_print((pk_loc-1):1,': Special: ''') ; + i := 0 ; + for j := pk_xxx1 to flag_byte do i := 256 * i + pk_byte ; + for j := 1 to i do t_print(xchr[pk_byte]) ; + t_print_ln('''') ; +end ; + pk_yyy : t_print_ln((pk_loc-1):1,': Num special: ',get_32:1) ; + pk_post : t_print_ln((pk_loc-1):1,': Postamble') ; + pk_no_op : t_print_ln((pk_loc-1):1,': No op') ; + pk_pre, pk_undefined : abort('Unexpected ', flag_byte:1,'!') ; +@.Unexpected bbb@> + endcases ; + until (flag_byte < 240) or (flag_byte = pk_post) ; +end ; + +@* Terminal communication. +We must get the file names and determine whether input is to be in +hexadecimal or binary. To do this, we use the standard input path +name. We need a procedure to flush the input buffer. For most systems, +this will be an empty statement. For other systems, a |print_ln| will +provide a quick fix. We also need a routine to get a line of input from +the terminal. On some systems, a simple |read_ln| will do. Finally, +a macro to print a string to the first blank is required. + +@d flush_buffer == begin end +@d get_line(#) == if eoln(input) then read_ln(input) ; + i := 1 ; + while not (eoln(input) or eof(input)) do begin + #[i] := input^ ; + incr(i) ; + get(input) ; + end ; + #[i] := ' ' + +@ @p procedure dialog ; +var i : integer ; {index variable} +buffer : packed array [1..name_length] of char; {input buffer} +begin + for i := 1 to name_length do begin + typ_name[i] := ' ' ; + pk_name[i] := ' ' ; + end; + print('Input file name: ') ; + flush_buffer ; + get_line(pk_name) ; + print('Output file name: ') ; + flush_buffer ; + get_line(typ_name) ; +end ; + +@* The main program. +Now that we have all the pieces written, let us put them together. + +@p begin +initialize ; +dialog ; +@<Open files@> ; +@<Read preamble@> ; +skip_specials ; +while flag_byte <> pk_post do begin + @<Unpack and write character@> ; + skip_specials ; +end ; +j := 0 ; +while not eof(pk_file) do begin + i := pk_byte ; + if i <> pk_no_op then abort('Bad byte at end of file: ',i:1) ; +@.Bad byte at end of file@> + t_print_ln((pk_loc-1):1,': No op') ; + incr(j) ; +end ; +t_print_ln(pk_loc:1,' bytes read from packed file.'); +final_end : +end . + +@* System-dependent changes. +This section should be replaced, if necessary, by changes to the program +that are necessary to make \.{PKtype} work at a particular installation. +Any additional routines should be inserted here. +@^system dependencies@> + +@* Index. +Pointers to error messages appear here together with the section numbers +where each ident\-i\-fier is used. diff --git a/systems/knuth/local/mfware/Makefile b/systems/knuth/local/mfware/Makefile new file mode 100644 index 0000000000..c4fdfffe97 --- /dev/null +++ b/systems/knuth/local/mfware/Makefile @@ -0,0 +1,55 @@ +# Make executable files for this workstation, using the master TeX sources + +PFLAGS= -g -I.. +CFLAGS= -g -I.. +PC= gpc + +all: gftype gftopk gftodvi mft pktype + +%.p: %.ch + tangle ../../dist/mfware/$*.web $*.ch +# mv ../../dist/mfware/$*.p . + +pktype.p: pktype.ch + tangle pktype.web pktype.ch + +%.ch: ../../dist/mfware/%.web + touch $*.ch + +%.o: %.p + ${PC} ${PFLAGS} -c $*.p + +gftype: gftype.o gftopk_ext.h gftopk_ext.o + pc ${PFLAGS} -o gftype gftype.o gftopk_ext.o + +gftopk: gftopk.o gftopk_ext.o gftopk_ext.h + pc ${PFLAGS} -o gftopk gftopk.o gftopk_ext.o + +pktype: pktype.o gftopk_ext.h gftopk_ext.o + pc ${PFLAGS} -o pktype pktype.o gftopk_ext.o + +gftodvi: gftodvi.o ext.o ../tex/ext.h + pc ${PFLAGS} -o gftodvi gftodvi.o ext.o + +gf2dvi.p: gf2dvi.ch + cp ../../dist/mfware/gftodvi.web gf2dvi.web + tangle gf2dvi.web gf2dvi.ch + rm gf2dvi.web + +gf2dvi: gf2dvi.o ext.o ../tex/ext.h + pc $(PFLAGS) -o gf2dvi gf2dvi.o ext.o + +ext.o: ../tex/ext.c + cc ${CFLAGS} -c ../tex/ext.c + +gftopk_ext.o: gftopk_ext.c + +mft: mft.o weavext.o mft_ext.h mft_ext.o + pc ${PFLAGS} -o mft mft.o mft_ext.o + +install: # doit make install "PROG=gftype" + mv $(PROG) /usr/local/bin/$(PROG) + +clean: +# rm -f *.p *.o *~ ../../dist/mfware/*.pool + rm -f *.p *.o *~ *.pool diff --git a/systems/knuth/local/mfware/gf2dvi.ch b/systems/knuth/local/mfware/gf2dvi.ch new file mode 100644 index 0000000000..dad33f0384 --- /dev/null +++ b/systems/knuth/local/mfware/gf2dvi.ch @@ -0,0 +1,834 @@ +% Change file for the GF2DVI processor, for use with GNU Pascal. +% [A "color separation" variant of gftodvi, for illustrations in Vols C, E] +% (by Don Knuth; see ../mfware-sparc for the prehistory) + +% History: +% 2000.04.30 Original 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{GF\lowercase{to}DVI changes for {\mc GNU} Pascal} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1] Change banner string +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d banner=='This is GFtoDVI, Version 3.0' {printed when the program starts} +@y +@d banner=='This is GF2DVI [double separation], Version 3.0 for Linux' + {printed when the program starts} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [2] Use default case statement feature of ISO Extended Pascal +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d othercases == others: {default for cases not listed explicitly} +@y +@d othercases == otherwise {default for cases not listed explicitly} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3] Add inclusion of ext.h and standard input to program header +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p program GF_to_DVI(@!output); +label @<Labels in the outer block@>@/ +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +procedure initialize; {this procedure gets things started properly} + var @!i,@!j,@!m,@!n:integer; {loop indices for initializations} + begin print_ln(banner);@/ + @<Set initial values@>@/ + end; +@y +@p program GF_to_DVI(@!input,@!output); +label @<Labels in the outer block@>@/ +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +@\@=#include "../tex/ext.h"@>@\ {declarations for external C procedures} +procedure initialize; {this procedure gets things started properly} + var @!i,@!j,@!m,@!n:integer; {loop indices for initializations} + begin print_ln(banner);@/ + @<Set initial values@>@/ + first_input:=true; + end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [4] Distinguish two brands of finality +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d final_end=9999 {label for the end of it all} + +@<Labels...@>=final_end; +@y +@d final_final_end=9999 {label for the end of it all} +@d final_end=9998 {label for the end of a pass} + +@<Labels...@>=final_end,final_final_end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [5] Enlarge file_name_size to 1024 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@<Constants...@>= +@!max_labels=2000; {maximum number of labels and dots and rules per character} +@!pool_size=10000; {maximum total length of labels and other strings} +@!max_strings=1100; {maximum number of labels and other strings} +@!terminal_line_length=150; {maximum number of characters input in a single + line of input from the terminal} +@!file_name_size=50; {a file name shouldn't be longer than this} +@!font_mem_size=2000; {space for font metric data} +@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8} +@!widest_row=8192; {maximum number of pixels per row} +@!lig_lookahead=20; {size of stack used when inserting ligature characters} +@y +@<Constants...@>= +@!max_labels=2000; {maximum number of labels and dots per character} +@!pool_size=10000; {maximum total length of labels and other strings} +@!max_strings=1100; {maximum number of labels and other strings} +@!terminal_line_length=150; {maximum number of characters input in a single + line of input from the terminal} +@!file_name_size=1024; {a file name shouldn't be longer than this} +@!font_mem_size=2000; {space for font metric data} +@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8} +@!widest_row=8192; {maximum number of pixels per row} +@!lig_lookahead=20; {size of stack used when inserting ligature characters} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [8] Add <nl> to end of abort() message; jump way out +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d abort(#)==@+begin print(' ',#); jump_out;@+end +@y +@d abort(#)==@+begin print_ln(' ',#); jump_out;@+end +@z +@x +begin goto final_end; +@y +begin goto final_final_end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [was15,now16] change update_terminal to flush(), change def'n of term_in +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +Since the terminal is being used for both input and output, some systems +need a special routine to make sure that the user can see a prompt message +before waiting for input based on that message. (Otherwise the message +may just be sitting in a hidden buffer somewhere, and the user will have +no idea what the program is waiting for.) We shall call a system-dependent +subroutine |update_terminal| in order to avoid this problem. + +@d update_terminal == break(output) {empty the terminal output buffer} + +@<Glob...@>= +@!buffer:array[0..terminal_line_length] of 0..255; +@!term_in:text_file; {the terminal, considered as an input file} +@y +Since the terminal is being used for both input and output, some systems +need a special routine to make sure that the user can see a prompt message +before waiting for input based on that message. (Otherwise the message +may just be sitting in a hidden buffer somewhere, and the user will have +no idea what the program is waiting for.) We shall call a system-dependent +subroutine |update_terminal| in order to avoid this problem. +@^system dependencies@> + +@d update_terminal == flush(output) {empty the terminal output buffer} +@d term_in == input {standard input} + +@<Glob...@>= +@!buffer:array[0..terminal_line_length] of 0..255; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [was16,now17] Remove reset(term_in) from input_ln +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ A global variable |line_length| records the first buffer position after +the line just read. +@^system dependencies@> + +@p procedure input_ln; {inputs a line from the terminal} +begin update_terminal; reset(term_in); +if eoln(term_in) then read_ln(term_in); +line_length:=0; +while (line_length<terminal_line_length)and not eoln(term_in) do + begin buffer[line_length]:=xord[term_in^]; incr(line_length); get(term_in); + end; +end; + +@y +@ A global variable |line_length| records the first buffer position after +the line just read. Another one, |first_input|, tells if such a line exists. +@^system dependencies@> + +@p procedure input_ln; {inputs a line from the terminal} +begin update_terminal; +if first_input then first_input:=false +else if eoln(term_in) then read_ln(term_in); +line_length:=0; +while (line_length<terminal_line_length)and not eoln(term_in) do + begin buffer[line_length]:=xord[term_in^]; incr(line_length); get(term_in); + end; +end; + +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [45] Change type of binary file for binary (byte) files +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +We shall stick to simple \PASCAL\ in this program, for reasons of clarity, +even if such simplicity is sometimes unrealistic. + +@<Types ...@>= +@!eight_bits=0..255; {unsigned one-byte quantity} +@!byte_file=packed file of eight_bits; {files that contain binary data} +@y +For Berkeley Pascal, we need to use `|packed file of -128..127|' to read and +write binary bytes. + +@<Types ...@>= +@!eight_bits=0..255; {unsigned one-byte quantity} +@!byte_file=packed file of -128..127; {files that contain binary data} +@!packed_ASCII_code=-128..127; {declaration needed only because of \.{ext.h}} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [47] Modify file open routines to match binary I/O library +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +variable that specifies the file name. +@^system dependencies@> + +@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|} +begin reset(gf_file,name_of_file); +cur_loc:=0; +end; +@# +procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|} +begin reset(tfm_file,name_of_file); +end; +@# +procedure open_dvi_file; {prepares to write packed bytes in |dvi_file|} +begin rewrite(dvi_file,name_of_file); +end; +@y +variable that specifies the file name. + +An external C procedure, |test_access| is used to check whether or not the +open will work. It is declared in the \.{ext.h} include file, and it returns +|true| or |false|. The |name_of_file| global holds the file name whose access +is to be tested. +The first parameter for |test_access| is the access mode, +one of |read_access_mode| or |write_access_mode|. + +We also implement path searching in |test_access|: its second parameter is +one of the ``file path'' constants defined below. If |name_of_file| +doesn't start with |'/'| then |test_access| tries prepending pathnames +from the appropriate path list until success or the end of path list +is reached. +On return, |real_name_of_file| contains the original name with the path +that succeeded (if any) prepended. It is the name used in the various +open procedures. + +@d read_access_mode=4 {``read'' mode for |test_access|} +@d write_access_mode=2 {``write'' mode for |test_access|} + +@d no_file_path=0 {do no path searching} +@d font_file_path=3 {path specifier for \.{TFM} files} + +@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|} +var@!i: 1..file_name_size; +begin if test_access(read_access_mode,no_file_path) then + begin reset(gf_file,real_name_of_file); cur_loc:=0; + end +else begin i:=1; + while (real_name_of_file[i] <> chr(0)) do@+incr(i); + abort('Can''t open GF file ',real_name_of_file:i); + end; +end; +@# +procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|} +var@!i: 1..file_name_size; +begin if test_access(read_access_mode,font_file_path) then + begin reset(tfm_file,real_name_of_file); cur_loc:=0; + temp_int:=tfm_file^; {prime the pump} + if temp_int<0 then temp_int:=temp_int+256; + end +else begin i:=1; + while (real_name_of_file[i] <> chr(0)) do@+incr(i); + abort('Can''t open TFM file ',real_name_of_file:i); + end; +end; +@# +procedure open_dvi_file; {prepares to write packed bytes in |dvi_file|} +var@!i: 1..file_name_size; +begin if test_access(write_access_mode,no_file_path) then + rewrite(dvi_file,real_name_of_file) +else begin i:=1; + while (real_name_of_file[i] <> chr(0)) do@+incr(i); + abort('Can''t write on DVI file ',real_name_of_file:i); + end; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [48] Declare real_name_of_file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +be read next, and the string |name_of_file| will be set to the current +file name before the file-opening procedures are called. + +@<Glob...@>= +@!cur_loc:integer; {current byte number in |gf_file|} +@!name_of_file:packed array[1..file_name_size] of char; {external file name} +@y +be read next, and the string |name_of_file| will be set to the current +file name before the file-opening procedures are called. +Under UNIX, we also have a |real_name_of_file| string, that gets +set by the external |test_access| procedure after path searching. + +@<Glob...@>= +@!cur_loc:integer; {current byte number in |gf_file|} +@!name_of_file,@!real_name_of_file,@!gf_file_name: + packed array[1..file_name_size] of char; {external name} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [50] Use modified routines to access tfm_file using b_read_unsigned() +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p procedure read_tfm_word; +begin read(tfm_file,b0); read(tfm_file,b1); +read(tfm_file,b2); read(tfm_file,b3); +end; +@y +For Berkeley {\mc UNIX} we had to make the |byte_file| type have data in the +range |-128..127|. +If the file byte contains |@'377|, we want to regard this as 255 in decimal. +However if we do |i:=tfm_file^| on that byte, where i is a signed integer, +then the result is |i=-1|. +File bytes with values |<@'200| are read properly. +The solution is to do the assignment as shown, and then add 256 to values +less than 0. +We could also assign to |eight_bits| values, but this causes an error if +runtime checking is turned on. +The integer |temp_int| will be added to global variables at the end, +where it won't disturb module numbering. + +@d fget==begin get(tfm_file); + temp_int:=tfm_file^; + if temp_int<0 then temp_int:=temp_int+256; + end + +@p procedure read_tfm_word; +begin b0:=temp_int; fget; b1:=temp_int; +fget; b2:=temp_int; fget; b3:=temp_int; fget; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [51] Use modified routines to access gf_file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ We shall use another set of simple functions to read the next byte or +bytes from |gf_file|. There are four possibilities, each of which is +treated as a separate function in order to minimize the overhead for +subroutine calls. +@^system dependencies@> + +@p function get_byte:integer; {returns the next byte, unsigned} +var b:eight_bits; +begin if eof(gf_file) then get_byte:=0 +else begin read(gf_file,b); incr(cur_loc); get_byte:=b; + end; +end; +@# +function get_two_bytes:integer; {returns the next two bytes, unsigned} +var a,@!b:eight_bits; +begin read(gf_file,a); read(gf_file,b); +cur_loc:=cur_loc+2; +get_two_bytes:=a*256+b; +end; +@# +function get_three_bytes:integer; {returns the next three bytes, unsigned} +var a,@!b,@!c:eight_bits; +begin read(gf_file,a); read(gf_file,b); read(gf_file,c); +cur_loc:=cur_loc+3; +get_three_bytes:=(a*256+b)*256+c; +end; +@# +function signed_quad:integer; {returns the next four bytes, signed} +var a,@!b,@!c,@!d:eight_bits; +begin read(gf_file,a); read(gf_file,b); read(gf_file,c); read(gf_file,d); +cur_loc:=cur_loc+4; +if a<128 then signed_quad:=((a*256+b)*256+c)*256+d +else signed_quad:=(((a-256)*256+b)*256+c)*256+d; +end; +@y +@ We shall use another set of simple functions to read the next byte or +bytes from |gf_file|. There are four possibilities, each of which is +treated as a separate function in order to minimize the overhead for +subroutine calls. +@^system dependencies@> + +@p function get_byte:integer; {returns the next byte, unsigned} +var b:-128..127; +begin if eof(gf_file) then get_byte:=0 +else begin read(gf_file,b); incr(cur_loc); + if b < 0 then get_byte := b + 256 else get_byte:=b; + end; +end; +@# +function signed_byte:integer; {returns the next byte, signed} +var b:-128..127; +begin read(gf_file,b); incr(cur_loc); +signed_byte:=b; +end; +@# +function get_two_bytes:integer; {returns the next two bytes, unsigned} +var a,b:integer; +begin a := get_byte; b := get_byte; +get_two_bytes:=a*256+b; +end; +@# +function get_three_bytes:integer; {returns the next three bytes, unsigned} +var a,@!b,@!c:integer; +begin a := get_byte; b := get_byte; c := get_byte; +get_three_bytes:=(a*256+b)*256+c; +end; +@# +function signed_quad:integer; {returns the next four bytes, signed} +var a,@!b,@!c,@!d:integer; +begin a := signed_byte; b := get_byte; c := get_byte; d := get_byte; +signed_quad:=((a*256+b)*256+c)*256+d +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [52] change definition of min/max_quarterword +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +the more general memory words of \TeX. On some machines it is necessary to +define |min_quarterword=-128| and |max_quarterword=127| in order to pack +four quarterwords into a single word.) +@^system dependencies@> + +@d min_quarterword=0 {change this to allow efficient packing, if necessary} +@d max_quarterword=255 {ditto} +@y +the more general memory words of \TeX. +With Berkeley {\mc UNIX} Pascal, we need to use the |-128..127| range to pack +an integer subrange into a byte. +@^system dependencies@> + +@d min_quarterword=-128 {change this to allow efficient packing, if necessary} +@d max_quarterword=127 {ditto} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [78] change default extension to ".2602gf" +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +l:=3; init_str3(".")("g")("f")(gf_ext);@/ +@y +l:=7; init_str7(".")("2")("6")("0")("2")("g")("f")(gf_ext);@/ +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [78] change default gray font to "black" +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +l:=4; init_str4("g")("r")("a")("y")(default_gray_font);@/ +@y +l:=5; init_str5("b")("l")("a")("c")("k")(default_gray_font);@/ +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [87] change ">" and ":" to "/" in file name scanning +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The file names we shall deal with for illustrative purposes have the +following structure: If the name contains `\.>' or `\.:', the file area +consists of all characters up to and including the final such character; +otherwise the file area is null. If the remaining file name contains +`\..', the file extension consists of all such characters from the first +remaining `\..' to the end, otherwise the file extension is null. +@^system dependencies@> + +We can scan such file names easily by using two global variables that keep track +of the occurrences of area and extension delimiters: + +@<Glob...@>= +@!area_delimiter:pool_pointer; {the most recent `\.>' or `\.:', if any} +@!ext_delimiter:pool_pointer; {the relevant `\..', if any} +@y +@ The file names we shall deal with for SunOS have the +following structure: If the name contains `\./', the file area +consists of all characters up to and including the final such character; +otherwise the file area is null. If the remaining file name contains +`\..', the file extension consists of all such characters from the first +remaining `\..' to the end, otherwise the file extension is null. +@^system dependencies@> + +We can scan such file names easily by using two global variables that keep track +of the occurrences of area and extension delimiters: + +@<Glob...@>= +@!area_delimiter:pool_pointer; {the most recent `\./', if any} +@!ext_delimiter:pool_pointer; {the relevant `\..', if any} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [88] change home_font_area to null_string (open_tfm provides path) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ Font metric files whose areas are not given +explicitly are assumed to appear in a standard system area called +|home_font_area|. This system area name will, of course, vary from place +to place. The program here sets it to `\.{TeXfonts:}'. +@^system dependencies@> +@.TeXfonts@> + +@<Initialize the strings@>= +l:=9; init_str9("T")("e")("X")("f")("o")("n")("t")("s")(":")(home_font_area);@/ +@y +@ Font metric files whose areas are not given +explicitly are assumed to appear in a standard system area called +|home_font_area|. This system area name will, of course, vary from place +to place. Under the Berkeley {\mc UNIX} version, we set |home_font_area| +to |null_string| because the default areas to search for \.{TFM} files +are built into the routine |test_access|. +@^system dependencies@> + +@<Initialize the strings@>= +l:=0; init_str0(home_font_area);@/ +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [90] change more_name to understand UNIX file name paths +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p function more_name(@!c:ASCII_code):boolean; +begin if c=" " then more_name:=false +else begin if (c=">")or(c=":") then + begin area_delimiter:=pool_ptr; ext_delimiter:=0; + end + else if (c=".")and(ext_delimiter=0) then ext_delimiter:=pool_ptr; + str_room(1); append_char(c); {contribute |c| to the current string} + more_name:=true; + end; +end; +@y +@p function more_name(@!c:ASCII_code):boolean; +begin if c=" " then more_name:=false +else begin if (c="/") then + begin area_delimiter:=pool_ptr; ext_delimiter:=0; + end + else if (c=".")and(ext_delimiter=0) then ext_delimiter:=pool_ptr; + str_room(1); append_char(c); {contribute |c| to the current string} + more_name:=true; + end; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [94] change start_gf to get file name from command line arguments +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The |start_gf| procedure prompts the user for the name of the generic +font file to be input. It opens the file, making sure that some input is +present; then it opens the output file. + +Although this routine is system-independent, it should probably be +modified to take the file name from the command line (without an initial +prompt), on systems that permit such things. + +@p procedure start_gf; +label found,done; +begin loop@+begin print_nl('GF file name: '); input_ln; +@.GF file name@> + buf_ptr:=0; buffer[line_length]:="?"; + while buffer[buf_ptr]=" " do incr(buf_ptr); + if buf_ptr<line_length then + begin @<Scan the file name in the buffer@>; + if cur_ext=null_string then cur_ext:=gf_ext; + pack_file_name(cur_name,cur_area,cur_ext); open_gf_file; + if not eof(gf_file) then goto found; + print_nl('Oops... I can''t find file '); print(name_of_file); +@.Oops...@> +@.I can't find...@> + end; + end; +found:job_name:=cur_name; pack_file_name(job_name,null_string,dvi_ext); +open_dvi_file; +end; +@y +@ The |start_gf| procedure obtains the name of the generic font file to +be input from the command line. +It opens the file, making sure that some input is +present; then it opens the output file. + +@p procedure start_gf; +label done; +var + arg_buffer: packed array [1..file_name_size] of char; + arg_buf_ptr: 1..file_name_size; +begin if (argc > 2) then abort('Usage: gftodvi [GF-file]'); +if argc = 1 then begin + print_nl('GF file name: '); input_ln; +@.GF file name@> + end +else begin + argv(1, arg_buffer); + arg_buf_ptr := 1; + line_length := 0; + while (arg_buf_ptr < file_name_size) + and (arg_buffer[arg_buf_ptr] = ' ') do + incr(arg_buf_ptr); + while (arg_buf_ptr < file_name_size) + and (line_length < terminal_line_length) + and (arg_buffer[arg_buf_ptr] <> ' ') do + begin + buffer[line_length] := xord[arg_buffer[arg_buf_ptr]]; + incr(line_length); + incr(arg_buf_ptr); + end; +end; + buf_ptr:=0; buffer[line_length]:="?"; + while buffer[buf_ptr]=" " do incr(buf_ptr); + if buf_ptr<line_length then + begin @<Scan the file name in the buffer@>; + if cur_ext=null_string then cur_ext:=gf_ext; + pack_file_name(cur_name,cur_area,cur_ext); + gf_file_name:=name_of_file; + open_gf_file; + end; +job_name:=cur_name; pack_file_name(job_name,null_string,dvi_ext); +open_dvi_file; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [98] load_fonts: +% KLUDGE: SUN Pascal compiler incorrectly aligns four_quarters data +% item on stack, which causes long reference to odd address. +% FIX: rearrange four_quarter data to follow aligned long (int) data. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@<Declare the procedure called |load_fonts|@>= +procedure load_fonts; +label done,continue,found,not_found; +var @!f:internal_font_number; +@!i:four_quarters; {font information word} +@!j,@!k,@!v:integer; {registers for initializing font tables} +@!m:title_font..slant_font+area_code; {keyword found} +@!n1:0..longest_keyword; {buffered character being checked} +@y +@<Declare the procedure called |load_fonts|@>= +procedure load_fonts; +label done,continue,found,not_found; +var @!f:internal_font_number; +@!j,@!k,@!v:integer; {registers for initializing font tables} +@!i:four_quarters; {font information word} +@!m:title_font..slant_font+area_code; {keyword found} +@!n1:0..longest_keyword; {buffered character being checked} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [107] write_dvi is now an external C routine +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p procedure write_dvi(@!a,@!b:dvi_index); +var k:dvi_index; +begin for k:=a to b do write(dvi_file,dvi_buf[k]); +end; +@y +For Berkeley {\mc UNIX}, this is going to be handled by an external procedure, +which will do the output using |fwrite|. +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [115] double the page count in the DVI file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +dvi_out(total_pages div 256); dvi_out(total_pages mod 256);@/ +@y +total_pages:=total_pages+total_pages; +dvi_out(total_pages div 256); dvi_out(total_pages mod 256);@/ +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [154] avoid spurious error message +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x + else print_nl('(Tardy font change will be ignored (byte ', +@y + else if pass=1 then print_nl('(Tardy font change will be ignored (byte ', +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [164] do the color separation +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@<Output all rules for the current character@>; +@<Output all labels for the current character@>; +do_pixels; +@y +cross(-655360,-655360); +cross(-655360,page_height+655360); +cross(page_width+655360,-655360); +cross(page_width+655360,page_height+655360); +if pass=1 then + begin @<Output all rules for the current character@>; + @<Output all labels for the current character@>; + skip_pixels; + end +else do_pixels; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [172] supply a secondary page number +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +for k:=3 to 9 do dvi_four(0); +@y +dvi_four(pass); for k:=4 to 9 do dvi_four(0); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [was188,now191] Avoid `oct', a reserved word in SunOS Pascal(!) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d octant==xr {octant code for nearest dot, plus 8 for coincident dots} +@y +@d octant==xr {octant code for nearest dot, plus 8 for coincident dots} +@d oct==octnt {changes variable name since |oct| is reserved word in SunOS} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [was216,now219] call set_paths before gf_start to initialize paths +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p begin initialize; {get all variables initialized} +@<Initialize the strings@>; +start_gf; {open the input and output files} +@<Process the preamble@>; +cur_gf:=get_byte; init_str_ptr:=str_ptr; +loop@+ begin @<Initialize variables for the next character@>; + while (cur_gf>=xxx1)and(cur_gf<=no_op) do @<Process a no-op command@>; + if cur_gf=post then @<Finish the \.{DVI} file and |goto final_end|@>; +@y +@p @<Last-minute procedures@>@; +begin initialize; {get all variables initialized} +@<Initialize the strings@>; +set_paths; {initialize paths for \.{TFM} files from environment if needed} +for pass:=1 to 2 do + begin if pass=1 then + begin start_gf; {open the input and output files} + @<Process the preamble@>; + init_str_ptr:=str_ptr; + end + else begin total_pages:=0; name_of_file:=gf_file_name; open_gf_file; + q:=get_byte; q:=get_byte; k:=get_byte; for m:=1 to k do q:=get_byte; + end; +cur_gf:=get_byte; +loop@+ begin @<Initialize variables for the next character@>; + while (cur_gf>=xxx1)and(cur_gf<=no_op) do @<Process a no-op command@>; + if cur_gf=post then + if pass=1 then goto final_end + else @<Finish the \.{DVI} file and |goto final_end|@>; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [was216,now219] finish normal end with <nl> on terminal; add another `end' +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x + cur_gf:=get_byte; str_ptr:=init_str_ptr; pool_ptr:=str_start[str_ptr]; + end; +final_end:end. +@y + cur_gf:=get_byte; str_ptr:=init_str_ptr; pool_ptr:=str_start[str_ptr]; + end; +final_end:end; +final_final_end:print_ln(' '); +end. +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [was219,now222] declare special globals and procedures +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@* System-dependent changes. +This section should be replaced, if necessary, by changes to the program +that are necessary to make \.{GFtoDVI} work at a particular installation. +It is usually best to design your change file so that all changes to +previous sections preserve the section numbering; then everybody's version +will be consistent with the printed program. More extensive changes, +which introduce new sections, can be inserted here; then only the index +itself will get a new section number. +@^system dependencies@> +@y +@* System-dependent changes. +This section should be replaced, if necessary, by changes to the program +that are necessary to make \.{GFtoDVI} work at a particular installation. +It is usually best to design your change file so that all changes to +previous sections preserve the section numbering; then everybody's version +will be consistent with the printed program. More extensive changes, +which introduce new sections, can be inserted here; then only the index +itself will get a new section number. +@^system dependencies@> + +@<Glob...@>= +@!pass:1..2; {are we doing the first pass (rules) or the second (pixels)?} +@!temp_int:integer; {used for TFM input} +@!last,@!first:0..terminal_line_length; {needed in \.{ext.c}} +@!interrupt:integer; {ditto} +@!first_input:boolean; {true before the first call to |input_ln|} + +@ @<Types in...@>= +@!word_file=file of memory_word; {needed in \.{ext.c}} + +@ Finally, here is a subroutine that draws cross-reference marks. +@<Last-minute...@>= +procedure cross(@!x,@!y:scaled); +begin dvi_goto(x-655360,y+13107); +dvi_out(put_rule); +dvi_four(26214); dvi_four(1310720); +dvi_out(pop);@/ +dvi_goto(x-13107,y+655360); +dvi_out(put_rule); +dvi_four(1310720); dvi_four(26214); +dvi_out(pop); +end; + +@ And still more finally, a subroutine that skips over +the meaty part of a ``character'' in the \.{GF} file. +@<Last-min...@>= +procedure skip_pixels; +label done; +var @!k:integer; {garbage} +begin while cur_gf<>eoc do + begin case cur_gf of + paint1,skip1:k:=get_byte; + paint2,skip2:k:=get_two_bytes; + paint3,skip3:k:=get_three_bytes; + xxx1,xxx2,xxx3,xxx4,yyy,no_op: begin skip_nop; goto done; end; + othercases do_nothing + endcases;@/ + cur_gf:=get_byte; +done: end; +end; +@z diff --git a/systems/knuth/local/mfware/gftopk.ch b/systems/knuth/local/mfware/gftopk.ch new file mode 100644 index 0000000000..4ed4b64ddf --- /dev/null +++ b/systems/knuth/local/mfware/gftopk.ch @@ -0,0 +1,367 @@ +% $Header: gftopk.ch,v 1.4 87/12/05 10:40:15 mackay Released $ + +% Change file for the GFtoPK processor, for use on Berkeley UNIX systems. + +% History: +% +% don upped max_rows on 90/8/30 +% don upgraded to version 2.3 on 90/8/6 +% don upgraded to version 2.2 on 89/11/21 +% +% don made changes for version 2 and SunOS on 89/8/12 +% (I simplified things by borrowing from texware change files) +% +% $Log: gftopk.ch,v $ +% Revision 1.4 87/12/05 10:40:15 mackay +% Released for GFtoPK 1.4; +% +% Revision 1.3 86/12/08 20:20:15 mackay +% Released for GFtoPK 1.3; +% +% Revision 1.2 86/02/01 14:45:21 richards +% Released for GFtoPK 1.2; +% +% +% Revision 1.1 86/01/30 19:56:05 richards +% Initial revision +% + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [0] WEAVE: print changes only +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +\pageno=\contentspagenumber \advance\pageno by 1 +@y +\pageno=\contentspagenumber \advance\pageno by 1 +\let\maybe=\iffalse +\def\title{GF\lowercase{to}PK changes for Berkeley {\mc UNIX}} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1] Change banner string +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d banner=='This is GFtoPK, Version 2.3' {printed when the program starts} +@y +@d banner=='This is GFtoPK, Version 2.3 for SunOS' + {printed when the program starts} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3] Fix others: +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d othercases == others: {default for cases not listed explicitly} +@y +@d othercases == otherwise {SunOS Pascal default cases} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [4] Redefine program header, eliminate gf_file and pxl_file +% add <Parse command line> section to initialize +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p program GFtoPK(@!gf_file,@!pk_file,@!output); +label @<Labels in the outer block@>@/ +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +procedure initialize; {this procedure gets things started properly} + var i:integer; {loop index for initializations} + begin print_ln(banner);@/ + @<Set initial values@>@/ + end; +@y +@p program GFtoPK(@!input,@!output); +label @<Labels in the outer block@>@/ +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +@\@=#include "gftopk_ext.h"@>@\ +procedure initialize; {this procedure gets things started properly} + var i:integer; {loop index for initializations} + begin print_ln(banner);@/ + @<Set initial values@>;@/ + @<Parse command line arguments@>@/ + end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [6] add file_name_size to constants in the outer block +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!line_length=79; {bracketed lines of output will be at most this long} +@!max_row=16000; {largest index in the main |row| array} +@y +@!line_length=79; {bracketed lines of output will be at most this long} +@!max_row=60000; {largest index in the main |row| array} +@!file_name_size=256; {maximum length of a file name} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [8] have abort() add <nl> to end of message +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d abort(#)==begin print(' ',#); jump_out; +@y +@d abort(#)==begin print_ln(' ',#); jump_out; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [37] Add UNIX_file_name type, redefine byte_file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!eight_bits=0..255; {unsigned one-byte quantity} +@!byte_file=packed file of eight_bits; {files that contain binary data} +@y +@!eight_bits=0..255; {unsigned one-byte quantity} +@!UNIX_file_name=packed array [1..file_name_size] of char; +@!byte_file=packed file of -128..127; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [38] add gf_name and pk_name to global vars +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!gf_file:byte_file; {the stuff we are \.{GFtoPK}ing} +@!pk_file:byte_file; {the stuff we have \.{GFtoPK}ed} +@y +@!gf_file:byte_file; {the stuff we are \.{GFtoPK}ing} +@!gf_name: UNIX_file_name; {the name of |gf_file|} +@!pk_file:byte_file; {the stuff we have \.{GFtoPK}ed} +@!pk_name: UNIX_file_name; {the name of |pk_file|} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [39] open_gf_file with extended reset command (can dump core!) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +begin reset(gf_file); +@y +begin if testreadaccess(gf_name) then reset(gf_file,gf_name) +else abort('Can''t open the GF file'); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [40] and open_pk_file... +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +begin rewrite(pk_file); +@y +var j,k,size:integer; startednumber:boolean; +begin +if argc < 3 then begin@/ + @<Generate |pk_name| from |gf_name| and |h_mag|@>@/ + end; +rewrite(pk_file,pk_name); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [43] replace gf_byte and gf_signed_quad +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p function gf_byte:integer; {returns the next byte, unsigned} +var b:eight_bits; +begin if eof(gf_file) then bad_gf('Unexpected end of file!') +@.Unexpected end of file@> +else begin read(gf_file,b); gf_byte:=b; + end; +incr(gf_loc); +end; +@# +function gf_signed_quad:integer; {returns the next four bytes, signed} +var a,@!b,@!c,@!d:eight_bits; +begin read(gf_file,a); read(gf_file,b); read(gf_file,c); read(gf_file,d); +if a<128 then gf_signed_quad:=((a*256+b)*256+c)*256+d +else gf_signed_quad:=(((a-256)*256+b)*256+c)*256+d; +gf_loc := gf_loc + 4 ; +end; +@y +@p function gf_byte:integer; {returns the next byte, unsigned} +var b:-128..127; +begin if eof(gf_file) then bad_gf('Unexpected end of file!') +else begin read(gf_file,b); + if b < 0 then gf_byte := b + 256 else gf_byte:=b; + end; +incr(gf_loc); +end; +@# +function gf_signed_quad:integer; {returns the next four bytes, signed} +var a,@!b,@!c,@!d:integer; +begin read(gf_file,a); b := gf_byte; c := gf_byte; d := gf_byte; +gf_signed_quad:=((a*256+b)*256+c)*256+d +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [44] redefine pk_byte, pk_halfword, pk_three_bytes, and pk_word +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p procedure pk_byte(a:integer) ; +begin + if pk_open then begin + if a < 0 then a := a + 256 ; + write(pk_file, a) ; + incr(pk_loc) ; + end ; +end ; +@# +procedure pk_halfword(a:integer) ; +begin + if a < 0 then a := a + 65536 ; + write(pk_file, a div 256) ; + write(pk_file, a mod 256) ; + pk_loc := pk_loc + 2 ; +end ; +@# +procedure pk_three_bytes(a:integer); +begin + write(pk_file, a div 65536 mod 256) ; + write(pk_file, a div 256 mod 256) ; + write(pk_file, a mod 256) ; + pk_loc := pk_loc + 3 ; +end ; +@# +procedure pk_word(a:integer) ; +var b : integer ; +begin + if pk_open then begin + if a < 0 then begin + a := a + @'10000000000 ; + a := a + @'10000000000 ; + b := 128 + a div 16777216 ; + end else b := a div 16777216 ; + write(pk_file, b) ; + write(pk_file, a div 65536 mod 256) ; + write(pk_file, a div 256 mod 256) ; + write(pk_file, a mod 256) ; + pk_loc := pk_loc + 4 ; + end ; +end ; +@y +@p procedure pk_byte(a:integer) ; +begin + if pk_open then begin + if a < 0 then a := a + 256 ; + if a > 127 then a := a-256; + write(pk_file, a) ; + incr(pk_loc) ; + end ; +end ; +@# +procedure pk_halfword(a:integer) ; +begin + if a < 0 then a := a + 65536 ; + pk_byte(a div 256); pk_byte(a mod 256); +end ; +@# +procedure pk_three_bytes(a:integer); +begin + pk_byte(a div 65536 mod 256) ; + pk_byte(a div 256 mod 256) ; + pk_byte(a mod 256) ; + end ; +@# +procedure pk_word(a:integer) ; +var b : integer ; +begin + if a < 0 then begin + a := a + @'10000000000 ; + a := a + @'10000000000 ; + b := 128 + a div 16777216 ; + end else b := a div 16777216 ; + pk_byte(b) ; + pk_byte(a div 65536 mod 256) ; + pk_byte(a div 256 mod 256) ; + pk_byte(a mod 256) ; + end ; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [46] redefine find_gf_length and move_to_byte +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p procedure find_gf_length ; +begin + set_pos(gf_file, -1) ; gf_len := cur_pos(gf_file) ; +end ; +@# +procedure move_to_byte(@!n : integer) ; +begin + set_pos(gf_file, n); gf_loc := n ; +end ; +@y +@p procedure find_gf_length ; +begin + gf_len := flength(gf_file); +end ; +@# +procedure move_to_byte(@!n : integer) ; +begin + b_seek(gf_file, n); gf_loc := n ; +end ; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [88+] add <Parse command line arguments> section and needed subsections +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@* System-dependent changes. +This section should be replaced, if necessary, by changes to the program +that are necessary to make \.{GFtoPK} work at a particular installation. +It is usually best to design your change file so that all changes to +previous sections preserve the section numbering; then everybody's version +will be consistent with the printed program. More extensive changes, +which introduce new sections, can be inserted here; then only the index +itself will get a new section number. +@^system dependencies@> +@y +@* System-dependent changes. +This section contains additions needed to make \.{GFtoPK} work under +{\mc UNIX}. The additions all deal with obtaining file names from +the invoking command line and if not all arguments are provided, +devising defaults for them. +@^system dependencies@> + +@<Parse command line arguments@>= +if (argc < 2) or (argc > 3) then begin@/ + write_ln('Usage: gftopk GF-file [PK-file]');@/ + goto final_end;@/ + end; +argv(1, gf_name);@/ +if (argc > 2) then@/ + argv(2, pk_name);@/ + +@ Here's a section to construct |pk_name| from |gf_name|, tacking on the +right extension from the magnification of the file. + +@<Generate |pk_name| ...@>= +j:=file_name_size;@/ +while (j > 1) and (gf_name[j] <> '/') do@/ + decr(j); +i:=j; +while (j > 1) do begin@/ + decr(j); pk_name[j] := gf_name[j]; + end; +while (i < file_name_size) and (gf_name[i] <> '.') and (gf_name[i] <> ' ') do begin@/ + pk_name[i] := gf_name[i];@/ + incr(i);@/ + end; +pk_name[i]:='.'; incr(i);@/ +size:=h_mag;@/ +j :=10000;@/ +startednumber:=false;@/ +while (j > 0) do begin@/ + k:=size div j;@/ + size := size mod j;@/ + j:=j div 10; + if startednumber or (k <> 0) or (j = 0) then begin@/ + pk_name[i] := chr(ord('0') + k); incr(i);@/ + startednumber := true;@/ + end;@/ + end;@/ +pk_name[i] := 'p'; incr(i);@/ +pk_name[i] := 'k'; incr(i);@/ +pk_name[i] := ' ';@/ +print_ln('[Output file named ''', pk_name:i-1, ''']');@/ + +@z + diff --git a/systems/knuth/local/mfware/gftopk_ext.c b/systems/knuth/local/mfware/gftopk_ext.c new file mode 100644 index 0000000000..5301fc90be --- /dev/null +++ b/systems/knuth/local/mfware/gftopk_ext.c @@ -0,0 +1,43 @@ +#include "h00vars.h" /* defines Pascal I/O structure */ + +#define namelength 100 /* should agree with gftopk.ch and gftype.ch */ + +bseek(filep,cnt) + register struct iorec *filep; + int cnt; +{ + register FILE *iop; /* stdio-style FILE pointer */ + + iop = filep->fbuf; + fseek(iop,(long)cnt,0); +} + +bool testreadaccess(fn) + char *fn; +{ + register char *p; + + fn[namelength-1] = ' '; + p = fn; + while (*p++ != ' '); + p--; + *p = '\0'; + if (access(fn,4)==0) { + *p = ' '; return(TRUE);} + else {*p = ' '; return(FALSE);} +} + +int flength(filep) + register struct iorec *filep; +{ + register FILE *iop; /* stdio-style FILE pointer */ + register long pos; /* current file position */ + register int len; /* the file length */ + + iop = filep->fbuf; + pos = ftell(iop); + fseek(iop,0L,2); + len = ftell(iop); + fseek(iop,pos,0); + return(len); +} diff --git a/systems/knuth/local/mfware/gftopk_ext.h b/systems/knuth/local/mfware/gftopk_ext.h new file mode 100644 index 0000000000..cd063b1cf1 --- /dev/null +++ b/systems/knuth/local/mfware/gftopk_ext.h @@ -0,0 +1,6 @@ +function flength(var f: bytefile):integer; + external; +procedure bseek(var f: bytefile; loc: integer); + external; +function testreadaccess(var fn: UNIXfilename):boolean; + external; diff --git a/systems/knuth/local/mfware/gftype.ch b/systems/knuth/local/mfware/gftype.ch new file mode 100644 index 0000000000..dc63dad049 --- /dev/null +++ b/systems/knuth/local/mfware/gftype.ch @@ -0,0 +1,430 @@ +% $Header: gftype.ch,v 2.2.1.4 86/01/27 15:43:41 richards Released $ + +% Change file for the GFtype processor, for use on Berkeley UNIX systems. + +% History: +% +% don upgraded to version 3.1 on 3/15/91 +% +% don added testreadaccess (to avoid core dump on bad GF file name) on 89/10/18 +% +% don made changes for version 3 and SunOS on 89/08/12 +% (I simplified things by borrowing from dvitype.ch) +% +% $Log: gftype.ch,v $ +% Revision 2.2.1.4 86/01/27 15:43:41 richards +% Changed: +% text_file type to "text" for Pyramid compiler, +% who doesn't believe packed array of char == text, and +% won't allow write('strings') to it! +% +% Revision 2.2.1.3 86/01/21 22:04:30 richards +% Changed: +% file_name_size and byte_file declaration to agree with binary I/O +% library updates; b_open_in() call to include path specifier +% +% Revision 2.2.1.2 86/01/21 15:54:21 richards +% Changed: +% interface to byte I/O again; now cur_loc is back to a variable, +% and b_set_ptr() saves addr of cur_loc so it can be kept in +% sync with files. b_file_loc() was called more frequently than +% I thought... +% +% Revision 2.2.1.1 86/01/20 22:06:53 richards +% Incorporate new Byte-I/O routines in place of fudging Pascal into +% reading bytes; for Pyramid .... +% +% Revision 2.2 85/10/18 23:31:09 richards +% Updated for GFtype Version 2.2 +% +% Revision 2.1 85/03/03 21:41:49 richards +% Updated to GF utilities distributed with MF Version 0.77 +% (New GF file format) +% +% Revision 2.0 84/12/16 22:42:52 richards +% Updated for GFtype Version 2.0 (New GF file format) +% +% Revision 1.2 84/12/06 02:35:40 richards +% Updated to GFtype Version 1.2; merged in changes from sdcarl!rusty +% +% Revision 0.0 84/11/10 02:13:19 richards +% Base version for GFtype 0.0 +% +% + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [0] WEAVE: print changes only +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +\pageno=\contentspagenumber \advance\pageno by 1 +@y +\pageno=\contentspagenumber \advance\pageno by 1 +\let\maybe=\iffalse +\def\title{GF$\,$\lowercase{type} changes for Berkeley {\mc UNIX}} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1] Change banner string +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d banner=='This is GFtype, Version 3.1' {printed when the program starts} +@y +@d banner=='This is GFtype, Version 3.1 for SunOS' + {printed when the program starts} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [2] Case statement default feature of SunOS Pascal +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d othercases == others: {default for cases not listed explicitly} +@y +@d othercases == otherwise {default for cases not listed explicitly} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3] Redirect GFtype output to correct output file +% depending on gfout_active value +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d print(#)==write(#) +@d print_ln(#)==write_ln(#) +@d print_nl==write_ln +@y +@d print(#)==begin if gfout_active then write(gftyout,#) else write(#) end +@d print_ln(#)==begin if gfout_active then write_ln(gftyout,#) + else write_ln(#) end +@d print_nl==begin if gfout_active then write_ln(gftyout) else write_ln end +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3] Change program header to standard input/output; include external header +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p program GF_type(@!gf_file,@!output); +label @<Labels in the outer block@>@/ +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +procedure initialize; {this procedure gets things started properly} + var i:integer; {loop index for initializations} + begin print_ln(banner);@/ + @<Set initial values@>@/ + end; +@y +@p program GF_type(@!input,@!output); +label @<Labels in the outer block@>@/ +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +@\@=#include "gftopk_ext.h"@>@\ +procedure initialize; {this procedure gets things started properly} + var i:integer; {loop index for initializations} + begin @<Set initial values@>@/ + @<Parse command line arguments@>; + end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [5] Add file_name_size to constants +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@<Constants...@>= +@!terminal_line_length=150; {maximum number of characters input in a single + line of input from the terminal} +@!line_length=79; {\\{xxx} strings will not produce lines longer than this} +@!max_row=79; {vertical extent of pixel image array} +@!max_col=79; {horizontal extent of pixel image array} +@y +@<Constants...@>= +@!terminal_line_length=150; {maximum number of characters input in a single + line of input from the terminal} +@!line_length=79; {\\{xxx} strings will not produce lines longer than this} +@!max_row=79; {vertical extent of pixel image array} +@!max_col=79; {horizontal extent of pixel image array} +@!file_name_size=100; {max length of file name on command line} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [7] Have abort append <nl> to end of msg +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d abort(#)==begin print(' ',#); jump_out; +@y +@d abort(#)==begin print_ln(' ',#); jump_out; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [20] Change definition of 'byte_file' to correct subrange +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +We shall stick to simple \PASCAL\ in this program, for reasons of clarity, +even if such simplicity is sometimes unrealistic. + +@<Types...@>= +@!eight_bits=0..255; {unsigned one-byte quantity} +@!byte_file=packed file of eight_bits; {files that contain binary data} +@y +On Berkeley {\mc UNIX}, we have to use |-128..127| for byte files, as +explained in the \TeX\ changes. + +@<Types...@>= +@!eight_bits=0..255; {unsigned one-byte quantity} +@!byte_file=packed file of -128..127; {files that contain binary data} +@!UNIX_file_name=packed array[1..file_name_size] of char; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [21] Add gf_name declaration +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The program deals with one binary file variable: |gf_file| is the main +input file that we are translating into symbolic form. + +@<Glob...@>= +@!gf_file:byte_file; {the stuff we are \.{GF}typing} +@y +@ The program deals with one binary file variable: |gf_file| is the main +input file that we are translating into symbolic form. +We also declare array |gf_name|, used to hold the name of |gf_file|. + +@<Glob...@>= +@!gf_file:byte_file; {the stuff we are \.{GF}typing} +@!gf_name: UNIX_file_name; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [22] Change to file opening +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|} +begin reset(gf_file); +@y +The local /PASCAL/ runtimes will dump core if the file isn't present. +We avoid that by using an external procedure. + +@p procedure open_gf_file; {prepares to read packed bytes in |gf_file|} +begin if testreadaccess(gf_name) then reset(gf_file,gf_name) +else abort('Can''t read the GF file'); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [24] Use modified routines to access gf_file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p function get_byte:integer; {returns the next byte, unsigned} +var b:eight_bits; +begin if eof(gf_file) then get_byte:=0 +else begin read(gf_file,b); incr(cur_loc); get_byte:=b; + end; +end; +@# +function get_two_bytes:integer; {returns the next two bytes, unsigned} +var a,@!b:eight_bits; +begin read(gf_file,a); read(gf_file,b); +cur_loc:=cur_loc+2; +get_two_bytes:=a*256+b; +end; +@# +function get_three_bytes:integer; {returns the next three bytes, unsigned} +var a,@!b,@!c:eight_bits; +begin read(gf_file,a); read(gf_file,b); read(gf_file,c); +cur_loc:=cur_loc+3; +get_three_bytes:=(a*256+b)*256+c; +end; +@# +function signed_quad:integer; {returns the next four bytes, signed} +var a,@!b,@!c,@!d:eight_bits; +begin read(gf_file,a); read(gf_file,b); read(gf_file,c); read(gf_file,d); +cur_loc:=cur_loc+4; +if a<128 then signed_quad:=((a*256+b)*256+c)*256+d +else signed_quad:=(((a-256)*256+b)*256+c)*256+d; +end; +@y +@p function get_byte:integer; {returns the next byte, unsigned} +var b:-128..127; +begin if eof(gf_file) then get_byte:=0 +else begin read(gf_file,b); incr(cur_loc); + if b < 0 then get_byte := b + 256 else get_byte:=b; + end; +end; +@# +function signed_byte:integer; {returns the next byte, signed} +var b:-128..127; +begin read(gf_file,b); incr(cur_loc); +signed_byte:=b; +end; +@# +function get_two_bytes:integer; {returns the next two bytes, unsigned} +var a,b:integer; +begin a := get_byte; b := get_byte; +get_two_bytes:=a*256+b; +end; +@# +function get_three_bytes:integer; {returns the next three bytes, unsigned} +var a,@!b,@!c:integer; +begin a := get_byte; b := get_byte; c := get_byte; +get_three_bytes:=(a*256+b)*256+c; +end; +@# +function signed_quad:integer; {returns the next four bytes, signed} +var a,@!b,@!c,@!d:integer; +begin a := signed_byte; b := get_byte; c := get_byte; d := get_byte; +signed_quad:=((a*256+b)*256+c)*256+d +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [27] Set term_in and term_out to standard input/output +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The |input_ln| routine waits for the user to type a line at his or her +terminal; then it puts ASCII-code equivalents for the characters on that line +into the |buffer| array. The |term_in| file is used for terminal input, +and |term_out| for terminal output. +@^system dependencies@> + +@<Glob...@>= +@!buffer:array[0..terminal_line_length] of ASCII_code; +@!term_in:text_file; {the terminal, considered as an input file} +@!term_out:text_file; {the terminal, considered as an output file} +@y +@ The |input_ln| routine waits for the user to type a line at his or her +terminal; then it puts ASCII-code equivalents for the characters on that line +into the |buffer| array. The |term_in| file is used for terminal input, +and |term_out| for terminal output. +@^system dependencies@> + +@d term_in == input {standard input} +@d term_out == output {standard output} + +@<Glob...@>= +@!buffer:array[0..terminal_line_length] of ASCII_code; +@!gftyout: text_file; {output from program} +@!gfout_name: packed array[1..file_name_size] of char; {file name} +@!gfout_active: boolean; {true if |gftyout| is open and ready to write} +@!first_input: boolean; {true before the first call of |input_ln|} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [28] update_terminal becomes flush() +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d update_terminal == break(term_out) {empty the terminal output buffer} +@y +@d update_terminal == flush(term_out) {empty the terminal output buffer} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [29] eliminate reset() from input_ln +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p procedure input_ln; {inputs a line from the terminal} +var k:0..terminal_line_length; +begin update_terminal; reset(term_in); +if eoln(term_in) then read_ln(term_in); +k:=0; +while (k<terminal_line_length)and not eoln(term_in) do + begin buffer[k]:=xord[term_in^]; incr(k); get(term_in); + end; +buffer[k]:=" "; +end; +@y +@p procedure input_ln; {inputs a line from the terminal} +var k:0..terminal_line_length; +begin update_terminal; +if first_input then first_input:=false +else if eoln(term_in) then read_ln(term_in); +k:=0; +while (k<terminal_line_length)and not eoln(term_in) do + begin buffer[k]:=xord[term_in^]; incr(k); get(term_in); + end; +buffer[k]:=" "; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [31] eliminate rewrite() from dialog +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p procedure dialog; +label 1,2; +begin rewrite(term_out); {prepare the terminal for output} +write_ln(term_out,banner);@/ +@<Determine whether the user |wants_mnemonics|@>; +@<Determine whether the user |wants_pixels|@>; +@<Print all the selected options@>; +end; +@y +@p procedure dialog; +label 1,2; +begin +write_ln(term_out,banner);@/ +@<Determine whether the user |wants_mnemonics|@>; +@<Determine whether the user |wants_pixels|@>; +@<Print all the selected options@>; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [65] finish last line written to statistics (stdout) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +print('The file had ',total_chars:1,' character'); +if total_chars<>1 then print('s'); +print(' altogether.'); +@.The file had n characters...@> +final_end:end. +@y +print('The file had ',total_chars:1,' character'); +if total_chars<>1 then print('s'); +print_ln(' altogether.'); +@.The file had n characters...@> +final_end:end. +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [74,75,76] Add new code to parse command line arguments +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@* System-dependent changes. +This section should be replaced, if necessary, by changes to the program +that are necessary to make \.{GFtype} work at a particular installation. +It is usually best to design your change file so that all changes to +previous sections preserve the section numbering; then everybody's version +will be consistent with the printed program. More extensive changes, +which introduce new sections, can be inserted here; then only the index +itself will get a new section number. +@^system dependencies@> +@y +@* System-dependent changes. +This section contains additions to \.{GFtype} necessary to integrate it +into the {\mc UNIX} environment. The primary addition is a section to +parse command line arguments and put file names into their correct +variables, if needed. +@^system dependencies@> + +@ The command line issued to start \.{GFtype} should also contain the +names of the input (GF) file, and optionally, the name of an output +file to receive the output from \.{GFtype}. This segment decodes +the command line, and saves the file names in the appropriate variables. +@^system dependencies@> + +@<Parse command...@>= +if (argc < 2) or (argc > 3) then + begin print_ln('Usage: gftype GFfile [outputfile]');@/ + goto final_end; { we will be unstructured just this once } + end; +argv(1, gf_name); +if argc > 2 then + begin argv(2, gfout_name);@/ + rewrite(gftyout, gfout_name);@/ + gfout_active := true;@/ + print_ln(banner);@/ + end + +@ We also need to initialize the values of the new boolean variables +we introduced. + +@<Set initial ...@>= +gfout_active:=false; +first_input:=true; +@z + diff --git a/systems/knuth/local/mfware/mft.ch b/systems/knuth/local/mfware/mft.ch new file mode 100644 index 0000000000..9f4d1e0821 --- /dev/null +++ b/systems/knuth/local/mfware/mft.ch @@ -0,0 +1,534 @@ +% Change file for the MFT processor, for use on Berkeley UNIX systems. +% This file was created by Pierre MacKay, and is based on the +% change file for WEAVE written by Howard Trickey and Pavel Curtis. + +% History: +% 6/09/86--WEAVE change file copied in entirety and renamed to +% refer to MFT. +% +% 10/16/89 modified by don for SunOS, brought up to version 2.0 +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [0] MFT: print changes only +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +\pageno=\contentspagenumber \advance\pageno by 1 +@y +\pageno=\contentspagenumber \advance\pageno by 1 +\let\maybe=\iffalse +\def\title{MFT changes for Berkeley {\mc UNIX}} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [2] Change banner message +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d banner=='This is MFT, Version 2.0' +@y +@d banner=='This is MFT, Version 2.0 for SunOS' +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3] add input and output, remove other files, add ref to scan_args, +% [3] and #include external definition for exit(), etc. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +program MFT(@!mf_file,@!change_file,@!style_file,@!tex_file); +label end_of_MFT; {go here to finish} +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +@<Error handling procedures@>@/ +@y +program MFT(@!input,@!output); +label end_of_MFT; {go here to finish} +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +@\ +@=#include "mft_ext.h"@> +@\@/ +@<Error handling procedures@>@/ +@<|scan_args| procedure@>@/ +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [4] compiler options +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@{@&$C+,A+,D-@} {range check, catch arithmetic overflow, no debug overhead} +@y +@=(*$C-*)@> {no range check} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [7] Fix others: +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d othercases == others: {default for cases not listed explicitly} +@y +@d othercases == otherwise {SunOS Pascal default cases} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [13] declare UNIX_file_name type +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!text_file=packed file of text_char; +@y +@!text_file=packed file of text_char; +@!UNIX_file_name = packed array[1..max_file_name_length] of char; +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [20] terminal output: use standard i/o +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d print(#)==write(term_out,#) {`|print|' means write on the terminal} +@y +@d term_out==output +@d print(#)==write(term_out,#) {`|print|' means write on the terminal} +@z + +@x +@<Globals...@>= +@!term_out:text_file; {the terminal as an output file} +@y + +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [21] init terminal +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ Different systems have different ways of specifying that the output on a +certain file will appear on the user's terminal. Here is one way to do this +on the \PASCAL\ system that was used in \.{WEAVE}'s initial development: +@^system dependencies@> + +@<Set init...@>= +rewrite(term_out,'TTY:'); {send |term_out| output to the terminal} +@y +@ Different systems have different ways of specifying that the output on a +certain file will appear on the user's terminal. +@^system dependencies@> + +@<Set init...@>= +; {nothing need be done} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [22] flush terminal buffer +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d update_terminal == break(term_out) {empty the terminal output buffer} +@y +@d update_terminal == flush(term_out) {empty the terminal output buffer} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [24] open input files +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The following code opens the input files. Since these files were listed +in the program header, we assume that the \PASCAL\ runtime system has +already checked that suitable file names have been given; therefore no +additional error checking needs to be done. +@^system dependencies@> + +@p procedure open_input; {prepare to read the inputs} +begin reset(mf_file); reset(change_file); reset(style_file); +end; +@y +@ The following code opens the input files. +This is called after |scan_args| has filled the file name variables +appropriately. +We use this opportunity, to define some constants related to file opening +and the use of paths. These constants are repeated in mft_ext.c and +must match the values given there. + +@d read_access_mode=4 {``read'' mode for |test_access|} +@d write_access_mode=2 {``write'' mode for |test_access|} + +@d no_file_path=0 {no path searching should be done} +@d good_file_path=3 {path specifier for style files} + +@^system dependencies@>@^changes for Berkeley {\mc UNIX}@> + +@p procedure open_input; {prepare to read inputs} +var i:integer; +begin if test_read_access(mf_name) then + begin reset(mf_file,mf_name); + if test_read_access(change_name) then + begin reset(change_file,change_name); + if test_access(read_access_mode,good_file_path) then + reset(style_file,real_name_of_file) + else begin i:=1; + while real_name_of_file[i]<>chr(0) do incr(i); + print_nl('! Can''t open the style file ',real_name_of_file:i); + mark_fatal; + jump_out; + end; + end + else begin i:=1; change_name[max_file_name_length]:=' '; + while change_name[i]<>' ' do incr(i); + print_nl('! Can''t open the change file ',change_name:i); + mark_fatal; jump_out; + end; + end +else begin i:=1; mf_name[max_file_name_length]:=' '; + while mf_name[i]<>' ' do incr(i); + print_nl('! Can''t open the METAFONT source file ',mf_name:i); + mark_fatal; jump_out; + end; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [26] opening \TeX\ file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The following code opens |tex_file|. +Since this file was listed in the program header, we assume that the +\PASCAL\ runtime system has checked that a suitable external file name has +been given. +@^system dependencies@> + +@<Set init...@>= +rewrite(tex_file); +@y +@ The following code opens |tex_file|. +The |scan_args| procedure is used to set up |tex_name| as required. +@^system dependencies@> + +@<Set init...@>= +scan_args; +rewrite(tex_file,tex_name); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [28] faster input_ln +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p function input_ln(var f:text_file):boolean; + {inputs a line or returns |false|} +var final_limit:0..buf_size; {|limit| without trailing blanks} +begin limit:=0; final_limit:=0; +if eof(f) then input_ln:=false +else begin while not eoln(f) do + begin buffer[limit]:=xord[f^]; get(f); + incr(limit); + if buffer[limit-1]<>" " then final_limit:=limit; + if limit=buf_size then + begin while not eoln(f) do get(f); + decr(limit); {keep |buffer[buf_size]| empty} + if final_limit>limit then final_limit:=limit; + print_nl('! Input line too long'); loc:=0; error; +@.Input line too long@> + end; + end; + read_ln(f); limit:=final_limit; input_ln:=true; + end; +end; +@y +With Berkeley {\mc UNIX} we call an external C procedure, |line_read|. +That routine fills |buffer| from 0 onwards with the |xord|'ed values +of the next line, setting |limit| appropriately (ignoring trailing +blanks). +It will stop if |limit=buf_size|, and the following will cause an error +message. +Note: for bootstrapping purposes it is all right to use the original form +of |input_ln|; it will just run slower. + +@p function input_ln(var f:text_file):boolean; + {inputs a line or returns |false|} +begin limit:=0; +if test_eof(f) then input_ln:=false +else begin line_read(f); + if limit=buf_size then + begin + decr(limit); {keep |buffer[buf_size]| empty} + print_nl('! Input line too long'); loc:=0; error; +@.Input line too long@> + end; + input_ln:=true; + end; +end; +@z + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [87] faster flush_buffer +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +done: for k:=1 to j do write(tex_file,xchr[out_buf[k]]); +@y +done: linewrite(tex_file,j); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [112] print newline at end of run and exit based upon value of history +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +Let's put it all together now: \.{MFT} starts and ends here. +@^system dependencies@> + +@y +Let's put it all together now: \.{MFT} starts and ends here. +@^system dependencies@> + +@d UNIXexit==e@&x@&i@&t + +@z + +@x +end. +@y +new_line; +if (history <> spotless) and (history <> harmless_message) then + UNIXexit(1) +else + UNIXexit(0); +end. +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [114] system dependent changes--the scan_args procedure +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@* System-dependent changes. +This module should be replaced, if necessary, by changes to the program +that are necessary to make \.{MFT} work at a particular installation. +It is usually best to design your change file so that all changes to +previous modules preserve the module numbering; then everybody's version +will be consistent with the printed program. More extensive changes, +which introduce new modules, can be inserted here; then only the index +itself will get a new module number. +@^system dependencies@> +@y +@* System-dependent changes. +The user calls \.{MFT} with arguments on the command line. +These are either file names or flags (beginning with '-'). +The following globals are for communicating the user's desires to the rest +of the program. The various |file_name| variables contain strings with +the full names of those files, as UNIX knows them. + +The only flags that affect \.{MFT} are |'-c'| and |'-s'| whose +status is kept in |no_change| and |no_style|. + +@d max_file_name_length==100 + +@<Globals...@>= +@!mf_name,@!change_name,@!style_name,@!tex_name, + @!real_name_of_file: UNIX_file_name; +@!no_change,no_style:boolean; + +@ The |scan_args| procedure looks at the command line arguments and sets +the |file_name| variables accordingly. + +At least one file name must be present as the first argument: +the \.{mf} file. It may have +an extension, or it may omit it to get |'.mf'| added. +If there is only one file name, the output file name is formed by replacing +the \.{mf} file name extension by |'.tex'|. +Thus, the command line \.{mft foo} implies the use of the \METAFONT\ +input file \.{foo.mf} and the output file \.{foo.tex}. +If this style of command line, with only one argument is used, +the default style file, |plain.mft|, will be used to provide +minimal formatting. + +An argument beginning with a minus sign is a flag. +Any letters following the minus sign may cause global +flag variables to be set. +Currently, a |c| means that there is a change file, and an |s| means +that there is a style file. The auxiliary files must +of course appear in the same order as the flags. For example, +the flag -sc must be followed by the name of the |style_file| first, +and then the name of the |change_file|. + +@<|scan_args|...@>= +procedure scan_args; +var dot_pos,i,a: integer; {indices} +@!which_file_next: char; +@!fname: array[1..max_file_name_length-5] of char; {temporary argument holder} +@!found_mf,@!found_change,found_style: boolean; {|true| when those + file names have been seen} +begin +setpaths; {Get path for style file from \.{MFINPUTS}} +found_mf:=false; +@<Set up null change file@>; found_change:=true; {Default to no change file} +@<Set up plain style file@>; found_style:=true; {Default to plain style file} +for a:=1 to argc-1 do begin + argv(a,fname); {put argument number |a| into |fname|} + if fname[1]<>'-' then begin + if not found_mf then + @<Get |mf_name| from |fname|, and set up |tex_name@> + else + if not found_change then begin + if which_file_next <> 's' then begin + @<Get |change_name| from |fname|@>; + which_file_next := 's' + end + else @<Get |style_name| from |fname|@> + end + else if not found_style then begin + if which_file_next = 's' then begin + @<Get |style_name| from |fname|@>; + which_file_next := 'c' + end; + end + else @<Print usage error message and quit@>; + end + else @<Handle flag argument in |fname|@>; + end; +if not found_mf then @<Print usage error message and quit@>; +end; + +@ Use all of |fname| for the |mf_name| if there is a |'.'| in it, +otherwise add |'.mf'|. +The \TeX\ file name comes from adding things after the dot. +The |argv| procedure will not put more than |max_file_name_length-5| +characters into |fname|, and this leaves enough room in the |file_name| +variables to add the extensions. + +The end of a file name is marked with a |' '|, the convention assumed by +the |reset| and |rewrite| procedures. + +@<Get |mf_name|...@>= +begin +dot_pos:=-1; +i:=1; +while (fname[i]<>' ') and (i<=max_file_name_length-5) do begin + mf_name[i]:=fname[i]; + if fname[i]='.' then dot_pos:=i; + incr(i); + end; +if dot_pos=-1 then begin + dot_pos:=i; + mf_name[dot_pos]:='.'; + mf_name[dot_pos+1]:='m'; + mf_name[dot_pos+2]:='f'; + mf_name[dot_pos+3]:=' '; + end +else mf_name[i]:=' '; +for i:=1 to dot_pos do begin + tex_name[i]:=mf_name[i]; + end; +tex_name[dot_pos+1]:='t'; +tex_name[dot_pos+2]:='e'; +tex_name[dot_pos+3]:='x'; +tex_name[dot_pos+4]:=' '; +which_file_next := 'z'; +found_mf:=true; +end + +@ Use all of |fname| for the |change_name| if there is a |'.'| in it, +otherwise add |'.ch'|. + +@<Get |change_name|...@>= +begin +dot_pos:=-1; +i:=1; +while (fname[i]<>' ') and (i<=max_file_name_length-5) +do begin + change_name[i]:=fname[i]; + if fname[i]='.' then dot_pos:=i; + incr(i); + end; +if dot_pos=-1 then begin + dot_pos:=i; + change_name[dot_pos]:='.'; + change_name[dot_pos+1]:='c'; + change_name[dot_pos+2]:='h'; + change_name[dot_pos+3]:=' '; + end +else change_name[i]:=' '; +which_file_next := 'z'; +found_change:=true; +end + +@ Use all of |fname| for the |style_name| if there is a |'.'| in it, +otherwise add |'.mft'|. + + +@<Get |style_name|...@>= +begin +dot_pos:=-1; +i:=1; +while (fname[i]<>' ') and (i<=max_file_name_length-5) +do begin + style_name[i]:=fname[i]; + if fname[i]='.' then dot_pos:=i; + incr(i); + end; +if dot_pos=-1 then begin + dot_pos:=i; + style_name[dot_pos]:='.'; + style_name[dot_pos+1]:='m'; + style_name[dot_pos+2]:='f'; + style_name[dot_pos+3]:='t'; + style_name[dot_pos+4]:=' '; + end +else style_name[i]:=' '; +which_file_next := 'z'; +found_style:=true; +end + +@ + +@<Set up null change file@>= +begin + change_name[1]:='/'; + change_name[2]:='d'; + change_name[3]:='e'; + change_name[4]:='v'; + change_name[5]:='/'; + change_name[6]:='n'; + change_name[7]:='u'; + change_name[8]:='l'; + change_name[9]:='l'; + change_name[10]:=' '; +end + +@ + +@<Set up plain style file@>= +begin + style_name[1]:='p'; + style_name[2]:='l'; + style_name[3]:='a'; + style_name[4]:='i'; + style_name[5]:='n'; + style_name[6]:='.'; + style_name[7]:='m'; + style_name[8]:='f'; + style_name[9]:='t'; + style_name[10]:=' '; +end + +@ + +@<Handle flag...@>= +begin +i:=2; +while (fname[i]<>' ') and (i<=max_file_name_length-5) do begin + if fname[i]='c' then begin found_change:=false; + if which_file_next <> 's' then which_file_next := 'c' + end + else if fname[i]='s' then begin found_style:=false; + if which_file_next <> 'c' then which_file_next := 's' + end + else print_nl('Invalid flag ',xchr[xord[fname[i]]]); + incr(i); + end; +end + +@ + +@<Print usage error message and quit@>= +begin +print_nl('! Usage: mft file[.mf] [-cs] [change[.ch]] [style[.mft]] '); +error; mark_fatal; +jump_out; +end + +@z diff --git a/systems/knuth/local/mfware/mft_ext.c b/systems/knuth/local/mfware/mft_ext.c new file mode 100644 index 0000000000..b8fe8d31e6 --- /dev/null +++ b/systems/knuth/local/mfware/mft_ext.c @@ -0,0 +1,249 @@ +/* External procedures for MFT*/ +/* (culled from weavext.c and ext.c for WEAVE and TeX) */ +/* Written by: H. Trickey, 11/17/83 */ +/* (modified for 8-bit input by don on 10/16/89) */ + +/* Note: these procedures aren't necessary; the default input_ln and + * flush_buffer routines in tangle/weave work fine on UNIX. + * However a very big time improvement is achieved by using these. + * + * These procedures are the same as for tangle, except for a slight offset + * in which characters are output from outbuf in linewrite. + */ + +#define BUF_SIZE 100 /* should agree with mft.web */ + +#include "mfpaths.h" /* defines default MFINPUTS path */ +#include "h00vars.h" /* defines Pascal I/O structure */ + +extern short buffer[]; /* 0..BUF_SIZE. Input goes here */ +extern short outbuf[]; /* 0..OUT_BUF_SIZE. Output from here */ +extern short xord[]; +extern char xchr[]; /* character translation arrays */ +extern char limit; /* index into buffer. Note that limit + is 0..buf_size (= 0..100) in mft.web; this + differs from the definition in weave.web */ + +/* + * lineread reads from the Pascal text file with iorec pointer filep + * into buffer[0], buffer[1],..., buffer[limit-1] (and + * setting "limit"). + * Characters are read until a newline is found (which isn't put in the + * buffer) or until the next character would go into buffer[BUF_SIZE]. + * And trailing blanks are to be ignored, so limit is really set to + * one past the last non-blank. + * The characters need to be translated, so really xord[c] is put into + * the buffer when c is read. + * If end-of-file is encountered, the funit field of *filep is set + * appropriately. + */ +lineread(filep) +struct iorec *filep; +{ + register c; + register short *cs; /* pointer into buffer where next char goes */ + register short *cnb; /* last non-blank character input */ + register FILE *iop; /* stdio-style FILE pointer */ + register int l; /* how many chars allowed before buffer overflow */ + + iop = filep->fbuf; + cnb = cs = &(buffer[0]); + l = BUF_SIZE; + /* overflow when next char would go into buffer[BUF_SIZE] */ + while (--l>=0 && (c = getc(iop)) != EOF && c!='\n') + if((*cs++ = xord[c])!=' ') cnb = cs; + if (c == EOF) + filep->funit |= EOFF; /* we hit end-of-file */ + limit = cnb-&(buffer[0]); +} + +/* + * linewrite writes to the Pascal text file with iorec pointer filep + * from outbuf[1], outbuf[1],..., outbuf[cnt]. + * (Note the offset of indices vis a vis the tangext version of this.) + * Translation is done, so that xchr[c] is output instead of c. + */ + linewrite(filep,cnt) + struct iorec *filep; + int cnt; + { + register FILE *iop; /* stdio-style FILE pointer */ + register short *cs; /* pointer to next character to output */ + register int l; /* how many characters left to output */ + + iop = filep->fbuf; + cs = &(outbuf[1]); + l = cnt; + while (--l>=0) putc(xchr[*cs++],iop); +} + +/* +** testeof(filep) +** +** Test whether or not the Pascal text file with iorec pointer filep +** has reached end-of-file (when the only I/O on it is done with +** lineread, above). +** We may have to read the next character and unget it to see if perhaps +** the end-of-file is next. +*/ + +bool +testeof(filep) +register struct iorec *filep; +{ + register char c; + register FILE *iop; /* stdio-style FILE pointer */ + if (filep->funit & EOFF) + return(TRUE); + else { /* check to see if next is EOF */ + iop = filep->fbuf; + c = getc(iop); + if (c == EOF) + return(TRUE); + else { + ungetc(c,iop); + return(FALSE); + } + } +} +/* and now, some routines to implement paths for file names. These routines + are taken from Howard Trickey's port of dvitype (2/19/84). Howard + adapted them from his port of TeX, ext.c */ + +char *inputpath; + +char *getenv(); + +/* + * setpaths is called to set up the pointer inputpath + * as follows: if the user's environment has a value for TEXINPUTS + * then use it; otherwise, use defaultinputpath. + */ +setpaths() +{ + register char *envpath; + + if ((envpath = getenv("TEXINPUTS")) != NULL) + inputpath = envpath; + else + inputpath = defaultinputpath; +} + +#define maxfilenamelength 100 /* should agree with mft.ch */ +extern char stylename[],realnameoffile[]; /* these have size namelength */ + +/* + * testaccess(amode,filepath) + * + * Test whether or not the file whose name is in the global curname + * can be opened for reading (if mode=READACCESS) + * or writing (if mode=WRITEACCESS). +* [the code here isn't as general as it should be ... it assumes that stylefile +* is the only file name of interest! Maybe I'll fix this some day -- don] + * + * The filepath argument is one of the ...FILEPATH constants defined below. + * If the filename given in curname does not begin with '/', we try + * prepending all the ':'-separated areanames in the appropriate path to the + * filename until access can be made, if it ever can. + * + * The realnameoffile global array will contain the name that yielded an + * access success. + */ + +/* note that corresponding constants are defined in mft.ch */ + +#define READACCESS 4 +#define WRITEACCESS 2 + +#define NOFILEPATH 0 +#define GOODFILEPATH 3 + +bool +testaccess(amode,filepath) + int amode,filepath; +{ + register bool ok; + register char *p; + char *curpathplace; + int f; + + switch(filepath) { + case NOFILEPATH: curpathplace = NULL; break; + case GOODFILEPATH: curpathplace = inputpath; break; + } + if (stylename[0]=='/') /* file name has absolute path */ + curpathplace = NULL; + do { + packrealnameoffile(&curpathplace); + if (amode==READACCESS) + /* use system call "access" to see if we could read it */ + if (access(realnameoffile,READACCESS)==0) ok = TRUE; + else ok = FALSE; + else { + /* WRITEACCESS: use creat to see if we could create it, but close + the file again if we're OK, to let pc open it for real */ + f = creat(realnameoffile,0666); + if (f>=0) ok = TRUE; + else ok = FALSE; + if (ok) + close(f); + } + } while (!ok && curpathplace != NULL); + if (ok) { /* pad realnameoffile with blanks, as Pascal wants */ + for (p = realnameoffile; *p != '\0'; p++) + /* nothing: find end of string */ ; + while (p < &(realnameoffile[maxfilenamelength])) + *p++ = ' '; + } + return (ok); +} + +/* + * packrealnameoffile(cpp) makes realnameoffile contain the directory at *cpp, + * followed by '/', followed by the characters in stylename up until the + * first blank there, and finally a '\0'. The cpp pointer is left pointing + * at the next directory in the path. + * But: if *cpp == NULL, then we are supposed to use stylename as is. + */ +packrealnameoffile(cpp) + char **cpp; +{ + register char *p,*realname; + + realname = realnameoffile; + if ((p = *cpp)!=NULL) { + while ((*p != ':') && (*p != '\0')) { + *realname++ = *p++; + if (realname == &(realnameoffile[maxfilenamelength-1])) + break; + } + if (*p == '\0') *cpp = NULL; /* at end of path now */ + else *cpp = p+1; /* else get past ':' */ + *realname++ = '/'; /* separate the area from the name to follow */ + } + /* now append stylename to realname... */ + p = stylename; + while (*p != ' ') { + if (realname >= &(realnameoffile[maxfilenamelength-1])) { + fprintf(stderr,"! Full file name is too long\n"); + break; + } + *realname++ = *p++; + } + *realname = '\0'; +} + +bool testreadaccess(fn) + char *fn; +{ + register char *p; + + fn[maxfilenamelength-1] = ' '; + p = fn; + while (*p++ != ' '); + p--; + *p = '\0'; + if (access(fn,4)==0) { + *p = ' '; return(TRUE);} + else {*p = ' '; return(FALSE);} +} diff --git a/systems/knuth/local/mfware/mft_ext.h b/systems/knuth/local/mfware/mft_ext.h new file mode 100644 index 0000000000..85090d43e6 --- /dev/null +++ b/systems/knuth/local/mfware/mft_ext.h @@ -0,0 +1,16 @@ +procedure exit(x : integer); + external; +procedure lineread(var f:textfile); + external; +procedure linewrite(var f:textfile; cnt:integer); + external; +function testeof(var f:textfile):boolean; + external; +(* now, some routines to implement paths for file names. These are borrowed + from Howard Trickey's dvitype *) +procedure setpaths; + external; +function testaccess(accessmode:integer; filepath:integer): boolean; + external; +function testreadaccess(var f:UNIXfilename):boolean; + external; diff --git a/systems/knuth/local/mfware/pktype.ch b/systems/knuth/local/mfware/pktype.ch new file mode 100644 index 0000000000..0d8e605ca1 --- /dev/null +++ b/systems/knuth/local/mfware/pktype.ch @@ -0,0 +1,241 @@ +% Change file for the PKtype processor, for use on Berkeley UNIX systems. + +% created by don on 21 Oct 1989 based on GFtype.ch +% brought up to version 2.3 by don on 18 Nov 89 + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [0] WEAVE: print changes only +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +\pageno=\contentspagenumber \advance\pageno by 1 +@y +\pageno=\contentspagenumber \advance\pageno by 1 +\let\maybe=\iffalse +\def\title{PK$\,$\lowercase{type} changes for Berkeley {\mc UNIX}} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [2] Change banner string +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d banner=='This is PKtype, Version 2.3' {printed when the program starts} +@y +@d banner=='This is PKtype, Version 2.3 for SunOS' + {printed when the program starts} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3] Case statement default feature of SunOS Pascal +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d othercases == others: {default for cases not listed explicitly} +@y +@d othercases == otherwise {default for cases not listed explicitly} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [4] Redirect PKtype output to correct output file +% depending on pkout_active value (consistent with GFtype) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d print_ln(#)==write_ln(output,#) +@d print(#)==write(output,#) +@d t_print_ln(#)==write_ln(typ_file,#) +@d t_print(#)==write(typ_file,#) +@y +@d print_ln(#)==if pkout_active then write_ln(typ_file,#)@+else write_ln(#) +@d print(#)==if pkout_active then write(typ_file,#)@+else write(#) +@d t_print_ln==print_ln +@d t_print==print +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [4] Include external header and parse the command line +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +var @<Globals in the outer block@>@/ +procedure initialize; {this procedure gets things started properly} + var i:integer; {loop index for initializations} + begin print_ln(banner);@/ + @<Set initial values@>@/ + end; +@y +var @<Globals in the outer block@>@/ +@\@=#include "gftopk_ext.h"@>@\ +procedure initialize; {this procedure gets things started properly} + var i:integer; {loop index for initializations} + begin @<Set initial values@>@/ + @<Parse command line arguments@>; + end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [6] Make name_size match the external C routine +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!name_length=80; {maximum length of a file name} +@y +@!name_length=100; {maximum length of a file name} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [7] Have abort print only once +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d abort(#)==begin print_ln(' ',#); t_print_ln(' ',#); jump_out; end +@y +@d abort(#)==begin print_ln(' ',#); jump_out; end +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [30] Change definition of 'byte_file' to correct subrange +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!byte_file=packed file of eight_bits ; {for packed file words} +@y +@!byte_file=packed file of -128..127; {files that contain binary data} +@!UNIX_file_name=packed array[1..name_length] of char; +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [32] Change to file opening +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +specifies the file name. If |eof(f)| is true immediately after +|reset(f,s)| has acted, we assume that no file named |s| is accessible. +@^system dependencies@> + +@p procedure open_pk_file; {prepares the input for reading} +begin reset(pk_file,pk_name); +@y +specifies the file name. + +The local /PASCAL/ runtimes will dump core if the file isn't present. +We avoid that by using an external procedure. +@^system dependencies@> + +@p procedure open_pk_file; {prepares the input for reading} +begin if testreadaccess(pk_name) then reset(pk_file,pk_name) +else abort('Can''t read the PK file'); +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [33] Slight change needed by fussy Pascal compiler +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!pk_name,@!typ_name:packed array[1..name_length] of char; {name of input + and output files} +@y +@!pk_name,@!typ_name:UNIX_file_name; {name of input and output files} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [34] Use modified routine to access pk_file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p function pk_byte : eight_bits ; +var temp : eight_bits ; +begin + temp := pk_file^ ; + get(pk_file) ; + incr(pk_loc) ; + pk_byte := temp ; +@y +@p function pk_byte : eight_bits ; +var temp : -128..127; +begin + temp := pk_file^ ; + get(pk_file) ; + incr(pk_loc) ; + if temp<0 then pk_byte:=temp+256 @+else pk_byte := temp ; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [35] Don't open the output file twice +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +open_typ_file ; +t_print_ln(banner) ; +@y +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [53--54] Use command line instead of dialog +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@* Terminal communication. +We must get the file names and determine whether input is to be in +hexadecimal or binary. To do this, we use the standard input path +name. We need a procedure to flush the input buffer. For most systems, +this will be an empty statement. For other systems, a |print_ln| will +provide a quick fix. We also need a routine to get a line of input from +the terminal. On some systems, a simple |read_ln| will do. Finally, +a macro to print a string to the first blank is required. + +@d flush_buffer == begin end +@d get_line(#) == if eoln(input) then read_ln(input) ; + i := 1 ; + while not (eoln(input) or eof(input)) do begin + #[i] := input^ ; + incr(i) ; + get(input) ; + end ; + #[i] := ' ' + +@ @p procedure dialog ; +var i : integer ; {index variable} +buffer : packed array [1..name_length] of char; {input buffer} +begin + for i := 1 to name_length do begin + typ_name[i] := ' ' ; + pk_name[i] := ' ' ; + end; + print('Input file name: ') ; + flush_buffer ; + get_line(pk_name) ; + print('Output file name: ') ; + flush_buffer ; + get_line(typ_name) ; +end ; +@y +@* Command line parsing. +The command line issued to start \.{PKtype} should also contain the +names of the input (PK) file, and optionally, the name of an output +file to receive the output from \.{PKtype}. This segment decodes +the command line, and saves the file names in the appropriate variables. +@^system dependencies@> + +@d dialog== {we omit the dialog} + +@<Parse command...@>= +if (argc < 2) or (argc > 3) then + begin print_ln('Usage: pktype PKfile [outputfile]');@/ + goto final_end; { we will be unstructured just this once } + end; +argv(1, pk_name); +if argc > 2 then + begin argv(2, typ_name);@/ + rewrite(typ_file,typ_name);@/ + pkout_active := true;@/ + write_ln(banner); {standard output gets only this} + end; +print_ln(banner) + +@ @<Glob...@>= +@!pkout_active: boolean; {has the |typ_file| been opened?} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [56] Final touchup +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@* System-dependent changes. +This section should be replaced, if necessary, by changes to the program +that are necessary to make \.{PKtype} work at a particular installation. +Any additional routines should be inserted here. +@^system dependencies@> +@y +@* System-dependent changes. +This section should be replaced, if necessary, by changes to the program +that are necessary to make \.{PKtype} work at a particular installation. +Any additional routines should be inserted here. +@^system dependencies@> + +We need to initialize the value of the new boolean variable that +we introduced. + +@<Set initial ...@>= +pkout_active:=false; +@z + diff --git a/systems/knuth/local/mfware/pktype.web b/systems/knuth/local/mfware/pktype.web new file mode 100644 index 0000000000..eac85ee36f --- /dev/null +++ b/systems/knuth/local/mfware/pktype.web @@ -0,0 +1,1158 @@ +% PKtype.web +% +% PKtype verifies the correctness of a PK file. +% +% Preliminary 0.0 version: May, 1985 +% First release, 0.9 version: 8 May 1985 +% Updated to reflect new pk format, 2.0 version: 25 July 1985 +% Updated again for new pk format, 2.1 version: 15 August 1985 +% Docmentation updated, 2.2 version: 17 November 1987 +% +% slight editing to correspond with MFware report -- don, 21 Oct 89 +% additional editing suggested by P Breitenlohner -- don, 18 Nov 89 +% Corrected two typos -- 21 Dec 96 (don) + +\def\versiondate{18 November 1989} +% +\def\hang{\hangindent 3em\noindent\ignorespaces} +\font\ninerm=cmr9 +\font\logo=logo10 % font used for the METAFONT logo +\def\MF{{\logo META}\-{\logo FONT}} +\def\PASCAL{Pascal} +\def\tamu{Texas A\char38 M} +\def\(#1){} % this is used to make section names sort themselves better +\def\9#1{} % this is used for sort keys in the index +\def\title{PKtype} +\def\contentspagenumber{0} +\def\topofcontents{\null + \def\titlepage{F} % include headline on the contents page + \def\rheader{\mainfont\hfil \contentspagenumber} + \vfill + \centerline{\titlefont The {\ttitlefont PKtype} processor} + \vskip 15pt + \centerline{(Version 2.3, \versiondate)} + \vfill} +\def\botofcontents{\vfill + \centerline{\hsize 5in\baselineskip9pt + \vbox{\ninerm\noindent + The preparation of this report + was supported in part by the National Science + Foundation under grants IST-8201926 and MCS-8300984, + and by the System Development Foundation. `\TeX' is a + trademark of the American Mathematical Society.}}} +\pageno=\contentspagenumber \advance\pageno by 1 + +@* Introduction. +This program reads a \.{PK} file, verifies that it is in the correct +format, and writes it in textual format. + +@ The |banner| string defined here should be changed whenever \.{PKtype} +gets modified. + +@d banner=='This is PKtype, Version 2.3' {printed when the program starts} + +@ This program is written in standard \PASCAL, except where it is necessary +to use extensions; for example, \.{PKtype} must read files whose names +are dynamically specified, and that would be impossible in pure \PASCAL. + +@d othercases == others: {default for cases not listed explicitly} +@d endcases == @+end {follows the default case in an extended |case| statement} +@f othercases == else +@f endcases == end + +@ Both the input and output come from binary files. On line interaction +is handled through \PASCAL's standard |input| and |output| files. Two macros +are used to write to the type file, so this output can easily be redirected. + +@d print_ln(#)==write_ln(output,#) +@d print(#)==write(output,#) +@d t_print_ln(#)==write_ln(typ_file,#) +@d t_print(#)==write(typ_file,#) + +@p program PKtype(@!input,@!output); +label @<Labels in the outer block@>@/ +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +procedure initialize; {this procedure gets things started properly} + var i:integer; {loop index for initializations} + begin print_ln(banner);@/ + @<Set initial values@>@/ + end; + +@ If the program has to stop prematurely, it goes to the +`|final_end|'. + +@d final_end=9999 {label for the end of it all} + +@<Labels...@>=final_end; + +@ These constants determine the maximum length of a file name and the length +of the terminal line, as well as the widest character that can be translated. +@^system dependencies@> + +@<Constants...@>= +@!name_length=80; {maximum length of a file name} +@!terminal_line_length=132; {maximum length of an input line} + +@ Here are some macros for common programming idioms. + +@d incr(#) == #:=#+1 {increase a variable by unity} +@d decr(#) == #:=#-1 {decrease a variable by unity} +@d do_nothing == {empty statement} + +@ It is possible that a malformed packed file (heaven forbid!) or some other +error might be detected by this program. Such errors might occur in a deeply +nested procedure, so the procedure called |jump_out| has been added to transfer +to the very end of the program with an error message. + +@d abort(#)==begin print_ln(' ',#); t_print_ln(' ',#); jump_out; end + +@p procedure jump_out; +begin goto final_end; +end; + +@* The character set. +Like all programs written with the \.{WEB} system, \.{PKtype} can be +used with any character set. But it uses ASCII code internally, because +the programming for portable input-output is easier when a fixed internal +code is used. + +The next few sections of \.{PKtype} have therefore been copied from the +analogous ones in the \.{WEB} system routines. They have been considerably +simplified, since \.{PKtype} need not deal with the controversial +ASCII codes less than @'40 or greater than @'176. + +@<Types...@>= +@!ASCII_code=" ".."~"; {a subrange of the integers} + +@ The original \PASCAL\ compiler was designed in the late 60s, when six-bit +character sets were common, so it did not make provision for lower case +letters. Nowadays, of course, we need to deal with both upper and lower case +alphabets in a convenient way, especially in a program like \.{PKtype}. +So we shall assume that the \PASCAL\ system being used for \.{PKtype} +has a character set containing at least the standard visible characters +of ASCII code (|"!"| through |"~"|). + +Some \PASCAL\ compilers use the original name |char| for the data type +associated with the characters in text files, while other \PASCAL s +consider |char| to be a 64-element subrange of a larger data type that has +some other name. In order to accommodate this difference, we shall use +the name |text_char| to stand for the data type of the characters in the +output file. We shall also assume that |text_char| consists of +the elements |chr(first_text_char)| through |chr(last_text_char)|, +inclusive. The following definitions should be adjusted if necessary. +@^system dependencies@> + +@d text_char == char {the data type of characters in text files} +@d first_text_char=0 {ordinal number of the smallest element of |text_char|} +@d last_text_char=127 {ordinal number of the largest element of |text_char|} + +@<Types...@>= +@!text_file=packed file of text_char; + +@ The \.{PKtype} processor converts between ASCII code and +the user's external character set by means of arrays |xord| and |xchr| +that are analogous to \PASCAL's |ord| and |chr| functions. + +@<Globals...@>= +@!xord: array [text_char] of ASCII_code; + {specifies conversion of input characters} +@!xchr: array [0..255] of text_char; + {specifies conversion of output characters} + +@ Under our assumption that the visible characters of standard ASCII are +all present, the following assignment statements initialize the +|xchr| array properly, without needing any system-dependent changes. + +@<Set init...@>= +for i:=0 to @'37 do xchr[i]:='?'; +xchr[@'40]:=' '; +xchr[@'41]:='!'; +xchr[@'42]:='"'; +xchr[@'43]:='#'; +xchr[@'44]:='$'; +xchr[@'45]:='%'; +xchr[@'46]:='&'; +xchr[@'47]:='''';@/ +xchr[@'50]:='('; +xchr[@'51]:=')'; +xchr[@'52]:='*'; +xchr[@'53]:='+'; +xchr[@'54]:=','; +xchr[@'55]:='-'; +xchr[@'56]:='.'; +xchr[@'57]:='/';@/ +xchr[@'60]:='0'; +xchr[@'61]:='1'; +xchr[@'62]:='2'; +xchr[@'63]:='3'; +xchr[@'64]:='4'; +xchr[@'65]:='5'; +xchr[@'66]:='6'; +xchr[@'67]:='7';@/ +xchr[@'70]:='8'; +xchr[@'71]:='9'; +xchr[@'72]:=':'; +xchr[@'73]:=';'; +xchr[@'74]:='<'; +xchr[@'75]:='='; +xchr[@'76]:='>'; +xchr[@'77]:='?';@/ +xchr[@'100]:='@@'; +xchr[@'101]:='A'; +xchr[@'102]:='B'; +xchr[@'103]:='C'; +xchr[@'104]:='D'; +xchr[@'105]:='E'; +xchr[@'106]:='F'; +xchr[@'107]:='G';@/ +xchr[@'110]:='H'; +xchr[@'111]:='I'; +xchr[@'112]:='J'; +xchr[@'113]:='K'; +xchr[@'114]:='L'; +xchr[@'115]:='M'; +xchr[@'116]:='N'; +xchr[@'117]:='O';@/ +xchr[@'120]:='P'; +xchr[@'121]:='Q'; +xchr[@'122]:='R'; +xchr[@'123]:='S'; +xchr[@'124]:='T'; +xchr[@'125]:='U'; +xchr[@'126]:='V'; +xchr[@'127]:='W';@/ +xchr[@'130]:='X'; +xchr[@'131]:='Y'; +xchr[@'132]:='Z'; +xchr[@'133]:='['; +xchr[@'134]:='\'; +xchr[@'135]:=']'; +xchr[@'136]:='^'; +xchr[@'137]:='_';@/ +xchr[@'140]:='`'; +xchr[@'141]:='a'; +xchr[@'142]:='b'; +xchr[@'143]:='c'; +xchr[@'144]:='d'; +xchr[@'145]:='e'; +xchr[@'146]:='f'; +xchr[@'147]:='g';@/ +xchr[@'150]:='h'; +xchr[@'151]:='i'; +xchr[@'152]:='j'; +xchr[@'153]:='k'; +xchr[@'154]:='l'; +xchr[@'155]:='m'; +xchr[@'156]:='n'; +xchr[@'157]:='o';@/ +xchr[@'160]:='p'; +xchr[@'161]:='q'; +xchr[@'162]:='r'; +xchr[@'163]:='s'; +xchr[@'164]:='t'; +xchr[@'165]:='u'; +xchr[@'166]:='v'; +xchr[@'167]:='w';@/ +xchr[@'170]:='x'; +xchr[@'171]:='y'; +xchr[@'172]:='z'; +xchr[@'173]:='{'; +xchr[@'174]:='|'; +xchr[@'175]:='}'; +xchr[@'176]:='~'; +for i:=@'177 to 255 do xchr[i]:='?'; + +@ The following system-independent code makes the |xord| array contain a +suitable inverse to the information in |xchr|. + +@<Set init...@>= +for i:=first_text_char to last_text_char do xord[chr(i)]:=@'40; +for i:=" " to "~" do xord[xchr[i]]:=i; + +@* Packed file format. +The packed file format is a compact representation of the data contained in a +\.{GF} file. The information content is the same, but packed (\.{PK}) files +are almost always less than half the size of their \.{GF} counterparts. They +are also easier to convert into a raster representation because they do not +have a profusion of \\{paint}, \\{skip}, and \\{new\_row} commands to be +separately interpreted. In addition, the \.{PK} format expressly forbids +\&{special} commands within a character. The minimum bounding box for each +character is explicit in the format, and does not need to be scanned for as in +the \.{GF} format. Finally, the width and escapement values are combined with +the raster information into character ``packets'', making it simpler in many +cases to process a character. + +A \.{PK} file is organized as a stream of 8-bit bytes. At times, these bytes +might be split into 4-bit nybbles or single bits, or combined into multiple +byte parameters. When bytes are split into smaller pieces, the `first' piece +is always the most significant of the byte. For instance, the first bit of +a byte is the bit with value 128; the first nybble can be found by dividing +a byte by 16. Similarly, when bytes are combined into multiple byte +parameters, the first byte is the most significant of the parameter. If the +parameter is signed, it is represented by two's-complement notation. + +The set of possible eight-bit values is separated into two sets, those that +introduce a character definition, and those that do not. The values that +introduce a character definition range from 0 to 239; byte values +above 239 are interpreted as commands. Bytes that introduce character +definitions are called flag bytes, and various fields within the byte indicate +various things about how the character definition is encoded. Command bytes +have zero or more parameters, and can never appear within a character +definition or between parameters of another command, where they would be +interpeted as data. + +A \.{PK} file consists of a preamble, followed by a sequence of one or more +character definitions, followed by a postamble. The preamble command must +be the first byte in the file, followed immediately by its parameters. +Any number of character definitions may follow, and any command but the +preamble command and the postamble command may occur between character +definitions. The very last command in the file must be the postamble. + +@ The packed file format is intended to be easy to read and interpret by +device drivers. The small size of the file reduces the input/output overhead +each time a font is loaded. For those drivers that load and save each font +file into memory, the small size also helps reduce the memory requirements. +The length of each character packet is specified, allowing the character raster +data to be loaded into memory by simply counting bytes, rather than +interpreting each command; then, each character can be interpreted on a demand +basis. This also makes it possible for a driver to skip a particular +character quickly if it knows that the character is unused. + +@ First, the command bytes will be presented; then the format of the +character definitions will be defined. Eight of the possible sixteen +commands (values 240 through 255) are currently defined; the others are +reserved for future extensions. The commands are listed below. Each command +is specified by its symbolic name (e.g., \\{pk\_no\_op}), its opcode byte, +and any parameters. The parameters are followed by a bracketed number +telling how many bytes they occupy, with the number preceded by a plus sign if +it is a signed quantity. (Four byte quantities are always signed, however.) + +\yskip\hang|pk_xxx1| 240 |k[1]| |x[k]|. This command is undefined in general; +it functions as a $(k+2)$-byte \\{no\_op} unless special \.{PK}-reading +programs are being used. \MF\ generates \\{xxx} commands when encountering +a \&{special} string. It is recommended that |x| be a string having the form +of a keyword followed by possible parameters relevant to that keyword. + +\yskip\hang\\{pk\_xxx2} 241 |k[2]| |x[k]|. Like |pk_xxx1|, but |0<=k<65536|. + +\yskip\hang\\{pk\_xxx3} 242 |k[3]| |x[k]|. Like |pk_xxx1|, but +|0<=k<@t$2^{24}$@>|. \MF\ uses this when sending a \&{special} string whose +length exceeds~255. + +\yskip\hang\\{pk\_xxx4} 243 |k[4]| |x[k]|. Like |pk_xxx1|, but |k| can be +ridiculously large; |k| musn't be negative. + +\yskip\hang|pk_yyy| 244 |y[4]|. This command is undefined in general; it +functions as a five-byte \\{no\_op} unless special \.{PK} reading programs +are being used. \MF\ puts |scaled| numbers into |yyy|'s, as a result of +\&{numspecial} commands; the intent is to provide numeric parameters to +\\{xxx} commands that immediately precede. + +\yskip\hang|pk_post| 245. Beginning of the postamble. This command is +followed by enough |pk_no_op| commands to make the file a multiple +of four bytes long. Zero through three bytes are usual, but any number +is allowed. +This should make the file easy to read on machines that pack four bytes to +a word. + +\yskip\hang|pk_no_op| 246. No operation, do nothing. Any number of +|pk_no_op|'s may appear between \.{PK} commands, but a |pk_no_op| cannot be +inserted between a command and its parameters, between two parameters, or +inside a character definition. + +\yskip\hang|pk_pre| 247 |i[1]| |k[1]| |x[k]| |ds[4]| |cs[4]| |hppp[4]| +|vppp[4]|. Preamble command. Here, |i| is the identification byte of the +file, currently equal to 89. The string |x| is merely a comment, usually +indicating the source of the \.{PK} file. The parameters |ds| and |cs| are +the design size of the file in $1/2^{20}$ points, and the checksum of the +file, respectively. The checksum should match the \.{TFM} file and the +\.{GF} files for this font. Parameters |hppp| and |vppp| are the ratios +of pixels per point, horizontally and vertically, multiplied by $2^{16}$; they +can be used to correlate the font with specific device resolutions, +magnifications, and ``at sizes''. Usually, the name of the \.{PK} file is +formed by concatenating the font name (e.g., cmr10) with the resolution at +which the font is prepared in pixels per inch multiplied by the magnification +factor, and the letters \.{pk}. For instance, cmr10 at 300 dots per inch +should be named \.{cmr10.300pk}; at one thousand dots per inch and magstephalf, +it should be named \.{cmr10.1095pk}. + +@ We put a few of the above opcodes into definitions for symbolic use by +this program. + +@d pk_id = 89 {the version of \.{PK} file described} +@d pk_xxx1 = 240 {\&{special} commands} +@d pk_yyy = 244 {\&{numspecial} commands} +@d pk_post = 245 {postamble} +@d pk_no_op = 246 {no operation} +@d pk_pre = 247 {preamble} +@d pk_undefined == 248, 249, 250, 251, 252, 253, 254, 255 + +@ The \.{PK} format has two conflicting goals: to pack character raster and +size information as compactly as possible, while retaining ease of translation +into raster and other forms. A suitable compromise was found in the use of +run-encoding of the raster information. Instead of packing the individual +bits of the character, we instead count the number of consecutive `black' or +`white' pixels in a horizontal raster row, and then encode this number. Run +counts are found for each row from left to right, traversing rows from the +top to bottom. This is essentially the way the \.{GF} format works. +Instead of presenting each row individually, however, we concatenate all +of the horizontal raster rows into one long string of pixels, and encode this +row. With knowledge of the width of the bit-map, the original character glyph +can easily be reconstructed. In addition, we do not need special commands to +mark the end of one row and the beginning of the next. + +Next, we place the burden of finding the minimum bounding box on the part +of the font generator, since the characters will usually be used much more +often than they are generated. The minimum bounding box is the smallest +rectangle that encloses all `black' pixels of a character. We also +eliminate the need for a special end of character marker, by supplying +exactly as many bits as are required to fill the minimum bounding box, from +which the end of the character is implicit. + +Let us next consider the distribution of the run counts. Analysis of several +dozen pixel files at 300 dots per inch yields a distribution peaking at four, +falling off slowly until ten, then a bit more steeply until twenty, and then +asymptotically approaching the horizontal. Thus, the great majority of our +run counts will fit in a four-bit nybble. The eight-bit byte is attractive for +our run-counts, as it is the standard on many systems; however, the wasted four +bits in the majority of cases seem a high price to pay. Another possibility +is to use a Huffman-type encoding scheme with a variable number of bits for +each run-count; this was rejected because of the overhead in fetching and +examining individual bits in the file. Thus, the character raster definitions +in the \.{PK} file format are based on the four-bit nybble. + +@ An analysis of typical pixel files yielded another interesting statistic: +Fully 37\char`\%\ +of the raster rows were duplicates of the previous row. Thus, the \.{PK} +format allows the specification of repeat counts, which indicate how many times +a horizontal raster row is to be repeated. These repeated rows are taken out +of the character glyph before individual rows are concatenated into the long +string of pixels. + +For elegance, we disallow a run count of zero. The case of a null raster +description should be gleaned from the character width and height being equal +to zero, and no raster data should be read. No other zero counts are ever +necessary. Also, in the absence of repeat counts, the repeat value is set to +be zero (only the original row is sent.) If a repeat count is seen, it takes +effect on the current row. The current row is defined as the row on which the +first pixel of the next run count will lie. The repeat count is set back to +zero when the last pixel in the current row is seen, and the row is sent out. + +This poses a problem for entirely black and entirely white rows, however. Let +us say that the current row ends with four white pixels, and then we have five +entirely empty rows, followed by a black pixel at the beginning of the next +row, and the character width is ten pixels. We would like to use a repeat +count, but there is no legal place to put it. If we put it before the white +run count, it will apply to the current row. If we put it after, it applies +to the row with the black pixel at the beginning. Thus, entirely white or +entirely black repeated rows are always packed as large run counts (in this +case, a white run count of 54) rather than repeat counts. + +@ Now we turn our attention to the actual packing of the run counts and +repeat counts into nybbles. There are only sixteen possible nybble values. +We need to indicate run counts and repeat counts. Since the run counts are +much more common, we will devote the majority of the nybble values to them. +We therefore indicate a repeat count by a nybble of 14 followed by a packed +number, where a packed number will be explained later. Since the repeat +count value of one is so common, we indicate a repeat one command by a single +nybble of 15. A 14 followed by the packed number 1 is still legal for a +repeat one count. The run counts are coded directly as packed +numbers. + +For packed numbers, therefore, we have the nybble values 0 through 13. We +need to represent the positive integers up to, say, $2^{31}-1$. We would +like the more common smaller numbers to take only one or two nybbles, and +the infrequent large numbers to take three or more. We could therefore +allocate one nybble value to indicate a large run count taking three or more +nybbles. We do this with the value 0. + +@ We are left with the values 1 through 13. We can allocate some of these, say +|dyn_f|, to be one-nybble run counts. +These will work for the run counts |1..dyn_f|. For subsequent run +counts, we will use a nybble greater than |dyn_f|, followed by a second nybble, +whose value can run from 0 through 15. Thus, the two-nybble values will +run from |dyn_f+1..(13-dyn_f)*16+dyn_f|. We have our definition of large run +count values now, being all counts greater than |(13-dyn_f)*16+dyn_f|. + +We can analyze our several dozen pixel files and determine an optimal value of +|dyn_f|, and use this value for all of the characters. Unfortunately, values +of |dyn_f| that pack small characters well tend to pack the large characters +poorly, and values that pack large characters well are not efficient for the +smaller characters. Thus, we choose the optimal |dyn_f| on a character basis, +picking the value that will pack each individual character in the smallest +number of nybbles. Legal values of |dyn_f| run from 0 (with no one-nybble run +counts) to 13 (with no two-nybble run counts). + +@ Our only remaining task in the coding of packed numbers is the large run +counts. We use a scheme suggested by D.~E.~Knuth +@^Knuth, Donald Ervin@> +that simply and elegantly represents arbitrarily large values. The +general scheme to represent an integer |i| is to write its hexadecimal +representation, with leading zeros removed. Then we count the number of +digits, and prepend one less than that many zeros before the hexadecimal +representation. Thus, the values from one to fifteen occupy one nybble; +the values sixteen through 255 occupy three, the values 256 through 4095 +require five, etc. + +For our purposes, however, we have already represented the numbers one +through |(13-dyn_f)*16+dyn_f|. In addition, the one-nybble values have +already been taken by our other commands, which means that only the values +from sixteen up are available to us for long run counts. Thus, we simply +normalize our long run counts, by subtracting |(13-dyn_f)*16+dyn_f+1| and +adding 16, and then we represent the result according to the scheme above. + +@ The final algorithm for decoding the run counts based on the above scheme +looks like this, assuming that a procedure called \\{get\_nyb} is available +to get the next nybble from the file, and assuming that the global +|repeat_count| indicates whether a row needs to be repeated. Note that this +routine is recursive, but since a repeat count can never directly follow +another repeat count, it can only be recursive to one level. + +@<Packed number procedure@>= +function pk_packed_num : integer ; +var i, @!j : integer ; +begin + i := get_nyb ; + if i = 0 then begin + repeat j := get_nyb ; incr(i) ; until j <> 0 ; + while i > 0 do begin j := j * 16 + get_nyb ; decr(i) ; end ; + pk_packed_num := j - 15 + (13-dyn_f)*16 + dyn_f ; + end else if i <= dyn_f then + pk_packed_num := i + else if i < 14 then + pk_packed_num := (i-dyn_f-1)*16+get_nyb+dyn_f+1 + else begin + if repeat_count <> 0 then abort('Second repeat count for this row!') ; +@.Second repeat count...@> + repeat_count := 1; {prevent recursion more than one level} + if i = 14 then repeat_count := pk_packed_num; + send_out(true, repeat_count) ; + pk_packed_num := pk_packed_num ; + end ; +end ; + +@ For low resolution fonts, or characters with `gray' areas, run encoding can +often make the character many times larger. Therefore, for those characters +that cannot be encoded efficiently with run counts, the \.{PK} format allows +bit-mapping of the characters. This is indicated by a |dyn_f| value of +14. The bits are packed tightly, by concatenating all of the horizontal raster +rows into one long string, and then packing this string eight bits to a byte. +The number of bytes required can be calculated by |(width*height+7) div 8|. +This format should only be used when packing the character by run counts takes +more bytes than this, although, of course, it is legal for any character. +Any extra bits in the last byte should be set to zero. + +@ At this point, we are ready to introduce the format for a character +descriptor. It consists of three parts: a flag byte, a character preamble, +and the raster data. The most significant four bits of the flag byte +yield the |dyn_f| value for that character. (Notice that only values of +0 through 14 are legal for |dyn_f|, with 14 indicating a bit mapped character; +thus, the flag bytes do not conflict with the command bytes, whose upper nybble +is always 15.) The next bit (with weight 8) indicates whether the first run +count is a black count or a white count, with a one indicating a black count. +For bit-mapped characters, this bit should be set to a zero. The next bit +(with weight 4) indicates whether certain later parameters (referred to as size +parameters) are given in one-byte or two-byte quantities, with a one indicating +that they are in two-byte quantities. The last two bits are concatenated on to +the beginning of the packet-length parameter in the character preamble, +which will be explained below. + +However, if the last three bits of the flag byte are all set (normally +indicating that the size parameters are two-byte values and that a 3 should be +prepended to the length parameter), then a long format of the character +preamble should be used instead of one of the short forms. + +Therefore, there are three formats for the character preamble; the one that +is used depends on the least significant three bits of the flag byte. If the +least significant three bits are in the range zero through three, the short +format is used. If they are in the range four through six, the extended short +format is used. Otherwise, if the least significant bits are all set, then +the long form of the character preamble is used. The preamble formats are +explained below. + +\yskip\hang Short form: |flag[1]| |pl[1]| |cc[1]| |tfm[3]| |dm[1]| |w[1]| +|h[1]| |hoff[+1]| |voff[+1]|. +If this format of the character preamble is used, the above +parameters must all fit in the indicated number of bytes, signed or unsigned +as indicated. Almost all of the standard \TeX\ font characters fit; the few +exceptions are fonts such as \.{cminch}. + +\yskip\hang Extended short form: |flag[1]| |pl[2]| |cc[1]| |tfm[3]| |dm[2]| +|w[2]| |h[2]| |hoff[+2]| |voff[+2]|. Larger characters use this extended +format. + +\yskip\hang Long form: |flag[1]| |pl[4]| |cc[4]| |tfm[4]| |dx[4]| |dy[4]| +|w[4]| |h[4]| |hoff[4]| |voff[4]|. This is the general format that +allows all of the +parameters of the \.{GF} file format, including vertical escapement. +\vskip\baselineskip +The |flag| parameter is the flag byte. The parameter |pl| (packet length) +contains the offset +of the byte following this character descriptor, with respect to the beginning +of the |tfm| width parameter. This is given so a \.{PK} reading program can, +once it has read the flag byte, packet length, and character code (|cc|), skip +over the character by simply reading this many more bytes. For the two short +forms of the character preamble, the last two bits of the flag byte should be +considered the two most-significant bits of the packet length. For the short +format, the true packet length might be calculated as |(flag mod 4)*256+pl|; +for the short extended format, it might be calculated as +|(flag mod 4)*65536+pl|. + +The |w| parameter is the width and the |h| parameter is the height in pixels +of the minimum bounding box. The |dx| and |dy| parameters are the horizontal +and vertical escapements, respectively. In the short formats, |dy| is assumed +to be zero and |dm| is |dx| but in pixels; +in the long format, |dx| and |dy| are both +in pixels multiplied by $2^{16}$. The |hoff| is the horizontal offset from the +upper left pixel to the reference pixel; the |voff| is the vertical offset. +They are both given in pixels, with right and down being positive. The +reference pixel is the pixel that occupies the unit square in \MF; the +\MF\ reference point is the lower left hand corner of this pixel. (See the +example below.) + +@ \TeX\ requires all characters that have the same character codes +modulo 256 to have also the same |tfm| widths and escapement values. The \.{PK} +format does not itself make this a requirement, but in order for the font to +work correctly with the \TeX\ software, this constraint should be observed. +(The standard version of \TeX\ cannot output character codes greater +than 255, but extended versions do exist.) + +Following the character preamble is the raster information for the +character, packed by run counts or by bits, as indicated by the flag byte. +If the character is packed by run counts and the required number of nybbles +is odd, then the last byte of the raster description should have a zero +for its least significant nybble. + +@ As an illustration of the \.{PK} format, the character \char4\ from the font +amr10 at 300 dots per inch will be encoded. This character was chosen +because it illustrates some +of the borderline cases. The raster for the character looks like this (the +row numbers are chosen for convenience, and are not \MF's row numbers.) + +\vskip\baselineskip +{\def\smbox{\vrule height 7pt width 7pt depth 0pt \hskip 3pt}% +\catcode`\*=\active \let*=\smbox +\centerline{\vbox{\baselineskip=10pt +\halign{\hfil#\quad&&\hfil#\hfil\cr +0& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr +1& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr +2& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr +3& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr +4& & &*&*& & & & & & & & & & & & & & & & &*&*\cr +5& & &*&*& & & & & & & & & & & & & & & & &*&*\cr +6& & &*&*& & & & & & & & & & & & & & & & &*&*\cr +7\cr +8\cr +9& & & & &*&*& & & & & & & & & & & & &*&*& & \cr +10& & & & &*&*& & & & & & & & & & & & &*&*& & \cr +11& & & & &*&*& & & & & & & & & & & & &*&*& & \cr +12& & & & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& & \cr +13& & & & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& & \cr +14& & & & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& & \cr +15& & & & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*& & \cr +16& & & & &*&*& & & & & & & & & & & & &*&*& & \cr +17& & & & &*&*& & & & & & & & & & & & &*&*& & \cr +18& & & & &*&*& & & & & & & & & & & & &*&*& & \cr +19\cr +20\cr +21\cr +22& & &*&*& & & & & & & & & & & & & & & & &*&*\cr +23& & &*&*& & & & & & & & & & & & & & & & &*&*\cr +24& & &*&*& & & & & & & & & & & & & & & & &*&*\cr +25& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr +26& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr +27& & &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr +28&+& &*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*&*\cr +&\hphantom{*}&\hphantom{*}\cr +}}}} +The width of the minimum bounding box for this character is 20; its height +is 29. The `+' represents the reference pixel; notice how it lies outside the +minimum bounding box. The |hoff| value is $-2$, and the |voff| is~28. + +The first task is to calculate the run counts and repeat counts. The repeat +counts are placed at the first transition (black to white or white to black) +in a row, and are enclosed in brackets. White counts are enclosed in +parentheses. It is relatively easy to generate the counts list: +\vskip\baselineskip +\centerline{82 [2] (16) 2 (42) [2] 2 (12) 2 (4) [3]} +\centerline{16 (4) [2] 2 (12) 2 (62) [2] 2 (16) 82} +\vskip\baselineskip +Note that any duplicated rows that are not all white or all black are removed +before the run counts are calculated. The rows thus removed are rows 5, 6, +10, 11, 13, 14, 15, 17, 18, 23, and 24. + +@ The next step in the encoding of this character is to calculate the optimal +value of |dyn_f|. The details of how this calculation is done are not +important here; suffice it to say that there is a simple algorithm that can +determine the best value of |dyn_f| in one pass over the count list. For this +character, the optimal value turns out to be 8 (atypically low). Thus, all +count values less than or equal to 8 are packed in one nybble; those from +nine to $(13-8)*16+8$ or 88 are packed in two nybbles. The run encoded values +now become (in hex, separated according to the above list): +\vskip\baselineskip +\centerline{\tt D9 E2 97 2 B1 E2 2 93 2 4 E3} +\centerline{\tt 97 4 E2 2 93 2 C5 E2 2 97 D9} +\vskip\baselineskip\noindent +which comes to 36 nybbles, or 18 bytes. This is shorter than the 73 bytes +required for the bit map, so we use the run count packing. + +@ The short form of the character preamble is used because all of the +parameters fit in their respective lengths. The packet length is therefore +18 bytes for the raster, plus +eight bytes for the character preamble parameters following the character +code, or 26. The |tfm| width for this character is 640796, or {\tt 9C71C} in +hexadecimal. The horizontal escapement is 25 pixels. The flag byte is +88 hex, indicating the short preamble, the black first count, and the +|dyn_f| value of 8. The final total character packet, in hexadecimal, is: +\vskip\baselineskip +$$\vbox{\halign{\hfil #\quad&&{\tt #\ }\cr +Flag byte&88\cr +Packet length&1A\cr +Character code&04\cr +|tfm| width&09&C7&1C\cr +Horizontal escapement (pixels)&19\cr +Width of bit map&14\cr +Height of bit map&1D\cr +Horizontal offset (signed)&FE\cr +Vertical offset&1C\cr +Raster data&D9&E2&97\cr +&2B&1E&22\cr +&93&24&E3\cr +&97&4E&22\cr +&93&2C&5E\cr +&22&97&D9\cr}}$$ + +@* Input and output. +There are two types of files that this program must deal with---standard +text files and files of bytes (packed files.) +For our purposes, we shall consider an eight-bit byte to consist of the +values |0..255|. If your system does not pack these values to a byte, it is +no major difficulty; you must only insure that the input function +|pk_byte| can read packed bytes. + +@<Types...@>= +@!eight_bits=0..255; {packed file byte} +@!byte_file=packed file of eight_bits ; {for packed file words} +@^system dependencies@> + +@ @<Glob...@>= +@!pk_file:byte_file; {where the input comes from} +@!typ_file:text_file; {where the final output goes} +@^system dependencies@> + +@ To prepare these files for input and output, we |reset| and |rewrite| them. +An extension of \PASCAL\ is needed, since we want to associate files +with external names that are specified dynamically (i.e., not +known at compile time). The following code assumes that `|reset(f,s)|' +does this, when |f| is a file variable and |s| is a string variable that +specifies the file name. If |eof(f)| is true immediately after +|reset(f,s)| has acted, we assume that no file named |s| is accessible. +@^system dependencies@> + +@p procedure open_pk_file; {prepares the input for reading} +begin reset(pk_file,pk_name); +pk_loc := 0 ; +end; +@# +procedure open_typ_file; {prepares to write text data to the |typ_file|} +begin rewrite(typ_file,typ_name); +end; + +@ We need a place to store the names of the input and output file, as well +as a byte counter for the output file. + +@<Glob...@>= +@!pk_name,@!typ_name:packed array[1..name_length] of char; {name of input + and output files} +@!pk_loc:integer; {how many bytes have we read?} + +@ We also need a function that will get a single byte from the \.{pk} file. + +@p function pk_byte : eight_bits ; +var temp : eight_bits ; +begin + temp := pk_file^ ; + get(pk_file) ; + incr(pk_loc) ; + pk_byte := temp ; +end ; + +@ Now we are ready to open the files. + +@<Open files@>= +open_pk_file ; +open_typ_file ; +t_print_ln(banner) ; +t_print('Input file: ') ; +i := 1 ; +while pk_name[i] <> ' ' do begin + t_print(pk_name[i]) ; incr(i) ; +end ; +t_print_ln(' ') + +@ As we are reading the packed file, we often need to fetch 16 and 32 bit +quantities. Here we have two procedures to do this. + +@p function get_16 : integer ; +var a : integer ; +begin a := pk_byte ; get_16 := a * 256 + pk_byte ; end ; +@# +function get_32 : integer ; +var a : integer ; +begin a := get_16 ; if a > 32767 then a := a - 65536 ; +get_32 := a * 65536 + get_16 ; end ; + +@ We still need the |term_pos| variable. + +@<Glob...@>= +@!term_pos : integer ; {current terminal position} + +@ Now we read and check the preamble of the \.{PK} file. In the preamble, we +find the |hppp|, |design_size|, |checksum|. + +@<Read preamble@>= +if pk_byte <> pk_pre then abort('Bad PK file: pre command missing!') ; +@.pre command missing@> +if pk_byte <> pk_id then abort('Wrong version of PK file!') ; +@.Wrong version of PK file@> +j := pk_byte ; +t_print('''') ; +for i := 1 to j do t_print(xchr[pk_byte]) ; +t_print_ln('''') ; +design_size := get_32 ; +t_print_ln('Design size = ',design_size:1) ; +checksum := get_32 ; +t_print_ln('Checksum = ',checksum:1) ; +hppp := get_32 ; vppp := get_32 ; +t_print('Resolution: horizontal = ',hppp:1,' vertical = ',vppp:1) ; +magnification := round(hppp * 72.27 / 65536) ; +t_print_ln(' (',magnification:1,' dpi)') ; +if hppp <> vppp then print_ln('Warning: aspect ratio not 1:1!') + +@ Of course, we need to define the above variables. + +@<Glob...@>= +@!magnification : integer ; {resolution at which pixel file is prepared} +@!design_size : integer ; {design size in FIXes} +@!checksum : integer ; {checksum of pixel file} +@!hppp, @!vppp : integer ; {horizontal and vertical points per inch} + +@* Character unpacking. +Here we simply unpack the character, writing the information we glean to the +|typ_file|. + +@<Unpack and write character@>= +t_print((pk_loc-1):1,': Flag byte = ',flag_byte:1) ; +dyn_f := flag_byte div 16 ; +flag_byte := flag_byte mod 16 ; +turn_on := flag_byte >= 8 ; +if turn_on then flag_byte := flag_byte - 8 ; +if flag_byte = 7 then + @<Read long character preamble@> +else if flag_byte > 3 then + @<Read extended short character preamble@> +else + @<Read short character preamble@> ; +t_print_ln(' Character = ',car:1,' Packet length = ', + packet_length:1) ; +t_print_ln(' Dynamic packing variable = ',dyn_f:1) ; +t_print(' TFM width = ',tfm_width:1,' dx = ',dx:1) ; +if dy <> 0 then t_print_ln(' dy = ',dy:1) else t_print_ln(' ') ; +t_print_ln(' Height = ',height:1,' Width = ',width:1,' X-offset = ', + x_off:1, ' Y-offset = ',y_off:1) ; +@<Read and translate raster description@> ; +if end_of_packet <> pk_loc then abort('Bad PK file: Bad packet length!') +@.Bad packet length@> + +@ We need a whole lot of globals used but not defined up there. + +@<Glob...@>= +@!i, @!j : integer ; {index pointers} +@!flag_byte : integer ; {the byte that introduces the character definition} +@!end_of_packet : integer ; {where we expect the end of the packet to be} +@!width, @!height : integer ; {width and height of character} +@!x_off, @!y_off : integer ; {x and y offsets of character} +@!tfm_width : integer ; {character tfm width} +@!tfms : array [0..255] of integer ; {character tfm widths} +@!dx, @!dy : integer ; {escapement values} +@!dxs, @!dys : array [0..255] of integer ; {escapement values} +@!status : array[0..255] of boolean ; {has the character been seen?} +@!dyn_f : integer ; {dynamic packing variable} +@!car : integer ; {the character we are reading} +@!packet_length : integer ; {the length of the character packet} + +@ Now, the preamble reading modules. First, we have the general case: the +long character preamble format. + +@<Read long character preamble@>= +begin + packet_length := get_32 ; car := get_32 ; + end_of_packet := packet_length + pk_loc ; + packet_length := packet_length + 9 ; + tfm_width := get_32 ; + dx := get_32 ; dy := get_32 ; + width := get_32 ; + height := get_32 ; + x_off := get_32 ; y_off := get_32 ; +end + +@ This module reads the character preamble with double byte parameters. + +@<Read extended short character preamble@>= +begin + packet_length := (flag_byte - 4) * 65536 + get_16 ; + car := pk_byte ; + end_of_packet := packet_length + pk_loc ; + packet_length := packet_length + 4 ; + i := pk_byte ; + tfm_width := i * 65536 + get_16 ; + dx := get_16 * 65536 ; + dy := 0 ; + width := get_16 ; + height := get_16 ; + x_off := get_16 ; y_off := get_16 ; + if x_off > 32767 then x_off := x_off - 65536 ; + if y_off > 32767 then y_off := y_off - 65536 ; +end + +@ Here we read the most common character preamble, that with single byte +parameters. + +@<Read short character preamble@>= +begin + packet_length := flag_byte * 256 + pk_byte ; + car := pk_byte ; + end_of_packet := packet_length + pk_loc ; + packet_length := packet_length + 3 ; + i := pk_byte ; + tfm_width := i * 65536 + get_16 ; + dx := pk_byte * 65536 ; + dy := 0 ; + width := pk_byte ; + height := pk_byte ; + x_off := pk_byte ; y_off := pk_byte ; + if x_off > 127 then x_off := x_off - 256 ; + if y_off > 127 then y_off := y_off - 256 ; +end + +@ Now we have the most important part of the program, where we actually +interpret the commands in the raster description. First of all, we need +a procedure to get a single nybble from the file, as well as one to get +a single bit. + +@p function get_nyb : integer ; +var temp : eight_bits ; +begin + if bit_weight = 0 then begin + input_byte := pk_byte ; + bit_weight := 16 ; + end ; + temp := input_byte div bit_weight ; + input_byte := input_byte - temp * bit_weight ; + bit_weight := bit_weight div 16 ; + get_nyb := temp ; +end ; +@# +function get_bit : boolean ; +var temp : boolean ; +begin + bit_weight := bit_weight div 2 ; + if bit_weight = 0 then begin + input_byte := pk_byte ; + bit_weight := 128 ; + end ; + temp := input_byte >= bit_weight ; + if temp then + input_byte := input_byte - bit_weight ; + get_bit := temp ; +end ; + +@ We also need a function to write output to the screen. We put as many +counts on a line as possible, to reduce the volume of output. Each count +will appear as a number, with white counts enclosed by parentheses and repeat +counts by brackets. + +@p procedure send_out(@!repeat_count: boolean ; @!value : integer ) ; +var i, len : integer ; +begin + i := 10 ; len := 1 ; + while value >= i do begin incr(len) ; i := i * 10 ; end ; + if repeat_count or not turn_on then len := len + 2 ; + if term_pos + len > 78 then begin + term_pos := len + 2 ; t_print_ln(' ') ; t_print(' ') ; + end else term_pos := term_pos + len ; + if repeat_count then t_print('[', value:1, ']') + else if turn_on then t_print(value:1) + else t_print('(', value:1, ')') ; +end ; +@<Packed number procedure@> + +@ Now, the globals to help communication between these procedures. + +@<Glob...@>= +@!input_byte : eight_bits ; {the byte we are currently decimating} +@!bit_weight : eight_bits ; {weight of the current bit} +@!nybble : eight_bits ; {the current nybble} + +@ And the main procedure. + +@<Read and translate raster description@>= +bit_weight := 0 ; +if dyn_f = 14 then + @<Get raster by bits@> +else @<Create normally packed raster@> + +@ If |dyn_f=14|, then we need to get the raster representation +one bit at a time. + +@<Get raster by bits@>= +begin +for i := 1 to height do begin + t_print(' ') ; + for j := 1 to width do + if get_bit then t_print('*') + else t_print('.') ; + t_print_ln(' ') ; +end; +end + +@ Otherwise, we translate the bit counts into the raster rows. |count| +contains the number of bits of the current color, and |turn_on| indicates +whether or not they should be black. |rows_left| contains the number of +rows to be sent. + +@<Create normally packed raster@>= +begin +term_pos := 2 ; +t_print(' ') ; +rows_left := height ; +h_bit := width ; +repeat_count := 0 ; +while rows_left > 0 do begin + count := pk_packed_num ; + send_out(false, count) ; + if count >= h_bit then begin + rows_left := rows_left - repeat_count - 1 ; + repeat_count := 0 ; + count := count - h_bit ; + h_bit := width ; + rows_left := rows_left - count div width ; + count := count mod width ; + end ; + h_bit := h_bit - count ; + turn_on := not turn_on ; +end ; +t_print_ln(' ') ; +if (rows_left <> 0) or (h_bit <> width) then + abort('Bad PK file: More bits than required!'); +@.More bits than required@> +end + +@ We need to declare the repeat flag, bit counter, and color flag here. + +@<Glob...@>= +@!repeat_count : integer ; {how many times to repeat the next row?} +@!rows_left : integer ; {how many rows left?} +@!turn_on : boolean ; {are we black here?} +@!h_bit : integer ; {what is our horizontal position?} +@!count : integer ; {how many bits of current color left?} + +@ If any specials are found, we write them out here. + +@d four_cases(#)==#,#+1,#+2,#+3 + +@p procedure skip_specials ; +var @!i, @!j: integer ; +begin + repeat + flag_byte := pk_byte ; + if flag_byte >= 240 then + case flag_byte of + four_cases(pk_xxx1): +begin + t_print((pk_loc-1):1,': Special: ''') ; + i := 0 ; + for j := pk_xxx1 to flag_byte do i := 256 * i + pk_byte ; + for j := 1 to i do t_print(xchr[pk_byte]) ; + t_print_ln('''') ; +end ; + pk_yyy : t_print_ln((pk_loc-1):1,': Num special: ',get_32:1) ; + pk_post : t_print_ln((pk_loc-1):1,': Postamble') ; + pk_no_op : t_print_ln((pk_loc-1):1,': No op') ; + pk_pre, pk_undefined : abort('Unexpected ', flag_byte:1,'!') ; +@.Unexpected bbb@> + endcases ; + until (flag_byte < 240) or (flag_byte = pk_post) ; +end ; + +@* Terminal communication. +We must get the file names and determine whether input is to be in +hexadecimal or binary. To do this, we use the standard input path +name. We need a procedure to flush the input buffer. For most systems, +this will be an empty statement. For other systems, a |print_ln| will +provide a quick fix. We also need a routine to get a line of input from +the terminal. On some systems, a simple |read_ln| will do. Finally, +a macro to print a string to the first blank is required. + +@d flush_buffer == begin end +@d get_line(#) == if eoln(input) then read_ln(input) ; + i := 1 ; + while not (eoln(input) or eof(input)) do begin + #[i] := input^ ; + incr(i) ; + get(input) ; + end ; + #[i] := ' ' + +@ @p procedure dialog ; +var i : integer ; {index variable} +buffer : packed array [1..name_length] of char; {input buffer} +begin + for i := 1 to name_length do begin + typ_name[i] := ' ' ; + pk_name[i] := ' ' ; + end; + print('Input file name: ') ; + flush_buffer ; + get_line(pk_name) ; + print('Output file name: ') ; + flush_buffer ; + get_line(typ_name) ; +end ; + +@* The main program. +Now that we have all the pieces written, let us put them together. + +@p begin +initialize ; +dialog ; +@<Open files@> ; +@<Read preamble@> ; +skip_specials ; +while flag_byte <> pk_post do begin + @<Unpack and write character@> ; + skip_specials ; +end ; +j := 0 ; +while not eof(pk_file) do begin + i := pk_byte ; + if i <> pk_no_op then abort('Bad byte at end of file: ',i:1) ; +@.Bad byte at end of file@> + t_print_ln((pk_loc-1):1,': No op') ; + incr(j) ; +end ; +t_print_ln(pk_loc:1,' bytes read from packed file.'); +final_end : +end . + +@* System-dependent changes. +This section should be replaced, if necessary, by changes to the program +that are necessary to make \.{PKtype} work at a particular installation. +Any additional routines should be inserted here. +@^system dependencies@> + +@* Index. +Pointers to error messages appear here together with the section numbers +where each ident\-i\-fier is used. diff --git a/systems/knuth/local/tex-sparc/Makefile b/systems/knuth/local/tex-sparc/Makefile new file mode 100644 index 0000000000..e7880da23c --- /dev/null +++ b/systems/knuth/local/tex-sparc/Makefile @@ -0,0 +1,74 @@ +# Make executable files for this workstation, using the master TeX sources + +#PFLAGS= -I.. -temp=. +PFLAGS= -I.. -g +#PFLAGS= -I.. +CFLAGS= -O -I.. +PC= time pc + +all: initex virtex + +triptest: triptex + -triptex < trip1.in + mv trip.log tripin.log + -triptex < trip2.in | tee trip.fot + dvitype trip.dvi < dvitype.in > /dev/null + mv dvitype.out trip.typ + rm -f *.dif + -diff tripin.log ../../dist/tex/tripin.log > tripin.log.dif + -diff trip.log ../../dist/tex/trip.log > trip.log.dif + -diff trip.fot ../../dist/tex/trip.fot > trip.fot.dif + -diff trip.typ ../../dist/tex/trip.typ > trip.typ.dif + more tripin.log.dif trip.log.dif trip.typ.dif trip.fot.dif + +%.p: %.ch + tangle ../../dist/tex/tex.web $*.ch + mv ../../dist/tex/tex.pool . + mv ../../dist/tex/tex.p $*.p + +initex.ch: ../../dist/tex/tex.web + +virtex.ch: initex.ch ini_to_vir + ini_to_vir initex.ch virtex.ch + +triptex.ch: initex.ch ini_to_trip + ini_to_trip initex.ch triptex.ch + +%.o: %.p + ${PC} ${PFLAGS} -c $*.p + +triptex.o: triptex.p + ${PC} -g ${PFLAGS} -c triptex.p + +initex: initex.o ext.o + pc ${PFLAGS} -o initex initex.o ext.o + +virtex: virtex.o ext.o + pc ${PFLAGS} -o virtex virtex.o ext.o + +triptex: triptex.o ext.o + pc -g ${PFLAGS} -o triptex triptex.o ext.o + cp ../../dist/tex/trip.tex . + +ext.o: ext.c ext.h ../h00vars.h ../texpaths.h + cc ${CFLAGS} -c ext.c + +plain.fmt: ../../dist/lib/plain.tex ../lib/local.tex + -initex plain \\input local \\dump + +install: # doit make install + mv initex virtex /usr/local/bin + rm /usr/local/bin/tex + ln /usr/local/bin/virtex /usr/local/bin/tex + make plain.fmt + +installtrip: # when the trip test is satisfactory + mv trip.tex tripin.log trip.log trip.fot trip.typ ../../dist/tex + +clean: + rm -f *.p *.o *~ *.tex triptex* *.dif trip.* tripin.log virtex.ch + @echo "Remaining files should be:" + @echo "Makefile ext.h initex.ch tex.pool" + @echo "dvitype.in ini_to_trip* plain.fmt trip1.in" + @echo "ext.c ini_to_vir* plain.log trip2.in" + diff --git a/systems/knuth/local/tex-sparc/dvitype.in b/systems/knuth/local/tex-sparc/dvitype.in new file mode 100644 index 0000000000..9aae7baa4b --- /dev/null +++ b/systems/knuth/local/tex-sparc/dvitype.in @@ -0,0 +1,5 @@ +2 +*.*.*.*.*.*.*.*.*.* +1000000 +7227/100 +0 diff --git a/systems/knuth/local/tex-sparc/ext.c b/systems/knuth/local/tex-sparc/ext.c new file mode 100644 index 0000000000..5d86e6799e --- /dev/null +++ b/systems/knuth/local/tex-sparc/ext.c @@ -0,0 +1,468 @@ +/* external procedures called by TeX */ +#include <sys/signal.h> +#include <sys/time.h> +#include "texpaths.h" /* defines MAXINPATHCHARS, defaultinputpath, etc. */ +#include "h00vars.h" + +/* The following are for closing files */ + +closea(f) + int *f; /* actually, file pointer, but it doesn't matter */ +{ + close1(f); +} + +closeb(f) + int *f; /* actually, file pointer, but it doesn't matter */ +{ + close1(f); +} + +closew(f) + int *f; /* actually, file pointer, but it doesn't matter */ +{ + close1(f); +} + +extern int interrupt; /* To be made nonzero to tell TeX about interrupts */ + +/* +** catchint() +** +** Gets called when the user hits his interrupt key. Sets the global +** "interrupt" nonzero, then sets it up so that the next interrupt will +** also be caught here. +** +*/ + +catchint() +{ + interrupt = 1; + signal(SIGINT,catchint); +} + +/* +** dateandtime(time, day, month, year) +** +** Stores minutes since midnight, current day, month and year into +** *time, *day, *month and *year, respectively. +** +** Also, set things up so that catchint() will get control on interrupts. +** +*/ + +dateandtime(minutes, day, month, year) +int *minutes, *day, *month, *year; +{ + long clock; + struct tm *tmptr, *localtime(); + + clock = time(0); + tmptr = localtime(&clock); + + *minutes = tmptr->tm_hour * 60 + tmptr->tm_min; + *day = tmptr->tm_mday; + *month = tmptr->tm_mon + 1; + *year = tmptr->tm_year + 1900; + signal(SIGINT,catchint); +} + + +/* fixed arrays are used to hold the paths, to avoid any possible problems + involving interaction of malloc and undump */ + +char inputpath[MAXINPATHCHARS] = defaultinputpath; +char fontpath[MAXOTHPATHCHARS] = defaultfontpath; +char formatpath[MAXOTHPATHCHARS] = defaultformatpath; +char poolpath[MAXOTHPATHCHARS] = defaultpoolpath; + +char *getenv(); + +/* + * setpaths is called to set up the arrays inputpath, fontpath, formatpath + * and poolpath as follows: if the user's environment has a value for the + * appropriate value, then use it; otherwise, leave the current value of + * the array (which may be the default path, or it may be the result of + * a call to setpaths on a previous run that was made the subject of + * an undump: this will give the maker of a preloaded TeX the option of + * providing a new set of "default" paths. + * + * Note that we have to copy the string from the environment area, since + * that will change on the next run (which matters if this is for a + * preloaded TeX). + */ +setpaths() +{ + register char *envpath; + + if ((envpath = getenv("TEXINPUTS")) != NULL) + copypath(inputpath,envpath,MAXINPATHCHARS); + if ((envpath = getenv("TEXFONTS")) != NULL) + copypath(fontpath,envpath,MAXOTHPATHCHARS); + if ((envpath = getenv("TEXFORMATS")) != NULL) + copypath(formatpath,envpath,MAXOTHPATHCHARS); + if ((envpath = getenv("TEXPOOL")) != NULL) + copypath(poolpath,envpath,MAXOTHPATHCHARS); +} + +/* + * copypath(s1,s2,n) copies at most n characters (including the null) + * from string s2 to string s1, giving an error message for paths + * that are too long. + */ +copypath(s1,s2,n) + register char *s1,*s2; + register int n; +{ + while ((*s1++ = *s2++) != '\0') + if (--n == 0) { + fprintf(stderr, "! Environment search path is too big\n"); + *--s1 = '\0'; + return; /* let user continue with truncated path */ + } +} + +extern short buffer[],xord[]; /* arrays of 0..255 */ +extern short last,first; /* pointers into buffer */ + +/* + * lineread reads from the Pascal text file with iorec pointer filep + * into buffer[first], buffer[first+1],..., buffer[last-1] (and + * setting "last"). + * Since 8-bit code is in the buffer, the elements are "short", not char. +* Characters are read until a newline is found (which isn't put in the + * buffer) or until the next character would go into buffer[lastlim]. + * The characters need to be translated, so really xord[c] is put into + * the buffer when c is read. + * If end-of-file is encountered, the funit field of *filep is set + * appropriately. + */ +lineread(filep, lastlim) +struct iorec *filep; +int lastlim; +{ + register c; + register short *cs; /* pointer into buffer where next char goes */ + register FILE *iop; /* stdio-style FILE pointer */ + int l; /* how many more chars are allowed before buffer overflow */ + short *bf; /* hold address of buffer[first] */ + + iop = filep->fbuf; + bf = cs = &(buffer[first]); + l = lastlim-first; + /* overflow when next char would go into buffer[lastlim] */ + while (--l>=0 && (c = getc(iop)) != EOF && c!='\n') + *cs++ = xord[c]; + if (c == EOF) + filep->funit |= EOFF; /* we hit end-of-file */ + last = first+cs-bf; +} + +#define filenamesize 1024 /* should agree with initex.ch */ +extern char nameoffile[],realnameoffile[]; /* these have size filenamesize */ + +/* + * testaccess(amode,filepath) + * + * Test whether or not the file whose name is in the global nameoffile + * can be opened for reading (if mode=READACCESS) + * or writing (if mode=WRITEACCESS). + * + * The filepath argument is one of the ...FILEPATH constants defined below. + * If the filename given in nameoffile does not begin with '/', we try + * prepending all the ':'-separated areanames in the appropriate path to the + * filename until access can be made, if it ever can. + * + * The realnameoffile global array will contain the name that yielded an + * access success. + */ + +#define READACCESS 4 +#define WRITEACCESS 2 + +#define NOFILEPATH 0 +#define INPUTFILEPATH 1 +#define READFILEPATH 2 +#define FONTFILEPATH 3 +#define FORMATFILEPATH 4 +#define POOLFILEPATH 5 + +bool +testaccess(amode,filepath) + int amode,filepath; +{ + register bool ok; + register char *p; + char *curpathplace; + int f; + + switch(filepath) { + case NOFILEPATH: curpathplace = NULL; break; + case INPUTFILEPATH: case READFILEPATH: + curpathplace = inputpath; break; + case FONTFILEPATH: curpathplace = fontpath; break; + case FORMATFILEPATH: curpathplace = formatpath; break; + case POOLFILEPATH: curpathplace = poolpath; break; + } + if (nameoffile[0]=='/') /* file name has absolute path */ + curpathplace = NULL; + do { + packrealnameoffile(&curpathplace); + if (amode==READACCESS) + /* use system call "access" to see if we could read it */ + if (access(realnameoffile,READACCESS)==0) ok = TRUE; + else ok = FALSE; + else { + /* WRITEACCESS: use creat to see if we could create it, but close + the file again if we're OK, to let pc open it for real */ + f = creat(realnameoffile,0666); + if (f>=0) ok = TRUE; + else ok = FALSE; + if (ok) + close(f); + } + } while (!ok && curpathplace != NULL); + if (ok) { /* pad realnameoffile with blanks, as Pascal wants */ + for (p = realnameoffile; *p != '\0'; p++) + /* nothing: find end of string */ ; + while (p < &(realnameoffile[filenamesize])) + *p++ = ' '; + } + return (ok); +} + +/* + * packrealnameoffile(cpp) makes realnameoffile contain the directory at *cpp, + * followed by '/', followed by the characters in nameoffile up until the + * first blank there, and finally a '\0'. The cpp pointer is left pointing + * at the next directory in the path. + * But: if *cpp == NULL, then we are supposed to use nameoffile as is. + */ +packrealnameoffile(cpp) + char **cpp; +{ + register char *p,*realname; + + realname = realnameoffile; + if ((p = *cpp)!=NULL) { + while ((*p != ':') && (*p != '\0')) { + *realname++ = *p++; + if (realname == &(realnameoffile[filenamesize-1])) + break; + } + if (*p == '\0') *cpp = NULL; /* at end of path now */ + else *cpp = p+1; /* else get past ':' */ + *realname++ = '/'; /* separate the area from the name to follow */ + } + /* now append nameoffile to realname... */ + p = nameoffile; + while (*p != ' ') { + if (realname >= &(realnameoffile[filenamesize-1])) { + fprintf(stderr,"! Full file name is too long\n"); + break; + } + *realname++ = *p++; + } + *realname = '\0'; +} + +/* +** testeof(filep) +** +** Test whether or not the Pascal text file with iorec pointer filep +** has reached end-of-file (when the only I/O on it is done with +** lineread, above). +** We may have to read the next character and unget it to see if perhaps +** the end-of-file is next. +*/ + +bool +testeof(filep) +register struct iorec *filep; +{ + register char c; + register FILE *iop; /* stdio-style FILE pointer */ + if (filep->funit & EOFF) + return(TRUE); + else { /* check to see if next is EOF */ + iop = filep->fbuf; + c = getc(iop); + if (c == EOF) + return(TRUE); + else { + ungetc(c,iop); + return(FALSE); + } + } +} + + +/* +** writedvi(a,b) +** +** writedvi is called to write dvibuf[a..b] to dvifile +** Unfortunately, dvibuf is declared as eight_bits, which in our +** implementation means that two bytes are taken by each entry. +** We only want to output the low order (first) byte of each pair. +*/ +extern struct iorec dvifile; +extern short dvibuf[]; +writedvi (a,b) + int a,b; +{ + register short *ptr,*final; + register FILE *iop; + + iop=dvifile.fbuf; + ptr= &(dvibuf[a]); + final= &(dvibuf[b]); + while (ptr<=final) { + putc((char) (*ptr & 0377), iop); + ptr += 1; + } + /* Note: The above code used to be machine dependent. By changing + * the declarations from "char *" to "short *" we get the machine + * to do its own byte ordering of the de-reference of "ptr" above. + * Then we AND off the low bits (now that it's been pulled from + * memory correctly) and cast it into a "char" for putc(). + * --Peter Kessler's idea; explanation, AND, cast a la clp. + */ +} + + +/* +** close1(filep) +** close1 does the proper things to pc's runtime system file data structure +** to close a file +*/ +close1(filep) + + register struct iorec *filep; +{ + register struct iorec *next; + + if (filep->fbuf != 0) { + if ((filep->funit & FDEF) == 0) { + next = (struct iorec *) &_fchain; + while (next->fchain != FILNIL + && next->fchain != filep) + next = next->fchain; + if (next->fchain != FILNIL) + next->fchain = next->fchain->fchain; + + if (filep->fblk > PREDEF) { + fflush(filep->fbuf); + setbuf(filep->fbuf, NULL); + } + fclose(filep->fbuf); + if (ferror(filep->fbuf)) { +/* ERROR and PERROR no longer exist in Pascal library; TeX doesn't know + what to do with them anyway! So I'm commenting this out... don 7/18/92 */ +/* ERROR("%s: Close failed\n", + filep->pfname); */ + return; + } + filep->fbuf=0; + } + if ((filep->funit & TEMP) != 0 && + unlink(filep->pfname)) { +/* PERROR("Could not remove ", filep->pfname); */ + return; + } + } +} + +/* +** The following procedure is due to sjc@s1-c. +** (with mods for 8-bit changes --- don, Sep 89) +** +** calledit(filename, fnlength, linenumber) +** +** TeX82 can call this to implement the 'e' feature in error-recovery +** mode, invoking a text editor on the erroneous source file. +** +** You should pass to "filename" the first character of the packed array +** containing the filename, and to "fnlength" the size of the filename. +** +** New problem (8-bit mod): need to add 128 to all characters of filename! +** +** Ordinarily, this invokes emacs. If you want a different +** editor, create a shell environment variable TEXEDIT containing +** the string that invokes that editor, with "%s" indicating where +** the filename goes and "%d" indicating where the decimal +** linenumber (if any) goes. For example, a TEXEDIT string for "vi" might be: +** +** setenv TEXEDIT "/usr/bin/vi +%d %s" +** +*/ + + char dvalue[] = "emacs +%d %s"; + char *texeditvalue = &dvalue[0]; + + calledit(filename, fnlength, linenumber) + char *filename; + int fnlength, linenumber; + { + char *temp, *command, c; + int sdone, ddone, i; + + sdone = ddone = 0; + + /* Replace default with environment variable if possible. */ + if (NULL != (temp = (char *) getenv("TEXEDIT"))) + texeditvalue = temp; + + /* Make command string containing envvalue, filename, and linenumber */ + if (NULL == + (command = (char *) malloc(strlen(texeditvalue) + fnlength + 25))) { + fprintf(stderr, "! Not enough memory to issue editor command\n"); + exit(1); + } + temp = command; + while ((c = *texeditvalue++) != '\0') { + if (c == '%') { + switch (c = *texeditvalue++) { + case 'd': + if (ddone) { + fprintf(stderr, + "! Line number cannot appear twice in editor command\n"); + exit(1); + } + sprintf(temp, "%d", linenumber); + while (*temp != '\0') + temp++; + ddone = 1; + break; + case 's': + if (sdone) { + fprintf(stderr, + "! Filename cannot appear twice in editor command\n"); + exit(1); + } + i = 0; + while (i < fnlength) + *temp++ = filename[i++] ^ 0x80; /* don's change */ + sdone = 1; + break; + case '\0': + *temp++ = '%'; + texeditvalue--; /* Back up to \0 to force termination. */ + break; + default: + *temp++ = '%'; + *temp++ = c; + break; + } + } + else + *temp++ = c; + } + *temp = '\0'; + + /* Execute command. */ + if (0 != system(command)) + fprintf(stderr, "! Trouble executing command %s\n", command); + + /* Quit, indicating TeX had found an error before you typed "e". */ + exit(1); + } diff --git a/systems/knuth/local/tex-sparc/ext.h b/systems/knuth/local/tex-sparc/ext.h new file mode 100644 index 0000000000..19dc5595f4 --- /dev/null +++ b/systems/knuth/local/tex-sparc/ext.h @@ -0,0 +1,32 @@ +procedure exit(x : integer); + external; + +procedure closea(var f:text); + external; + +procedure closeb(var f:bytefile); + external; + +procedure closew(var f:wordfile); + external; + +procedure dateandtime(var minutes, day, month, year : integer); + external; + +procedure setpaths; + external; + +function testaccess(accessmode:integer; filepath:integer): boolean; + external; + +function testeof(var f: text): boolean; + external; + +procedure lineread(var f: text; lastlim: integer); + external; + +procedure writedvi(a,b:integer); + external; + +procedure calledit(var filename: packedASCIIcode; fnlength, linenumber: integer); + external; diff --git a/systems/knuth/local/tex-sparc/ini_to_trip b/systems/knuth/local/tex-sparc/ini_to_trip new file mode 100644 index 0000000000..89ccab0759 --- /dev/null +++ b/systems/knuth/local/tex-sparc/ini_to_trip @@ -0,0 +1,41 @@ +#! /bin/csh +# A shell script to perform modifications on the changefile for initex +# to make a changefile for triptex (used to test tex). +# +# To use it, say +# ini_to_trip initex.ch triptex.ch +# +ed - $1 <<edscriptend +/debug=/ +// +s/@{//p +/gubed=/ +s/@t@>@}//p +/@!mem_max=/ +// +s/[0-9][0-9]*/3000/p +/@!mem_min=/ +s/-[0-9]*/1/p +/@!error_line=/ +s/[0-9][0-9]*/64/p +/@!half_error_line=/ +s/[0-9][0-9]*/32/p +/@!max_print_line=/ +s/[0-9][0-9]*/72/p +/@!font_max=/ +s/[0-9][0-9]*/75/p +/@!font_mem_size=/ +s/[0-9][0-9]*/20000/p +/@!pool_size=/ +s/[0-9][0-9]*/32000/p +/@d mem_bot=/ +// +s/-[0-9]*/1/p +/@d mem_top==/ +s/[0-9][0-9]*/3000/p +/@d hash_size=/ +s/[0-9][0-9]*/2100/p +/@d hash_prime=/ +s/[0-9][0-9]*/1777/p +w $2 +edscriptend diff --git a/systems/knuth/local/tex-sparc/ini_to_vir b/systems/knuth/local/tex-sparc/ini_to_vir new file mode 100644 index 0000000000..2120a4beea --- /dev/null +++ b/systems/knuth/local/tex-sparc/ini_to_vir @@ -0,0 +1,23 @@ +#! /bin/csh +# A shell script to perform modifications on the changefile for initex +# to make a changefile for virtex. This means changing constants and +# debug..gubed, init..tini, stat..tats. +# +# To use it, say +# ini_to_vir initex.ch virtex.ch +# +ed - $1 <<edscriptend +/@d init==/ +// +s//&@{/p +/@d tini==/ +s//&@t@>@}/p +/@!mem_max=/ +// +s/[0-9][0-9]*/32766/p +/@!max_strings=/ +s/[0-9][0-9]*/6000/p +/@!trie_size=/ +s/[0-9][0-9]*/6500/p +w $2 +edscriptend diff --git a/systems/knuth/local/tex-sparc/initex.ch b/systems/knuth/local/tex-sparc/initex.ch new file mode 100644 index 0000000000..11b4a9ab38 --- /dev/null +++ b/systems/knuth/local/tex-sparc/initex.ch @@ -0,0 +1,1419 @@ +% Change file for Berkeley UNIX, for a hacked version of the pc pascal +% compiler (with the others: clause in case statements). +% +% Distant relation of David Fuchs' Sep 13, 1982 TOPS20 version, greatly +% modified by Howard Trickey and Pavel Curtis + +% Modification History: +% +% (10/9) HWT Brought up to version 0.1 +% (10/13) HWT Fixed bug in hpack +% (10/17) HWT Changed to version 0.3 +% (10/22) HWT Brought up to version 0.4 +% (10/26) HWT Changed to use version 0.5 source +% (11/19) HWT Changed to use version 0.8 source; fixed glue_ratios to use +% external C procedures +% (11/30) HWT Changed to use new tangle, with verbatim Pascal mode, to avoid +% need for editing in the #include statement +% (changed modules 4,9) +% (1/15/83) HWT Changed to use version 0.94 source; added Pavel's changes to +% allow undumping; added Grim's fix for grtofl, etc.; +% modified for Knuth's new tangle. +% (2/1/83) PC Consolidated with Pavel's version, changed the fl<->gr +% routines to avoid slow and messy union type. +% (3/18/83) HWT Changed to use version 0.96 source (means changing fltogr and +% grtofl to unfloat and float, then getting rid of a lot of +% changes); made TeX print a newline +% at the end of the run. +% (4/2/83) PC Added call to exit() at end of run, with exit-value dependent +% upon the value of `history'. +% (4/16/83) PC Brought up to version 0.97 of TeX. +% (5/23/83) HWT Changed mem_max to 30000 for initex (because of latex) +% (6/2/83) HWT Brought up to version 0.98 of TeX. Changed some of the +% string-related constants to match the latest tops20 +% change file. Modified input_ln and write_dvi to use external +% C procedures, for speed increase. Changed file opening +% procedures to use external C procedure to test for +% accessibility, so that now none of the pc runtime library +% programs need to be modified (though close1 is still needed) +% (6/28/83) HWT Brought up to 0.99, with new change file format. +% (7/17/83) HWT Brought up to 0.999. Added switch-to-editor stuff. +% (7/29/83) HWT Brought up to 0.9999. +% (11/4/83) HWT Brought up to 0.999999. +% (11/16/83) HWT Brought up to 1.0. Upped max_strings, string_vacancies, +% pool_size, hash_size, and hash_prime, to agree with +% TOPS20-changes constants. +% (1/4/84) HWT Again, upped pool_size to 40000 for LaTeX. +% (2/18/84) HWT Made changes to use search path stuff in new ext.c. Now all +% the path specific stuff is localized to texpaths.h +% (6/6/84) HWT Brought up to 1.1. Upped pool_size and hash_size for LaTeX. +% (31/7/84) HWT Removed the forgetting of the full file name, so that +% switch-to-editor works for non-primary file. +% (11/16/84) RKF Brought up to 1.2 +% (12/26/84) RKF Brought up to 1.3, consulting changes already done by +% SVB@Purdue, rusty@sdcarl, and a related file from HWT +% (3/11/85) RKF Brought up to 1.3b +% (9/2/85) RKF Brought up to 1.5 (yep, missed 1.4) +% (1/30/86) PAM brought up to 2.0 +% (12/11/86) PAM commented out the patch which turns on debug. This is +% partly since debug is no longer necessary at this point of development +% but also because debug turns on range checking in the pc, and in +% recent months the pc range check has been giving bogus error +% messages. +% (2/27/87) PAM No change in working code, but noted places where SUNMakefile +% makes alterations for more efficient SUN code. +% (3/7/87) PAM Changed version number for TeX 2.1 +% (9/23/87) PAM Changed version number for TeX 2.3 +% (10/25/87) PAM Changed version number for TeX 2.5 +% (12/5/87) PAM Changed version number for TeX 2.7 +% (1/15/88) PAM Changed version number for TeX 2.9 +% (8/9/89) don SunOS changes for TeX 2.991; decreased some constants +% (9/10/89) don Major changes for 8-bit TeX beta test (version 2.992-eps) +% (10/6/89) don Now uptodate with TeX version 2.992 (\approx 3.0) +% (10/29/89) don Upped fontmax to 127 and fontmemsize to 40000 +% (1/23/90) don Fixed max_buf_stack logic (it was one too high) +% (9/6/90) don to Version 3.1 +% (1/30/91) don to Version 3.14 +% (9/19/91) don to Version 3.14a +% (1/25/92) don to Version 3.14b +% (3/15/92) don to Version 3.141 +% (6/15/92) don reversed the UNIXexit values (0 is success)(cf make) +% (2/26/93) don to Version 3.1415 +% (3/8/95) don to Version 3.14159 +% (4/2/97) don increased pool_size from 50000 to 60000 +% (and max_strings from 4000 to 6000 in ini_to_vir) +% (9/16/97) don increased buf_size from 500 to 5000 (without bothering +% to see why the implementation doesn't overflow buf_size gracefully) + +% Use this file as is to make an INITEX. To get production TeX, use the +% shell script ``ini_to_vir'' and re-TANGLE. + +% NOTE: the module numbers in this change file refer to Volume B. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [0] WEAVE: only print changes +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +\def\botofcontents{\vskip 0pt plus 1fil minus 1.5in} +@y +\def\botofcontents{\vskip 0pt plus 1fil minus 1.5in} +\let\maybe=\iffalse +\def\title{\TeX82 changes for SunOS} +\def\glob{13}\def\gglob{20, 26} % these are defined in module 1 +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.2] banner line +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d banner=='This is TeX, Version 3.14159' {printed when \TeX\ starts} +@y +@d banner=='This is TeX, Version 3.14159 for SunOS' {printed when \TeX\ starts} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.4] program header +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +Actually the heading shown here is not quite normal: The |program| line +does not mention any |output| file, because \ph\ would ask the \TeX\ user +to specify a file name if |output| were specified here. +@^system dependencies@> + +@d mtype==t@&y@&p@&e {this is a \.{WEB} coding trick:} +@y +@d mtype==t@&y@&p@&e {this is a \.{WEB} coding trick:} +@d standard_input==i@&n@&p@&u@&t {and another} +@z +@x +program TEX; {all file names are defined dynamically} +@y +program TEX(standard_input,output); {other file names are defined dynamically} +@z +@x +var @<Global variables@>@/ +@y +var @<Global variables@>@/ +@# +@\@=#include "ext.h"@>@\ {declarations for external C procedures} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.7] debug..gubed, stat..tats +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging} +@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging} +@y +@d debug==@{ {the trip test will use debugging} +@d gubed==@t@>@} +@z +@x +@d stat==@{ {change this to `$\\{stat}\equiv\null$' when gathering + usage statistics} +@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$' when gathering + usage statistics} +@y +@d stat== +@d tats== +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.8] init..tini +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d init== {change this to `$\\{init}\equiv\.{@@\{}$' in the production version} +@d tini== {change this to `$\\{tini}\equiv\.{@@\}}$' in the production version} +@y +@d init== +@d tini== +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.9] compiler directives +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead} +@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging} +@y +@=(*$C-*)@> {no range check} +@!debug @=(*$C+*)@> @+ gubed {debug with range check (may cause bogus errors)} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.10] othercases, feature of Sun Pascal +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d othercases == others: {default for cases not listed explicitly} +@y +@d othercases == otherwise {default for cases not listed explicitly} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.11] compile-time constants +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!mem_max=30000; {greatest index in \TeX's internal |mem| array; + must be strictly less than |max_halfword|; + must be equal to |mem_top| in \.{INITEX}, otherwise |>=mem_top|} +@!mem_min=0; {smallest index in \TeX's internal |mem| array; + must be |min_halfword| or more; + must be equal to |mem_bot| in \.{INITEX}, otherwise |<=mem_bot|} +@!buf_size=500; {maximum number of characters simultaneously present in + current lines of open files and in control sequences between + \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|} +@!error_line=72; {width of context lines on terminal error messages} +@!half_error_line=42; {width of first lines of contexts in terminal + error messages; should be between 30 and |error_line-15|} +@!max_print_line=79; {width of longest text lines output; should be at least 60} +@!stack_size=200; {maximum number of simultaneous input sources} +@!max_in_open=6; {maximum number of input files and error insertions that + can be going on simultaneously} +@!font_max=75; {maximum internal font number; must not exceed |max_quarterword| + and must be at most |font_base+256|} +@!font_mem_size=20000; {number of words of |font_info| for all fonts} +@!param_size=60; {maximum number of simultaneous macro parameters} +@!nest_size=40; {maximum number of semantic levels simultaneously active} +@!max_strings=3000; {maximum number of strings; must not exceed |max_halfword|} +@!string_vacancies=8000; {the minimum number of characters that should be + available for the user's control sequences and font names, + after \TeX's own error messages are stored} +@!pool_size=32000; {maximum number of characters in strings, including all + error messages and help texts, and the names of all fonts and + control sequences; must exceed |string_vacancies| by the total + length of \TeX's own strings, which is currently about 23000} +@!save_size=600; {space for saving values outside of current group; must be + at most |max_halfword|} +@!trie_size=8000; {space for hyphenation patterns; should be larger for + \.{INITEX} than it is in production versions of \TeX} +@!trie_op_size=500; {space for ``opcodes'' in the hyphenation patterns} +@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8} +@!file_name_size=40; {file names shouldn't be longer than this} +@!pool_name='TeXformats:TEX.POOL '; + {string of length |file_name_size|; tells where the string pool appears} +@y +@!mem_max=30000; {greatest index in \TeX's internal |mem| array; + must be strictly less than |max_halfword|; + must be equal to |mem_top| in \.{INITEX}, otherwise |>=mem_top|} +@!mem_min=-32767; {smallest index in \TeX's internal |mem| array; + must be |min_halfword| or more; + must be equal to |mem_bot| in \.{INITEX}, otherwise |<=mem_bot|} +@!buf_size=5000; {maximum number of characters simultaneously present in + current lines of open files and in control sequences between + \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|} +@!error_line=79; {width of context lines on terminal error messages} +@!half_error_line=50; {width of first lines of contexts in terminal + error messages; should be between 30 and |error_line-15|} +@!max_print_line=79; {width of longest text lines output; should be at least 60} +@!stack_size=200; {maximum number of simultaneous input sources} +@!max_in_open=15; {maximum number of input files and error insertions that + can be going on simultaneously} +@!font_max=127; {maximum internal font number; must not exceed |max_quarterword| + and must be at most |font_base+256|} +@!font_mem_size=40000; {number of words of |font_info| for all fonts} +@!param_size=60; {maximum number of simultaneous macro parameters} +@!nest_size=40; {maximum number of semantic levels simultaneously active} +@!max_strings=3000; {maximum number of strings; must not exceed |max_halfword|} +@!string_vacancies=8000; {the minimum number of characters that should be + available for the user's control sequences and font names, + after \TeX's own error messages are stored} +@!pool_size=60000; {maximum number of characters in strings, including all + error messages and help texts, and the names of all fonts and + control sequences; must exceed |string_vacancies| by the total + length of \TeX's own strings, which is currently about 23000} +@!save_size=600; {space for saving values outside of current group; must be + at most |max_halfword|} +@!trie_size=8000; {space for hyphenation patterns; should be larger for + \.{INITEX} than it is in production versions of \TeX} +@!trie_op_size=500; {space for ``opcodes'' in the hyphenation patterns} +@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8} +@!file_name_size=1024; {file names shouldn't be longer than this} +@!pool_name='tex.pool'; + {string of length |file_name_size|; the string pool name} +@.TeXformats@> +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.12] sensitive compile-time constants +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d mem_bot=0 {smallest index in the |mem| array dumped by \.{INITEX}; + must not be less than |mem_min|} +@d mem_top==30000 {largest index in the |mem| array dumped by \.{INITEX}; + must be substantially larger than |mem_bot| + and not greater than |mem_max|} +@d font_base=0 {smallest internal font number; must not be less + than |min_quarterword|} +@d hash_size=2100 {maximum number of control sequences; it should be at most + about |(mem_max-mem_min)/10|} +@d hash_prime=1777 {a prime number equal to about 85\pct! of |hash_size|} +@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions} +@y +@d mem_bot=-32767 {smallest index in the |mem| array dumped by \.{INITEX}; + must not be less than |mem_min|} +@d mem_top==30000 {largest index in the |mem| array dumped by \.{INITEX}; + must be substantially larger than |mem_bot| + and not greater than |mem_max|} +@d font_base=0 {smallest internal font number; must not be less + than |min_quarterword|} +@d hash_size=4000 {maximum number of control sequences; it should be at most + about |(mem_max-mem_min)/10|} +@d hash_prime=3443 {a prime number equal to about 85\pct! of |hash_size|} +@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [2.23] allow any character that we can input to get in +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +for i:=0 to @'37 do xchr[i]:=' '; +for i:=@'177 to @'377 do xchr[i]:=' '; +@y +for i:=0 to @'37 do xchr[i]:=chr(i); +for i:=@'177 to @'377 do xchr[i]:=chr(i); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.25] file types +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +The program actually makes use also of a third kind of file, called a +@y +The pc compiler on Berkeley {\mc UNIX} won't pack a range into one byte unless +the lower bound is |-128| or more, and the upper bound is |127| or less. +This applies to files, too. To make the program work with compiler range +checking turned on, we'll have to adjust |eight_bits| codes by sometimes +adding or subtracting |256|. +Note that |eight_bits| really takes 16 bits here. + +The program actually makes use also of a third kind of file, called a +@z +@x +@!alpha_file=packed file of text_char; {files that contain textual data} +@!byte_file=packed file of eight_bits; {files that contain binary data} +@y +@!alpha_file=t@&e@&x@&t; {files that contain textual data} +@!byte_file=packed file of -128..127; {files that contain binary data} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.26] add real_name_of_file array +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +is crucial for our purposes. We shall assume that |name_of_file| is a variable +of an appropriate type such that the \PASCAL\ run-time system being used to +implement \TeX\ can open a file whose external name is specified by +|name_of_file|. +@^system dependencies@> + +@<Glob...@>= +@!name_of_file:packed array[1..file_name_size] of char;@;@/ + {on some systems this may be a \&{record} variable} +@!name_length:0..file_name_size;@/{this many characters are actually + relevant in |name_of_file| (the rest are blank)} +@y +is crucial for our purposes. We shall assume that |name_of_file| is a variable +of an appropriate type such that the \PASCAL\ run-time system being used to +implement \TeX\ can open a file whose external name is specified by +|name_of_file|. +The Berkeley {\mc UNIX} version uses search paths to look for files to open. +We use |real_name_of_file| to hold the |name_of_file| with a directory +name from the path in front of it. +@^system dependencies@> + +@<Glob...@>= +@!name_of_file,@!real_name_of_file:packed array[1..file_name_size] of char; +@;@/ +@!name_length:0..file_name_size;@/{this many characters are actually + relevant in |name_of_file| (the rest are blank)} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.27] file opening +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The \ph\ compiler with which the present version of \TeX\ was prepared has +extended the rules of \PASCAL\ in a very convenient way. To open file~|f|, +we can write +$$\vbox{\halign{#\hfil\qquad&#\hfil\cr +|reset(f,@t\\{name}@>,'/O')|&for input;\cr +|rewrite(f,@t\\{name}@>,'/O')|&for output.\cr}}$$ +The `\\{name}' parameter, which is of type `{\bf packed array +$[\langle\\{any}\rangle]$ of \\{char}}', stands for the name of +the external file that is being opened for input or output. +Blank spaces that might appear in \\{name} are ignored. + +The `\.{/O}' parameter tells the operating system not to issue its own +error messages if something goes wrong. If a file of the specified name +cannot be found, or if such a file cannot be opened for some other reason +(e.g., someone may already be trying to write the same file), we will have +|@!erstat(f)<>0| after an unsuccessful |reset| or |rewrite|. This allows +\TeX\ to undertake appropriate corrective action. +@:PASCAL H}{\ph@> +@^system dependencies@> + +\TeX's file-opening procedures return |false| if no file identified by +|name_of_file| could be opened. + +@d reset_OK(#)==erstat(#)=0 +@d rewrite_OK(#)==erstat(#)=0 + +@p function a_open_in(var f:alpha_file):boolean; + {open a text file for input} +begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f); +end; +@# +function a_open_out(var f:alpha_file):boolean; + {open a text file for output} +begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f); +end; +@# +function b_open_in(var f:byte_file):boolean; + {open a binary file for input} +begin reset(f,name_of_file,'/O'); b_open_in:=reset_OK(f); +end; +@# +function b_open_out(var f:byte_file):boolean; + {open a binary file for output} +begin rewrite(f,name_of_file,'/O'); b_open_out:=rewrite_OK(f); +end; +@# +function w_open_in(var f:word_file):boolean; + {open a word file for input} +begin reset(f,name_of_file,'/O'); w_open_in:=reset_OK(f); +end; +@# +function w_open_out(var f:word_file):boolean; + {open a word file for output} +begin rewrite(f,name_of_file,'/O'); w_open_out:=rewrite_OK(f); +end; +@y +@ The \ph\ compiler with which the present version of \TeX\ was prepared has +extended the rules of \PASCAL\ in a very convenient way for file opening. +Berkeley {\mc UNIX} \PASCAL\ isn't nearly as nice as \ph. +Normally, it bombs out if a file open fails. +An external C procedure, |test_access| is used to check whether or not the +open will work. It is declared in the ``ext.h'' include file, and it returns +|true| or |false|. The |name_of_file| global holds the file name whose access +is to be tested. +The first parameter for |test_access| is the access mode, +one of |read_access_mode| or |write_access_mode|. + +We also implement path searching in |test_access|: its second parameter is +one of the ``file path'' constants defined below. If |name_of_file| +doesn't start with |'/'| then |test_access| tries prepending pathnames +from the appropriate path list until success or the end of path list +is reached. +On return, |real_name_of_file| contains the original name with the path +that succeeded (if any) prepended. It is the name used in the various +open procedures. + +Note that |a_open_in| has been redefined to take an additional argument, +which should be one of the ``file path'' specifiers. +Since |b_open_in| is only used for \.{TFM} files, and +|w_open_in| is only used for format files, we don't need a path specifying +argument for them. +Path searching is not done for output files. + +@d read_access_mode=4 {``read'' mode for |test_access|} +@d write_access_mode=2 {``write'' mode for |test_access|} + +@d no_file_path=0 {no path searching should be done} +@d input_file_path=1 {path specifier for \.{\\input} files} +@d read_file_path=2 {path specifier for \.{\\read} files} +@d font_file_path=3 {path specifier for \.{TFM} files} +@d format_file_path=4 {path specifier for format files} +@d pool_file_path=5 {path specifier for the pool file} + +@p function a_open_in(var f:alpha_file;@!path_specifier:integer):boolean; + {open a text file for input} +var @!ok:boolean; +begin +if test_access(read_access_mode,path_specifier) then + begin reset(f,real_name_of_file); ok:=true@+end +else + ok:=false; +a_open_in:=ok; +end; +@# +function a_open_out(var f:alpha_file):boolean; + {open a text file for output} +var @!ok:boolean; +begin +if test_access(write_access_mode,no_file_path) then + begin rewrite(f,real_name_of_file); ok:=true @+end +else ok:=false; +a_open_out:=ok; +end; +@# +function b_open_in(var f:byte_file):boolean; + {open a binary file for input} +var @!ok:boolean; +begin +if test_access(read_access_mode,font_file_path) then + begin reset(f,real_name_of_file); ok:=true @+end +else ok:=false; +b_open_in:=ok; +end; +@# +function b_open_out(var f:byte_file):boolean; + {open a binary file for output} +var @!ok:boolean; +begin +if test_access(write_access_mode,no_file_path) then + begin rewrite(f,real_name_of_file); ok:=true @+end +else ok:=false; +b_open_out:=ok; +end; +@# +function w_open_in(var f:word_file):boolean; + {open a word file for input} +var @!ok:boolean; +begin +if test_access(read_access_mode,format_file_path) then + begin reset(f,real_name_of_file); ok:=true @+end +else ok:=false; +w_open_in:=ok; +end; +@# +function w_open_out(var f:word_file):boolean; + {open a word file for output} +var @!ok:boolean; +begin +if test_access(write_access_mode,no_file_path) then + begin rewrite(f,name_of_file); ok:=true @+end +else ok:=false; +w_open_out:=ok; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.28] file closing +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +This makes |f| available to be opened again, if desired; and if |f| was used for +output, the |close| operation makes the corresponding external file appear +on the user's area, ready to be read. + +These procedures should not generate error messages if a file is +being closed before it has been successfully opened. + +@p procedure a_close(var f:alpha_file); {close a text file} +begin close(f); +end; +@# +procedure b_close(var f:byte_file); {close a binary file} +begin close(f); +end; +@# +procedure w_close(var f:word_file); {close a word file} +begin close(f); +end; +@y +This makes |f| available to be opened again, if desired; and if |f| was used for +output, the |close| operation makes the corresponding external file appear +on the user's area, ready to be read. + +With the pc library, files will be automatically closed when the program stops +and when one reopens them. +There is, however, the problem of opening a file and writing it, and then +wanting to read it again, but from a different file variable. +For this purpose we use external procedures |close_a|, |close_b|, and +|close_w|. + +@p procedure a_close(var f:alpha_file); {close a text file} +begin close_a(f); +end; +@# +procedure b_close(var f:byte_file); {close a binary file} +begin close_b(f); +end; +@# +procedure w_close(var f:word_file); {close a word file} +begin close_w(f); +end; + +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.31] faster version of input_ln +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +Since the inner loop of |input_ln| is part of \TeX's ``inner loop''---each +character of input comes in at this place---it is wise to reduce system +overhead by making use of special routines that read in an entire array +of characters at once, if such routines are available. The following +code uses standard \PASCAL\ to illustrate what needs to be done, but +finer tuning is often possible at well-developed \PASCAL\ sites. +@^inner loop@> + +@p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean; + {inputs the next line or returns |false|} +var last_nonblank:0..buf_size; {|last| with trailing blanks removed} +begin if bypass_eoln then if not eof(f) then get(f); + {input the first character of the line into |f^|} +last:=first; {cf.\ Matthew 19\thinspace:\thinspace30} +if eof(f) then input_ln:=false +else begin last_nonblank:=first; + while not eoln(f) do + begin if last>=max_buf_stack then + begin max_buf_stack:=last+1; + if max_buf_stack=buf_size then + @<Report overflow of the input buffer, and abort@>; + end; + buffer[last]:=xord[f^]; get(f); incr(last); + if buffer[last-1]<>" " then last_nonblank:=last; + end; + last:=last_nonblank; input_ln:=true; + end; +end; +@y +Since the inner loop of |input_ln| is part of \TeX's ``inner loop''---each +character of input comes in at this place---it is wise to reduce system +overhead by making use of special routines that read in an entire array +of characters at once. + +With Berkeley {\mc UNIX} we call an external C procedure, |line_read|. +That routine fills |buffer| from |first| onwards with the |xord|'ed values +of the next line, setting |last| appropriately. It will stop if +|last=buf_size|, and the following will cause an ``overflow'' abort. +We ignore the |bypass_eoln| argument, since the |line_read| procedure +will have handled bypassing the end-of-line in its previous call, if +there was one. + +If one uses |input_ln| on a file, the normal |read| +and |get| routines shouldn't be used, nor the |eof| and |eoln| tests. +End of file can be tested with the external function |test_eof|. +@^inner loop@> + + +@p function input_ln(var f:alpha_file;@!bypass_eoln:boolean):boolean; + {inputs the next line or returns |false|} +label done; +begin +last:=first; {cf.\ Matthew 19\thinspace:\thinspace30} +if test_eof(f) then input_ln:=false +else begin last:=first; + line_read(f,buf_size); + if last>max_buf_stack then begin + max_buf_stack:=last; + if max_buf_stack>=buf_size then + @<Report overflow of the input buffer, and abort@>; + end; + loop@+ begin if last=first then goto done; + if buffer[last-1]<>" " then goto done; + decr(last); + end; +done: input_ln:=true; + end; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.32] term_in/out are input,output +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The user's terminal acts essentially like other files of text, except +that it is used both for input and for output. When the terminal is +considered an input file, the file variable is called |term_in|, and when it +is considered an output file the file variable is |term_out|. +@^system dependencies@> + +@<Glob...@>= +@!term_in:alpha_file; {the terminal as an input file} +@!term_out:alpha_file; {the terminal as an output file} +@y +@ The user's terminal acts essentially like other files of text, except +that it is used both for input and for output. When the terminal is +considered an input file, the file is called |term_in|, and when it +is considered an output file the file is |term_out|. +For Berkeley {\mc UNIX} we use |standard_input| and |output| for these +files, as were declared in the program header. The former name +|standard_input| was defined using a .{WEB} trick so that `input' is +produced in the Pascal file. + +@d term_in==standard_input {the terminal as an input file} +@d term_out==output {the terminal as an output file} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.33] don't need to open terminal files +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ Here is how to open the terminal files +in \ph. The `\.{/I}' switch suppresses the first |get|. +@^system dependencies@> + +@d t_open_in==reset(term_in,'TTY:','/O/I') {open the terminal for text input} +@d t_open_out==rewrite(term_out,'TTY:','/O') {open the terminal for text output} +@y +@ Here is how to open the terminal files---do nothing. + +@d t_open_in == {input already open for text input} +@d t_open_out == {output already open for text output} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.34] flushing output +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +these operations can be specified in \ph: +@^system dependencies@> + +@d update_terminal == break(term_out) {empty the terminal output buffer} +@d clear_terminal == break_in(term_in,true) {clear the terminal input buffer} +@d wake_up_terminal == do_nothing {cancel the user's cancellation of output} +@y +these operations can be specified with Berkeley {\mc UNIX}: +@^system dependencies@> + +@d update_terminal == flush(output) +@d clear_terminal == {nothing necessary on UNIX} +@d wake_up_terminal == {nothing necessary on UNIX} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.37] rescanning the command line +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The following program does the required initialization +without retrieving a possible command line. +It should be clear how to modify this routine to deal with command lines, +if the system permits them. +@^system dependencies@> + +@p function init_terminal:boolean; {gets the terminal input started} +label exit; +begin t_open_in; +loop@+begin wake_up_terminal; write(term_out,'**'); update_terminal; +@.**@> + if not input_ln(term_in,true) then {this shouldn't happen} + begin write_ln(term_out); + write(term_out,'! End of file on the terminal... why?'); +@.End of file on the terminal@> + init_terminal:=false; return; + end; + loc:=first; + while (loc<last)and(buffer[loc]=" ") do incr(loc); + if loc<last then + begin init_terminal:=true; + return; {return unless the line was all blank} + end; + write_ln(term_out,'Please type the name of your input file.'); + end; +exit:end; +@y +@ The following program does the required initialization +and also retrieves a possible command line. +@^system dependencies@> + +@p +function init_terminal:boolean; {gets the terminal input started} +label exit; + +var + dummy, i, j, k: integer; + arg: packed array[1..100] of char; + +begin + t_open_in; + if argc > 1 then begin + last := first; + for i := 1 to argc - 1 do begin + argv(i, arg); + j := 1; + k := 100; {find last non-blank char in arg} + while (k > 1) and (arg[k] = ' ') do@/ + decr(k); + while (j <= k) do begin + buffer[last] := xord[arg[j]]; + incr(j); incr(last); + end; + if k > 1 then begin + buffer[last] := xord[' ']; + incr(last); + end; + end; + if last > first then begin + loc := first; + init_terminal := true; + return; + end; + end; + loop@+begin + wake_up_terminal; write(term_out, '**'); update_terminal; +@.**@> + if not input_ln(term_in,true) then begin {this shouldn't happen} + write_ln(term_out); + write_ln(term_out, '! End of file on the terminal... why?'); +@.End of file on the terminal@> + init_terminal:=false; + return; + end; + + loc:=first; + while (loc<last)and(buffer[loc]=" ") do + incr(loc); + + if loc<last then begin + init_terminal:=true; + return; {return unless the line was all blank} + end; + write_ln(term_out, 'Please type the name of your input file.'); +@.Please type the name...@> + end; +exit: +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [4.38] string data to be offset -128 for packing +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d si(#) == # {convert from |ASCII_code| to |packed_ASCII_code|} +@d so(#) == # {convert from |packed_ASCII_code| to |ASCII_code|} + +@<Types...@>= +@!pool_pointer = 0..pool_size; {for variables that point into |str_pool|} +@!str_number = 0..max_strings; {for variables that point into |str_start|} +@!packed_ASCII_code = 0..255; {elements of |str_pool| array} +@y +@d si(#) == #-128 {convert from |ASCII_code| to |packed_ASCII_code|} +@d so(#) == #+128 {convert from |packed_ASCII_code| to |ASCII_code|} + +@<Types...@>= +@!pool_pointer = 0..pool_size; {for variables that point into |str_pool|} +@!str_number = 0..max_strings; {for variables that point into |str_start|} +@!packed_ASCII_code = -128..127; {elements of |str_pool| array} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [4.51] a_open_in of pool file needs path specifier +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +if a_open_in(pool_file) then +@y +if a_open_in(pool_file,pool_file_path) then +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [4.51,52,53] make TEX.POOL lowercase in messages +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +else bad_pool('! I can''t read TEX.POOL.') +@y +else bad_pool('! I can''t read tex.pool.') +@z +@x +begin if eof(pool_file) then bad_pool('! TEX.POOL has no check sum.'); +@y +begin if eof(pool_file) then bad_pool('! tex.pool has no check sum.'); +@z +@x + bad_pool('! TEX.POOL line doesn''t begin with two digits.'); +@y + bad_pool('! tex.pool line doesn''t begin with two digits.'); +@z +@x + bad_pool('! TEX.POOL check sum doesn''t have nine digits.'); +@y + bad_pool('! tex.pool check sum doesn''t have nine digits.'); +@z +@x +done: if a<>@$ then bad_pool('! TEX.POOL doesn''t match; TANGLE me again.'); +@y +done: if a<>@$ then bad_pool('! tex.pool doesn''t match; tangle me again.'); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [6.84] switch-to-editor option +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +line ready to be edited. But such an extension requires some system +wizardry, so the present implementation simply types out the name of the +file that should be +edited and the relevant line number. +@^system dependencies@> + +There is a secret `\.D' option available when the debugging routines haven't +been commented~out. +@^debugging@> +@y +line ready to be edited. +We do this by calling the external procedure |calledit| with a pointer to +the filename, its length, and the line number. +However, here we just set up the variables that will be used as arguments, +since we don't want to do the switch-to-editor until after \TeX\ has closed +its files. +@^system dependencies@> + +There is a secret `\.D' option available when the debugging routines haven't +been commented~out. +@^debugging@> +@d edit_file==input_stack[base_ptr] +@z +@x +"E": if base_ptr>0 then + begin print_nl("You want to edit file "); +@.You want to edit file x@> + slow_print(input_stack[base_ptr].name_field); + print(" at line "); print_int(line); + interaction:=scroll_mode; jump_out; +@y +"E": if base_ptr>0 then + begin + ed_name_start:=str_start[edit_file.name_field]; + ed_name_length:=str_start[edit_file.name_field+1] - + str_start[edit_file.name_field]; + edit_line:=line; + jump_out; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [7.109] glue_ratio +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!glue_ratio=real; {one-word representation of a glue expansion factor} +@y +@!glue_ratio=shortreal; {one-word representation of a glue expansion factor} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [8.110] ranges for quarter,half words +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +if the subrange is `|-128..127|'. + +The present implementation tries to accommodate as many variations as possible, +so it makes few assumptions. If integers having the subrange +`|min_quarterword..max_quarterword|' can be packed into a quarterword, +and if integers having the subrange `|min_halfword..max_halfword|' +can be packed into a halfword, everything should work satisfactorily. + +It is usually most efficient to have |min_quarterword=min_halfword=0|, +so one should try to achieve this unless it causes a severe problem. +The values defined here are recommended for most 32-bit computers. + +@d min_quarterword=0 {smallest allowable value in a |quarterword|} +@d max_quarterword=255 {largest allowable value in a |quarterword|} +@d min_halfword==0 {smallest allowable value in a |halfword|} +@d max_halfword==65535 {largest allowable value in a |halfword|} +@y +if the subrange is `|-128..127|'. + +For Berkeley {\mc UNIX} (SunOS) we need to do the |-128..127| kind of range. + +@d min_quarterword=-128 {smallest allowable value in a |quarterword|} +@d max_quarterword=127 {largest allowable value in a |quarterword|} +@d min_halfword==-32768 {smallest allowable value in a |halfword|} +@d max_halfword==32767 {largest allowable value in a |halfword|} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [11.165] fix the word "free" so that it doesn't conflict with a runtime proc +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +been included. (You may want to decrease the size of |mem| while you +@^debugging@> +are debugging.) +@y +been included. (You may want to decrease the size of |mem| while you +@^debugging@> +are debugging.) + +@d free==free_arr +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [12.186] glue_ratio fix +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +floating point underflow on the author's computer. +@^system dependencies@> +@^dirty \PASCAL@> + +@<Display the value of |glue_set(p)|@>= +g:=float(glue_set(p)); +if (g<>float_constant(0))and(glue_sign(p)<>normal) then + begin print(", glue set "); + if glue_sign(p)=shrinking then print("- "); + if abs(mem[p+glue_offset].int)<@'4000000 then print("?.?") + else if abs(g)>float_constant(20000) then + begin if g>float_constant(0) then print_char(">") + else print("< -"); + print_glue(20000*unity,glue_order(p),0); + end + else print_glue(round(unity*g),glue_order(p),0); +@^real multiplication@> + end +@y +floating point underflow on the author's computer. +For the {\mc VAX}, the only possible random value that could hurt is +a reserved value with 1 in the sign bit and 0 for the (excess) exponent. +Because the sign-plus-exponent is in the middle of the word, the chances +of this happening are miniscule, and ignored here. +@^system dependencies@> +@^dirty \PASCAL@> + +@<Display the value of |glue_set(p)|@>= +g:=float(glue_set(p)); +if (g<>float_constant(0))and(glue_sign(p)<>normal) then + begin print(", glue set "); + if glue_sign(p)=shrinking then print("- "); + if abs(float(glue_set(p)))>20000.0 then + begin if float(glue_set(p))>0 then print_char(">") + else print("< -"); + print_glue(20000*unity,glue_order(p),0); + end + else print_glue(round(float(glue_set(p))*unity),glue_order(p),0); +@^real multiplication@> + end +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [17.241] fix_date_and_time +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The following procedure, which is called just before \TeX\ initializes its +input and output, establishes the initial values of the date and time. +@^system dependencies@> +Since standard \PASCAL\ cannot provide such information, something special +is needed. The program here simply specifies July 4, 1776, at noon; but +users probably want a better approximation to the truth. + +@p procedure fix_date_and_time; +begin time:=12*60; {minutes since midnight} +day:=4; {fourth day of the month} +month:=7; {seventh month of the year} +year:=1776; {Anno Domini} +end; +@y +@ The following procedure, which is called just before \TeX\ initializes its +input and output, establishes the initial values of the date and time. +It is calls an externally defined |date_and_time|, even though it could +be done from Pascal. +The external procedure also sets up interrupt catching. +@^system dependencies@> + +@p procedure fix_date_and_time; +begin + date_and_time(time,day,month,year); +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [29.513] area and extension rules +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The file names we shall deal with for illustrative purposes have the +following structure: If the name contains `\.>' or `\.:', the file area +consists of all characters up to and including the final such character; +otherwise the file area is null. If the remaining file name contains +`\..', the file extension consists of all such characters from the first +remaining `\..' to the end, otherwise the file extension is null. +@^system dependencies@> + +We can scan such file names easily by using two global variables that keep track +of the occurrences of area and extension delimiters: + +@<Glob...@>= +@!area_delimiter:pool_pointer; {the most recent `\.>' or `\.:', if any} +@!ext_delimiter:pool_pointer; {the relevant `\..', if any} +@y +@ The file names we shall deal with for SunOS have the +following structure: If the name contains `\./', the file area +consists of all characters up to and including the final such character; +otherwise the file area is null. If the remaining file name contains +`\..', the file extension consists of all such characters from the first +remaining `\..' to the end, otherwise the file extension is null. +@^system dependencies@> + +We can scan such file names easily by using two global variables that keep +track of the occurrences of area and extension delimiters: + +@<Glob...@>= +@!area_delimiter:pool_pointer; {the most recent `\./', if any} +@!ext_delimiter:pool_pointer; {the most recent `\..', if any} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [29.514] TeX area directories +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d TEX_area=="TeXinputs:" +@.TeXinputs@> +@d TEX_font_area=="TeXfonts:" +@.TeXfonts@> +@y +Under Berkeley {\mc UNIX}, the default paths are specified in a separate +file, `\.{texpaths.h}'. The file opening procedures do path searching +based either on those default paths, or on paths given by the user +in ``environment'' variables. +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [29.516] more_name +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x + if (c=">")or(c=":") then +@y + if c="/" then +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [29.520] default format +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d format_default_length=20 {length of the |TEX_format_default| string} +@d format_area_length=11 {length of its area part} +@d format_ext_length=4 {length of its `\.{.fmt}' part} +@y +Under Berkeley {\mc UNIX} we don't give the area part, instead depending +on the path searching that will happen during file opening. + +@d format_default_length=9 {length of the |TEX_format_default| string} +@d format_area_length=0 {length of its area part} +@d format_ext_length=4 {length of its `\.{.fmt}' part} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [29.521] plain format location +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +TEX_format_default:='TeXformats:plain.fmt'; +@y +TEX_format_default:='plain.fmt'; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [29.524] format file opening: only try once, with path search +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x + pack_buffered_name(0,loc,j-1); {try first without the system file area} + if w_open_in(fmt_file) then goto found; + pack_buffered_name(format_area_length,loc,j-1); + {now try the system format file area} + if w_open_in(fmt_file) then goto found; +@y + pack_buffered_name(0,loc,j-1); + if w_open_in(fmt_file) then goto found; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [29.525] make_name_string +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +which simply makes a \TeX\ string from the value of |name_of_file|, should +ideally be changed to deduce the full name of file~|f|, which is the file +most recently opened, if it is possible to do this in a \PASCAL\ program. +@^system dependencies@> + +This routine might be called after string memory has overflowed, hence +we dare not use `|str_room|'. + +@p function make_name_string:str_number; +var k:1..file_name_size; {index into |name_of_file|} +begin if (pool_ptr+name_length>pool_size)or(str_ptr=max_strings)or + (cur_length>0) then + make_name_string:="?" +else begin for k:=1 to name_length do append_char(xord[name_of_file[k]]); + make_name_string:=make_string; + end; +end; +@y +which simply makes a \TeX\ string from the value of |name_of_file|, should +ideally be changed to deduce the full name of file~|f|, which is the file +most recently opened, if it is possible to do this in a \PASCAL\ program. +With the Berkeley {\mc UNIX} version, we know that |real_name_of_file| +contains |name_of_file| prepended with the directory name that was found +by path searching. +If |real_name_of_file| starts with |'./'|, we don't use that part of the +name, since {\mc UNIX} users understand that. +@^system dependencies@> + +This routine might be called after string memory has overflowed, hence +we dare not use `|str_room|'. + +@p function make_name_string:str_number; +var k,@!kstart:1..file_name_size; {index into |name_of_file|} +begin +k:=1; +while (k<file_name_size) and (xord[real_name_of_file[k]]<>" ") do + incr(k); +name_length:=k-1; {the real |name_length|} +if (pool_ptr+name_length>pool_size)or(str_ptr=max_strings)or + (cur_length>0) then + make_name_string:="?" +else begin + if (xord[real_name_of_file[1]]=".") and (xord[real_name_of_file[2]]="/") then + kstart:=3 + else + kstart:=1; + for k:=kstart to name_length do append_char(xord[real_name_of_file[k]]); + make_name_string:=make_string; + end +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [29.537] a_open_in of \input file needs path selector +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x + if a_open_in(cur_file) then goto done; + if cur_area="" then + begin pack_file_name(cur_name,TEX_area,cur_ext); + if a_open_in(cur_file) then goto done; + end; +@y + if a_open_in(cur_file,input_file_path) then goto done; + if cur_ext=".tex" then + begin pack_file_name(cur_name,cur_area,""); + if a_open_in(cur_file,input_file_path) then goto done; + end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [29.537] get rid of return of name to string pool +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +if name=str_ptr-1 then {we can conserve string pool space now} + begin flush_string; name:=cur_name; + end; +@y +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [30.557] optimize kern_base_offset +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d kern_base_offset==256*(128+min_quarterword) +@y +@d kern_base_offset==0 {our |kern_flag| is zero} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [30.563] opening tfm file: now path searching is done +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Set temp_int to value of first byte +@x +@ @<Open |tfm_file| for input@>= +file_opened:=false; +if aire="" then pack_file_name(nom,TEX_font_area,".tfm") +else pack_file_name(nom,aire,".tfm"); +if not b_open_in(tfm_file) then abort; +file_opened:=true +@y +@ Here we have to ``prime the pump'' for the |temp_int| trick explained below. + + @<Open |tfm_file| for input@>= +file_opened:=false; +pack_file_name(nom,aire,".tfm"); +if not b_open_in(tfm_file) then abort; +begin temp_int:=tfm_file^; + if temp_int<0 then temp_int:=temp_int+256; +end; +file_opened:=true +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [30.564] reading the tfm file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d fget==get(tfm_file) +@d fbyte==tfm_file^ +@y +For Berkeley {\mc UNIX} we had to make the |byte_file| type have data in the +range |-128..127|. +If the file byte contains |@'377|, we want to regard this as 255 in decimal. +However if we do |i:=tfm_file^| on that byte, where i is a signed integer, +then the result is |i=-1|. +File bytes with values |<@'200| are read properly. +The solution is to do the assignment as shown, and then add 256 to values +less than 0. +We could also assign to |eight_bits| values, but this causes an error if +runtime checking is turned on. +The integer |temp_int| will be added to global variables at the end, +where it won't disturb module numbering. + +@d fget==begin get(tfm_file); + temp_int:=tfm_file^; + if temp_int<0 then temp_int:=temp_int+256; + end +@d fbyte==temp_int +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [32.597] write_dvi +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p procedure write_dvi(@!a,@!b:dvi_index); +var k:dvi_index; +begin for k:=a to b do write(dvi_file,dvi_buf[k]); +end; +@y +For Berkeley {\mc UNIX}, this is going to be handled by an external procedure, +|writedvi|, which will do the output using |fwrite|. +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [49.1275] a_open_in of \read file needs path specifier +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x + if a_open_in(read_file[n]) then read_open[n]:=just_open; +@y + if a_open_in(read_file[n],read_file_path) then read_open[n]:=just_open; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [51.1332] Delete ready_already; also add call to set_paths; +% also add call to exit() depending upon value of `history' +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ Now this is really it: \TeX\ starts and ends here. + +The initial test involving |ready_already| should be deleted if the +\PASCAL\ runtime system is smart enough to detect such a ``mistake.'' +@y +@ Now this is really it: \TeX\ starts and ends here. + +Instead of testing |ready_already|, we give up the idea of a preloaded +core image in favor of silently loading a format file based on the +name by which this program has been invoked. For example, if the +program is being called \.{tex}, we will load \.{plain} format; +if \.{latex}, we will load \.{latex} format. On my machine the +loading of a format isn't too slow. (I use the new string capabilities +of Sun Pascal here; |my_name| will be declared {\bf varying} [100] +{\bf of\/} |char|.) + +At the end of the job, we look at |history| to decide the correct +exit code. We use 1 if |history <= warning_issued| and 0 otherwise. + +@d UNIXexit==e@&x@&i@&t +@z + +@x +t_open_out; {open the terminal for output} +if ready_already=314159 then goto start_of_TEX; +@y +t_open_out; {open the terminal for output} +set_paths; +@z + +@x +start_of_TEX: @<Initialize the output routines@>; +@y +start_of_TEX: argv(0,my_name); +if (my_name<>'initex')and(my_name<>'triptex') then + begin if my_name = 'tex' then name_of_file:='plain.fmt' + else name_of_file:=my_name+'.fmt'; + if w_open_in(fmt_file) then + if not load_fmt_file then + begin w_close(fmt_file); goto final_end; + end + else w_close(fmt_file); + end; +@<Initialize the output routines@>; +@z + +@x +final_end: ready_already:=0; +@y +final_end: ready_already:=0; +if (history <= warning_issued) then + UNIXexit(0) +else + UNIXexit(1); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [51.1333] print new line before termination; switch to editor if nec. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x + slow_print(log_name); print_char("."); + end; + end; +@y + slow_print(log_name); print_char("."); + end; + end; +print_ln; +if (ed_name_start<>0) and (interaction>batch_mode) then + calledit(str_pool[ed_name_start],ed_name_length,edit_line); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [54.1376] add temp_int and editor-switch variables to globals +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@* \[54] System-dependent changes. +This section should be replaced, if necessary, by any special +modifications of the program +that are necessary to make \TeX\ work at a particular installation. +It is usually best to design your change file so that all changes to +previous sections preserve the section numbering; then everybody's version +will be consistent with the published program. More extensive changes, +which introduce new sections, can be inserted here; then only the index +itself will get a new section number. +@^system dependencies@> +@y +@* \[54] System-dependent changes. +Here is a temporary integer, used as a holder during reading and writing of +TFM files. +Also, the variable used omphaloskeptically. +Also, the variables that holds ``switch-to-editor'' information. +@^system dependencies@> + +@f varying == array + +@<Global...@>= +@!temp_int:integer; +@!my_name:varying [100] of char; +@!ed_name_start: pool_pointer; +@!ed_name_length,@!edit_line: integer; + +@ The |ed_name_start| will be set to point into |str_pool| somewhere after +its beginning if \TeX\ is supposed to switch to an editor on exit. + +@<Set init...@>= +ed_name_start:=0; + +@z diff --git a/systems/knuth/local/tex-sparc/plain.fmt b/systems/knuth/local/tex-sparc/plain.fmt Binary files differnew file mode 100644 index 0000000000..f9c7455f65 --- /dev/null +++ b/systems/knuth/local/tex-sparc/plain.fmt diff --git a/systems/knuth/local/tex-sparc/plain.log b/systems/knuth/local/tex-sparc/plain.log new file mode 100644 index 0000000000..6a7f9f18a3 --- /dev/null +++ b/systems/knuth/local/tex-sparc/plain.log @@ -0,0 +1,103 @@ +This is TeX, Version 3.14159 for SunOS (INITEX) 14 AUG 1998 08:06 +**plain \input local \dump +(/home/tex/dist/lib/plain.tex Preloading the plain format: codes, registers, +\maxdimen=\dimen10 +\hideskip=\skip10 +\centering=\skip11 +\p@=\dimen11 +\z@=\dimen12 +\z@skip=\skip12 +\voidb@x=\box10 + +parameters, +\smallskipamount=\skip13 +\medskipamount=\skip14 +\bigskipamount=\skip15 +\normalbaselineskip=\skip16 +\normallineskip=\skip17 +\normallineskiplimit=\dimen13 +\jot=\dimen14 +\interdisplaylinepenalty=\count23 +\interfootnotelinepenalty=\count24 + fonts, more fonts, +\itfam=\fam4 +\slfam=\fam5 +\bffam=\fam6 +\ttfam=\fam7 + macros, +\strutbox=\box11 +\mscount=\count25 +\tabs=\box12 +\tabsyet=\box13 +\tabsdone=\box14 + math definitions, +\rootbox=\box15 +\p@renwd=\dimen15 + output routines, +\headline=\toks10 +\footline=\toks11 +\footins=\insert254 +\topins=\insert253 + +hyphenation (/home/tex/dist/lib/hyphen.tex)) (/home/tex/local/lib/local.tex) +Beginning to dump on file plain.fmt + (preloaded format=plain 98.8.14) +1968 strings of total length 27846 +5013 memory locations dumped; current usage is 110&4900 +926 multiletter control sequences +\font\nullfont=nullfont +\font\tenrm=cmr10 +\font\preloaded=cmr9 +\font\preloaded=cmr8 +\font\sevenrm=cmr7 +\font\preloaded=cmr6 +\font\fiverm=cmr5 +\font\teni=cmmi10 +\font\preloaded=cmmi9 +\font\preloaded=cmmi8 +\font\seveni=cmmi7 +\font\preloaded=cmmi6 +\font\fivei=cmmi5 +\font\tensy=cmsy10 +\font\preloaded=cmsy9 +\font\preloaded=cmsy8 +\font\sevensy=cmsy7 +\font\preloaded=cmsy6 +\font\fivesy=cmsy5 +\font\tenex=cmex10 +\font\preloaded=cmss10 +\font\preloaded=cmssq8 +\font\preloaded=cmssi10 +\font\preloaded=cmssqi8 +\font\tenbf=cmbx10 +\font\preloaded=cmbx9 +\font\preloaded=cmbx8 +\font\sevenbf=cmbx7 +\font\preloaded=cmbx6 +\font\fivebf=cmbx5 +\font\tentt=cmtt10 +\font\preloaded=cmtt9 +\font\preloaded=cmtt8 +\font\preloaded=cmsltt10 +\font\tensl=cmsl10 +\font\preloaded=cmsl9 +\font\preloaded=cmsl8 +\font\tenit=cmti10 +\font\preloaded=cmti9 +\font\preloaded=cmti8 +\font\preloaded=cmti7 +\font\preloaded=cmu10 +\font\preloaded=cmmib10 +\font\preloaded=cmbsy10 +\font\preloaded=cmcsc10 +\font\preloaded=cmssbx10 +\font\preloaded=cmdunh10 +\font\preloaded=cmr7 at 14.51799pt +\font\preloaded=cmtt10 at 14.4pt +\font\preloaded=cmssbx10 at 14.4pt +\font\preloaded=manfnt +14787 words of font info for 50 preloaded fonts +14 hyphenation exceptions +Hyphenation trie of length 6075 has 181 ops out of 500 + 181 for language 0 +No pages of output. diff --git a/systems/knuth/local/tex-sparc/tex.pool b/systems/knuth/local/tex-sparc/tex.pool new file mode 100644 index 0000000000..c1358a0a41 --- /dev/null +++ b/systems/knuth/local/tex-sparc/tex.pool @@ -0,0 +1,1040 @@ +11buffer size +09pool size +17number of strings +03??? +13m2d5c2l5x2v5i +28End of file on the terminal! +02! +42(That makes 100 errors; please try again.) +02? +60Type <return> to proceed, S to scroll future error messages, +44R to run without stopping, Q to run quietly, +23I to insert something, +20E to edit your file, +561 or ... or 9 to ignore the next 1 to 9 tokens of input, +22H for help, X to quit. +13OK, entering +09batchmode +11nonstopmode +10scrollmode +03... +07insert> +44I have just deleted some text, as you asked. +48You can now delete more, or insert, or whatever. +50Sorry, I don't know how to help in this situation. +36Maybe you should try asking a human? +42Sorry, I already gave what help I could... +59An error might have occurred before I noticed any problems. +45``If all else fails, read the instructions.'' +02 ( +14Emergency stop +30TeX capacity exceeded, sorry [ +44If you really absolutely need more capacity, +35you can ask a wizard to enlarge me. +19This can't happen ( +59I'm broken. Please show this to someone who can fix can fix +35I can't go on meeting you like this +55One of your faux pas seems to have wounded me deeply... +59in fact, I'm barely conscious. Please fix it and try again. +12Interruption +09You rang? +60Try to insert some instructions for me (e.g.,`I\showlists'), +43unless you just want to quit by typing `X'. +16main memory size +24AVAIL list clobbered at +31Double-AVAIL list clobbered at +24Doubly free location at +12Bad flag at +14New busy locs: +05LINK( +05INFO( +02[] +10CLOBBERED. +04foul +03fil +06 plus +07 minus +03 [] +26Bad link, display aborted. +04etc. +18Unknown node type! +05unset +04box( +02)x +10, shifted +09 columns) +10, stretch +09, shrink +11, glue set +02- +03< - +05rule( +06insert +15, natural size +08; split( +14); float cost +04glue +09nonscript +05mskip +02mu +00 +08leaders +04kern +13 (for accent) +05mkern +04math +02on +03off +13, surrounded +11 (ligature +08penalty +13discretionary +11 replacing +04mark +07vadjust +08flushing +07copying +08vertical +10horizontal +12display math +02no +17internal vertical +21restricted horizontal +05 mode +18semantic nest size +04### +17 entered at line +10 (language +10:hyphenmin +18 (\output routine) +25### recent contributions: +10prevdepth +07ignored +11, prevgraf +05 line +12spacefactor +19, current language +28this will be denominator of: +08lineskip +12baselineskip +07parskip +16abovedisplayskip +16belowdisplayskip +21abovedisplayshortskip +21belowdisplayshortskip +08leftskip +09rightskip +07topskip +12splittopskip +07tabskip +09spaceskip +10xspaceskip +11parfillskip +10thinmuskip +09medmuskip +11thickmuskip +25[unknown glue parameter!] +04skip +06muskip +02pt +06output +08everypar +09everymath +12everydisplay +09everyhbox +09everyvbox +08everyjob +07everycr +07errhelp +04toks +08parshape +03box +04void +12current font +08textfont +10scriptfont +16scriptscriptfont +07catcode +06lccode +06uccode +06sfcode +08mathcode +12pretolerance +09tolerance +11linepenalty +13hyphenpenalty +15exhyphenpenalty +11clubpenalty +12widowpenalty +19displaywidowpenalty +13brokenpenalty +12binoppenalty +10relpenalty +17predisplaypenalty +18postdisplaypenalty +16interlinepenalty +20doublehyphendemerits +19finalhyphendemerits +11adjdemerits +03mag +15delimiterfactor +09looseness +04time +03day +05month +04year +14showboxbreadth +12showboxdepth +08hbadness +08vbadness +07pausing +13tracingonline +13tracingmacros +12tracingstats +17tracingparagraphs +12tracingpages +13tracingoutput +16tracinglostchars +15tracingcommands +15tracingrestores +06uchyph +13outputpenalty +13maxdeadcycles +09hangafter +15floatingpenalty +10globaldefs +03fam +10escapechar +17defaulthyphenchar +15defaultskewchar +11endlinechar +11newlinechar +08language +13lefthyphenmin +14righthyphenmin +14holdinginserts +17errorcontextlines +28[unknown integer parameter!] +05count +07delcode +09parindent +12mathsurround +13lineskiplimit +05hsize +05vsize +08maxdepth +13splitmaxdepth +11boxmaxdepth +05hfuzz +05vfuzz +18delimitershortfall +18nulldelimiterspace +11scriptspace +14predisplaysize +12displaywidth +13displayindent +12overfullrule +10hangindent +07hoffset +07voffset +16emergencystretch +26[unknown dimen parameter!] +05dimen +06EQUIV( +12notexpanded: +09hash size +06csname +09endcsname +11IMPOSSIBLE. +12NONEXISTENT. +06accent +07advance +15afterassignment +10aftergroup +10begingroup +04char +09delimiter +06divide +08endgroup +11expandafter +04font +09fontdimen +06halign +05hrule +12ignorespaces +10mathaccent +08mathchar +10mathchoice +08multiply +07noalign +10noboundary +08noexpand +04omit +07penalty +08prevgraf +07radical +04read +05relax +06setbox +03the +06valign +07vcenter +05vrule +09save size +15grouping levels +08curlevel +09retaining +09restoring +05SAVE( +28Incompatible magnification ( +02); +36 the previous value will be retained +58I can handle only one magnification ratio per job. So I've +59reverted to the magnification you used earlier on this run. +46Illegal magnification has been changed to 1000 +52The magnification ratio must be between 1 and 32768. +04ETC. +04BAD. +02-> +22begin-group character +20end-group character +21math shift character +26macro parameter character +22superscript character +20subscript character +25end of alignment template +12blank space +11the letter +14the character +23[unknown command code!] +02: +08Runaway +10definition +08argument +08preamble +04text +03<*> +09<insert> +06<read +02l. +11<argument> +11<template> +16<recently read> +19<to be read again> +16<inserted text> +09<output> +11<everypar> +12<everymath> +15<everydisplay> +12<everyhbox> +12<everyvbox> +11<everyjob> +10<everycr> +07<mark> +08<write> +16input stack size +05write +48(interwoven alignment preambles are not allowed) +17text input levels +03par +11Incomplete +34; all text was ignored after line +54A forbidden control sequence occurred in skipped text. +59This kind of error happens when you say `\if...' and forget +59the matching `\fi'. I've inserted a `\fi'; this might work. +53The file ended while I was skipping conditional text. +10File ended +32Forbidden control sequence found +16 while scanning +04 of +46I suspect you have forgotten a `}', causing me +41to read past where you wanted me to stop. +49I'll try to recover; but if the error is serious, +51you'd better type `E' or `X' now and fix your file. +03use +39Text line contains an invalid character +53A funny symbol that I can't read has just been input. +48Continue, and I'll forget that it ever happened. +37(Please type a command or say `\end') +38*** (job aborted, no legal \end found) +02=> +26Undefined control sequence +47The control sequence at the end of the top line +52of your error message was never \def'ed. If you have +55misspelled it (e.g., `\hobx'), type `I' and the correct +51spelling (e.g., `I\hbox'). Otherwise just continue, +45and I'll forget about whatever was undefined. +08Missing +09 inserted +53The control sequence marked <to be read again> should +42not appear between \csname and \endcsname. +05input +08endinput +07topmark +09firstmark +07botmark +14splitfirstmark +12splitbotmark +20parameter stack size +12Argument of +15 has an extra } +58I've run across a `}' that doesn't seem to match anything. +52For example, `\def\a#1{...}' and `\a}' would produce +54this error. If you simply proceed now, the `\par' that +52I've just inserted will cause me to report a runaway +54argument that might be the root of the problem. But if +57your `}' was spurious, just type `2' and it will go away. +23Paragraph ended before +13 was complete +58I suspect you've forgotten a `}', causing me to apply this +54control sequence to too much text. How can we recover? +59My plan is to forget the whole thing and hope for the best. +07Use of +29 doesn't match its definition +54If you say, e.g., `\def\a1{...}', then you must always +52put `1' after `\a', since control sequence names are +52made up of letters only. The macro here has not been +51followed by the required stuff, so I'm ignoring it. +02<- +18Missing { inserted +52A left brace was mandatory here, so I've put one in. +55You might want to delete and/or insert some corrections +48so that I will find a matching right brace soon. +54(If you're confused by all this, try typing `I}' now.) +23Incompatible glue units +52I'm going to assume that 1mu=1pt when they're mixed. +31Missing number, treated as zero +47A number should have been here; I inserted `0'. +54(If you can't figure out why I needed to see a number, +51look up `weird error' in the index to The TeXbook.) +11spacefactor +09prevdepth +10deadcycles +15insertpenalties +02wd +02ht +02dp +11lastpenalty +08lastkern +08lastskip +11inputlineno +07badness +09Improper +54You can refer to \spacefactor only in horizontal mode; +54you can refer to \prevdepth only in vertical mode; and +48neither of these is meaningful inside \write. So +52I'm forgetting what you said and using zero instead. +15You can't use ` +08' after +17Bad register code +44A register number must be between 0 and 255. +27I changed this one to zero. +18Bad character code +45A character number must be between 0 and 255. +10Bad number +51Since I expected to read a number between 0 and 15, +12Bad mathchar +46A mathchar number must be between 0 and 32767. +18Bad delimiter code +56A numeric delimiter code must be between 0 and 2^{27}-1. +28Improper alphabetic constant +56A one-character control sequence belongs after a ` mark. +37So I'm essentially inserting \0 here. +14Number too big +54I can only go up to 2147483647='17777777777="7FFFFFFF, +42so I'm using that number instead of yours. +04true +25Illegal unit of measure ( +18replaced by filll) +35I dddon't go any higher than filll. +02em +02ex +12mu inserted) +48The unit of measurement in math glue must be mu. +51To recover gracefully from this error, it's best to +52delete the erroneous units; e.g., type `2' to delete +45two letters. (See Chapter 27 of The TeXbook.) +02in +02pc +02cm +02mm +02bp +02dd +02cc +02sp +12pt inserted) +49Dimensions can be in units of em, ex, in, pt, pc, +50cm, mm, dd, cc, bp, or sp; but yours is a new one! +59I'll assume that you meant to say pt, for printer's points. +19Dimension too large +50I can't work with sizes bigger than about 19 feet. +46Continue and I'll use the largest value I can. +04plus +05minus +05width +06height +05depth +06number +12romannumeral +06string +07meaning +08fontname +07jobname +04 at +60Where was the left brace? You said something like `\def\a}', +43which I'm going to interpret as `\def\a{}'. +32You already have nine parameters +45I'm going to ignore the # sign you just used. +41Parameters must be numbered consecutively +57I've inserted the digit you should have used after the #. +36Type `1' to delete what you did use. +42Illegal parameter number in definition of +41You meant to type ## instead of #, right? +56Or maybe a } was forgotten somewhere earlier, and things +58are all screwed up? I'm going to assume that you meant ##. +49*** (cannot \read from terminal in nonstop modes) +18File ended within +33This \read has unbalanced braces. +02if +05ifcat +05ifnum +05ifdim +05ifodd +07ifvmode +07ifhmode +07ifmmode +07ifinner +06ifvoid +06ifhbox +06ifvbox +03ifx +05ifeof +06iftrue +07iffalse +06ifcase +02fi +02or +04else +06Extra +44I'm ignoring this; it doesn't match any \if. +06{true} +07{false} +23Missing = inserted for +48I was expecting to see `<', `=', or `>'. Didn't. +06{case +04.fmt +15input file name +19I can't find file ` +23I can't write on file ` +02'. +04.tex +20Please type another +45*** (job aborted, file error in nonstop mode) +04.dvi +20file name for output +06texput +04.log +02** +20transcript file name +02 +08nullfont +05Font +08 scaled +36 not loadable: Bad metric (TFM) file +42 not loadable: Metric (TFM) file not found +50I wasn't able to read the size data for this font, +40so I will ignore the font specification. +48[Wizards can fix TFM files using TFtoPL/PLtoTF.] +46You might try inserting a different font spec; +57e.g., type `I\font<same font id>=<substitute font name>'. +04.tfm +33 not loaded: Not enough room left +52I'm afraid I won't be able to make use of this font, +55because my memory for character-size data is too small. +51If you're really stuck, ask a wizard to enlarge me. +58Or maybe try `I\font<same font id>=<name of loaded font>'. +23Missing font identifier +42I was looking for a control sequence whose +42current meaning has been defined by \font. +10 has only +21 fontdimen parameters +51To increase the number of font parameters, you must +53use \fontdimen immediately after the \font is loaded. +11font memory +31Missing character: There is no +09 in font +12 TeX output +08vlistout +31Completed box being shipped out +21Memory usage before: +08 after: +19; still untouched: +31Huge page cannot be shipped out +50The page just created is more than 18 feet tall or +58more than 18 feet wide, so I suspect something went wrong. +35The following box has been deleted: +19No pages of output. +18Output written on +05 page +02, +08 bytes). +02to +06spread +09Underfull +05Loose +16 \hbox (badness +38) has occurred while \output is active +24) in paragraph at lines +24) in alignment at lines +02-- +19) detected at line +16Overfull \hbox ( +11pt too wide +21Tight \hbox (badness +05vpack +16 \vbox (badness +16Overfull \vbox ( +11pt too high +21Tight \vbox (badness +02{} +12displaystyle +09textstyle +11scriptstyle +17scriptscriptstyle +14Unknown style! +07mathord +06mathop +07mathbin +07mathrel +08mathopen +09mathclose +09mathpunct +09mathinner +08overline +09underline +04left +05right +06limits +08nolimits +20fraction, thickness +09= default +17, left-delimiter +18, right-delimiter +25 is undefined (character +54Somewhere in the math formula just ended, you used the +60stated character from an undefined font family. For example, +58plain TeX doesn't allow \it or \sl in subscripts. Proceed, +52and I'll try to forget that I needed that character. +06mlist1 +06mlist2 +06mlist3 +640234000122*4000133**3**344*0400400*000000234000111*1111112341011 +06mlist4 +12 inside $$'s +53Displays can use special alignments (like \eqalignno) +57only if nothing but the alignment itself is between $$'s. +58So I've deleted the formulas that preceded this alignment. +04span +02cr +04crcr +11endtemplate +24alignment tab character +40Missing # inserted in alignment preamble +50There should be exactly one # between &'s, when an +56\halign or \valign is being set up. In this case you had +47none, so I've put one in; maybe that will work. +29Only one # is allowed per tab +49more than one, so I'm ignoring all but the first. +04endv +40Extra alignment tab has been changed to +52You have given more \span or & marks than there were +58in the preamble to the \halign or \valign now in progress. +50So I'll assume that you meant to type \cr instead. +09256 spans +06align1 +06align0 +44Infinite glue shrinkage found in a paragraph +52The paragraph just ended includes some glue that has +54infinite shrinkability, e.g., `\hskip 0pt minus 1fil'. +54Such glue doesn't belong there---it allows a paragraph +59of any length to fit on one line. But it's safe to proceed, +55since the offensive shrinkability has been made finite. +05disc1 +05disc2 +02@@ +07: line +03 t= +06 -> @@ +07 via @@ +03 b= +03 p= +03 d= +10@firstpass +11@secondpass +14@emergencypass +09paragraph +05disc3 +05disc4 +13line breaking +05HYPH( +11hyphenation +16 will be flushed +48Hyphenation exceptions must contain only letters +51and hyphens. But continue; I'll forgive and forget. +12Not a letter +50Letters in \hyphenation words must have \lccode>0. +47Proceed; I'll ignore the character I just read. +20exception dictionary +18pattern memory ops +31pattern memory ops per language +14pattern memory +13Too late for +08patterns +53All patterns must be given before typesetting begins. +04Bad +17(See Appendix H.) +09Nonletter +17Duplicate pattern +07pruning +09vertbreak +48Infinite glue shrinkage found in box being split +52The box you are \vsplitting contains some infinitely +57shrinkable glue, e.g., `\vss' or `\vskip 0pt minus 1fil'. +59Such glue doesn't belong there; but you can safely proceed, +06vsplit +09 needs a +04vbox +44The box you are trying to split is an \hbox. +49I can't split such a box, so I'll leave it alone. +08pagegoal +09pagetotal +11pagestretch +14pagefilstretch +15pagefillstretch +16pagefilllstretch +10pageshrink +09pagedepth +04fill +05filll +17### current page: +28 (held over for next output) +13total height +13 goal height +06 adds +03, # +12 might split +15%% goal height= +12, max depth= +38Insertions can only be added to a vbox +40Tut tut: You're trying to \insert into a +41\box register that now contains an \hbox. +47Proceed, and I'll discard its present contents. +04page +45Infinite glue shrinkage found on current page +52The page about to be output contains some infinitely +03 g= +03 c= +38Infinite glue shrinkage inserted from +53The correction glue for page breaking with insertions +52must have finite shrinkability. But you may proceed, +07% split +04 to +15255 is not void +53You shouldn't use \box255 except in \output routines. +14Output loop--- +24 consecutive dead cycles +57I've concluded that your \output is awry; it never does a +55\shipout, so I'm shipping \box255 out myself. Next time +58increase \maxdeadcycles if you want me to be more patient! +25Unbalanced output routine +58Your sneaky output routine has problematic {'s and/or }'s. +41I can't handle that very well; good luck. +33Output routine didn't use all of +43Your \output commands should empty \box255, +34e.g., by saying `\shipout\box255'. +43Proceed; I'll discard its present contents. +18Missing $ inserted +56I've inserted a begin-math/end-math symbol since I think +48you left one out. Proceed, with fingers crossed. +05' in +50Sorry, but I'm not programmed to handle this case; +45I'll just pretend that you didn't ask for it. +49If you're in the wrong mode, you might be able to +58return to the right one by typing `I}' or `I$' or `I\par'. +03end +04dump +05hskip +04hfil +05hfill +03hss +07hfilneg +05vskip +04vfil +05vfill +03vss +07vfilneg +52I've inserted something that you may have forgotten. +32(See the <inserted text> above.) +48With luck, this will get me unwedged. But if you +55really didn't forget anything, try typing `2' now; then +56my insertion and my current dilemma will both disappear. +06right. +58Things are pretty mixed up, but I think the worst is over. +12Too many }'s +42You've closed more groups than you opened. +51Such booboos are generally harmless, so keep going. +10rightbrace +22Extra }, or forgotten +58I've deleted a group-closing symbol because it seems to be +59spurious, as in `$x}$'. But perhaps the } is legitimate and +59you forgot something else, as in `\hbox{$x}'. In such cases +58the way to recover is to insert both the forgotten and the +40deleted material, e.g., by typing `I$}'. +08moveleft +09moveright +05raise +05lower +04copy +07lastbox +04vtop +04hbox +07shipout +07leaders +08cleaders +08xleaders +35Leaders not followed by proper glue +56You should say `\leaders <box or rule><hskip or vskip>'. +50I found the <box or rule>, but there's no suitable +48<hskip or vskip>, so I'm ignoring these leaders. +34Sorry; this \lastbox will be void. +58Sorry...I usually can't take things from the current page. +37This \lastbox will therefore be void. +21Missing `to' inserted +48I'm working on `\vsplit<box number> to <dimen>'; +31will look for the <dimen> next. +31A <box> was supposed to be here +57I was expecting to see \hbox or \vbox or \copy or \box or +59something like that. So you might find something missing in +53your output. But keep trying; you can fix this later. +06indent +08noindent +26' here except with leaders +52To put a horizontal rule in an hbox or an alignment, +56you should use \leaders or \hrulefill (see The TeXbook). +10You can't +45I'm changing to \insert0; box 255 is special. +32Try `I\vskip-\lastskip' instead. +31Try `I\kern-\lastkern' instead. +46Perhaps you can make the output routine do it. +09unpenalty +06unkern +06unskip +06unhbox +07unhcopy +06unvbox +07unvcopy +34Incompatible list can't be unboxed +35Sorry, Pandora. (You sneaky devil.) +58I refuse to unbox an \hbox in vertical mode or vice versa. +40And I can't open any boxes in math mode. +13Illegal math +54Sorry: The third part of a discretionary break must be +57empty, in math formulas. I had to delete your third part. +30Discretionary list is too long +50Wow---I never thought anybody would tweak me here. +56You can't seriously need such a huge discretionary list? +27Improper discretionary list +54Discretionary lists must contain only boxes and kerns. +53The following discretionary sublist has been deleted: +18Missing } inserted +45I've put in what seems to be necessary to fix +44the current column of the current alignment. +43Try to go on, since this might almost work. +10Misplaced +55I can't figure out why you would want to use a tab mark +50here. If you just want an ampersand, the remedy is +52simple: Just type `I\&' now. But if some right brace +52up above has ended a previous alignment prematurely, +52you're probably due for more error messages, and you +57might try typing `S' now just to see what is salvageable. +57or \cr or \span just now. If something like a right brace +46I expect to see \noalign only after the \cr of +49an alignment. Proceed, and I'll ignore this case. +56I expect to see \omit only after tab marks or the \cr of +53I'm guessing that you meant to end an alignment here. +50I'm ignoring this, since I wasn't doing a \csname. +04eqno +05leqno +13displaylimits +42Limit controls must follow a math operator +57I'm ignoring this misplaced \limits or \nolimits command. +30Missing delimiter (. inserted) +52I was expecting to see something like `(' or `\{' or +55`\}' here. If you typed, e.g., `{' instead of `\{', you +57should probably delete the `{' by typing `1' now, so that +52braces don't get unbalanced. Otherwise just proceed. +54Acceptable delimiters are characters whose \delcode is +58nonnegative, or you can use `\delimiter <delimiter code>'. +11Please use +25 for accents in math mode +55I'm changing \accent to \mathaccent here; wish me luck. +59(Accents are not the same in formulas as they are in text.) +18Double superscript +43I treat `x^1^2' essentially like `x^1{}^2'. +16Double subscript +43I treat `x_1_2' essentially like `x_1{}_2'. +05above +04over +04atop +15abovewithdelims +14overwithdelims +14atopwithdelims +35Ambiguous; you need another { and } +55I'm ignoring this fraction specification, since I don't +52know whether a construction like `x \over y \over z' +53means `{x \over y} \over z' or `x \over {y \over z}'. +49I'm ignoring a \right that had no matching \left. +47Math formula deleted: Insufficient symbol fonts +50Sorry, but I can't typeset math unless \textfont 2 +50and \scriptfont 2 and \scriptscriptfont 2 have all +50the \fontdimen values needed in math symbol fonts. +50Math formula deleted: Insufficient extension fonts +50Sorry, but I can't typeset math unless \textfont 3 +50and \scriptfont 3 and \scriptscriptfont 3 have all +53the \fontdimen values needed in math extension fonts. +31Display math should end with $$ +59The `$' that I just saw supposedly matches a previous `$$'. +49So I shall assume that you typed `$$' both times. +07display +19Missing $$ inserted +04long +05outer +06global +03def +04gdef +04edef +04xdef +06prefix +29You can't use a prefix with ` +55I'll pretend you didn't say \long or \outer or \global. +06' or ` +08' with ` +49I'll pretend you didn't say \long or \outer here. +33Missing control sequence inserted +52Please don't say `\def cs{...}', say `\def\cs{...}'. +59I've inserted an inaccessible control sequence so that your +60definition will be completed without mixing me up too badly. +53You can recover graciously from this error, if you're +42careful; see exercise 27.2 in The TeXbook. +12inaccessible +03let +09futurelet +07chardef +11mathchardef +08countdef +08dimendef +07skipdef +09muskipdef +07toksdef +44You should have said `\read<number> to \cs'. +34I'm going to look for the \cs now. +14Invalid code ( +29), should be in the range 0.. +21), should be at most +54I'm going to use 0 instead of that illegal code value. +02by +19Arithmetic overflow +50I can't carry out that multiplication or division, +33since the result is out of range. +55I'm forgetting what you said and not changing anything. +57Sorry, \setbox is not allowed after \halign in a display, +45or between \accent and an accented character. +16Bad space factor +47I allow only values in the range 1..32767 here. +37I allow only nonnegative values here. +37Patterns can be loaded only by INITEX +10hyphenchar +08skewchar +04FONT +02at +06scaled +20Improper `at' size ( +21pt), replaced by 10pt +50I can only handle fonts at positive sizes that are +56less than 2048pt, so I've changed what you said to 10pt. +12select font +13errorstopmode +06openin +07closein +07message +10errmessage +31(That was another \errmessage.) +50This error message was generated by an \errmessage +43command, so I can't give any explicit help. +54Pretend that you're Hercule Poirot: Examine all clues, +41and deduce the truth by order and method. +09lowercase +09uppercase +04show +07showbox +07showthe +09showlists +57This isn't an error message; I'm just \showing something. +46Type `I\show...' to show more (e.g., \show\cs, +43\showthe\count10, \showbox255, \showlists). +54And type `I\tracingonline=1\show...' to show boxes and +57lists on your terminal as well as in the transcript file. +02> +09undefined +05macro +10long macro +11outer macro +17outer endtemplate +06> \box +02OK +26 (see the transcript file) +09 (INITEX) +29You can't dump inside a group +24`{...\dump}' is a no-no. +25 strings of total length +43 memory locations dumped; current usage is +30 multiletter control sequences +24 words of font info for +15 preloaded font +05\font +22 hyphenation exception +27Hyphenation trie of length +05 has +03 op +08 out of +14 for language +19 (preloaded format= +16format file name +26Beginning to dump on file +22Transcript written on +02 ) +13end occurred +24inside a group at level +05when +09 on line +16 was incomplete) +52(see the transcript file for additional information) +35(\dump is performed only by INITEX) +21debug # (-1 to exit): +07openout +08closeout +07special +09immediate +11setlanguage +20[unknown extension!] +04ext1 +12 (hyphenmin +08whatsit? +04ext2 +04ext3 +08endwrite +24Unbalanced write command +59On this page there's a \write with fewer real {'s than }'s. +04ext4 +16output file name +*461251401 diff --git a/systems/knuth/local/tex-sparc/trip1.in b/systems/knuth/local/tex-sparc/trip1.in new file mode 100644 index 0000000000..a93fd916c0 --- /dev/null +++ b/systems/knuth/local/tex-sparc/trip1.in @@ -0,0 +1,2 @@ + +\input trip diff --git a/systems/knuth/local/tex-sparc/trip2.in b/systems/knuth/local/tex-sparc/trip2.in new file mode 100644 index 0000000000..205d5cd650 --- /dev/null +++ b/systems/knuth/local/tex-sparc/trip2.in @@ -0,0 +1 @@ + &trip trip diff --git a/systems/knuth/local/tex/Makefile b/systems/knuth/local/tex/Makefile new file mode 100644 index 0000000000..0890d2cc46 --- /dev/null +++ b/systems/knuth/local/tex/Makefile @@ -0,0 +1,75 @@ +# Make executable files for this workstation, using the master TeX sources + +#PFLAGS= -I.. -temp=. +PFLAGS= -I.. -g +#PFLAGS= -I.. +CFLAGS= -O -I.. +PC= time pc + +all: initex virtex + +triptest: triptex + -triptex < trip1.in + mv trip.log tripin.log + -triptex < trip2.in | tee trip.fot + dvitype trip.dvi < dvitype.in > /dev/null + mv dvitype.out trip.typ + rm -f *.dif + -diff tripin.log ../../dist/tex/tripin.log > tripin.log.dif + -diff trip.log ../../dist/tex/trip.log > trip.log.dif + -diff trip.fot ../../dist/tex/trip.fot > trip.fot.dif + -diff trip.typ ../../dist/tex/trip.typ > trip.typ.dif + more tripin.log.dif trip.log.dif trip.typ.dif trip.fot.dif + +%.p: %.ch + tangle ../../dist/tex/tex.web $*.ch + mv ../../dist/tex/tex.pool . + mv ../../dist/tex/tex.p $*.p + +initex.ch: ../../dist/tex/tex.web + +virtex.ch: initex.ch ini_to_vir + ini_to_vir initex.ch virtex.ch + +triptex.ch: initex.ch ini_to_trip + ini_to_trip initex.ch triptex.ch + +%.o: %.p + ${PC} ${PFLAGS} -c $*.p + +triptex.o: triptex.p + ${PC} -g ${PFLAGS} -c triptex.p + +initex: initex.o ext.o + pc ${PFLAGS} -o initex initex.o ext.o + +virtex: virtex.o ext.o + pc ${PFLAGS} -o virtex virtex.o ext.o + +triptex: triptex.o ext.o + pc -g ${PFLAGS} -o triptex triptex.o ext.o + cp ../../dist/tex/trip.tex . + +ext.o: ext.c ext.h ../h00vars.h ../texpaths.h + cc ${CFLAGS} -c ext.c + +plain.fmt: ../../dist/lib/plain.tex ../lib/local.tex + -initex plain \\input local \\dump + +install: # doit make install + mv initex virtex /usr/local/bin + rm /usr/local/bin/tex + ln /usr/local/bin/virtex /usr/local/bin/tex + make plain.fmt + +installtrip: # when the trip test is satisfactory + mv trip.tex tripin.log trip.log trip.fot trip.typ \ + trip.dvi trip.tfm ../../dist/tex + +clean: + rm -f *.p *.o *~ *.tex triptex* *.dif trip.* tripin.log virtex.ch + @echo "Remaining files should be:" + @echo "Makefile ext.h initex.ch tex.pool" + @echo "dvitype.in ini_to_trip* plain.fmt trip1.in" + @echo "ext.c ini_to_vir* plain.log trip2.in" + diff --git a/systems/knuth/local/tex/dvitype.in b/systems/knuth/local/tex/dvitype.in new file mode 100644 index 0000000000..9aae7baa4b --- /dev/null +++ b/systems/knuth/local/tex/dvitype.in @@ -0,0 +1,5 @@ +2 +*.*.*.*.*.*.*.*.*.* +1000000 +7227/100 +0 diff --git a/systems/knuth/local/tex/ext.c b/systems/knuth/local/tex/ext.c new file mode 100644 index 0000000000..c0238a9b86 --- /dev/null +++ b/systems/knuth/local/tex/ext.c @@ -0,0 +1,228 @@ +/* external procedures called by TeX */ +#include <sys/signal.h> +#include <sys/time.h> +#include "texpaths.h" /* defines MAXINPATHCHARS, defaultinputpath, etc. */ +#include "GPCtypes.h" +#include <string.h> + +#define max_file_name_length 1024 + +void Argv(int n, char* str) +{ + register char *s,*t; + if (n<0 || n>=_p_argc) return; + s=_p_argv[n]; + if (strlen(s) >= max_file_name_length-5) { + str[0]='\0'; return; /* TANGLE doesn't want it too long */ + } + for (t=str; *s; s++,t++) *t=*s; + *t='\0'; +} + +void Flushstdout() +{ + fflush(stdout); +} + +/* The following are for closing files */ + +extern _p_close(FDR f); /* in GPC rts/file.c */ + +Closea(FDR f) +{ + _p_close(f); +} + +Closeb(FDR f) +{ + _p_close(f); +} + +Closew(FDR f) +{ + _p_close(f); +} + +/* +** dateandtime(time, day, month, year) +** +** Stores minutes since midnight, current day, month and year into +** *time, *day, *month and *year, respectively. +** +** +*/ + +Dateandtime(minutes, day, month, year) +int *minutes, *day, *month, *year; +{ + long clock; + struct tm *tmptr, *localtime(); + + clock = time(0); + tmptr = localtime(&clock); + + *minutes = tmptr->tm_hour * 60 + tmptr->tm_min; + *day = tmptr->tm_mday; + *month = tmptr->tm_mon + 1; + *year = tmptr->tm_year + 1900; +} + + +/* fixed arrays are used to hold the paths, to avoid any possible problems + involving interaction of malloc and undump */ + +char inputpath[MAXINPATHCHARS] = defaultinputpath; +char fontpath[MAXOTHPATHCHARS] = defaultfontpath; +char formatpath[MAXOTHPATHCHARS] = defaultformatpath; +char poolpath[MAXOTHPATHCHARS] = defaultpoolpath; + +extern char *getenv(); + +/* + * setpaths is called to set up the arrays inputpath, fontpath, formatpath + * and poolpath as follows: if the user's environment has a value for the + * appropriate value, then use it; otherwise, leave the current value of + * the array (which may be the default path, or it may be the result of + * a call to setpaths on a previous run that was made the subject of + * an undump: this will give the maker of a preloaded TeX the option of + * providing a new set of "default" paths. + * + * Note that we have to copy the string from the environment area, since + * that will change on the next run (which matters if this is for a + * preloaded TeX). + */ +Setpaths() +{ + register char *envpath; + + if ((envpath = getenv("TEXINPUTS")) != NULL) + copypath(inputpath,envpath,MAXINPATHCHARS); + if ((envpath = getenv("TEXFONTS")) != NULL) + copypath(fontpath,envpath,MAXOTHPATHCHARS); + if ((envpath = getenv("TEXFORMATS")) != NULL) + copypath(formatpath,envpath,MAXOTHPATHCHARS); + if ((envpath = getenv("TEXPOOL")) != NULL) + copypath(poolpath,envpath,MAXOTHPATHCHARS); +} + +/* + * copypath(s1,s2,n) copies at most n characters (including the null) + * from string s2 to string s1, giving an error message for paths + * that are too long. + */ +copypath(s1,s2,n) + register char *s1,*s2; + register int n; +{ + while ((*s1++ = *s2++) != '\0') + if (--n == 0) { + fprintf(stderr, "! Environment search path is too big\n"); + *--s1 = '\0'; + return; /* let user continue with truncated path */ + } +} + +#define filenamesize 1024 /* should agree with initex.ch */ +#define nameoffile Nameoffile +#define realnameoffile Realnameoffile +char nameoffile[filenamesize],realnameoffile[filenamesize]; + +/* + * testaccess(amode,filepath) + * + * Test whether or not the file whose name is in the global nameoffile + * can be opened for reading (if mode=READACCESS) + * or writing (if mode=WRITEACCESS). + * + * The filepath argument is one of the ...FILEPATH constants defined below. + * If the filename given in nameoffile does not begin with '/', we try + * prepending all the ':'-separated areanames in the appropriate path to the + * filename until access can be made, if it ever can. + * + * The realnameoffile global array will contain the name that yielded an + * access success. + */ + +#define READACCESS 4 +#define WRITEACCESS 2 + +#define NOFILEPATH 0 +#define INPUTFILEPATH 1 +#define READFILEPATH 2 +#define FONTFILEPATH 3 +#define FORMATFILEPATH 4 +#define POOLFILEPATH 5 + +bool +Testaccess(amode,filepath) + int amode,filepath; +{ + register bool ok; + register char *p; + char *curpathplace; + int f; + + switch(filepath) { + case NOFILEPATH: curpathplace = NULL; break; + case INPUTFILEPATH: case READFILEPATH: + curpathplace = inputpath; break; + case FONTFILEPATH: curpathplace = fontpath; break; + case FORMATFILEPATH: curpathplace = formatpath; break; + case POOLFILEPATH: curpathplace = poolpath; break; + } + if (nameoffile[0]=='/') /* file name has absolute path */ + curpathplace = NULL; + do { + packrealnameoffile(&curpathplace); + if (amode==READACCESS) + /* use system call "access" to see if we could read it */ + if (access(realnameoffile,READACCESS)==0) ok = TRUE; + else ok = FALSE; + else { + /* WRITEACCESS: use creat to see if we could create it, but close + the file again if we're OK, to let pc open it for real */ + f = creat(realnameoffile,0666); + if (f>=0) ok = TRUE; + else ok = FALSE; + if (ok) + close(f); + } + } while (!ok && curpathplace != NULL); + return (ok); +} + +/* + * packrealnameoffile(cpp) makes realnameoffile contain the directory at *cpp, + * followed by '/', followed by the characters in nameoffile up until the + * first blank there, and finally a '\0'. The cpp pointer is left pointing + * at the next directory in the path. + * But: if *cpp == NULL, then we are supposed to use nameoffile as is. + */ +packrealnameoffile(cpp) + char **cpp; +{ + register char *p,*realname; + + realname = realnameoffile; + if ((p = *cpp)!=NULL) { + while ((*p != ':') && (*p != '\0')) { + *realname++ = *p++; + if (realname == &(realnameoffile[filenamesize-1])) + break; + } + if (*p == '\0') *cpp = NULL; /* at end of path now */ + else *cpp = p+1; /* else get past ':' */ + *realname++ = '/'; /* separate the area from the name to follow */ + } + /* now append nameoffile to realname... */ + p = nameoffile; + while (*p) { + if (realname >= &(realnameoffile[filenamesize-1])) { + fprintf(stderr,"! Full file name is too long\n"); + break; + } + *realname++ = *p++; + } + *realname = '\0'; +} + diff --git a/systems/knuth/local/tex/ext.h b/systems/knuth/local/tex/ext.h new file mode 100644 index 0000000000..d6914c4c67 --- /dev/null +++ b/systems/knuth/local/tex/ext.h @@ -0,0 +1,27 @@ +argc:asmname '_p_argc' Integer; + +procedure argv(no:Integer;var str:UNIXfilename); external; + +procedure flushstdout; external; + +procedure exit(x : integer); + external; + +procedure closea(var f:text); + external; + +procedure closeb(var f:bytefile); + external; + +procedure closew(var f:wordfile); + external; + +procedure dateandtime(var minutes, day, month, year : integer); + external; + +procedure setpaths; + external; + +function testaccess(accessmode:integer; filepath:integer): boolean; + external; + diff --git a/systems/knuth/local/tex/ini_to_trip b/systems/knuth/local/tex/ini_to_trip new file mode 100644 index 0000000000..89ccab0759 --- /dev/null +++ b/systems/knuth/local/tex/ini_to_trip @@ -0,0 +1,41 @@ +#! /bin/csh +# A shell script to perform modifications on the changefile for initex +# to make a changefile for triptex (used to test tex). +# +# To use it, say +# ini_to_trip initex.ch triptex.ch +# +ed - $1 <<edscriptend +/debug=/ +// +s/@{//p +/gubed=/ +s/@t@>@}//p +/@!mem_max=/ +// +s/[0-9][0-9]*/3000/p +/@!mem_min=/ +s/-[0-9]*/1/p +/@!error_line=/ +s/[0-9][0-9]*/64/p +/@!half_error_line=/ +s/[0-9][0-9]*/32/p +/@!max_print_line=/ +s/[0-9][0-9]*/72/p +/@!font_max=/ +s/[0-9][0-9]*/75/p +/@!font_mem_size=/ +s/[0-9][0-9]*/20000/p +/@!pool_size=/ +s/[0-9][0-9]*/32000/p +/@d mem_bot=/ +// +s/-[0-9]*/1/p +/@d mem_top==/ +s/[0-9][0-9]*/3000/p +/@d hash_size=/ +s/[0-9][0-9]*/2100/p +/@d hash_prime=/ +s/[0-9][0-9]*/1777/p +w $2 +edscriptend diff --git a/systems/knuth/local/tex/ini_to_vir b/systems/knuth/local/tex/ini_to_vir new file mode 100644 index 0000000000..2120a4beea --- /dev/null +++ b/systems/knuth/local/tex/ini_to_vir @@ -0,0 +1,23 @@ +#! /bin/csh +# A shell script to perform modifications on the changefile for initex +# to make a changefile for virtex. This means changing constants and +# debug..gubed, init..tini, stat..tats. +# +# To use it, say +# ini_to_vir initex.ch virtex.ch +# +ed - $1 <<edscriptend +/@d init==/ +// +s//&@{/p +/@d tini==/ +s//&@t@>@}/p +/@!mem_max=/ +// +s/[0-9][0-9]*/32766/p +/@!max_strings=/ +s/[0-9][0-9]*/6000/p +/@!trie_size=/ +s/[0-9][0-9]*/6500/p +w $2 +edscriptend diff --git a/systems/knuth/local/tex/initex.ch b/systems/knuth/local/tex/initex.ch new file mode 100644 index 0000000000..b4024f6f2f --- /dev/null +++ b/systems/knuth/local/tex/initex.ch @@ -0,0 +1,982 @@ +% Change file for GNU Pascal and Linux +% (by Don Knuth, 2000; see ../tex-sparc for the prehistory) +% (I'm no longer keeping the "efficiency" changes; just enuf for TRIP test) +% +% Use this file as is to make an INITEX. To get triptex, use the +% shell script ``ini_to_trip'' and re-TANGLE. + +% History: +% 2000.04.30 first sketch --- untested --- see FIXTHIS for parts not done yet + +% NOTE: the module numbers in this change file refer to Volume B. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [0] WEAVE: only print changes +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +\def\botofcontents{\vskip 0pt plus 1fil minus 1.5in} +@y +\def\botofcontents{\vskip 0pt plus 1fil minus 1.5in} +\let\maybe=\iffalse +\def\title{\TeX82 changes for GNU Pascal} +\def\glob{13}\def\gglob{20, 26} % these are defined in module 1 +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.2] banner line +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d banner=='This is TeX, Version 3.14159' {printed when \TeX\ starts} +@y +@d banner=='This is TeX, Version 3.14159 for Linux' {printed when \TeX\ starts} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.4] program header +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +Actually the heading shown here is not quite normal: The |program| line +does not mention any |output| file, because \ph\ would ask the \TeX\ user +to specify a file name if |output| were specified here. +@^system dependencies@> + +@d mtype==t@&y@&p@&e {this is a \.{WEB} coding trick:} +@y +@d mtype==t@&y@&p@&e {this is a \.{WEB} coding trick:} +@d standard_input==i@&n@&p@&u@&t {and another} +@z +@x +program TEX; {all file names are defined dynamically} +label @<Labels in the outer block@>@/ +const @<Constants in the outer block@>@/ +mtype @<Types in the outer block@>@/ +var @<Global variables@>@/ +@y +program TEX(standard_input,output); {other file names are defined dynamically} +label @<Labels in the outer block@>@/ +const @<Constants in the outer block@>@/ +mtype @!UNIX_filename = packed array[1..file_name_size] of char;@/ +@<Types in the outer block@>@/ +var @<Global variables@>@/ +@# +@\@=#include "ext.h"@>@\ {declarations for external C procedures} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.7] debug..gubed, stat..tats +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging} +@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging} +@y +@d debug==@{ {the trip test will use debugging} +@d gubed==@t@>@} +@z +@x +@d stat==@{ {change this to `$\\{stat}\equiv\null$' when gathering + usage statistics} +@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$' when gathering + usage statistics} +@y +@d stat== +@d tats== +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.8] init..tini +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d init== {change this to `$\\{init}\equiv\.{@@\{}$' in the production version} +@d tini== {change this to `$\\{tini}\equiv\.{@@\}}$' in the production version} +@y +@d init== +@d tini== +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.10] othercases, feature of ISO Extended Pascal +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d othercases == others: {default for cases not listed explicitly} +@y +@d othercases == otherwise {default for cases not listed explicitly} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.11] compile-time constants +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!mem_max=30000; {greatest index in \TeX's internal |mem| array; + must be strictly less than |max_halfword|; + must be equal to |mem_top| in \.{INITEX}, otherwise |>=mem_top|} +@!mem_min=0; {smallest index in \TeX's internal |mem| array; + must be |min_halfword| or more; + must be equal to |mem_bot| in \.{INITEX}, otherwise |<=mem_bot|} +@!buf_size=500; {maximum number of characters simultaneously present in + current lines of open files and in control sequences between + \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|} +@!error_line=72; {width of context lines on terminal error messages} +@!half_error_line=42; {width of first lines of contexts in terminal + error messages; should be between 30 and |error_line-15|} +@!max_print_line=79; {width of longest text lines output; should be at least 60} +@!stack_size=200; {maximum number of simultaneous input sources} +@!max_in_open=6; {maximum number of input files and error insertions that + can be going on simultaneously} +@!font_max=75; {maximum internal font number; must not exceed |max_quarterword| + and must be at most |font_base+256|} +@!font_mem_size=20000; {number of words of |font_info| for all fonts} +@!param_size=60; {maximum number of simultaneous macro parameters} +@!nest_size=40; {maximum number of semantic levels simultaneously active} +@!max_strings=3000; {maximum number of strings; must not exceed |max_halfword|} +@!string_vacancies=8000; {the minimum number of characters that should be + available for the user's control sequences and font names, + after \TeX's own error messages are stored} +@!pool_size=32000; {maximum number of characters in strings, including all + error messages and help texts, and the names of all fonts and + control sequences; must exceed |string_vacancies| by the total + length of \TeX's own strings, which is currently about 23000} +@!save_size=600; {space for saving values outside of current group; must be + at most |max_halfword|} +@!trie_size=8000; {space for hyphenation patterns; should be larger for + \.{INITEX} than it is in production versions of \TeX} +@!trie_op_size=500; {space for ``opcodes'' in the hyphenation patterns} +@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8} +@!file_name_size=40; {file names shouldn't be longer than this} +@!pool_name='TeXformats:TEX.POOL '; + {string of length |file_name_size|; tells where the string pool appears} +@y +@!mem_max=30000; {greatest index in \TeX's internal |mem| array; + must be strictly less than |max_halfword|; + must be equal to |mem_top| in \.{INITEX}, otherwise |>=mem_top|} +@!mem_min=-32767; {smallest index in \TeX's internal |mem| array; + must be |min_halfword| or more; + must be equal to |mem_bot| in \.{INITEX}, otherwise |<=mem_bot|} +@!buf_size=5000; {maximum number of characters simultaneously present in + current lines of open files and in control sequences between + \.{\\csname} and \.{\\endcsname}; must not exceed |max_halfword|} +@!error_line=79; {width of context lines on terminal error messages} +@!half_error_line=50; {width of first lines of contexts in terminal + error messages; should be between 30 and |error_line-15|} +@!max_print_line=79; {width of longest text lines output; should be at least 60} +@!stack_size=200; {maximum number of simultaneous input sources} +@!max_in_open=15; {maximum number of input files and error insertions that + can be going on simultaneously} +@!font_max=127; {maximum internal font number; must not exceed |max_quarterword| + and must be at most |font_base+256|} +@!font_mem_size=40000; {number of words of |font_info| for all fonts} +@!param_size=60; {maximum number of simultaneous macro parameters} +@!nest_size=40; {maximum number of semantic levels simultaneously active} +@!max_strings=3000; {maximum number of strings; must not exceed |max_halfword|} +@!string_vacancies=8000; {the minimum number of characters that should be + available for the user's control sequences and font names, + after \TeX's own error messages are stored} +@!pool_size=60000; {maximum number of characters in strings, including all + error messages and help texts, and the names of all fonts and + control sequences; must exceed |string_vacancies| by the total + length of \TeX's own strings, which is currently about 23000} +@!save_size=600; {space for saving values outside of current group; must be + at most |max_halfword|} +@!trie_size=8000; {space for hyphenation patterns; should be larger for + \.{INITEX} than it is in production versions of \TeX} +@!trie_op_size=500; {space for ``opcodes'' in the hyphenation patterns} +@!dvi_buf_size=800; {size of the output buffer; must be a multiple of 8} +@!file_name_size=1024; {file names shouldn't be longer than this} +@!pool_name='tex.pool'; + {string of length |file_name_size|; the string pool name} +@.TeXformats@> +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1.12] sensitive compile-time constants +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d mem_bot=0 {smallest index in the |mem| array dumped by \.{INITEX}; + must not be less than |mem_min|} +@d mem_top==30000 {largest index in the |mem| array dumped by \.{INITEX}; + must be substantially larger than |mem_bot| + and not greater than |mem_max|} +@d font_base=0 {smallest internal font number; must not be less + than |min_quarterword|} +@d hash_size=2100 {maximum number of control sequences; it should be at most + about |(mem_max-mem_min)/10|} +@d hash_prime=1777 {a prime number equal to about 85\pct! of |hash_size|} +@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions} +@y +@d mem_bot=-32767 {smallest index in the |mem| array dumped by \.{INITEX}; + must not be less than |mem_min|} +@d mem_top==30000 {largest index in the |mem| array dumped by \.{INITEX}; + must be substantially larger than |mem_bot| + and not greater than |mem_max|} +@d font_base=0 {smallest internal font number; must not be less + than |min_quarterword|} +@d hash_size=4000 {maximum number of control sequences; it should be at most + about |(mem_max-mem_min)/10|} +@d hash_prime=3443 {a prime number equal to about 85\pct! of |hash_size|} +@d hyph_size=307 {another prime; the number of \.{\\hyphenation} exceptions} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [2.23] allow any character that we can input to get in +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +for i:=0 to @'37 do xchr[i]:=' '; +for i:=@'177 to @'377 do xchr[i]:=' '; +@y +for i:=0 to @'37 do xchr[i]:=chr(i); +for i:=@'177 to @'377 do xchr[i]:=chr(i); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.25] file types +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!eight_bits=0..255; {unsigned one-byte quantity} +@!alpha_file=packed file of text_char; {files that contain textual data} +@y +@!eight_bits=ByteCard; {unsigned one-byte quantity} +@!alpha_file=t@&e@&x@&t; {files that contain textual data} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.26] add real_name_of_file array +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +is crucial for our purposes. We shall assume that |name_of_file| is a variable +of an appropriate type such that the \PASCAL\ run-time system being used to +implement \TeX\ can open a file whose external name is specified by +|name_of_file|. +@^system dependencies@> + +@<Glob...@>= +@!name_of_file:packed array[1..file_name_size] of char;@;@/ + {on some systems this may be a \&{record} variable} +@y +is crucial for our purposes. We shall assume that |name_of_file| is a variable +of an appropriate type such that the \PASCAL\ run-time system being used to +implement \TeX\ can open a file whose external name is specified by +|name_of_file|. +The Linux version uses search paths to look for files to open. +We use |real_name_of_file| to hold the |name_of_file| with a directory +name from the path in front of it. +@^system dependencies@> + +@<Glob...@>= +@!name_of_file,@!real_name_of_file:external UNIX_filename; +@;@/ +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.27] file opening +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The \ph\ compiler with which the present version of \TeX\ was prepared has +extended the rules of \PASCAL\ in a very convenient way. To open file~|f|, +we can write +$$\vbox{\halign{#\hfil\qquad&#\hfil\cr +|reset(f,@t\\{name}@>,'/O')|&for input;\cr +|rewrite(f,@t\\{name}@>,'/O')|&for output.\cr}}$$ +The `\\{name}' parameter, which is of type `{\bf packed array +$[\langle\\{any}\rangle]$ of \\{char}}', stands for the name of +the external file that is being opened for input or output. +Blank spaces that might appear in \\{name} are ignored. + +The `\.{/O}' parameter tells the operating system not to issue its own +error messages if something goes wrong. If a file of the specified name +cannot be found, or if such a file cannot be opened for some other reason +(e.g., someone may already be trying to write the same file), we will have +|@!erstat(f)<>0| after an unsuccessful |reset| or |rewrite|. This allows +\TeX\ to undertake appropriate corrective action. +@:PASCAL H}{\ph@> +@^system dependencies@> + +\TeX's file-opening procedures return |false| if no file identified by +|name_of_file| could be opened. + +@d reset_OK(#)==erstat(#)=0 +@d rewrite_OK(#)==erstat(#)=0 + +@p function a_open_in(var f:alpha_file):boolean; + {open a text file for input} +begin reset(f,name_of_file,'/O'); a_open_in:=reset_OK(f); +end; +@# +function a_open_out(var f:alpha_file):boolean; + {open a text file for output} +begin rewrite(f,name_of_file,'/O'); a_open_out:=rewrite_OK(f); +end; +@# +function b_open_in(var f:byte_file):boolean; + {open a binary file for input} +begin reset(f,name_of_file,'/O'); b_open_in:=reset_OK(f); +end; +@# +function b_open_out(var f:byte_file):boolean; + {open a binary file for output} +begin rewrite(f,name_of_file,'/O'); b_open_out:=rewrite_OK(f); +end; +@# +function w_open_in(var f:word_file):boolean; + {open a word file for input} +begin reset(f,name_of_file,'/O'); w_open_in:=reset_OK(f); +end; +@# +function w_open_out(var f:word_file):boolean; + {open a word file for output} +begin rewrite(f,name_of_file,'/O'); w_open_out:=rewrite_OK(f); +end; +@y +@ An external C procedure, |test_access| is used to check whether or not the +open will work. It is declared in the ``ext.h'' include file, and it returns +|true| or |false|. The |name_of_file| global holds the file name whose access +is to be tested. +The first parameter for |test_access| is the access mode, +one of |read_access_mode| or |write_access_mode|. + +We also implement path searching in |test_access|: its second parameter is +one of the ``file path'' constants defined below. If |name_of_file| +doesn't start with |'/'| then |test_access| tries prepending pathnames +from the appropriate path list until success or the end of path list +is reached. +On return, |real_name_of_file| contains the original name with the path +that succeeded (if any) prepended. It is the name used in the various +open procedures. + +Note that |a_open_in| has been redefined to take an additional argument, +which should be one of the ``file path'' specifiers. +Since |b_open_in| is only used for \.{TFM} files, and +|w_open_in| is only used for format files, we don't need a path specifying +argument for them. +Path searching is not done for output files. + +@d read_access_mode=4 {``read'' mode for |test_access|} +@d write_access_mode=2 {``write'' mode for |test_access|} + +@d no_file_path=0 {no path searching should be done} +@d input_file_path=1 {path specifier for \.{\\input} files} +@d read_file_path=2 {path specifier for \.{\\read} files} +@d font_file_path=3 {path specifier for \.{TFM} files} +@d format_file_path=4 {path specifier for format files} +@d pool_file_path=5 {path specifier for the pool file} + +@p function a_open_in(var f:alpha_file;@!path_specifier:integer):boolean; + {open a text file for input} +var @!ok:boolean; +begin +if test_access(read_access_mode,path_specifier) then + begin reset(f,real_name_of_file); ok:=true@+end +else + ok:=false; +a_open_in:=ok; +end; +@# +function a_open_out(var f:alpha_file):boolean; + {open a text file for output} +var @!ok:boolean; +begin +if test_access(write_access_mode,no_file_path) then + begin rewrite(f,real_name_of_file); ok:=true @+end +else ok:=false; +a_open_out:=ok; +end; +@# +function b_open_in(var f:byte_file):boolean; + {open a binary file for input} +var @!ok:boolean; +begin +if test_access(read_access_mode,font_file_path) then + begin reset(f,real_name_of_file); ok:=true @+end +else ok:=false; +b_open_in:=ok; +end; +@# +function b_open_out(var f:byte_file):boolean; + {open a binary file for output} +var @!ok:boolean; +begin +if test_access(write_access_mode,no_file_path) then + begin rewrite(f,real_name_of_file); ok:=true @+end +else ok:=false; +b_open_out:=ok; +end; +@# +function w_open_in(var f:word_file):boolean; + {open a word file for input} +var @!ok:boolean; +begin +if test_access(read_access_mode,format_file_path) then + begin reset(f,real_name_of_file); ok:=true @+end +else ok:=false; +w_open_in:=ok; +end; +@# +function w_open_out(var f:word_file):boolean; + {open a word file for output} +var @!ok:boolean; +begin +if test_access(write_access_mode,no_file_path) then + begin rewrite(f,name_of_file); ok:=true @+end +else ok:=false; +w_open_out:=ok; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.28] file closing +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +This makes |f| available to be opened again, if desired; and if |f| was used for +output, the |close| operation makes the corresponding external file appear +on the user's area, ready to be read. + +These procedures should not generate error messages if a file is +being closed before it has been successfully opened. + +@p procedure a_close(var f:alpha_file); {close a text file} +begin close(f); +end; +@# +procedure b_close(var f:byte_file); {close a binary file} +begin close(f); +end; +@# +procedure w_close(var f:word_file); {close a word file} +begin close(f); +end; +@y +This makes |f| available to be opened again, if desired; and if |f| was used for +output, the |close| operation makes the corresponding external file appear +on the user's area, ready to be read. + +With the pc library, files will be automatically closed when the program stops +and when one reopens them. +There is, however, the problem of opening a file and writing it, and then +wanting to read it again, but from a different file variable. +For this purpose we use external procedures |close_a|, |close_b|, and +|close_w|. + +@p procedure a_close(var f:alpha_file); {close a text file} +begin close_a(f); +end; +@# +procedure b_close(var f:byte_file); {close a binary file} +begin close_b(f); +end; +@# +procedure w_close(var f:word_file); {close a word file} +begin close_w(f); +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.32] term_in/out are input,output +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The user's terminal acts essentially like other files of text, except +that it is used both for input and for output. When the terminal is +considered an input file, the file variable is called |term_in|, and when it +is considered an output file the file variable is |term_out|. +@^system dependencies@> + +@<Glob...@>= +@!term_in:alpha_file; {the terminal as an input file} +@!term_out:alpha_file; {the terminal as an output file} +@y +@ The user's terminal acts essentially like other files of text, except +that it is used both for input and for output. When the terminal is +considered an input file, the file is called |term_in|, and when it +is considered an output file the file is |term_out|. +For Berkeley {\mc UNIX} we use |standard_input| and |output| for these +files, as were declared in the program header. The former name +|standard_input| was defined using a .{WEB} trick so that `input' is +produced in the Pascal file. + +@d term_in==standard_input {the terminal as an input file} +@d term_out==output {the terminal as an output file} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.33] don't need to open terminal files +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ Here is how to open the terminal files +in \ph. The `\.{/I}' switch suppresses the first |get|. +@^system dependencies@> + +@d t_open_in==reset(term_in,'TTY:','/O/I') {open the terminal for text input} +@d t_open_out==rewrite(term_out,'TTY:','/O') {open the terminal for text output} +@y +@ Here is how to open the terminal files---do nothing. + +@d t_open_in == {input already open for text input} +@d t_open_out == {output already open for text output} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3.34] flushing output +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +these operations can be specified in \ph: +@^system dependencies@> + +@d update_terminal == break(term_out) {empty the terminal output buffer} +@d clear_terminal == break_in(term_in,true) {clear the terminal input buffer} +@d wake_up_terminal == do_nothing {cancel the user's cancellation of output} +@y +these operations can be specified with Berkeley {\mc UNIX}: +@^system dependencies@> + +@d update_terminal == flush_stdout +@d clear_terminal == {nothing necessary on UNIX} +@d wake_up_terminal == {nothing necessary on UNIX} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [4.38] string data +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!packed_ASCII_code = 0..255; {elements of |str_pool| array} +@y +@!packed_ASCII_code = ByteCard; {elements of |str_pool| array} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [4.51] a_open_in of pool file needs path specifier +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +if a_open_in(pool_file) then +@y +if a_open_in(pool_file,pool_file_path) then +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [4.51,52,53] make TEX.POOL lowercase in messages +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +else bad_pool('! I can''t read TEX.POOL.') +@y +else bad_pool('! I can''t read tex.pool.') +@z +@x +begin if eof(pool_file) then bad_pool('! TEX.POOL has no check sum.'); +@y +begin if eof(pool_file) then bad_pool('! tex.pool has no check sum.'); +@z +@x + bad_pool('! TEX.POOL line doesn''t begin with two digits.'); +@y + bad_pool('! tex.pool line doesn''t begin with two digits.'); +@z +@x + bad_pool('! TEX.POOL check sum doesn''t have nine digits.'); +@y + bad_pool('! tex.pool check sum doesn''t have nine digits.'); +@z +@x +done: if a<>@$ then bad_pool('! TEX.POOL doesn''t match; TANGLE me again.'); +@y +done: if a<>@$ then bad_pool('! tex.pool doesn''t match; tangle me again.'); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [7.109] glue_ratio +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!glue_ratio=real; {one-word representation of a glue expansion factor} +@y +@!glue_ratio=ShortReal; {one-word representation of a glue expansion factor} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [8.110] ranges for quarter,half words FIXTHIS +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +if the subrange is `|-128..127|'. + +The present implementation tries to accommodate as many variations as possible, +so it makes few assumptions. If integers having the subrange +`|min_quarterword..max_quarterword|' can be packed into a quarterword, +and if integers having the subrange `|min_halfword..max_halfword|' +can be packed into a halfword, everything should work satisfactorily. + +It is usually most efficient to have |min_quarterword=min_halfword=0|, +so one should try to achieve this unless it causes a severe problem. +The values defined here are recommended for most 32-bit computers. + +@d min_quarterword=0 {smallest allowable value in a |quarterword|} +@d max_quarterword=255 {largest allowable value in a |quarterword|} +@d min_halfword==0 {smallest allowable value in a |halfword|} +@d max_halfword==65535 {largest allowable value in a |halfword|} +@y +if the subrange is `|-128..127|'. + +For Berkeley {\mc UNIX} (SunOS) we need to do the |-128..127| kind of range. + +@d min_quarterword=-128 {smallest allowable value in a |quarterword|} +@d max_quarterword=127 {largest allowable value in a |quarterword|} +@d min_halfword==-32768 {smallest allowable value in a |halfword|} +@d max_halfword==32767 {largest allowable value in a |halfword|} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [11.165] fix the word "free" so that it doesn't conflict with a runtime proc +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +been included. (You may want to decrease the size of |mem| while you +@^debugging@> +are debugging.) +@y +been included. (You may want to decrease the size of |mem| while you +@^debugging@> +are debugging.) + +@d free==free_arr +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [12.186] glue_ratio fix FIXTHIS +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +floating point underflow on the author's computer. +@^system dependencies@> +@^dirty \PASCAL@> + +@<Display the value of |glue_set(p)|@>= +g:=float(glue_set(p)); +if (g<>float_constant(0))and(glue_sign(p)<>normal) then + begin print(", glue set "); + if glue_sign(p)=shrinking then print("- "); + if abs(mem[p+glue_offset].int)<@'4000000 then print("?.?") + else if abs(g)>float_constant(20000) then + begin if g>float_constant(0) then print_char(">") + else print("< -"); + print_glue(20000*unity,glue_order(p),0); + end + else print_glue(round(unity*g),glue_order(p),0); +@^real multiplication@> + end +@y +floating point underflow on the author's computer. +For the {\mc VAX}, the only possible random value that could hurt is +a reserved value with 1 in the sign bit and 0 for the (excess) exponent. +Because the sign-plus-exponent is in the middle of the word, the chances +of this happening are miniscule, and ignored here. +@^system dependencies@> +@^dirty \PASCAL@> + +@<Display the value of |glue_set(p)|@>= +g:=float(glue_set(p)); +if (g<>float_constant(0))and(glue_sign(p)<>normal) then + begin print(", glue set "); + if glue_sign(p)=shrinking then print("- "); + if abs(float(glue_set(p)))>20000.0 then + begin if float(glue_set(p))>0 then print_char(">") + else print("< -"); + print_glue(20000*unity,glue_order(p),0); + end + else print_glue(round(float(glue_set(p))*unity),glue_order(p),0); +@^real multiplication@> + end +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [17.241] fix_date_and_time +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The following procedure, which is called just before \TeX\ initializes its +input and output, establishes the initial values of the date and time. +@^system dependencies@> +Since standard \PASCAL\ cannot provide such information, something special +is needed. The program here simply specifies July 4, 1776, at noon; but +users probably want a better approximation to the truth. + +@p procedure fix_date_and_time; +begin time:=12*60; {minutes since midnight} +day:=4; {fourth day of the month} +month:=7; {seventh month of the year} +year:=1776; {Anno Domini} +end; +@y +@ The following procedure, which is called just before \TeX\ initializes its +input and output, establishes the initial values of the date and time. +It is calls an externally defined |date_and_time|, even though it could +be done from Pascal. +The external procedure also sets up interrupt catching. +@^system dependencies@> + +@p procedure fix_date_and_time; +begin + date_and_time(time,day,month,year); +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [29.513] area and extension rules +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The file names we shall deal with for illustrative purposes have the +following structure: If the name contains `\.>' or `\.:', the file area +consists of all characters up to and including the final such character; +otherwise the file area is null. If the remaining file name contains +`\..', the file extension consists of all such characters from the first +remaining `\..' to the end, otherwise the file extension is null. +@^system dependencies@> + +We can scan such file names easily by using two global variables that keep track +of the occurrences of area and extension delimiters: + +@<Glob...@>= +@!area_delimiter:pool_pointer; {the most recent `\.>' or `\.:', if any} +@!ext_delimiter:pool_pointer; {the relevant `\..', if any} +@y +@ The file names we shall deal with for SunOS have the +following structure: If the name contains `\./', the file area +consists of all characters up to and including the final such character; +otherwise the file area is null. If the remaining file name contains +`\..', the file extension consists of all such characters from the first +remaining `\..' to the end, otherwise the file extension is null. +@^system dependencies@> + +We can scan such file names easily by using two global variables that keep +track of the occurrences of area and extension delimiters: + +@<Glob...@>= +@!area_delimiter:pool_pointer; {the most recent `\./', if any} +@!ext_delimiter:pool_pointer; {the most recent `\..', if any} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [29.514] TeX area directories +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d TEX_area=="TeXinputs:" +@.TeXinputs@> +@d TEX_font_area=="TeXfonts:" +@.TeXfonts@> +@y +Under Linux, the default paths are specified in a separate +file, `\.{texpaths.h}'. The file opening procedures do path searching +based either on those default paths, or on paths given by the user +in ``environment'' variables. +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [29.516] more_name +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x + if (c=">")or(c=":") then +@y + if c="/" then +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [29.520] default format +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d format_default_length=20 {length of the |TEX_format_default| string} +@d format_area_length=11 {length of its area part} +@d format_ext_length=4 {length of its `\.{.fmt}' part} +@y +Under Linux we don't give the area part, instead depending +on the path searching that will happen during file opening. + +@d format_default_length=9 {length of the |TEX_format_default| string} +@d format_area_length=0 {length of its area part} +@d format_ext_length=4 {length of its `\.{.fmt}' part} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [29.521] plain format location +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +TEX_format_default:='TeXformats:plain.fmt'; +@y +TEX_format_default:='plain.fmt'; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [29.524] format file opening: only try once, with path search +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x + pack_buffered_name(0,loc,j-1); {try first without the system file area} + if w_open_in(fmt_file) then goto found; + pack_buffered_name(format_area_length,loc,j-1); + {now try the system format file area} + if w_open_in(fmt_file) then goto found; +@y + pack_buffered_name(0,loc,j-1); + if w_open_in(fmt_file) then goto found; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [29.525] make_name_string +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +which simply makes a \TeX\ string from the value of |name_of_file|, should +ideally be changed to deduce the full name of file~|f|, which is the file +most recently opened, if it is possible to do this in a \PASCAL\ program. +@^system dependencies@> + +This routine might be called after string memory has overflowed, hence +we dare not use `|str_room|'. + +@p function make_name_string:str_number; +var k:1..file_name_size; {index into |name_of_file|} +begin if (pool_ptr+name_length>pool_size)or(str_ptr=max_strings)or + (cur_length>0) then + make_name_string:="?" +else begin for k:=1 to name_length do append_char(xord[name_of_file[k]]); + make_name_string:=make_string; + end; +end; +@y +which simply makes a \TeX\ string from the value of |name_of_file|, should +ideally be changed to deduce the full name of file~|f|, which is the file +most recently opened, if it is possible to do this in a \PASCAL\ program. +With the Berkeley {\mc UNIX} version, we know that |real_name_of_file| +contains |name_of_file| prepended with the directory name that was found +by path searching. +If |real_name_of_file| starts with |'./'|, we don't use that part of the +name, since {\mc UNIX} users understand that. +@^system dependencies@> + +This routine might be called after string memory has overflowed, hence +we dare not use `|str_room|'. + +@p function make_name_string:str_number; +var k,@!kstart:1..file_name_size; {index into |name_of_file|} +begin +k:=1; +while (k<file_name_size) and (xord[real_name_of_file[k]]<>" ") do + incr(k); +name_length:=k-1; {the real |name_length|} +if (pool_ptr+name_length>pool_size)or(str_ptr=max_strings)or + (cur_length>0) then + make_name_string:="?" +else begin + if (xord[real_name_of_file[1]]=".") and (xord[real_name_of_file[2]]="/") then + kstart:=3 + else + kstart:=1; + for k:=kstart to name_length do append_char(xord[real_name_of_file[k]]); + make_name_string:=make_string; + end +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [29.537] a_open_in of \input file needs path selector +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x + if a_open_in(cur_file) then goto done; + if cur_area="" then + begin pack_file_name(cur_name,TEX_area,cur_ext); + if a_open_in(cur_file) then goto done; + end; +@y + if a_open_in(cur_file,input_file_path) then goto done; + if cur_ext=".tex" then + begin pack_file_name(cur_name,cur_area,""); + if a_open_in(cur_file,input_file_path) then goto done; + end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [30.563] opening tfm file: now path searching is done +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Set temp_int to value of first byte +@x +@ @<Open |tfm_file| for input@>= +file_opened:=false; +if aire="" then pack_file_name(nom,TEX_font_area,".tfm") +else pack_file_name(nom,aire,".tfm"); +if not b_open_in(tfm_file) then abort; +file_opened:=true +@y +@ Here we have to ``prime the pump'' for the |temp_int| trick explained below. + + @<Open |tfm_file| for input@>= +file_opened:=false; +pack_file_name(nom,aire,".tfm"); +if not b_open_in(tfm_file) then abort; +begin temp_int:=tfm_file^; + if temp_int<0 then temp_int:=temp_int+256; +end; +file_opened:=true +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [49.1275] a_open_in of \read file needs path specifier +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x + if a_open_in(read_file[n]) then read_open[n]:=just_open; +@y + if a_open_in(read_file[n],read_file_path) then read_open[n]:=just_open; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [51.1332] Delete ready_already; also add call to set_paths; +% also add call to exit() depending upon value of `history' +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ Now this is really it: \TeX\ starts and ends here. + +The initial test involving |ready_already| should be deleted if the +\PASCAL\ runtime system is smart enough to detect such a ``mistake.'' +@y +@ Now this is really it: \TeX\ starts and ends here. + +At the end of the job, we look at |history| to decide the correct +exit code. We use 1 if |history <= warning_issued| and 0 otherwise. + +@d UNIXexit==e@&x@&i@&t +@z + +@x +t_open_out; {open the terminal for output} +if ready_already=314159 then goto start_of_TEX; +@y +t_open_out; {open the terminal for output} +set_paths; +@z + +@x +start_of_TEX: @<Initialize the output routines@>; +@y +start_of_TEX: argv(0,my_name); FIXTHIS: DELETE MY_NAME! +if (my_name<>'initex')and(my_name<>'triptex') then + begin if my_name = 'tex' then name_of_file:='plain.fmt' + else name_of_file:=my_name+'.fmt'; + if w_open_in(fmt_file) then + if not load_fmt_file then + begin w_close(fmt_file); goto final_end; + end + else w_close(fmt_file); + end; +@<Initialize the output routines@>; +@z + +@x +final_end: ready_already:=0; +@y +final_end: ready_already:=0; +if (history <= warning_issued) then + UNIXexit(0) +else + UNIXexit(1); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [51.1333] print new line before termination; switch to editor if nec. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x + slow_print(log_name); print_char("."); + end; + end; +@y + slow_print(log_name); print_char("."); + end; + end; +print_ln; +if (ed_name_start<>0) and (interaction>batch_mode) then + calledit(str_pool[ed_name_start],ed_name_length,edit_line); +@z + diff --git a/systems/knuth/local/tex/plain.fmt b/systems/knuth/local/tex/plain.fmt Binary files differnew file mode 100644 index 0000000000..f9c7455f65 --- /dev/null +++ b/systems/knuth/local/tex/plain.fmt diff --git a/systems/knuth/local/tex/plain.log b/systems/knuth/local/tex/plain.log new file mode 100644 index 0000000000..6a7f9f18a3 --- /dev/null +++ b/systems/knuth/local/tex/plain.log @@ -0,0 +1,103 @@ +This is TeX, Version 3.14159 for SunOS (INITEX) 14 AUG 1998 08:06 +**plain \input local \dump +(/home/tex/dist/lib/plain.tex Preloading the plain format: codes, registers, +\maxdimen=\dimen10 +\hideskip=\skip10 +\centering=\skip11 +\p@=\dimen11 +\z@=\dimen12 +\z@skip=\skip12 +\voidb@x=\box10 + +parameters, +\smallskipamount=\skip13 +\medskipamount=\skip14 +\bigskipamount=\skip15 +\normalbaselineskip=\skip16 +\normallineskip=\skip17 +\normallineskiplimit=\dimen13 +\jot=\dimen14 +\interdisplaylinepenalty=\count23 +\interfootnotelinepenalty=\count24 + fonts, more fonts, +\itfam=\fam4 +\slfam=\fam5 +\bffam=\fam6 +\ttfam=\fam7 + macros, +\strutbox=\box11 +\mscount=\count25 +\tabs=\box12 +\tabsyet=\box13 +\tabsdone=\box14 + math definitions, +\rootbox=\box15 +\p@renwd=\dimen15 + output routines, +\headline=\toks10 +\footline=\toks11 +\footins=\insert254 +\topins=\insert253 + +hyphenation (/home/tex/dist/lib/hyphen.tex)) (/home/tex/local/lib/local.tex) +Beginning to dump on file plain.fmt + (preloaded format=plain 98.8.14) +1968 strings of total length 27846 +5013 memory locations dumped; current usage is 110&4900 +926 multiletter control sequences +\font\nullfont=nullfont +\font\tenrm=cmr10 +\font\preloaded=cmr9 +\font\preloaded=cmr8 +\font\sevenrm=cmr7 +\font\preloaded=cmr6 +\font\fiverm=cmr5 +\font\teni=cmmi10 +\font\preloaded=cmmi9 +\font\preloaded=cmmi8 +\font\seveni=cmmi7 +\font\preloaded=cmmi6 +\font\fivei=cmmi5 +\font\tensy=cmsy10 +\font\preloaded=cmsy9 +\font\preloaded=cmsy8 +\font\sevensy=cmsy7 +\font\preloaded=cmsy6 +\font\fivesy=cmsy5 +\font\tenex=cmex10 +\font\preloaded=cmss10 +\font\preloaded=cmssq8 +\font\preloaded=cmssi10 +\font\preloaded=cmssqi8 +\font\tenbf=cmbx10 +\font\preloaded=cmbx9 +\font\preloaded=cmbx8 +\font\sevenbf=cmbx7 +\font\preloaded=cmbx6 +\font\fivebf=cmbx5 +\font\tentt=cmtt10 +\font\preloaded=cmtt9 +\font\preloaded=cmtt8 +\font\preloaded=cmsltt10 +\font\tensl=cmsl10 +\font\preloaded=cmsl9 +\font\preloaded=cmsl8 +\font\tenit=cmti10 +\font\preloaded=cmti9 +\font\preloaded=cmti8 +\font\preloaded=cmti7 +\font\preloaded=cmu10 +\font\preloaded=cmmib10 +\font\preloaded=cmbsy10 +\font\preloaded=cmcsc10 +\font\preloaded=cmssbx10 +\font\preloaded=cmdunh10 +\font\preloaded=cmr7 at 14.51799pt +\font\preloaded=cmtt10 at 14.4pt +\font\preloaded=cmssbx10 at 14.4pt +\font\preloaded=manfnt +14787 words of font info for 50 preloaded fonts +14 hyphenation exceptions +Hyphenation trie of length 6075 has 181 ops out of 500 + 181 for language 0 +No pages of output. diff --git a/systems/knuth/local/tex/tex.pool b/systems/knuth/local/tex/tex.pool new file mode 100644 index 0000000000..c1358a0a41 --- /dev/null +++ b/systems/knuth/local/tex/tex.pool @@ -0,0 +1,1040 @@ +11buffer size +09pool size +17number of strings +03??? +13m2d5c2l5x2v5i +28End of file on the terminal! +02! +42(That makes 100 errors; please try again.) +02? +60Type <return> to proceed, S to scroll future error messages, +44R to run without stopping, Q to run quietly, +23I to insert something, +20E to edit your file, +561 or ... or 9 to ignore the next 1 to 9 tokens of input, +22H for help, X to quit. +13OK, entering +09batchmode +11nonstopmode +10scrollmode +03... +07insert> +44I have just deleted some text, as you asked. +48You can now delete more, or insert, or whatever. +50Sorry, I don't know how to help in this situation. +36Maybe you should try asking a human? +42Sorry, I already gave what help I could... +59An error might have occurred before I noticed any problems. +45``If all else fails, read the instructions.'' +02 ( +14Emergency stop +30TeX capacity exceeded, sorry [ +44If you really absolutely need more capacity, +35you can ask a wizard to enlarge me. +19This can't happen ( +59I'm broken. Please show this to someone who can fix can fix +35I can't go on meeting you like this +55One of your faux pas seems to have wounded me deeply... +59in fact, I'm barely conscious. Please fix it and try again. +12Interruption +09You rang? +60Try to insert some instructions for me (e.g.,`I\showlists'), +43unless you just want to quit by typing `X'. +16main memory size +24AVAIL list clobbered at +31Double-AVAIL list clobbered at +24Doubly free location at +12Bad flag at +14New busy locs: +05LINK( +05INFO( +02[] +10CLOBBERED. +04foul +03fil +06 plus +07 minus +03 [] +26Bad link, display aborted. +04etc. +18Unknown node type! +05unset +04box( +02)x +10, shifted +09 columns) +10, stretch +09, shrink +11, glue set +02- +03< - +05rule( +06insert +15, natural size +08; split( +14); float cost +04glue +09nonscript +05mskip +02mu +00 +08leaders +04kern +13 (for accent) +05mkern +04math +02on +03off +13, surrounded +11 (ligature +08penalty +13discretionary +11 replacing +04mark +07vadjust +08flushing +07copying +08vertical +10horizontal +12display math +02no +17internal vertical +21restricted horizontal +05 mode +18semantic nest size +04### +17 entered at line +10 (language +10:hyphenmin +18 (\output routine) +25### recent contributions: +10prevdepth +07ignored +11, prevgraf +05 line +12spacefactor +19, current language +28this will be denominator of: +08lineskip +12baselineskip +07parskip +16abovedisplayskip +16belowdisplayskip +21abovedisplayshortskip +21belowdisplayshortskip +08leftskip +09rightskip +07topskip +12splittopskip +07tabskip +09spaceskip +10xspaceskip +11parfillskip +10thinmuskip +09medmuskip +11thickmuskip +25[unknown glue parameter!] +04skip +06muskip +02pt +06output +08everypar +09everymath +12everydisplay +09everyhbox +09everyvbox +08everyjob +07everycr +07errhelp +04toks +08parshape +03box +04void +12current font +08textfont +10scriptfont +16scriptscriptfont +07catcode +06lccode +06uccode +06sfcode +08mathcode +12pretolerance +09tolerance +11linepenalty +13hyphenpenalty +15exhyphenpenalty +11clubpenalty +12widowpenalty +19displaywidowpenalty +13brokenpenalty +12binoppenalty +10relpenalty +17predisplaypenalty +18postdisplaypenalty +16interlinepenalty +20doublehyphendemerits +19finalhyphendemerits +11adjdemerits +03mag +15delimiterfactor +09looseness +04time +03day +05month +04year +14showboxbreadth +12showboxdepth +08hbadness +08vbadness +07pausing +13tracingonline +13tracingmacros +12tracingstats +17tracingparagraphs +12tracingpages +13tracingoutput +16tracinglostchars +15tracingcommands +15tracingrestores +06uchyph +13outputpenalty +13maxdeadcycles +09hangafter +15floatingpenalty +10globaldefs +03fam +10escapechar +17defaulthyphenchar +15defaultskewchar +11endlinechar +11newlinechar +08language +13lefthyphenmin +14righthyphenmin +14holdinginserts +17errorcontextlines +28[unknown integer parameter!] +05count +07delcode +09parindent +12mathsurround +13lineskiplimit +05hsize +05vsize +08maxdepth +13splitmaxdepth +11boxmaxdepth +05hfuzz +05vfuzz +18delimitershortfall +18nulldelimiterspace +11scriptspace +14predisplaysize +12displaywidth +13displayindent +12overfullrule +10hangindent +07hoffset +07voffset +16emergencystretch +26[unknown dimen parameter!] +05dimen +06EQUIV( +12notexpanded: +09hash size +06csname +09endcsname +11IMPOSSIBLE. +12NONEXISTENT. +06accent +07advance +15afterassignment +10aftergroup +10begingroup +04char +09delimiter +06divide +08endgroup +11expandafter +04font +09fontdimen +06halign +05hrule +12ignorespaces +10mathaccent +08mathchar +10mathchoice +08multiply +07noalign +10noboundary +08noexpand +04omit +07penalty +08prevgraf +07radical +04read +05relax +06setbox +03the +06valign +07vcenter +05vrule +09save size +15grouping levels +08curlevel +09retaining +09restoring +05SAVE( +28Incompatible magnification ( +02); +36 the previous value will be retained +58I can handle only one magnification ratio per job. So I've +59reverted to the magnification you used earlier on this run. +46Illegal magnification has been changed to 1000 +52The magnification ratio must be between 1 and 32768. +04ETC. +04BAD. +02-> +22begin-group character +20end-group character +21math shift character +26macro parameter character +22superscript character +20subscript character +25end of alignment template +12blank space +11the letter +14the character +23[unknown command code!] +02: +08Runaway +10definition +08argument +08preamble +04text +03<*> +09<insert> +06<read +02l. +11<argument> +11<template> +16<recently read> +19<to be read again> +16<inserted text> +09<output> +11<everypar> +12<everymath> +15<everydisplay> +12<everyhbox> +12<everyvbox> +11<everyjob> +10<everycr> +07<mark> +08<write> +16input stack size +05write +48(interwoven alignment preambles are not allowed) +17text input levels +03par +11Incomplete +34; all text was ignored after line +54A forbidden control sequence occurred in skipped text. +59This kind of error happens when you say `\if...' and forget +59the matching `\fi'. I've inserted a `\fi'; this might work. +53The file ended while I was skipping conditional text. +10File ended +32Forbidden control sequence found +16 while scanning +04 of +46I suspect you have forgotten a `}', causing me +41to read past where you wanted me to stop. +49I'll try to recover; but if the error is serious, +51you'd better type `E' or `X' now and fix your file. +03use +39Text line contains an invalid character +53A funny symbol that I can't read has just been input. +48Continue, and I'll forget that it ever happened. +37(Please type a command or say `\end') +38*** (job aborted, no legal \end found) +02=> +26Undefined control sequence +47The control sequence at the end of the top line +52of your error message was never \def'ed. If you have +55misspelled it (e.g., `\hobx'), type `I' and the correct +51spelling (e.g., `I\hbox'). Otherwise just continue, +45and I'll forget about whatever was undefined. +08Missing +09 inserted +53The control sequence marked <to be read again> should +42not appear between \csname and \endcsname. +05input +08endinput +07topmark +09firstmark +07botmark +14splitfirstmark +12splitbotmark +20parameter stack size +12Argument of +15 has an extra } +58I've run across a `}' that doesn't seem to match anything. +52For example, `\def\a#1{...}' and `\a}' would produce +54this error. If you simply proceed now, the `\par' that +52I've just inserted will cause me to report a runaway +54argument that might be the root of the problem. But if +57your `}' was spurious, just type `2' and it will go away. +23Paragraph ended before +13 was complete +58I suspect you've forgotten a `}', causing me to apply this +54control sequence to too much text. How can we recover? +59My plan is to forget the whole thing and hope for the best. +07Use of +29 doesn't match its definition +54If you say, e.g., `\def\a1{...}', then you must always +52put `1' after `\a', since control sequence names are +52made up of letters only. The macro here has not been +51followed by the required stuff, so I'm ignoring it. +02<- +18Missing { inserted +52A left brace was mandatory here, so I've put one in. +55You might want to delete and/or insert some corrections +48so that I will find a matching right brace soon. +54(If you're confused by all this, try typing `I}' now.) +23Incompatible glue units +52I'm going to assume that 1mu=1pt when they're mixed. +31Missing number, treated as zero +47A number should have been here; I inserted `0'. +54(If you can't figure out why I needed to see a number, +51look up `weird error' in the index to The TeXbook.) +11spacefactor +09prevdepth +10deadcycles +15insertpenalties +02wd +02ht +02dp +11lastpenalty +08lastkern +08lastskip +11inputlineno +07badness +09Improper +54You can refer to \spacefactor only in horizontal mode; +54you can refer to \prevdepth only in vertical mode; and +48neither of these is meaningful inside \write. So +52I'm forgetting what you said and using zero instead. +15You can't use ` +08' after +17Bad register code +44A register number must be between 0 and 255. +27I changed this one to zero. +18Bad character code +45A character number must be between 0 and 255. +10Bad number +51Since I expected to read a number between 0 and 15, +12Bad mathchar +46A mathchar number must be between 0 and 32767. +18Bad delimiter code +56A numeric delimiter code must be between 0 and 2^{27}-1. +28Improper alphabetic constant +56A one-character control sequence belongs after a ` mark. +37So I'm essentially inserting \0 here. +14Number too big +54I can only go up to 2147483647='17777777777="7FFFFFFF, +42so I'm using that number instead of yours. +04true +25Illegal unit of measure ( +18replaced by filll) +35I dddon't go any higher than filll. +02em +02ex +12mu inserted) +48The unit of measurement in math glue must be mu. +51To recover gracefully from this error, it's best to +52delete the erroneous units; e.g., type `2' to delete +45two letters. (See Chapter 27 of The TeXbook.) +02in +02pc +02cm +02mm +02bp +02dd +02cc +02sp +12pt inserted) +49Dimensions can be in units of em, ex, in, pt, pc, +50cm, mm, dd, cc, bp, or sp; but yours is a new one! +59I'll assume that you meant to say pt, for printer's points. +19Dimension too large +50I can't work with sizes bigger than about 19 feet. +46Continue and I'll use the largest value I can. +04plus +05minus +05width +06height +05depth +06number +12romannumeral +06string +07meaning +08fontname +07jobname +04 at +60Where was the left brace? You said something like `\def\a}', +43which I'm going to interpret as `\def\a{}'. +32You already have nine parameters +45I'm going to ignore the # sign you just used. +41Parameters must be numbered consecutively +57I've inserted the digit you should have used after the #. +36Type `1' to delete what you did use. +42Illegal parameter number in definition of +41You meant to type ## instead of #, right? +56Or maybe a } was forgotten somewhere earlier, and things +58are all screwed up? I'm going to assume that you meant ##. +49*** (cannot \read from terminal in nonstop modes) +18File ended within +33This \read has unbalanced braces. +02if +05ifcat +05ifnum +05ifdim +05ifodd +07ifvmode +07ifhmode +07ifmmode +07ifinner +06ifvoid +06ifhbox +06ifvbox +03ifx +05ifeof +06iftrue +07iffalse +06ifcase +02fi +02or +04else +06Extra +44I'm ignoring this; it doesn't match any \if. +06{true} +07{false} +23Missing = inserted for +48I was expecting to see `<', `=', or `>'. Didn't. +06{case +04.fmt +15input file name +19I can't find file ` +23I can't write on file ` +02'. +04.tex +20Please type another +45*** (job aborted, file error in nonstop mode) +04.dvi +20file name for output +06texput +04.log +02** +20transcript file name +02 +08nullfont +05Font +08 scaled +36 not loadable: Bad metric (TFM) file +42 not loadable: Metric (TFM) file not found +50I wasn't able to read the size data for this font, +40so I will ignore the font specification. +48[Wizards can fix TFM files using TFtoPL/PLtoTF.] +46You might try inserting a different font spec; +57e.g., type `I\font<same font id>=<substitute font name>'. +04.tfm +33 not loaded: Not enough room left +52I'm afraid I won't be able to make use of this font, +55because my memory for character-size data is too small. +51If you're really stuck, ask a wizard to enlarge me. +58Or maybe try `I\font<same font id>=<name of loaded font>'. +23Missing font identifier +42I was looking for a control sequence whose +42current meaning has been defined by \font. +10 has only +21 fontdimen parameters +51To increase the number of font parameters, you must +53use \fontdimen immediately after the \font is loaded. +11font memory +31Missing character: There is no +09 in font +12 TeX output +08vlistout +31Completed box being shipped out +21Memory usage before: +08 after: +19; still untouched: +31Huge page cannot be shipped out +50The page just created is more than 18 feet tall or +58more than 18 feet wide, so I suspect something went wrong. +35The following box has been deleted: +19No pages of output. +18Output written on +05 page +02, +08 bytes). +02to +06spread +09Underfull +05Loose +16 \hbox (badness +38) has occurred while \output is active +24) in paragraph at lines +24) in alignment at lines +02-- +19) detected at line +16Overfull \hbox ( +11pt too wide +21Tight \hbox (badness +05vpack +16 \vbox (badness +16Overfull \vbox ( +11pt too high +21Tight \vbox (badness +02{} +12displaystyle +09textstyle +11scriptstyle +17scriptscriptstyle +14Unknown style! +07mathord +06mathop +07mathbin +07mathrel +08mathopen +09mathclose +09mathpunct +09mathinner +08overline +09underline +04left +05right +06limits +08nolimits +20fraction, thickness +09= default +17, left-delimiter +18, right-delimiter +25 is undefined (character +54Somewhere in the math formula just ended, you used the +60stated character from an undefined font family. For example, +58plain TeX doesn't allow \it or \sl in subscripts. Proceed, +52and I'll try to forget that I needed that character. +06mlist1 +06mlist2 +06mlist3 +640234000122*4000133**3**344*0400400*000000234000111*1111112341011 +06mlist4 +12 inside $$'s +53Displays can use special alignments (like \eqalignno) +57only if nothing but the alignment itself is between $$'s. +58So I've deleted the formulas that preceded this alignment. +04span +02cr +04crcr +11endtemplate +24alignment tab character +40Missing # inserted in alignment preamble +50There should be exactly one # between &'s, when an +56\halign or \valign is being set up. In this case you had +47none, so I've put one in; maybe that will work. +29Only one # is allowed per tab +49more than one, so I'm ignoring all but the first. +04endv +40Extra alignment tab has been changed to +52You have given more \span or & marks than there were +58in the preamble to the \halign or \valign now in progress. +50So I'll assume that you meant to type \cr instead. +09256 spans +06align1 +06align0 +44Infinite glue shrinkage found in a paragraph +52The paragraph just ended includes some glue that has +54infinite shrinkability, e.g., `\hskip 0pt minus 1fil'. +54Such glue doesn't belong there---it allows a paragraph +59of any length to fit on one line. But it's safe to proceed, +55since the offensive shrinkability has been made finite. +05disc1 +05disc2 +02@@ +07: line +03 t= +06 -> @@ +07 via @@ +03 b= +03 p= +03 d= +10@firstpass +11@secondpass +14@emergencypass +09paragraph +05disc3 +05disc4 +13line breaking +05HYPH( +11hyphenation +16 will be flushed +48Hyphenation exceptions must contain only letters +51and hyphens. But continue; I'll forgive and forget. +12Not a letter +50Letters in \hyphenation words must have \lccode>0. +47Proceed; I'll ignore the character I just read. +20exception dictionary +18pattern memory ops +31pattern memory ops per language +14pattern memory +13Too late for +08patterns +53All patterns must be given before typesetting begins. +04Bad +17(See Appendix H.) +09Nonletter +17Duplicate pattern +07pruning +09vertbreak +48Infinite glue shrinkage found in box being split +52The box you are \vsplitting contains some infinitely +57shrinkable glue, e.g., `\vss' or `\vskip 0pt minus 1fil'. +59Such glue doesn't belong there; but you can safely proceed, +06vsplit +09 needs a +04vbox +44The box you are trying to split is an \hbox. +49I can't split such a box, so I'll leave it alone. +08pagegoal +09pagetotal +11pagestretch +14pagefilstretch +15pagefillstretch +16pagefilllstretch +10pageshrink +09pagedepth +04fill +05filll +17### current page: +28 (held over for next output) +13total height +13 goal height +06 adds +03, # +12 might split +15%% goal height= +12, max depth= +38Insertions can only be added to a vbox +40Tut tut: You're trying to \insert into a +41\box register that now contains an \hbox. +47Proceed, and I'll discard its present contents. +04page +45Infinite glue shrinkage found on current page +52The page about to be output contains some infinitely +03 g= +03 c= +38Infinite glue shrinkage inserted from +53The correction glue for page breaking with insertions +52must have finite shrinkability. But you may proceed, +07% split +04 to +15255 is not void +53You shouldn't use \box255 except in \output routines. +14Output loop--- +24 consecutive dead cycles +57I've concluded that your \output is awry; it never does a +55\shipout, so I'm shipping \box255 out myself. Next time +58increase \maxdeadcycles if you want me to be more patient! +25Unbalanced output routine +58Your sneaky output routine has problematic {'s and/or }'s. +41I can't handle that very well; good luck. +33Output routine didn't use all of +43Your \output commands should empty \box255, +34e.g., by saying `\shipout\box255'. +43Proceed; I'll discard its present contents. +18Missing $ inserted +56I've inserted a begin-math/end-math symbol since I think +48you left one out. Proceed, with fingers crossed. +05' in +50Sorry, but I'm not programmed to handle this case; +45I'll just pretend that you didn't ask for it. +49If you're in the wrong mode, you might be able to +58return to the right one by typing `I}' or `I$' or `I\par'. +03end +04dump +05hskip +04hfil +05hfill +03hss +07hfilneg +05vskip +04vfil +05vfill +03vss +07vfilneg +52I've inserted something that you may have forgotten. +32(See the <inserted text> above.) +48With luck, this will get me unwedged. But if you +55really didn't forget anything, try typing `2' now; then +56my insertion and my current dilemma will both disappear. +06right. +58Things are pretty mixed up, but I think the worst is over. +12Too many }'s +42You've closed more groups than you opened. +51Such booboos are generally harmless, so keep going. +10rightbrace +22Extra }, or forgotten +58I've deleted a group-closing symbol because it seems to be +59spurious, as in `$x}$'. But perhaps the } is legitimate and +59you forgot something else, as in `\hbox{$x}'. In such cases +58the way to recover is to insert both the forgotten and the +40deleted material, e.g., by typing `I$}'. +08moveleft +09moveright +05raise +05lower +04copy +07lastbox +04vtop +04hbox +07shipout +07leaders +08cleaders +08xleaders +35Leaders not followed by proper glue +56You should say `\leaders <box or rule><hskip or vskip>'. +50I found the <box or rule>, but there's no suitable +48<hskip or vskip>, so I'm ignoring these leaders. +34Sorry; this \lastbox will be void. +58Sorry...I usually can't take things from the current page. +37This \lastbox will therefore be void. +21Missing `to' inserted +48I'm working on `\vsplit<box number> to <dimen>'; +31will look for the <dimen> next. +31A <box> was supposed to be here +57I was expecting to see \hbox or \vbox or \copy or \box or +59something like that. So you might find something missing in +53your output. But keep trying; you can fix this later. +06indent +08noindent +26' here except with leaders +52To put a horizontal rule in an hbox or an alignment, +56you should use \leaders or \hrulefill (see The TeXbook). +10You can't +45I'm changing to \insert0; box 255 is special. +32Try `I\vskip-\lastskip' instead. +31Try `I\kern-\lastkern' instead. +46Perhaps you can make the output routine do it. +09unpenalty +06unkern +06unskip +06unhbox +07unhcopy +06unvbox +07unvcopy +34Incompatible list can't be unboxed +35Sorry, Pandora. (You sneaky devil.) +58I refuse to unbox an \hbox in vertical mode or vice versa. +40And I can't open any boxes in math mode. +13Illegal math +54Sorry: The third part of a discretionary break must be +57empty, in math formulas. I had to delete your third part. +30Discretionary list is too long +50Wow---I never thought anybody would tweak me here. +56You can't seriously need such a huge discretionary list? +27Improper discretionary list +54Discretionary lists must contain only boxes and kerns. +53The following discretionary sublist has been deleted: +18Missing } inserted +45I've put in what seems to be necessary to fix +44the current column of the current alignment. +43Try to go on, since this might almost work. +10Misplaced +55I can't figure out why you would want to use a tab mark +50here. If you just want an ampersand, the remedy is +52simple: Just type `I\&' now. But if some right brace +52up above has ended a previous alignment prematurely, +52you're probably due for more error messages, and you +57might try typing `S' now just to see what is salvageable. +57or \cr or \span just now. If something like a right brace +46I expect to see \noalign only after the \cr of +49an alignment. Proceed, and I'll ignore this case. +56I expect to see \omit only after tab marks or the \cr of +53I'm guessing that you meant to end an alignment here. +50I'm ignoring this, since I wasn't doing a \csname. +04eqno +05leqno +13displaylimits +42Limit controls must follow a math operator +57I'm ignoring this misplaced \limits or \nolimits command. +30Missing delimiter (. inserted) +52I was expecting to see something like `(' or `\{' or +55`\}' here. If you typed, e.g., `{' instead of `\{', you +57should probably delete the `{' by typing `1' now, so that +52braces don't get unbalanced. Otherwise just proceed. +54Acceptable delimiters are characters whose \delcode is +58nonnegative, or you can use `\delimiter <delimiter code>'. +11Please use +25 for accents in math mode +55I'm changing \accent to \mathaccent here; wish me luck. +59(Accents are not the same in formulas as they are in text.) +18Double superscript +43I treat `x^1^2' essentially like `x^1{}^2'. +16Double subscript +43I treat `x_1_2' essentially like `x_1{}_2'. +05above +04over +04atop +15abovewithdelims +14overwithdelims +14atopwithdelims +35Ambiguous; you need another { and } +55I'm ignoring this fraction specification, since I don't +52know whether a construction like `x \over y \over z' +53means `{x \over y} \over z' or `x \over {y \over z}'. +49I'm ignoring a \right that had no matching \left. +47Math formula deleted: Insufficient symbol fonts +50Sorry, but I can't typeset math unless \textfont 2 +50and \scriptfont 2 and \scriptscriptfont 2 have all +50the \fontdimen values needed in math symbol fonts. +50Math formula deleted: Insufficient extension fonts +50Sorry, but I can't typeset math unless \textfont 3 +50and \scriptfont 3 and \scriptscriptfont 3 have all +53the \fontdimen values needed in math extension fonts. +31Display math should end with $$ +59The `$' that I just saw supposedly matches a previous `$$'. +49So I shall assume that you typed `$$' both times. +07display +19Missing $$ inserted +04long +05outer +06global +03def +04gdef +04edef +04xdef +06prefix +29You can't use a prefix with ` +55I'll pretend you didn't say \long or \outer or \global. +06' or ` +08' with ` +49I'll pretend you didn't say \long or \outer here. +33Missing control sequence inserted +52Please don't say `\def cs{...}', say `\def\cs{...}'. +59I've inserted an inaccessible control sequence so that your +60definition will be completed without mixing me up too badly. +53You can recover graciously from this error, if you're +42careful; see exercise 27.2 in The TeXbook. +12inaccessible +03let +09futurelet +07chardef +11mathchardef +08countdef +08dimendef +07skipdef +09muskipdef +07toksdef +44You should have said `\read<number> to \cs'. +34I'm going to look for the \cs now. +14Invalid code ( +29), should be in the range 0.. +21), should be at most +54I'm going to use 0 instead of that illegal code value. +02by +19Arithmetic overflow +50I can't carry out that multiplication or division, +33since the result is out of range. +55I'm forgetting what you said and not changing anything. +57Sorry, \setbox is not allowed after \halign in a display, +45or between \accent and an accented character. +16Bad space factor +47I allow only values in the range 1..32767 here. +37I allow only nonnegative values here. +37Patterns can be loaded only by INITEX +10hyphenchar +08skewchar +04FONT +02at +06scaled +20Improper `at' size ( +21pt), replaced by 10pt +50I can only handle fonts at positive sizes that are +56less than 2048pt, so I've changed what you said to 10pt. +12select font +13errorstopmode +06openin +07closein +07message +10errmessage +31(That was another \errmessage.) +50This error message was generated by an \errmessage +43command, so I can't give any explicit help. +54Pretend that you're Hercule Poirot: Examine all clues, +41and deduce the truth by order and method. +09lowercase +09uppercase +04show +07showbox +07showthe +09showlists +57This isn't an error message; I'm just \showing something. +46Type `I\show...' to show more (e.g., \show\cs, +43\showthe\count10, \showbox255, \showlists). +54And type `I\tracingonline=1\show...' to show boxes and +57lists on your terminal as well as in the transcript file. +02> +09undefined +05macro +10long macro +11outer macro +17outer endtemplate +06> \box +02OK +26 (see the transcript file) +09 (INITEX) +29You can't dump inside a group +24`{...\dump}' is a no-no. +25 strings of total length +43 memory locations dumped; current usage is +30 multiletter control sequences +24 words of font info for +15 preloaded font +05\font +22 hyphenation exception +27Hyphenation trie of length +05 has +03 op +08 out of +14 for language +19 (preloaded format= +16format file name +26Beginning to dump on file +22Transcript written on +02 ) +13end occurred +24inside a group at level +05when +09 on line +16 was incomplete) +52(see the transcript file for additional information) +35(\dump is performed only by INITEX) +21debug # (-1 to exit): +07openout +08closeout +07special +09immediate +11setlanguage +20[unknown extension!] +04ext1 +12 (hyphenmin +08whatsit? +04ext2 +04ext3 +08endwrite +24Unbalanced write command +59On this page there's a \write with fewer real {'s than }'s. +04ext4 +16output file name +*461251401 diff --git a/systems/knuth/local/tex/trip1.in b/systems/knuth/local/tex/trip1.in new file mode 100644 index 0000000000..a93fd916c0 --- /dev/null +++ b/systems/knuth/local/tex/trip1.in @@ -0,0 +1,2 @@ + +\input trip diff --git a/systems/knuth/local/tex/trip2.in b/systems/knuth/local/tex/trip2.in new file mode 100644 index 0000000000..205d5cd650 --- /dev/null +++ b/systems/knuth/local/tex/trip2.in @@ -0,0 +1 @@ + &trip trip diff --git a/systems/knuth/local/texpaths.h b/systems/knuth/local/texpaths.h new file mode 100644 index 0000000000..1e3c02230f --- /dev/null +++ b/systems/knuth/local/texpaths.h @@ -0,0 +1,26 @@ +/* + * This file defines the default paths that will be used for TeX software. + * (These paths are used if the user's environment doesn't specify paths + * in TEXINPUTS, TEXFONTS, TEXBASES, or TEXPOOL.) + * + * Paths should be colon-separated and no longer than MAXINPATHCHARS-1 + * (for defaultinputpath) or MAXOTHPATHCHARS (for other default paths). + */ + +#define MAXINPATHCHARS 700 /* maximum number of chars in an input path */ + +#define defaultinputpath ".:..:/home/tex/local/lib:/home/tex/dist/lib" + /* this should always start with "." */ + +#define MAXOTHPATHCHARS 200 /* other paths should be much shorter */ + +#define defaultfontpath "/home/fonts" + /* it is probably best not to include "." here to prevent confusion + by spooled device drivers that think they know where the fonts + really are */ + +#define defaultformatpath ".:/home/tex/local/tex" + +#define defaultpoolpath ".:/home/tex/local/tex" + + diff --git a/systems/knuth/local/texware-sparc/Makefile b/systems/knuth/local/texware-sparc/Makefile new file mode 100644 index 0000000000..3478169052 --- /dev/null +++ b/systems/knuth/local/texware-sparc/Makefile @@ -0,0 +1,39 @@ +# Make executable files for this workstation, using the master TeX sources + +PFLAGS= -O -I.. -temp=. +CFLAGS= -O -I.. +PC= time pc + +all: pooltype tftopl pltotf dvitype + +%.p: %.ch + tangle ../../dist/texware/$*.web $*.ch + mv ../../dist/texware/$*.p . + +%.ch: ../../dist/texware/%.web + touch $*.ch + +%.o: %.p + ${PC} ${PFLAGS} -c $*.p + +pooltype: pooltype.o + ${PC} ${PFLAGS} -o pooltype pooltype.o + +tftopl: tftopl.o access.o + ${PC} ${PFLAGS} -o tftopl tftopl.o access.o + +pltotf: pltotf.o access.o + ${PC} ${PFLAGS} -o pltotf pltotf.o access.o + +dvitype: dvitype.o dvityext.o dvityext.h + ${PC} ${PFLAGS} -o dvitype dvitype.o dvityext.o + +dvityext.o: dvityext.c ../h00vars.h ../texpaths.h + +access.o: access.c + +install: # doit make install "PROG=dvitype" + mv $(PROG) /usr/local/bin/$(PROG) + +clean: + rm -f *.p *.o *~ ../../dist/texware/*.pool diff --git a/systems/knuth/local/texware-sparc/access.c b/systems/knuth/local/texware-sparc/access.c new file mode 100644 index 0000000000..af3e5de5e2 --- /dev/null +++ b/systems/knuth/local/texware-sparc/access.c @@ -0,0 +1,19 @@ +#include "h00vars.h" /* defines Pascal I/O structure */ + +#define namelength 100 /* must agree with tftopl.ch and pltotf.ch */ + +bool testreadaccess(fn) + char *fn; +{ + register char *p; + + fn[namelength-1] = ' '; + p = fn; + while (*p++ != ' '); + p--; + *p = '\0'; + if (access(fn,4)==0) { + *p = ' '; return(TRUE);} + else {*p = ' '; return(FALSE);} +} + diff --git a/systems/knuth/local/texware-sparc/dvityext.c b/systems/knuth/local/texware-sparc/dvityext.c new file mode 100644 index 0000000000..38c1d45159 --- /dev/null +++ b/systems/knuth/local/texware-sparc/dvityext.c @@ -0,0 +1,150 @@ +/* External procedures for dvitype */ +/* Written by: H. Trickey, 2/19/83 (adapted from TeX's ext.c) */ + +#include "texpaths.h" /* defines default TEXFONTS path */ +#include "h00vars.h" /* defines Pascal I/O structure */ + +char *fontpath; + +char *getenv(); + +/* + * setpaths is called to set up the pointer fontpath + * as follows: if the user's environment has a value for TEXFONTS + * then use it; otherwise, use defaultfontpath. + */ +setpaths() +{ + register char *envpath; + + if ((envpath = getenv("TEXFONTS")) != NULL) + fontpath = envpath; + else + fontpath = defaultfontpath; +} + +#define namelength 100 /* should agree with dvitype.ch */ +extern char curname[],realnameoffile[]; /* these have size namelength */ + +/* + * testaccess(amode,filepath) + * + * Test whether or not the file whose name is in the global curname + * can be opened for reading (if mode=READACCESS) + * or writing (if mode=WRITEACCESS). + * + * The filepath argument is one of the ...FILEPATH constants defined below. + * If the filename given in curname does not begin with '/', we try + * prepending all the ':'-separated areanames in the appropriate path to the + * filename until access can be made, if it ever can. + * + * The realnameoffile global array will contain the name that yielded an + * access success. + */ + +#define READACCESS 4 +#define WRITEACCESS 2 + +#define NOFILEPATH 0 +#define FONTFILEPATH 3 + +bool +testaccess(amode,filepath) + int amode,filepath; +{ + register bool ok; + register char *p; + char *curpathplace; + int f; + + switch(filepath) { + case NOFILEPATH: curpathplace = NULL; break; + case FONTFILEPATH: curpathplace = fontpath; break; + } + if (curname[0]=='/') /* file name has absolute path */ + curpathplace = NULL; + do { + packrealnameoffile(&curpathplace); + if (amode==READACCESS) + /* use system call "access" to see if we could read it */ + if (access(realnameoffile,READACCESS)==0) ok = TRUE; + else ok = FALSE; + else { + /* WRITEACCESS: use creat to see if we could create it, but close + the file again if we're OK, to let pc open it for real */ + f = creat(realnameoffile,0666); + if (f>=0) ok = TRUE; + else ok = FALSE; + if (ok) + close(f); + } + } while (!ok && curpathplace != NULL); + if (ok) { /* pad realnameoffile with blanks, as Pascal wants */ + for (p = realnameoffile; *p != '\0'; p++) + /* nothing: find end of string */ ; + while (p < &(realnameoffile[namelength])) + *p++ = ' '; + } + return (ok); +} + +/* + * packrealnameoffile(cpp) makes realnameoffile contain the directory at *cpp, + * followed by '/', followed by the characters in curname up until the + * first blank there, and finally a '\0'. The cpp pointer is left pointing + * at the next directory in the path. + * But: if *cpp == NULL, then we are supposed to use curname as is. + */ +packrealnameoffile(cpp) + char **cpp; +{ + register char *p,*realname; + + realname = realnameoffile; + if ((p = *cpp)!=NULL) { + while ((*p != ':') && (*p != '\0')) { + *realname++ = *p++; + if (realname == &(realnameoffile[namelength-1])) + break; + } + if (*p == '\0') *cpp = NULL; /* at end of path now */ + else *cpp = p+1; /* else get past ':' */ + *realname++ = '/'; /* separate the area from the name to follow */ + } + /* now append curname to realname... */ + p = curname; + while (*p != ' ') { + if (realname >= &(realnameoffile[namelength-1])) { + fprintf(stderr,"! Full file name is too long\n"); + break; + } + *realname++ = *p++; + } + *realname = '\0'; +} + +int flength(filep) + register struct iorec *filep; +{ + register FILE *iop; /* stdio-style FILE pointer */ + register long pos; /* current file position */ + register int len; /* the file length */ + + iop = filep->fbuf; + pos = ftell(iop); + fseek(iop,0L,2); + len = ftell(iop); + fseek(iop,pos,0); + return(len); +} + +bseek(filep,cnt) + register struct iorec *filep; + int cnt; +{ + register FILE *iop; /* stdio-style FILE pointer */ + + iop = filep->fbuf; + fseek(iop,(long)cnt,0); +} + diff --git a/systems/knuth/local/texware-sparc/dvityext.h b/systems/knuth/local/texware-sparc/dvityext.h new file mode 100644 index 0000000000..d177f6fe7e --- /dev/null +++ b/systems/knuth/local/texware-sparc/dvityext.h @@ -0,0 +1,11 @@ +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; diff --git a/systems/knuth/local/texware-sparc/dvitype.ch b/systems/knuth/local/texware-sparc/dvitype.ch new file mode 100644 index 0000000000..a2ce230dd7 --- /dev/null +++ b/systems/knuth/local/texware-sparc/dvitype.ch @@ -0,0 +1,497 @@ +% Change file for the DVItype processor, for use on Berkeley UNIX systems. +% This file was created by Howard Trickey, CSD.Trickey@SCORE, and modified +% by Pavel Curtis, Pavel@Cornell. + +% History: +% ?? (HT) Original version. +% 4/4/83 (PC) Merged with Pavel's change file and made to work with the +% version 1.0 of DVItype released with version 0.95 of TeX in +% February, 1983. +% 4/18 (PC) Added changes to module 47 so that it would work the same +% when input was a file (or pipe) as with a terminal. +% 6/29 (HWT) Brought up to version 1.1 as released with version 0.99 of +% TeX, with new change file format +% 7/28 (HWT) Brought up to version 2 as released with version 0.999. +% Only the banner changes. +% 11/21 (HWT) Brought up to version 2.2 as released with version 1.0. +% 2/19/84 (HWT) Made it use TEXFONTS environment. +% 3/23/84 (HWT) Brought up to version 2.3. +% 7/11/84 (HWT) Brought up to version 2.6 as released with version 1.1. +% 8/4/84 (RKF) To version 2.7 +% 9/3/85 (RKF) To version 2.8 +% 12/5/87 (PAM) To version 2.9 +% 8/10/89 (don) Cosmetic change for SunOS; moved usage test +% 10/15/89 (don) Fixed input_ln so that initial newline isn't lost +% 10/18/89 (don) Enabled random reading +% 10/30/89 (don) To version 3 +% 11/18/89 (don) To version 3.1 +% 1/2/90 (don) To version 3.2 +% 5/17/90 (don) To version 3.3 +% 9/6/90 (don) To version 3.4 +% 3/7/95 (don) To version 3.5 +% 12/28/95 (don) To version 3.6 +% 12/23/96 (don) Identified the TFM file that was missing + +% The section numbers used in this file refer to those in the standard +% TeXware report (CS1097). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [0] WEAVE: print changes only +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +\pageno=\contentspagenumber \advance\pageno by 1 +@y +\pageno=\contentspagenumber \advance\pageno by 1 +\let\maybe=\iffalse +\def\title{DVI$\,$\lowercase{type} changes for SunOS} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1] Change banner string +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d banner=='This is DVItype, Version 3.6' {printed when the program starts} +@y +@d banner=='This is DVItype, Version 3.6 for SunOS' + {printed when the program starts} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [2] Use default case statement feature of SunOS Pascal +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d othercases == others: {default for cases not listed explicitly} +@y +@d othercases == otherwise {default for cases not listed explicitly} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3] Change filenames in program statement; add #include statement +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d print(#)==write(#) +@d print_ln(#)==write_ln(#) + +@p program DVI_type(@!dvi_file,@!output); +@y +For Berkeley {\mc UNIX}, we need the name |output| for the dialog, so make +the output come out on a file called |'dvitype.out'|. + +@d print(#)==write(dvityout,#) +@d print_ln(#)==write_ln(dvityout,#) + +@p program DVI_type(@!input,@!output); +@z + +@x +var @<Globals in the outer block@>@/ +@y +var @<Globals in the outer block@>@/ +@\@=#include "dvityext.h"@>@\ {declarations for external C procedures} +@z + +@x + begin print_ln(banner);@/ +@y + begin + setpaths; {read environment, to find TEXFONTS, if there} + rewrite(dvityout,'dvitype.out'); {prepare typescript for output} + print_ln(banner);@/ +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [5] Increase name_length +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!name_length=50; {a file name shouldn't be longer than this} +@y +@!name_length=100; {a file name shouldn't be longer than this} +@z + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [21] Change definition of 'byte_file' to correct subrange +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +We shall stick to simple \PASCAL\ in this program, for reasons of clarity, +even if such simplicity is sometimes unrealistic. + +@<Types...@>= +@!eight_bits=0..255; {unsigned one-byte quantity} +@!byte_file=packed file of eight_bits; {files that contain binary data} +@y +On Berkeley {\mc UNIX}, we have to use |-128..127| for byte files, as +explained in the \TeX\ changes. + +@<Types...@>= +@!eight_bits=0..255; {unsigned one-byte quantity} +@!byte_file=packed file of -128..127; {files that contain binary data} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [23] Fix up opening the binary files +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p procedure open_dvi_file; {prepares to read packed bytes in |dvi_file|} +begin reset(dvi_file); +cur_loc:=0; +end; +@# +procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|} +begin reset(tfm_file,cur_name); +end; +@y +On Berkeley {\mc UNIX}, the |eof| testing won't work. +We use the external |test_access| procedure, which also does path searching +based on the user's environment or the default path. + +@d read_access_mode=4 {``read'' mode for |test_access|} +@d write_access_mode=2 {``write'' mode for |test_access|} + +@d no_file_path=0 {no path searching should be done} +@d font_file_path=3 {path specifier for \.{TFM} files} + +@p procedure open_dvi_file; {prepares to read packed bytes in |dvi_file|} +begin argv(1, cur_name); + if test_access(read_access_mode,no_file_path) then + begin dvi_name:=real_name_of_file; reset(dvi_file,dvi_name) + end + else begin + write_ln('DVI file not found'); + jump_out; + end; + cur_loc:=0; +end; +@# +procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|} +begin +if test_access(read_access_mode,font_file_path) then + reset(tfm_file,real_name_of_file) +else begin + write_ln('TFM file not found: ',cur_name); + jump_out +end; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [24] Declare real_name_of_file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +|dvi_file|, and |cur_name| is a string variable that will be set to the +current font metric file name before |open_tfm_file| is called. + +@<Glob...@>= +@!cur_loc:integer; {where we are about to look, in |dvi_file|} +@!cur_name:packed array[1..name_length] of char; {external name, + with no lower case letters} +@y +|dvi_file|, and |cur_name| is a string variable that will be set to the +current font metric file name before |open_tfm_file| is called. +Under UNIX, we also have a |real_name_of_file| string, that gets +set by the external |test_access| procedure after path searching. + +@<Glob...@>= +@!cur_loc:integer; {where we are about to look, in |dvi_file|} +@!cur_name,@!real_name_of_file,@!dvi_name:packed array[1..name_length] of char; + {external name} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [26] Fix read_tfm_word to read bytes properly +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p procedure read_tfm_word; +begin read(tfm_file,b0); read(tfm_file,b1); +read(tfm_file,b2); read(tfm_file,b3); +end; +@y +@d get_tfm_byte(#) == + read(tfm_file,byte); if byte < 0 then # := byte + 256 else # := byte; + +@p procedure read_tfm_word; +var byte : -128..127; +begin +get_tfm_byte(b0); +get_tfm_byte(b1); +get_tfm_byte(b2); +get_tfm_byte(b3); +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [27] Fix up functions to read DVI bytes +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p function get_byte:integer; {returns the next byte, unsigned} +var b:eight_bits; +begin if eof(dvi_file) then get_byte:=0 +else begin read(dvi_file,b); incr(cur_loc); get_byte:=b; + end; +end; +@# +function signed_byte:integer; {returns the next byte, signed} +var b:eight_bits; +begin read(dvi_file,b); incr(cur_loc); +if b<128 then signed_byte:=b @+ else signed_byte:=b-256; +end; +@# +function get_two_bytes:integer; {returns the next two bytes, unsigned} +var a,@!b:eight_bits; +begin read(dvi_file,a); read(dvi_file,b); +cur_loc:=cur_loc+2; +get_two_bytes:=a*256+b; +end; +@# +function signed_pair:integer; {returns the next two bytes, signed} +var a,@!b:eight_bits; +begin read(dvi_file,a); read(dvi_file,b); +cur_loc:=cur_loc+2; +if a<128 then signed_pair:=a*256+b +else signed_pair:=(a-256)*256+b; +end; +@# +function get_three_bytes:integer; {returns the next three bytes, unsigned} +var a,@!b,@!c:eight_bits; +begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c); +cur_loc:=cur_loc+3; +get_three_bytes:=(a*256+b)*256+c; +end; +@# +function signed_trio:integer; {returns the next three bytes, signed} +var a,@!b,@!c:eight_bits; +begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c); +cur_loc:=cur_loc+3; +if a<128 then signed_trio:=(a*256+b)*256+c +else signed_trio:=((a-256)*256+b)*256+c; +end; +@# +function signed_quad:integer; {returns the next four bytes, signed} +var a,@!b,@!c,@!d:eight_bits; +begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c); read(dvi_file,d); +cur_loc:=cur_loc+4; +if a<128 then signed_quad:=((a*256+b)*256+c)*256+d +else signed_quad:=(((a-256)*256+b)*256+c)*256+d; +end; +@y +@p function get_byte:integer; {returns the next byte, unsigned} +var b:-128..127; +begin if eof(dvi_file) then get_byte:=0 +else begin read(dvi_file,b); incr(cur_loc); + if b < 0 then get_byte := b + 256 else get_byte:=b; + end; +end; +@# +function signed_byte:integer; {returns the next byte, signed} +var b:-128..127; +begin read(dvi_file,b); incr(cur_loc); +signed_byte:=b; +end; +@# +function get_two_bytes:integer; {returns the next two bytes, unsigned} +var a,b:integer; +begin a := get_byte; b := get_byte; +get_two_bytes:=a*256+b; +end; +@# +function signed_pair:integer; {returns the next two bytes, signed} +var a,@!b:integer; +begin a := signed_byte; b := get_byte; +signed_pair:=a*256+b +end; +@# +function get_three_bytes:integer; {returns the next three bytes, unsigned} +var a,@!b,@!c:integer; +begin a := get_byte; b := get_byte; c := get_byte; +get_three_bytes:=(a*256+b)*256+c; +end; +@# +function signed_trio:integer; {returns the next three bytes, signed} +var a,@!b,@!c:integer; +begin a := signed_byte; b := get_byte; c := get_byte; +signed_trio:=(a*256+b)*256+c +end; +@# +function signed_quad:integer; {returns the next four bytes, signed} +var a,@!b,@!c,@!d:integer; +begin a := signed_byte; b := get_byte; c := get_byte; d := get_byte; +signed_quad:=((a*256+b)*256+c)*256+d +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [28] Redefine dvi_length() and move_to_byte(). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p function dvi_length:integer; +begin set_pos(dvi_file,-1); dvi_length:=cur_pos(dvi_file); +end; +@# +procedure move_to_byte(n:integer); +begin set_pos(dvi_file,n); cur_loc:=n; +end; +@y +@p function dvi_length:integer; +begin dvi_length:=flength(dvi_file); +end; +@# +procedure move_to_byte(n:integer); +begin bseek(dvi_file,n); cur_loc:=n; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [45] Define term_in and term_out and declare dvityout, first_input +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +and |term_out| for terminal output. +@^system dependencies@> + +@<Glob...@>= +@!buffer:array[0..terminal_line_length] of ASCII_code; +@!term_in:text_file; {the terminal, considered as an input file} +@!term_out:text_file; {the terminal, considered as an output file} +@y +and |term_out| for terminal output. +@^system dependencies@> + +@d term_in==input +@d term_out==output + +@<Glob...@>= +@!buffer:array[0..terminal_line_length] of ASCII_code; +@!dvityout:text; +@!first_input:boolean; {true until |input_ln| has been invoked} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [46] Define update_terminal +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d update_terminal == break(term_out) {empty the terminal output buffer} +@y +@d update_terminal == flush(term_out) {empty the terminal output buffer} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [47] Remove call to reset(term_in) and initial eoln test +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +begin update_terminal; reset(term_in); +if eoln(term_in) then read_ln(term_in); +@y +begin update_terminal; +if first_input then first_input:=false +else if eoln(term_in) then read_ln(term_in); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [50] Remove call to rewrite(term_out) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +begin rewrite(term_out); {prepare the terminal for output} +@y +begin +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [64] Set default_directory_name +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d default_directory_name=='TeXfonts:' {change this to the correct name} +@d default_directory_name_length=9 {change this to the correct length} + +@<Glob...@>= +@!default_directory:packed array[1..default_directory_name_length] of char; +@y +Actually, under UNIX the standard area is defined in an external +``texpaths.h'' file. And the users have a path searched for fonts, +by setting the TEXFONTS environment variable. +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [65] Remove initialization of now-defunct array +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ @<Set init...@>= +default_directory:=default_directory_name; +@y +@ (No initialization to be done. Keep this module to preserve numbering.) +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [66] Fix addition of ".tfm" suffix for portability and keep lowercase +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The string |cur_name| is supposed to be set to the external name of the +\.{TFM} file for the current font. This usually means that we need to +prepend the name of the default directory, and +to append the suffix `\.{.TFM}'. Furthermore, we change lower case letters +to upper case, since |cur_name| is a \PASCAL\ string. +@y +@ The string |cur_name| is supposed to be set to the external name of the +\.{TFM} file for the current font. This usually means that we need to, +at most sites, append the +suffix ``.tfm''. +@z + +@x +if p=0 then + begin for k:=1 to default_directory_name_length do + cur_name[k]:=default_directory[k]; + r:=default_directory_name_length; + end +else r:=0; +@y +r:=0; +@z + +@x + if (names[k]>="a")and(names[k]<="z") then + cur_name[r]:=xchr[names[k]-@'40] + else cur_name[r]:=xchr[names[k]]; + end; +cur_name[r+1]:='.'; cur_name[r+2]:='T'; cur_name[r+3]:='F'; cur_name[r+4]:='M' +@y + cur_name[r]:=xchr[names[k]]; + end; +cur_name[r+1]:='.'; cur_name[r+2]:='t'; cur_name[r+3]:='f'; cur_name[r+4]:='m' +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [105] Reopen DVI file after postamble has been checked +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +if not eof(dvi_file) then bad_dvi('signature in byte ',cur_loc-1:1, +@.signature...should be...@> + ' should be 223') +else if cur_loc<k+4 then + print_ln('not enough signature bytes at end of file (', +@.not enough signature bytes...@> + cur_loc-k:1,')'); +@y +if not eof(dvi_file) then bad_dvi('signature in byte ',cur_loc-1:1, +@.signature...should be...@> + ' should be 223'); +if cur_loc<k+4 then + print_ln('not enough signature bytes at end of file (', +@.not enough signature bytes...@> + cur_loc-k:1,')'); +reset(dvi_file,dvi_name) {the Berkeley UNIX routines have closed the file} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [107] Check usage; also print newline at end of program +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +dialog; {set up all the options} +@y +if argc <> 2 then + begin write_ln('Usage: dvitype <dvi-file>'); goto final_end; + end; +first_input:=true; dialog; {set up all the options} +@z +@x +final_end:end. +@y +final_end: print_ln(' '); end. +@z diff --git a/systems/knuth/local/texware-sparc/pltotf.ch b/systems/knuth/local/texware-sparc/pltotf.ch new file mode 100644 index 0000000000..8134f8dc46 --- /dev/null +++ b/systems/knuth/local/texware-sparc/pltotf.ch @@ -0,0 +1,135 @@ +% Change file for the PLtoTF processor, for use on Berkeley UNIX systems. +% This file was created by Pavel Curtis, Pavel@Cornell. + +% History: +% 4/4/83 (PC) Original version, made to work with version 1.2 of PLtoTF. +% 4/16 (PC) Brought up to version 1.3 of PLtoTF. +% 6/30 (HWT) Revised changefile format for version 1.7 Tangle +% 7/28 (HWT) Brought up to version 2 +% 11/21 (HWT) Brought up to version 2.1 +% 9/3/85 (RKF) Brought up to version 2.3 +% 8/7/89 (don) Cosmetic change for SunOS +% 9/16/89 (don) Cosmetic change for version 3 +% 10/16/89 (don) Avoided core dump when PL file can't be opened +% 11/18/89 (don) Brought up to version 3.1 +% 9/6/90 (don) Version 3.3 +% 3/25/91 (don) Version 3.4 +% 3/6/95 (don) Version 3.5 + +% The section numbers used in this file refer to the current nunmbers, +% and, where different, also to those in the standard TeXware report (CS1097). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [0] WEAVE: print changes only +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +\pageno=\contentspagenumber \advance\pageno by 1 +@y +\pageno=\contentspagenumber \advance\pageno by 1 +\let\maybe=\iffalse +\def\title{PL\lowercase{to}TF changes for SunOS} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1] Change banner string +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d banner=='This is PLtoTF, Version 3.5' {printed when the program starts} +@y +@d banner=='This is PLtoTF, Version 3.5 for SunOS' + {printed when the program starts} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [2] Fix filenames in program statement; add `final_end' label; add access +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p program PLtoTF(@!pl_file,@!tfm_file,@!output); +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +@y +@d final_end==9999 + +@p program PLtoTF(@!output); +label final_end; +const @<Constants in the outer block@>@/ +type UNIX_file_name=packed array[1..100] of char; + @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +function testreadaccess(var fn:UNIX_file_name):boolean; external; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [6] Open PL file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +reset(pl_file); +@y +if argc < 3 then begin + print_ln('Usage: pltotf <pl-file> <tfm-file>'); + goto final_end; +end; +argv(1, pl_name); +if testreadaccess(pl_name) then reset(pl_file, pl_name) +else begin print_ln('I can''t read the PL file!'); goto final_end; + end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [15] Change type of tfm_file and declare extra TFM-file variables +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!tfm_file:packed file of 0..255; +@y +@!tfm_file : packed file of -128..127; +@!tmp : 0..255; +@!tfm_name, +@!pl_name : UNIX_file_name; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [16] Open TFM file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ On some systems you may have to do something special to write a +packed file of bytes. For example, the following code didn't work +when it was first tried at Stanford, because packed files have to be +opened with a special switch setting on the \PASCAL\ that was used. +@^system dependencies@> + +@<Set init...@>= +rewrite(tfm_file); +@y +@ On some systems you may have to do something special to write a +packed file of bytes. +@^system dependencies@> + +@<Set init...@>= +argv(2, tfm_name); +rewrite(tfm_file, tfm_name); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [127, was 119] Change TFM-byte output to fix ranges +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d out(#)==write(tfm_file,#) +@y +@d out(#)==begin + tmp := #; + if tmp > 127 then + write(tfm_file, tmp - 256) + else + write(tfm_file, tmp) + end +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [147, was 135] Define label `final_end'; print newline at end of program +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +end. +@y +final_end: print_ln(' '); end. +@z diff --git a/systems/knuth/local/texware-sparc/pooltype.ch b/systems/knuth/local/texware-sparc/pooltype.ch new file mode 100644 index 0000000000..94241bd9c6 --- /dev/null +++ b/systems/knuth/local/texware-sparc/pooltype.ch @@ -0,0 +1,70 @@ +% Change file for the Pooltype processor +% Hacked together by don on 8/7/89 since the old pooltype.ch seems lost +% 8-bit modifications made 9/11/89 + +% Module numbers are from the standard TeXware report (CS1097) + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [0] WEAVE: print changes only +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +\pageno=\contentspagenumber \advance\pageno by 1 +@y +\pageno=\contentspagenumber \advance\pageno by 1 +\let\maybe=\iffalse +\def\title{POOLTYPE changes for SunOS} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [2] Program header +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +@x +@p program POOLtype(@!pool_file,@!output); +@y +@p program POOLtype(@!output); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [12] Permissiveness +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +for i:=0 to @'37 do xchr[i]:=' '; +for i:=@'177 to @'377 do xchr[i]:=' '; +@y +for i:=0 to @'37 do xchr[i]:=chr(i); +for i:=@'177 to @'377 do xchr[i]:=chr(i); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [15] Beginning of main program +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +@x +@p begin initialize;@/ +@y +@p begin if argc < 2 then + abort('Usage: pooltype <pool-file>'); +initialize;@/ +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [18] Input file declaration needs also a string +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +@x +@!pool_file:packed file of text_char; +@y +@!pool_file:packed file of text_char; +@!pool_name: array[1..100] of char; {not 100 percent robust} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [19] Opening the input file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +@x +reset(pool_file); xsum:=false; +@y +argv(1,pool_name); reset(pool_file,pool_name); xsum:=false; +@z diff --git a/systems/knuth/local/texware-sparc/tftopl.ch b/systems/knuth/local/texware-sparc/tftopl.ch new file mode 100644 index 0000000000..cb18739546 --- /dev/null +++ b/systems/knuth/local/texware-sparc/tftopl.ch @@ -0,0 +1,206 @@ +% Change file for the TFtoPL processor, for use on Berkeley UNIX systems. +% This file was created by Pavel Curtis, Pavel@Cornell. + +% History: +% 4/4/83 (PC) Original version, made to work with version 1.0 of TFtoPL, +% released with version 0.96 of TeX in February, 1983. +% 4/16 (PC) Brought up to version 1.0 released with version 0.97 of TeX +% in April, 1983. +% 6/30 (HWT) Revised changefile format, for use with version 1.7 Tangle. +% 7/28 (HWT) Brought up to version 2 +% 11/21 (HWT) Brought up to version 2.1 +% 3/24/84 (HWT) Brought up to version 2.2 +% 7/12/84 (HWT) Brought up to version 2.3 +% 9/3/85 (RKF) Brought up to version 2.4 +% 3/1/86 (PAM) Cosmetic upgrade to Version 2.5 +% 8/7/89 (don) Cosmetic change for SunOS +% 9/15/89 (don) Cosmetic upgrade to Version 3 +% 10/18/89 (don) Avoid core dump when the file isn't present +% 11/18/89 (don) Brought up to version 3.1 + +% The section numbers used in this file refer to the current numbers, +% and, where different, also to those in the standard TeXware report (CS1097). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [0] WEAVE: print changes only +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +\pageno=\contentspagenumber \advance\pageno by 1 +@y +\pageno=\contentspagenumber \advance\pageno by 1 +\let\maybe=\iffalse +\def\title{TF\lowercase{to}PL changes for SunOS} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1] Change banner string +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d banner=='This is TFtoPL, Version 3.1' {printed when the program starts} +@y +@d banner=='This is TFtoPL, Version 3.1 for SunOS' + {printed when the program starts} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [2] Fix files in program statement; add external access procedure +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p program TFtoPL(@!tfm_file,@!pl_file,@!output); +label @<Labels in the outer block@>@/ +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +@y +@p program TFtoPL(@!output); +label @<Labels in the outer block@>@/ +const @<Constants in the outer block@>@/ +type UNIX_file_name=packed array[1..100] of char; + @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +function testreadaccess(var fn:UNIX_file_name):boolean; external; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [6] Fix declaration of tfm_file; declare extra TFM-file variables +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!tfm_file:packed file of 0..255; +@y +@!tfm_file:packed file of -128..127; {files that contain binary data} +@!tfm_name:UNIX_file_name; +@!tfm_byte:integer; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [7] Open TFM file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ On some systems you may have to do something special to read a +packed file of bytes. For example, the following code didn't work +when it was first tried at Stanford, because packed files have to be +opened with a special switch setting on the \PASCAL\ that was used. +@^system dependencies@> + +@<Set init...@>= +reset(tfm_file); +@y +@ On some systems you may have to do something special to read a +packed file of bytes. + +@<Set init...@>= +if argc < 3 then begin + print_ln('Usage: tftopl <tfm-file> <pl-file>'); + goto final_end; +end; +argv(1, tfm_name); +if testreadaccess(tfm_name) then reset(tfm_file, tfm_name) +else begin print_ln('I can''t read the TFM file!'); goto final_end; + end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [16] Declare pl_name +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!pl_file:text; +@y +@!pl_file:text; +@!pl_name: array[1..100] of char; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [17] Open PL file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ @<Set init...@>= +rewrite(pl_file); +@y +@ @<Set init...@>= +argv(2, pl_name); +rewrite(pl_file, pl_name); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [20] Fix reading of TFM bytes. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@<Read the whole input file@>= +read(tfm_file,tfm[0]); +if tfm[0]>127 then abort('The first byte of the input file exceeds 127!'); +@.The first byte...@> +if eof(tfm_file) then abort('The input file is only one byte long!'); +@.The input...one byte long@> +read(tfm_file,tfm[1]); lf:=tfm[0]*@'400+tfm[1]; +if lf=0 then + abort('The file claims to have length zero, but that''s impossible!'); +@.The file claims...@> +if 4*lf-1>tfm_size then abort('The file is bigger than I can handle!'); +@.The file is bigger...@> +for tfm_ptr:=2 to 4*lf-1 do + begin if eof(tfm_file) then + abort('The file has fewer bytes than it claims!'); +@.The file has fewer bytes...@> + read(tfm_file,tfm[tfm_ptr]); + end; +if not eof(tfm_file) then + begin print_ln('There''s some extra junk at the end of the TFM file,'); +@.There's some extra junk...@> + print_ln('but I''ll proceed as if it weren''t there.'); + end +@y +@d fget==begin get(tfm_file); + tfm_byte:=tfm_file^; + if tfm_byte<0 then tfm_byte:=tfm_byte+256; + end +@d fbyte==tfm_byte +@d read_sixteen(#)==begin #:=fbyte; + if #>127 then abort; + fget; #:=#*@'400+fbyte; + end +@d store_four_quarters(#)==begin fget; a:=fbyte; qw.b0:=qi(a); + fget; b:=fbyte; qw.b1:=qi(b); + fget; c:=fbyte; qw.b2:=qi(c); + fget; d:=fbyte; qw.b3:=qi(d); + #:=qw; + end + +@<Read the whole input file@>= + {Prime the pump} +tfm_byte:=tfm_file^; +if tfm_byte<0 then tfm_byte:=tfm_byte+256; + +tfm[0]:=fbyte; fget; +if tfm[0]>127 then abort('The first byte of the input file exceeds 127!'); +@.The first byte...@> +if eof(tfm_file) then abort('The input file is only one byte long!'); +@.The input...one byte long@> +tfm[1]:=fbyte; fget; lf:=tfm[0]*@'400+tfm[1]; +if lf=0 then + abort('The file claims to have length zero, but that''s impossible!'); +@.The file claims...@> +if 4*lf-1>tfm_size then abort('The file is bigger than I can handle!'); +@.The file is bigger...@> +for tfm_ptr:=2 to 4*lf-1 do + begin if eof(tfm_file) then + abort('The file has fewer bytes than it claims!'); +@.The file has fewer bytes...@> + tfm[tfm_ptr]:=fbyte; fget; + end; +if not eof(tfm_file) then + begin print_ln('There''s some extra junk at the end of the TFM file,'); +@.There's some extra junk...@> + print_ln('but I''ll proceed as if it weren''t there.'); + end + +@^system dependencies@>@^Changes for Berkeley {\mc UNIX}@> +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [99, was 88] Add printing of newline at end of program +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +final_end:end. +@y +final_end: print_ln(' '); end. +@z diff --git a/systems/knuth/local/texware/Makefile b/systems/knuth/local/texware/Makefile new file mode 100644 index 0000000000..db7ad06a2c --- /dev/null +++ b/systems/knuth/local/texware/Makefile @@ -0,0 +1,40 @@ +# Make executable files for this workstation, using the master TeX sources + +PFLAGS= -g -I.. +CFLAGS= -g -I.. +PC= gpc + +all: pooltype tftopl pltotf dvitype + +%.p: %.ch + tangle ../../dist/texware/$*.web $*.ch +# the next line formerly necessary; but not with Linux's (Web2C) tangle +# mv ../../dist/texware/$*.p . + +%.ch: ../../dist/texware/%.web + touch $*.ch + +%.o: %.p + ${PC} ${PFLAGS} -c $*.p + +pooltype: pooltype.o dvityext.o dvityext.h + pc ${PFLAGS} -o pooltype pooltype.o dvityext.o + +tftopl: tftopl.o dvityext.o dvityext.h + pc ${PFLAGS} -o tftopl tftopl.o dvityext.o + +pltotf: pltotf.o dvityext.o dvityext.h + ${PC} ${PFLAGS} -o pltotf pltotf.o dvityext.o + +dvitype: dvitype.o dvityext.o dvityext.h + ${PC} ${PFLAGS} -o dvitype dvitype.o dvityext.o + +dvityext.o: dvityext.c ../GPCtypes.h ../texpaths.h + +install: # doit make install "PROG=dvitype" + mv $(PROG) /usr/local/bin/$(PROG) + +clean: +# rm -f *.p *.o *~ ../../dist/texware/*.pool + rm -f *.p *.o *~ *.pool core + diff --git a/systems/knuth/local/texware/access.c b/systems/knuth/local/texware/access.c new file mode 100644 index 0000000000..6fde385791 --- /dev/null +++ b/systems/knuth/local/texware/access.c @@ -0,0 +1,17 @@ +#define namelength 100 /* must agree with tftopl.ch and pltotf.ch */ + +bool testreadaccess(fn) + char *fn; +{ + register char *p; + + fn[namelength-1] = ' '; + p = fn; + while (*p++ != ' '); + p--; + *p = '\0'; + if (access(fn,4)==0) { + *p = ' '; return(TRUE);} + else {*p = ' '; return(FALSE);} +} + diff --git a/systems/knuth/local/texware/dvityext.c b/systems/knuth/local/texware/dvityext.c new file mode 100644 index 0000000000..61f20538a5 --- /dev/null +++ b/systems/knuth/local/texware/dvityext.c @@ -0,0 +1,176 @@ +/* External procedures for texware */ +/* Written by Don Knuth, 2000.04.29, based on Trickey's vintage 1983 code */ + +#include "../texpaths.h" /* defines default TEXFONTS path */ +#include "../GPCtypes.h" /* defines Pascal I/O structure */ +#include <string.h> +#include <unistd.h> +#include <sys/stat.h> + +#define namelength 100 /* should agree with .ch files */ + +void Argv(int n, char* str) +{ + register char *s,*t; + if (n<0 || n>=_p_argc) return; + s=_p_argv[n]; + if (strlen(s) >= namelength-5) { + str[0]='\0'; return; /* we don't want it too long */ + } + for (t=str; *s; s++,t++) *t=*s; + *t='\0'; +} + +bool Testreadaccess(char *fn) +{ + return access(fn,R_OK)? FALSE: TRUE; +} + +char *fontpath; + +char *getenv(); + +/* + * setpaths is called to set up the pointer fontpath + * as follows: if the user's environment has a value for TEXFONTS + * then use it; otherwise, use defaultfontpath. + */ +Setpaths() +{ + register char *envpath; + + if ((envpath = getenv("TEXFONTS")) != NULL) + fontpath = envpath; + else + fontpath = defaultfontpath; +} + +#define namelength 100 /* should agree with dvitype.ch */ +char Curname[namelength],Realnameoffile[namelength]; +#define curname Curname +#define realnameoffile Realnameoffile + +/* + * testaccess(amode,filepath) + * + * Test whether or not the file whose name is in the global curname + * can be opened for reading (if mode=READACCESS) + * or writing (if mode=WRITEACCESS). + * + * The filepath argument is one of the ...FILEPATH constants defined below. + * If the filename given in curname does not begin with '/', we try + * prepending all the ':'-separated areanames in the appropriate path to the + * filename until access can be made, if it ever can. + * + * The realnameoffile global array will contain the name that yielded an + * access success. + */ + +#define READACCESS 4 +#define WRITEACCESS 2 + +#define NOFILEPATH 0 +#define FONTFILEPATH 3 + +bool +Testaccess(int amode,int filepath) +{ + register bool ok; + register char *p; + char *curpathplace; + int f; + + switch(filepath) { + case NOFILEPATH: curpathplace = NULL; break; + case FONTFILEPATH: curpathplace = fontpath; break; + } + if (curname[0]=='/') /* file name has absolute path */ + curpathplace = NULL; + do { + packrealnameoffile(&curpathplace); + if (amode==READACCESS) + /* use system call "access" to see if we could read it */ + if (access(realnameoffile,R_OK)==0) ok = TRUE; + else ok = FALSE; + else { + /* WRITEACCESS: use creat to see if we could create it, but close + the file again if we're OK, to let pc open it for real */ + f = creat(realnameoffile,0666); + if (f>=0) { ok = TRUE; close(f);} + else ok = FALSE; + } + } while (!ok && curpathplace != NULL); + return (ok); +} + +/* + * packrealnameoffile(cpp) makes realnameoffile contain the directory at *cpp, + * followed by '/', followed by the characters in curname up until the + * first blank there, and finally a '\0'. The cpp pointer is left pointing + * at the next directory in the path. + * But: if *cpp == NULL, then we are supposed to use curname as is. + */ +packrealnameoffile(cpp) + char **cpp; +{ + register char *p,*realname; + + realname = realnameoffile; + if ((p = *cpp)!=NULL) { + while ((*p != ':') && (*p != '\0')) { + *realname++ = *p++; + if (realname == &(realnameoffile[namelength-1])) + break; + } + if (*p == '\0') *cpp = NULL; /* at end of path now */ + else *cpp = p+1; /* else get past ':' */ + *realname++ = '/'; /* separate the area from the name to follow */ + } + /* now append curname to realname... */ + p = curname; + while (*p) { + if (realname >= &(realnameoffile[namelength-1])) { + fprintf(stderr,"! Full file name is too long\n"); + break; + } + *realname++ = *p++; + } + *realname = '\0'; +} + +int Flength(FDR filep) +{ + register FILE *iop; /* stdio-style FILE pointer */ + register long pos; /* current file position */ + register int len; /* the file length */ + + iop = filep->FilJfn; + pos = ftell(iop); + fseek(iop,0L,SEEK_END); + len = ftell(iop); + fseek(iop,pos,0); + return len; +} + +void Bseek(FDR filep,int cnt) +{ + register FILE *iop; /* stdio-style FILE pointer */ + + iop = filep->FilJfn; + fseek(iop,(long)cnt,SEEK_SET); +} + +void Flushstdout() +{ + fflush(stdout); +} + +void Readbyte(FDR filep, unsigned char *x) +{ + /* reads a character WITHOUT using the Pascal runtime buffers etc */ + register int c; + c=getc(filep->FilJfn); + if (c==EOF) c=0; + *x=c; +} + diff --git a/systems/knuth/local/texware/dvityext.h b/systems/knuth/local/texware/dvityext.h new file mode 100644 index 0000000000..ab9a63da75 --- /dev/null +++ b/systems/knuth/local/texware/dvityext.h @@ -0,0 +1,17 @@ +argc:asmname '_p_argc' Integer; + +procedure argv(no:Integer;var str:UNIXfilename); external; + +function testreadaccess(var a:UNIXfilename):boolean; external; + +procedure setpaths; external; + +function testaccess(accessmode:integer; filepath:integer): boolean; external; + +function flength(var f: bytefile):integer; external; + +procedure bseek(var f: bytefile; loc: integer); external; + +procedure flushstdout; external; + +procedure readbyte(var f: bytefile; var v: ByteCard); external; diff --git a/systems/knuth/local/texware/dvitype.ch b/systems/knuth/local/texware/dvitype.ch new file mode 100644 index 0000000000..4857a60d62 --- /dev/null +++ b/systems/knuth/local/texware/dvitype.ch @@ -0,0 +1,468 @@ +% Change file for the DVItype processor, for use with GNU Pascal. +% (by Don Knuth, based on prior work by Trickey and Curtis) +% (see ../texware-sparc for complete details of their changes) + +% History: +% 2000.04.29 Original version. + +% The section numbers used in this file refer to those in the standard +% TeXware report (CS1097). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [0] WEAVE: print changes only +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +\pageno=\contentspagenumber \advance\pageno by 1 +@y +\pageno=\contentspagenumber \advance\pageno by 1 +\let\maybe=\iffalse +\def\title{DVI$\,$\lowercase{type} changes for GNU Pascal} +@z +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1] Change banner string +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d banner=='This is DVItype, Version 3.6' {printed when the program starts} +@y +@d banner=='This is DVItype, Version 3.6 for Linux' + {printed when the program starts} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [2] Use default case statement feature of ISO extended Pascal +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d othercases == others: {default for cases not listed explicitly} +@y +@d othercases == otherwise {default for cases not listed explicitly} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3] Change filenames in program statement; add #include statement +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d print(#)==write(#) +@d print_ln(#)==write_ln(#) + +@p program DVI_type(@!dvi_file,@!output); +@y +For {\mc UNIX}, we need the name |output| for the dialog, so make +the output come out on a file called |'dvitype.out'|. + +@d print(#)==write(dvityout,#) +@d print_ln(#)==write_ln(dvityout,#) + +@p program DVI_type(@!input,@!output); +@z + +@x +var @<Globals in the outer block@>@/ +@y +var @<Globals in the outer block@>@/ +@\@=#include "dvityext.h"@>@\ {declarations for external C procedures} +@z + +@x + begin print_ln(banner);@/ +@y + begin + setpaths; {read environment, to find TEXFONTS, if there} + rewrite(dvityout,'dvitype.out'); {prepare typescript for output} + print_ln(banner);@/ +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [5] Increase name_length +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!name_length=50; {a file name shouldn't be longer than this} +@y +@!name_length=100; {a file name shouldn't be longer than this} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [9] make the compiler recognize a text file as text +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d text_char == char {the data type of characters in text files} +@d first_text_char=0 {ordinal number of the smallest element of |text_char|} +@d last_text_char=127 {ordinal number of the largest element of |text_char|} + +@<Types...@>= +@!text_file=packed file of text_char; +@y +@d text_char == char {the data type of characters in text files} +@d first_text_char=0 {ordinal number of the smallest element of |text_char|} +@d last_text_char=255 {ordinal number of the largest element of |text_char|} +@d text_file==text + +@<Types...@>= +@!UNIX_filename=packed array[1..name_length] of char; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [21] Change definition of 'eight_bits' +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!eight_bits=0..255; {unsigned one-byte quantity} +@y +@!eight_bits=ByteCard; {unsigned one-byte quantity} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [23] Fix up opening the binary files +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p procedure open_dvi_file; {prepares to read packed bytes in |dvi_file|} +begin reset(dvi_file); +cur_loc:=0; +end; +@# +procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|} +begin reset(tfm_file,cur_name); +end; +@y +We use the external |test_access| procedure, which also does path searching +based on the user's environment or the default path. + +@d read_access_mode=4 {``read'' mode for |test_access|} +@d write_access_mode=2 {``write'' mode for |test_access|} + +@d no_file_path=0 {no path searching should be done} +@d font_file_path=3 {path specifier for \.{TFM} files} + +@p procedure open_dvi_file; {prepares to read packed bytes in |dvi_file|} +begin argv(1, cur_name); + if test_access(read_access_mode,no_file_path) then + begin dvi_name:=real_name_of_file; reset(dvi_file,dvi_name) + end + else begin + write_ln('DVI file not found'); + jump_out; + end; + cur_loc:=0; +end; +@# +procedure open_tfm_file; {prepares to read packed bytes in |tfm_file|} +begin +if test_access(read_access_mode,font_file_path) then + reset(tfm_file,real_name_of_file) +else begin + write_ln('TFM file not found: ',cur_name); + jump_out +end; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [24] Declare real_name_of_file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +|dvi_file|, and |cur_name| is a string variable that will be set to the +current font metric file name before |open_tfm_file| is called. + +@<Glob...@>= +@!cur_loc:integer; {where we are about to look, in |dvi_file|} +@!cur_name:packed array[1..name_length] of char; {external name, + with no lower case letters} +@y +|dvi_file|, and |cur_name| is a string variable that will be set to the +current font metric file name before |open_tfm_file| is called. +Under UNIX, we also have a |real_name_of_file| string, that gets +set by the external |test_access| procedure after path searching. + +@<Glob...@>= +@!cur_loc:integer; {where we are about to look, in |dvi_file|} +@!cur_name,@!real_name_of_file:external UNIX_filename; {external names} +@!dvi_name:UNIX_filename; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [27] Use C library to read bytes +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p function get_byte:integer; {returns the next byte, unsigned} +var b:eight_bits; +begin if eof(dvi_file) then get_byte:=0 +else begin read(dvi_file,b); incr(cur_loc); get_byte:=b; + end; +end; +@# +function signed_byte:integer; {returns the next byte, signed} +var b:eight_bits; +begin read(dvi_file,b); incr(cur_loc); +if b<128 then signed_byte:=b @+ else signed_byte:=b-256; +end; +@# +function get_two_bytes:integer; {returns the next two bytes, unsigned} +var a,@!b:eight_bits; +begin read(dvi_file,a); read(dvi_file,b); +cur_loc:=cur_loc+2; +get_two_bytes:=a*256+b; +end; +@# +function signed_pair:integer; {returns the next two bytes, signed} +var a,@!b:eight_bits; +begin read(dvi_file,a); read(dvi_file,b); +cur_loc:=cur_loc+2; +if a<128 then signed_pair:=a*256+b +else signed_pair:=(a-256)*256+b; +end; +@# +function get_three_bytes:integer; {returns the next three bytes, unsigned} +var a,@!b,@!c:eight_bits; +begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c); +cur_loc:=cur_loc+3; +get_three_bytes:=(a*256+b)*256+c; +end; +@# +function signed_trio:integer; {returns the next three bytes, signed} +var a,@!b,@!c:eight_bits; +begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c); +cur_loc:=cur_loc+3; +if a<128 then signed_trio:=(a*256+b)*256+c +else signed_trio:=((a-256)*256+b)*256+c; +end; +@# +function signed_quad:integer; {returns the next four bytes, signed} +var a,@!b,@!c,@!d:eight_bits; +begin read(dvi_file,a); read(dvi_file,b); read(dvi_file,c); read(dvi_file,d); +cur_loc:=cur_loc+4; +if a<128 then signed_quad:=((a*256+b)*256+c)*256+d +else signed_quad:=(((a-256)*256+b)*256+c)*256+d; +end; +@y +The GNU Pascal runtime programs for |read| keeps its own +buffers, and this conflicts with the |move_to_byte| routine. +So we substitute our own function, |read_byte|. (Actually +the Pascal runtimes work fine if |random_reading| is false.) + +@p function get_byte:integer; {returns the next byte, unsigned} +var b:eight_bits; +begin read_byte(dvi_file,b); +incr(cur_loc); get_byte:=b; +end; +@# +function signed_byte:integer; {returns the next byte, signed} +var b:eight_bits; +begin read_byte(dvi_file,b); incr(cur_loc); +if b<128 then signed_byte:=b @+ else signed_byte:=b-256; +end; +@# +function get_two_bytes:integer; {returns the next two bytes, unsigned} +var a,@!b:eight_bits; +begin read_byte(dvi_file,a); read_byte(dvi_file,b); +cur_loc:=cur_loc+2; +get_two_bytes:=a*256+b; +end; +@# +function signed_pair:integer; {returns the next two bytes, signed} +var a,@!b:eight_bits; +begin read_byte(dvi_file,a); read_byte(dvi_file,b); +cur_loc:=cur_loc+2; +if a<128 then signed_pair:=a*256+b +else signed_pair:=(a-256)*256+b; +end; +@# +function get_three_bytes:integer; {returns the next three bytes, unsigned} +var a,@!b,@!c:eight_bits; +begin read_byte(dvi_file,a); read_byte(dvi_file,b); read_byte(dvi_file,c); +cur_loc:=cur_loc+3; +get_three_bytes:=(a*256+b)*256+c; +end; +@# +function signed_trio:integer; {returns the next three bytes, signed} +var a,@!b,@!c:eight_bits; +begin read_byte(dvi_file,a); read_byte(dvi_file,b); read_byte(dvi_file,c); +cur_loc:=cur_loc+3; +if a<128 then signed_trio:=(a*256+b)*256+c +else signed_trio:=((a-256)*256+b)*256+c; +end; +@# +function signed_quad:integer; {returns the next four bytes, signed} +var a,@!b,@!c,@!d:eight_bits; +begin read_byte(dvi_file,a); read_byte(dvi_file,b); read_byte(dvi_file,c); read_byte(dvi_file,d); +cur_loc:=cur_loc+4; +if a<128 then signed_quad:=((a*256+b)*256+c)*256+d +else signed_quad:=(((a-256)*256+b)*256+c)*256+d; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [28] Redefine dvi_length() and move_to_byte(). +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p function dvi_length:integer; +begin set_pos(dvi_file,-1); dvi_length:=cur_pos(dvi_file); +end; +@# +procedure move_to_byte(n:integer); +begin set_pos(dvi_file,n); cur_loc:=n; +end; +@y +@p function dvi_length:integer; +begin dvi_length:=flength(dvi_file); +end; +@# +procedure move_to_byte(n:integer); +begin bseek(dvi_file,n); cur_loc:=n; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [45] Define term_in and term_out and declare dvityout, first_input +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +and |term_out| for terminal output. +@^system dependencies@> + +@<Glob...@>= +@!buffer:array[0..terminal_line_length] of ASCII_code; +@!term_in:text_file; {the terminal, considered as an input file} +@!term_out:text_file; {the terminal, considered as an output file} +@y +and |term_out| for terminal output. +@^system dependencies@> + +@d term_in==input +@d term_out==output + +@<Glob...@>= +@!buffer:array[0..terminal_line_length] of ASCII_code; +@!dvityout:text; +@!first_input:boolean; {true until |input_ln| has been invoked} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [46] Define update_terminal +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d update_terminal == break(term_out) {empty the terminal output buffer} +@y +@d update_terminal == flush_stdout {empty the terminal output buffer} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [47] Remove call to reset(term_in) and initial eoln test +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +begin update_terminal; reset(term_in); +if eoln(term_in) then read_ln(term_in); +@y +begin update_terminal; +if first_input then first_input:=false +else if eoln(term_in) then read_ln(term_in); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [50] Remove call to rewrite(term_out) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +begin rewrite(term_out); {prepare the terminal for output} +@y +begin +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [64] Set default_directory_name +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d default_directory_name=='TeXfonts:' {change this to the correct name} +@d default_directory_name_length=9 {change this to the correct length} + +@<Glob...@>= +@!default_directory:packed array[1..default_directory_name_length] of char; +@y +Actually, under UNIX the standard area is defined in an external +``texpaths.h'' file. And the users have a path searched for fonts, +by setting the TEXFONTS environment variable. +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [65] Remove initialization of now-defunct array +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ @<Set init...@>= +default_directory:=default_directory_name; +@y +@ (No initialization to be done. Keep this module to preserve numbering.) +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [66] Fix addition of ".tfm" suffix for portability and keep lowercase +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The string |cur_name| is supposed to be set to the external name of the +\.{TFM} file for the current font. This usually means that we need to +prepend the name of the default directory, and +to append the suffix `\.{.TFM}'. Furthermore, we change lower case letters +to upper case, since |cur_name| is a \PASCAL\ string. +@y +@ The string |cur_name| is supposed to be set to the external name of the +\.{TFM} file for the current font. This usually means that we need to, +at most sites, append the +suffix ``.tfm''. +@z + +@x +if p=0 then + begin for k:=1 to default_directory_name_length do + cur_name[k]:=default_directory[k]; + r:=default_directory_name_length; + end +else r:=0; +@y +r:=0; +@z + +@x + if (names[k]>="a")and(names[k]<="z") then + cur_name[r]:=xchr[names[k]-@'40] + else cur_name[r]:=xchr[names[k]]; + end; +cur_name[r+1]:='.'; cur_name[r+2]:='T'; cur_name[r+3]:='F'; cur_name[r+4]:='M' +@y + cur_name[r]:=xchr[names[k]]; + end; +cur_name[r+1]:='.'; cur_name[r+2]:='t'; cur_name[r+3]:='f'; cur_name[r+4]:='m'; +cur_name[r+5]:=chr(0) +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [105] Reopen DVI file after postamble has been checked +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +if not eof(dvi_file) then bad_dvi('signature in byte ',cur_loc-1:1, +@.signature...should be...@> + ' should be 223') +else if cur_loc<k+4 then + print_ln('not enough signature bytes at end of file (', +@.not enough signature bytes...@> + cur_loc-k:1,')'); +@y +if not eof(dvi_file) then bad_dvi('signature in byte ',cur_loc-1:1, +@.signature...should be...@> + ' should be 223'); +if cur_loc<k+4 then + print_ln('not enough signature bytes at end of file (', +@.not enough signature bytes...@> + cur_loc-k:1,')'); +reset(dvi_file,dvi_name) {the UNIX routines may have closed the file} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [107] Check usage; also print newline at end of program +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +dialog; {set up all the options} +@y +if argc <> 2 then + begin write_ln('Usage: dvitype <dvi-file>'); goto final_end; + end; +first_input:=true; dialog; {set up all the options} +@z +@x +final_end:end. +@y +final_end: print_ln(' '); end. +@z diff --git a/systems/knuth/local/texware/dvitype.p b/systems/knuth/local/texware/dvitype.p new file mode 100644 index 0000000000..71262aa3d8 --- /dev/null +++ b/systems/knuth/local/texware/dvitype.p @@ -0,0 +1,604 @@ +{3:}program DVItype(input,output);label{4:}9999,30;{:4}const{5:} +maxfonts=100;maxwidths=10000;linelength=79;terminallinelength=150; +stacksize=100;namesize=1000;namelength=100;{:5}type{8:} +ASCIIcode=32..126;{:8}{9:} +UNIXfilename=packed array[1..namelength]of char;{:9}{21:} +eightbits=ByteCard;bytefile=packed file of eightbits;{:21}var{10:} +xord:array[char]of ASCIIcode;xchr:array[0..255]of char;{:10}{22:} +dvifile:bytefile;tfmfile:bytefile;{:22}{24:}curloc:integer; +curname,realnameoffile:external UNIXfilename;dviname:UNIXfilename;{:24} +{25:}b0,b1,b2,b3:eightbits;{:25}{30:} +fontnum:array[0..maxfonts]of integer; +fontname:array[0..maxfonts]of 1..namesize; +names:array[1..namesize]of ASCIIcode; +fontchecksum:array[0..maxfonts]of integer; +fontscaledsize:array[0..maxfonts]of integer; +fontdesignsize:array[0..maxfonts]of integer; +fontspace:array[0..maxfonts]of integer; +fontbc:array[0..maxfonts]of integer;fontec:array[0..maxfonts]of integer; +widthbase:array[0..maxfonts]of integer; +width:array[0..maxwidths]of integer;nf:0..maxfonts; +widthptr:0..maxwidths;{:30}{33:}inwidth:array[0..255]of integer; +tfmchecksum:integer;tfmdesignsize:integer;tfmconv:real;{:33}{39:} +pixelwidth:array[0..maxwidths]of integer;conv:real;trueconv:real; +numerator,denominator:integer;mag:integer;{:39}{41:}outmode:0..4; +maxpages:integer;resolution:real;newmag:integer;{:41}{42:} +startcount:array[0..9]of integer;startthere:array[0..9]of boolean; +startvals:0..9;count:array[0..9]of integer;{:42}{45:} +buffer:array[0..terminallinelength]of ASCIIcode;dvityout:text; +firstinput:boolean;{:45}{48:}bufptr:0..terminallinelength;{:48}{57:} +inpostamble:boolean;{:57}{67:}textptr:0..linelength; +textbuf:array[1..linelength]of ASCIIcode;{:67}{72:} +h,v,w,x,y,z,hh,vv:integer; +hstack,vstack,wstack,xstack,ystack,zstack:array[0..stacksize]of integer; +hhstack,vvstack:array[0..stacksize]of integer;{:72}{73:}maxv:integer; +maxh:integer;maxs:integer;maxvsofar,maxhsofar,maxssofar:integer; +totalpages:integer;pagecount:integer;{:73}{78:}s:integer;ss:integer; +curfont:integer;showing:boolean;{:78}{97:}oldbackpointer:integer; +newbackpointer:integer;started:boolean;{:97}{101:}postloc:integer; +firstbackpointer:integer;startloc:integer;afterpre:integer;{:101}{108:} +k,m,n,p,q:integer;{:108} +#include "dvityext.h" +procedure initialize;var i:integer;begin setpaths; +rewrite(dvityout,'dvitype.out'); +writeln(dvityout,'This is DVItype, Version 3.6 for Linux');{11:} +for i:=0 to 31 do xchr[i]:='?';xchr[32]:=' ';xchr[33]:='!'; +xchr[34]:='"';xchr[35]:='#';xchr[36]:='$';xchr[37]:='%';xchr[38]:='&'; +xchr[39]:='''';xchr[40]:='(';xchr[41]:=')';xchr[42]:='*';xchr[43]:='+'; +xchr[44]:=',';xchr[45]:='-';xchr[46]:='.';xchr[47]:='/';xchr[48]:='0'; +xchr[49]:='1';xchr[50]:='2';xchr[51]:='3';xchr[52]:='4';xchr[53]:='5'; +xchr[54]:='6';xchr[55]:='7';xchr[56]:='8';xchr[57]:='9';xchr[58]:=':'; +xchr[59]:=';';xchr[60]:='<';xchr[61]:='=';xchr[62]:='>';xchr[63]:='?'; +xchr[64]:='@';xchr[65]:='A';xchr[66]:='B';xchr[67]:='C';xchr[68]:='D'; +xchr[69]:='E';xchr[70]:='F';xchr[71]:='G';xchr[72]:='H';xchr[73]:='I'; +xchr[74]:='J';xchr[75]:='K';xchr[76]:='L';xchr[77]:='M';xchr[78]:='N'; +xchr[79]:='O';xchr[80]:='P';xchr[81]:='Q';xchr[82]:='R';xchr[83]:='S'; +xchr[84]:='T';xchr[85]:='U';xchr[86]:='V';xchr[87]:='W';xchr[88]:='X'; +xchr[89]:='Y';xchr[90]:='Z';xchr[91]:='[';xchr[92]:='\';xchr[93]:=']'; +xchr[94]:='^';xchr[95]:='_';xchr[96]:='`';xchr[97]:='a';xchr[98]:='b'; +xchr[99]:='c';xchr[100]:='d';xchr[101]:='e';xchr[102]:='f'; +xchr[103]:='g';xchr[104]:='h';xchr[105]:='i';xchr[106]:='j'; +xchr[107]:='k';xchr[108]:='l';xchr[109]:='m';xchr[110]:='n'; +xchr[111]:='o';xchr[112]:='p';xchr[113]:='q';xchr[114]:='r'; +xchr[115]:='s';xchr[116]:='t';xchr[117]:='u';xchr[118]:='v'; +xchr[119]:='w';xchr[120]:='x';xchr[121]:='y';xchr[122]:='z'; +xchr[123]:='{';xchr[124]:='|';xchr[125]:='}';xchr[126]:='~'; +for i:=127 to 255 do xchr[i]:='?';{:11}{12:} +for i:=0 to 255 do xord[chr(i)]:=32; +for i:=32 to 126 do xord[xchr[i]]:=i;{:12}{31:}nf:=0;widthptr:=0; +fontname[0]:=1;fontspace[maxfonts]:=0;fontbc[maxfonts]:=1; +fontec[maxfonts]:=0;{:31}{43:}outmode:=4;maxpages:=1000000;startvals:=0; +startthere[0]:=false;{:43}{58:}inpostamble:=false;{:58}{68:}textptr:=0; +{:68}{74:}maxv:=2147483548;maxh:=2147483548;maxs:=stacksize+1; +maxvsofar:=0;maxhsofar:=0;maxssofar:=0;pagecount:=0;{:74}{98:} +oldbackpointer:=-1;started:=false;{:98}end;{:3}{7:}procedure jumpout; +begin goto 9999;end;{:7}{23:}procedure opendvifile; +begin argv(1,curname); +if testaccess(4,0)then begin dviname:=realnameoffile; +reset(dvifile,dviname)end else begin writeln('DVI file not found'); +jumpout;end;curloc:=0;end;procedure opentfmfile; +begin if testaccess(4,3)then reset(tfmfile,realnameoffile)else begin +writeln('TFM file not found: ',curname);jumpout end;end;{:23}{26:} +procedure readtfmword;begin read(tfmfile,b0);read(tfmfile,b1); +read(tfmfile,b2);read(tfmfile,b3);end;{:26}{27:} +function getbyte:integer;var b:eightbits;begin readbyte(dvifile,b); +curloc:=curloc+1;getbyte:=b;end;function signedbyte:integer; +var b:eightbits;begin readbyte(dvifile,b);curloc:=curloc+1; +if b<128 then signedbyte:=b else signedbyte:=b-256;end; +function gettwobytes:integer;var a,b:eightbits; +begin readbyte(dvifile,a);readbyte(dvifile,b);curloc:=curloc+2; +gettwobytes:=a*256+b;end;function signedpair:integer;var a,b:eightbits; +begin readbyte(dvifile,a);readbyte(dvifile,b);curloc:=curloc+2; +if a<128 then signedpair:=a*256+b else signedpair:=(a-256)*256+b;end; +function getthreebytes:integer;var a,b,c:eightbits; +begin readbyte(dvifile,a);readbyte(dvifile,b);readbyte(dvifile,c); +curloc:=curloc+3;getthreebytes:=(a*256+b)*256+c;end; +function signedtrio:integer;var a,b,c:eightbits; +begin readbyte(dvifile,a);readbyte(dvifile,b);readbyte(dvifile,c); +curloc:=curloc+3; +if a<128 then signedtrio:=(a*256+b)*256+c else signedtrio:=((a-256)*256+ +b)*256+c;end;function signedquad:integer;var a,b,c,d:eightbits; +begin readbyte(dvifile,a);readbyte(dvifile,b);readbyte(dvifile,c); +readbyte(dvifile,d);curloc:=curloc+4; +if a<128 then signedquad:=((a*256+b)*256+c)*256+d else signedquad:=(((a +-256)*256+b)*256+c)*256+d;end;{:27}{28:}function dvilength:integer; +begin dvilength:=flength(dvifile);end;procedure movetobyte(n:integer); +begin bseek(dvifile,n);curloc:=n;end;{:28}{32:} +procedure printfont(f:integer);var k:0..namesize; +begin if f=maxfonts then write(dvityout,'UNDEFINED!')else begin for k:= +fontname[f]to fontname[f+1]-1 do write(dvityout,xchr[names[k]]);end;end; +{:32}{34:}function inTFM(z:integer):boolean;label 9997,9998,9999; +var k:integer;lh:integer;nw:integer;wp:0..maxwidths;alpha,beta:integer; +begin{35:}readtfmword;lh:=b2*256+b3;readtfmword;fontbc[nf]:=b0*256+b1; +fontec[nf]:=b2*256+b3; +if fontec[nf]<fontbc[nf]then fontbc[nf]:=fontec[nf]+1; +if widthptr+fontec[nf]-fontbc[nf]+1>maxwidths then begin writeln( +dvityout,'---not loaded, DVItype needs larger width table');goto 9998; +end;wp:=widthptr+fontec[nf]-fontbc[nf]+1;readtfmword;nw:=b0*256+b1; +if(nw=0)or(nw>256)then goto 9997; +for k:=1 to 3+lh do begin if eof(tfmfile)then goto 9997;readtfmword; +if k=4 then if b0<128 then tfmchecksum:=((b0*256+b1)*256+b2)*256+b3 else +tfmchecksum:=(((b0-256)*256+b1)*256+b2)*256+b3 else if k=5 then if b0< +128 then tfmdesignsize:=round(tfmconv*(((b0*256+b1)*256+b2)*256+b3))else +goto 9997;end;{:35};{36:} +if wp>0 then for k:=widthptr to wp-1 do begin readtfmword; +if b0>nw then goto 9997;width[k]:=b0;end;{:36};{37:}{38:} +begin alpha:=16;while z>=8388608 do begin z:=z div 2;alpha:=alpha+alpha; +end;beta:=256 div alpha;alpha:=alpha*z;end{:38}; +for k:=0 to nw-1 do begin readtfmword; +inwidth[k]:=(((((b3*z)div 256)+(b2*z))div 256)+(b1*z))div beta; +if b0>0 then if b0<255 then goto 9997 else inwidth[k]:=inwidth[k]-alpha; +end{:37};{40:}if inwidth[0]<>0 then goto 9997; +widthbase[nf]:=widthptr-fontbc[nf]; +if wp>0 then for k:=widthptr to wp-1 do if width[k]=0 then begin width[k +]:=2147483647;pixelwidth[k]:=0; +end else begin width[k]:=inwidth[width[k]]; +pixelwidth[k]:=round(conv*(width[k]));end{:40};widthptr:=wp;inTFM:=true; +goto 9999;9997:writeln(dvityout,'---not loaded, TFM file is bad'); +9998:inTFM:=false;9999:end;{:34}{44:}function startmatch:boolean; +var k:0..9;match:boolean;begin match:=true; +for k:=0 to startvals do if startthere[k]and(startcount[k]<>count[k]) +then match:=false;startmatch:=match;end;{:44}{47:}procedure inputln; +var k:0..terminallinelength;begin flushstdout; +if firstinput then firstinput:=false else if eoln(input)then readln( +input);k:=0; +while(k<terminallinelength)and not eoln(input)do begin buffer[k]:=xord[ +input^];k:=k+1;get(input);end;buffer[k]:=32;end;{:47}{49:} +function getinteger:integer;var x:integer;negative:boolean; +begin if buffer[bufptr]=45 then begin negative:=true;bufptr:=bufptr+1; +end else negative:=false;x:=0; +while(buffer[bufptr]>=48)and(buffer[bufptr]<=57)do begin x:=10*x+buffer[ +bufptr]-48;bufptr:=bufptr+1;end; +if negative then getinteger:=-x else getinteger:=x;end;{:49}{50:} +procedure dialog;label 1,2,3,4,5;var k:integer; +begin writeln(output,'This is DVItype, Version 3.6 for Linux');{51:} +1:write(output,'Output level (default=4, ? for help): ');outmode:=4; +inputln; +if buffer[0]<>32 then if(buffer[0]>=48)and(buffer[0]<=52)then outmode:= +buffer[0]-48 else begin write(output,'Type 4 for complete listing,'); +write(output,' 0 for errors and fonts only,'); +writeln(output,' 1 or 2 or 3 for something in between.');goto 1;end{:51} +;{52:}2:write(output,'Starting page (default=*): ');startvals:=0; +startthere[0]:=false;inputln;bufptr:=0;k:=0; +if buffer[0]<>32 then repeat if buffer[bufptr]=42 then begin startthere[ +k]:=false;bufptr:=bufptr+1;end else begin startthere[k]:=true; +startcount[k]:=getinteger;end; +if(k<9)and(buffer[bufptr]=46)then begin k:=k+1;bufptr:=bufptr+1; +end else if buffer[bufptr]=32 then startvals:=k else begin write(output, +'Type, e.g., 1.*.-5 to specify the '); +writeln(output,'first page with \count0=1, \count2=-5.');goto 2;end; +until startvals=k{:52};{53:} +3:write(output,'Maximum number of pages (default=1000000): '); +maxpages:=1000000;inputln;bufptr:=0; +if buffer[0]<>32 then begin maxpages:=getinteger; +if maxpages<=0 then begin writeln(output, +'Please type a positive number.');goto 3;end;end{:53};{54:} +4:write(output,'Assumed device resolution'); +write(output,' in pixels per inch (default=300/1): ');resolution:=300.0; +inputln;bufptr:=0;if buffer[0]<>32 then begin k:=getinteger; +if(k>0)and(buffer[bufptr]=47)and(buffer[bufptr+1]>48)and(buffer[bufptr+1 +]<=57)then begin bufptr:=bufptr+1;resolution:=k/getinteger; +end else begin write(output,'Type a ratio of positive integers;'); +writeln(output,' (1 pixel per mm would be 254/10).');goto 4;end;end{:54} +;{55:} +5:write(output,'New magnification (default=0 to keep the old one): '); +newmag:=0;inputln;bufptr:=0; +if buffer[0]<>32 then if(buffer[0]>=48)and(buffer[0]<=57)then newmag:= +getinteger else begin write(output, +'Type a positive integer to override '); +writeln(output,'the magnification in the DVI file.');goto 5;end{:55}; +{56:}writeln(dvityout,'Options selected:'); +write(dvityout,' Starting page = '); +for k:=0 to startvals do begin if startthere[k]then write(dvityout, +startcount[k]:1)else write(dvityout,'*'); +if k<startvals then write(dvityout,'.')else writeln(dvityout,' ');end; +writeln(dvityout,' Maximum number of pages = ',maxpages:1); +write(dvityout,' Output level = ',outmode:1); +case outmode of 0:writeln(dvityout, +' (showing bops, fonts, and error messages only)'); +1:writeln(dvityout,' (terse)');2:writeln(dvityout,' (mnemonics)'); +3:writeln(dvityout,' (verbose)'); +4:if true then writeln(dvityout,' (the works)')else begin outmode:=3; +writeln(dvityout,' (the works: same as level 3 in this DVItype)');end; +end; +writeln(dvityout,' Resolution = ',resolution:12:8,' pixels per inch'); +if newmag>0 then writeln(dvityout,' New magnification factor = ',newmag +/1000:8:3){:56};end;{:50}{59:}procedure definefont(e:integer); +var f:0..maxfonts;p:integer;n:integer;c,q,d,m:integer;r:0..namelength; +j,k:0..namesize;mismatch:boolean; +begin if nf=maxfonts then begin write(dvityout,' ', +'DVItype capacity exceeded (max fonts=',maxfonts:1,')!');jumpout;end; +fontnum[nf]:=e;f:=0;while fontnum[f]<>e do f:=f+1;{61:}c:=signedquad; +fontchecksum[nf]:=c;q:=signedquad;fontscaledsize[nf]:=q;d:=signedquad; +fontdesignsize[nf]:=d; +if(q<=0)or(d<=0)then m:=1000 else m:=round((1000.0*conv*q)/(trueconv*d)) +;p:=getbyte;n:=getbyte; +if fontname[nf]+n+p>namesize then begin write(dvityout,' ', +'DVItype capacity exceeded (name size=',namesize:1,')!');jumpout;end; +fontname[nf+1]:=fontname[nf]+n+p; +if showing then write(dvityout,': ')else write(dvityout,'Font ',e:1,': ' +); +if n+p=0 then write(dvityout,'null font name!')else for k:=fontname[nf] +to fontname[nf+1]-1 do names[k]:=getbyte;printfont(nf); +if not showing then if m<>1000 then write(dvityout,' scaled ',m:1){:61}; +if((outmode=4)and inpostamble)or((outmode<4)and not inpostamble)then +begin if f<nf then writeln(dvityout,'---this font was already defined!') +;end else begin if f=nf then writeln(dvityout, +'---this font wasn''t loaded before!');end;if f=nf then{62:}begin{66:} +for k:=1 to namelength do curname[k]:=' ';r:=0; +for k:=fontname[nf]to fontname[nf+1]-1 do begin r:=r+1; +if r+4>namelength then begin write(dvityout,' ', +'DVItype capacity exceeded (max font name length=',namelength:1,')!'); +jumpout;end;curname[r]:=xchr[names[k]];end;curname[r+1]:='.'; +curname[r+2]:='t';curname[r+3]:='f';curname[r+4]:='m'; +curname[r+5]:=chr(0){:66};opentfmfile; +if eof(tfmfile)then write(dvityout, +'---not loaded, TFM file can''t be opened!')else begin if(q<=0)or(q>= +134217728)then write(dvityout,'---not loaded, bad scale (',q:1,')!')else +if(d<=0)or(d>=134217728)then write(dvityout, +'---not loaded, bad design size (',d:1,')!')else if inTFM(q)then{63:} +begin fontspace[nf]:=q div 6; +if(c<>0)and(tfmchecksum<>0)and(c<>tfmchecksum)then begin writeln( +dvityout,'---beware: check sums do not agree!'); +writeln(dvityout,' (',c:1,' vs. ',tfmchecksum:1,')'); +write(dvityout,' ');end; +if abs(tfmdesignsize-d)>2 then begin writeln(dvityout, +'---beware: design sizes do not agree!'); +writeln(dvityout,' (',d:1,' vs. ',tfmdesignsize:1,')'); +write(dvityout,' ');end; +write(dvityout,'---loaded at size ',q:1,' DVI units'); +d:=round((100.0*conv*q)/(trueconv*d)); +if d<>100 then begin writeln(dvityout,' '); +write(dvityout,' (this font is magnified ',d:1,'%)');end;nf:=nf+1; +end{:63};end;if outmode=0 then writeln(dvityout,' ');end{:62}else{60:} +begin if fontchecksum[f]<>c then writeln(dvityout, +'---check sum doesn''t match previous definition!'); +if fontscaledsize[f]<>q then writeln(dvityout, +'---scaled size doesn''t match previous definition!'); +if fontdesignsize[f]<>d then writeln(dvityout, +'---design size doesn''t match previous definition!');j:=fontname[f]; +k:=fontname[nf]; +if fontname[f+1]-j<>fontname[nf+1]-k then mismatch:=true else begin +mismatch:=false; +while j<fontname[f+1]do begin if names[j]<>names[k]then mismatch:=true; +j:=j+1;k:=k+1;end;end; +if mismatch then writeln(dvityout, +'---font name doesn''t match previous definition!');end{:60};end;{:59} +{69:}procedure flushtext;var k:0..linelength; +begin if textptr>0 then begin if outmode>0 then begin write(dvityout,'[' +);for k:=1 to textptr do write(dvityout,xchr[textbuf[k]]); +writeln(dvityout,']');end;textptr:=0;end;end;{:69}{70:} +procedure outtext(c:ASCIIcode); +begin if textptr=linelength-2 then flushtext;textptr:=textptr+1; +textbuf[textptr]:=c;end;{:70}{75:} +function firstpar(o:eightbits):integer; +begin case o of 0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21, +22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45, +46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69, +70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93, +94,95,96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112, +113,114,115,116,117,118,119,120,121,122,123,124,125,126,127:firstpar:=o +-0;128,133,235,239,243:firstpar:=getbyte; +129,134,236,240,244:firstpar:=gettwobytes; +130,135,237,241,245:firstpar:=getthreebytes; +143,148,153,157,162,167:firstpar:=signedbyte; +144,149,154,158,163,168:firstpar:=signedpair; +145,150,155,159,164,169:firstpar:=signedtrio; +131,132,136,137,146,151,156,160,165,170,238,242,246:firstpar:=signedquad +;138,139,140,141,142,247,248,249,250,251,252,253,254,255:firstpar:=0; +147:firstpar:=w;152:firstpar:=x;161:firstpar:=y;166:firstpar:=z; +171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188, +189,190,191,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206, +207,208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,224, +225,226,227,228,229,230,231,232,233,234:firstpar:=o-171;end;end;{:75} +{76:}function rulepixels(x:integer):integer;var n:integer; +begin n:=trunc(conv*x); +if n<conv*x then rulepixels:=n+1 else rulepixels:=n;end;{:76}{79:}{82:} +function specialcases(o:eightbits;p,a:integer):boolean; +label 46,44,30,9998;var q:integer;k:integer;badchar:boolean; +pure:boolean;vvv:integer;begin pure:=true;case o of{85:} +157,158,159,160:begin if abs(p)>=5*fontspace[curfont]then vv:=round(conv +*(v+p))else vv:=vv+round(conv*(p));if outmode>0 then begin flushtext; +showing:=true;write(dvityout,a:1,': ','down',o-156:1,' ',p:1);end; +goto 44;end;161,162,163,164,165:begin y:=p; +if abs(p)>=5*fontspace[curfont]then vv:=round(conv*(v+p))else vv:=vv+ +round(conv*(p));if outmode>0 then begin flushtext;showing:=true; +write(dvityout,a:1,': ','y',o-161:1,' ',p:1);end;goto 44;end; +166,167,168,169,170:begin z:=p; +if abs(p)>=5*fontspace[curfont]then vv:=round(conv*(v+p))else vv:=vv+ +round(conv*(p));if outmode>0 then begin flushtext;showing:=true; +write(dvityout,a:1,': ','z',o-166:1,' ',p:1);end;goto 44;end;{:85}{86:} +171,172,173,174,175,176,177,178,179,180,181,182,183,184,185,186,187,188, +189,190,191,192,193,194,195,196,197,198,199,200,201,202,203,204,205,206, +207,208,209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,224, +225,226,227,228,229,230,231,232,233,234:begin if outmode>0 then begin +flushtext;showing:=true;write(dvityout,a:1,': ','fntnum',p:1);end; +goto 46;end;235,236,237,238:begin if outmode>0 then begin flushtext; +showing:=true;write(dvityout,a:1,': ','fnt',o-234:1,' ',p:1);end; +goto 46;end;243,244,245,246:begin if outmode>0 then begin flushtext; +showing:=true;write(dvityout,a:1,': ','fntdef',o-242:1,' ',p:1);end; +definefont(p);goto 30;end;{:86}239,240,241,242:{87:} +begin if outmode>0 then begin flushtext;showing:=true; +write(dvityout,a:1,': ','xxx ''');end;badchar:=false; +if p<0 then if not showing then begin flushtext;showing:=true; +write(dvityout,a:1,': ','string of negative length!'); +end else write(dvityout,' ','string of negative length!'); +for k:=1 to p do begin q:=getbyte;if(q<32)or(q>126)then badchar:=true; +if showing then write(dvityout,xchr[q]);end; +if showing then write(dvityout,''''); +if badchar then if not showing then begin flushtext;showing:=true; +write(dvityout,a:1,': ','non-ASCII character in xxx command!'); +end else write(dvityout,' ','non-ASCII character in xxx command!'); +goto 30;end{:87};247:begin if not showing then begin flushtext; +showing:=true; +write(dvityout,a:1,': ','preamble command within a page!'); +end else write(dvityout,' ','preamble command within a page!'); +goto 9998;end;248,249:begin if not showing then begin flushtext; +showing:=true; +write(dvityout,a:1,': ','postamble command within a page!'); +end else write(dvityout,' ','postamble command within a page!'); +goto 9998;end;otherwise begin if not showing then begin flushtext; +showing:=true;write(dvityout,a:1,': ','undefined command ',o:1,'!'); +end else write(dvityout,' ','undefined command ',o:1,'!');goto 30; +end end;44:{92:} +if(v>0)and(p>0)then if v>2147483647-p then begin if not showing then +begin flushtext;showing:=true; +write(dvityout,a:1,': ','arithmetic overflow! parameter changed from ',p +:1,' to ',2147483647-v:1);end else write(dvityout,' ', +'arithmetic overflow! parameter changed from ',p:1,' to ',2147483647-v:1 +);p:=2147483647-v;end; +if(v<0)and(p<0)then if-v>p+2147483647 then begin if not showing then +begin flushtext;showing:=true; +write(dvityout,a:1,': ','arithmetic overflow! parameter changed from ',p +:1,' to ',(-v)-2147483647:1);end else write(dvityout,' ', +'arithmetic overflow! parameter changed from ',p:1,' to ',(-v) +-2147483647:1);p:=(-v)-2147483647;end;vvv:=round(conv*(v+p)); +if abs(vvv-vv)>2 then if vvv>vv then vv:=vvv-2 else vv:=vvv+2; +if showing then if outmode>2 then begin write(dvityout,' v:=',v:1); +if p>=0 then write(dvityout,'+'); +write(dvityout,p:1,'=',v+p:1,', vv:=',vv:1);end;v:=v+p; +if abs(v)>maxvsofar then begin if abs(v)>maxv+99 then begin if not +showing then begin flushtext;showing:=true; +write(dvityout,a:1,': ','warning: |v|>',maxv:1,'!'); +end else write(dvityout,' ','warning: |v|>',maxv:1,'!');maxv:=abs(v); +end;maxvsofar:=abs(v);end;goto 30{:92};46:{94:}fontnum[nf]:=p; +curfont:=0;while fontnum[curfont]<>p do curfont:=curfont+1; +if curfont=nf then begin curfont:=maxfonts; +if not showing then begin flushtext;showing:=true; +write(dvityout,a:1,': ','invalid font selection: font ',p:1, +' was never defined!'); +end else write(dvityout,' ','invalid font selection: font ',p:1, +' was never defined!');end; +if showing then if outmode>2 then begin write(dvityout, +' current font is ');printfont(curfont);end;goto 30{:94}; +9998:pure:=false;30:specialcases:=pure;end;{:82}function dopage:boolean; +label 41,42,43,45,30,9998,9999;var o:eightbits;p,q:integer;a:integer; +hhh:integer;begin curfont:=maxfonts;s:=0;h:=0;v:=0;w:=0;x:=0;y:=0;z:=0; +hh:=0;vv:=0;while true do{80:}begin a:=curloc;showing:=false;o:=getbyte; +p:=firstpar(o); +if eof(dvifile)then begin write(dvityout,' ','Bad DVI file: ', +'the file ended prematurely','!');jumpout;end;{81:}if o<128 then{88:} +begin if(o>32)and(o<=126)then begin outtext(p); +if outmode>1 then begin showing:=true; +write(dvityout,a:1,': ','setchar',p:1);end; +end else if outmode>0 then begin flushtext;showing:=true; +write(dvityout,a:1,': ','setchar',p:1);end;goto 41;end{:88} +else case o of 128,129,130,131:begin if outmode>0 then begin flushtext; +showing:=true;write(dvityout,a:1,': ','set',o-127:1,' ',p:1);end; +goto 41;end;133,134,135,136:begin if outmode>0 then begin flushtext; +showing:=true;write(dvityout,a:1,': ','put',o-132:1,' ',p:1);end; +goto 41;end;132:begin if outmode>0 then begin flushtext;showing:=true; +write(dvityout,a:1,': ','setrule');end;goto 42;end; +137:begin if outmode>0 then begin flushtext;showing:=true; +write(dvityout,a:1,': ','putrule');end;goto 42;end;{83:} +138:begin if outmode>1 then begin showing:=true; +write(dvityout,a:1,': ','nop');end;goto 30;end; +139:begin if not showing then begin flushtext;showing:=true; +write(dvityout,a:1,': ','bop occurred before eop!'); +end else write(dvityout,' ','bop occurred before eop!');goto 9998;end; +140:begin if outmode>0 then begin flushtext;showing:=true; +write(dvityout,a:1,': ','eop');end; +if s<>0 then if not showing then begin flushtext;showing:=true; +write(dvityout,a:1,': ','stack not empty at end of page (level ',s:1, +')!'); +end else write(dvityout,' ','stack not empty at end of page (level ',s:1 +,')!');dopage:=true;writeln(dvityout,' ');goto 9999;end; +141:begin if outmode>0 then begin flushtext;showing:=true; +write(dvityout,a:1,': ','push');end; +if s=maxssofar then begin maxssofar:=s+1; +if s=maxs then if not showing then begin flushtext;showing:=true; +write(dvityout,a:1,': ','deeper than claimed in postamble!'); +end else write(dvityout,' ','deeper than claimed in postamble!'); +if s=stacksize then begin if not showing then begin flushtext; +showing:=true; +write(dvityout,a:1,': ','DVItype capacity exceeded (stack size=', +stacksize:1,')'); +end else write(dvityout,' ','DVItype capacity exceeded (stack size=', +stacksize:1,')');goto 9998;end;end;hstack[s]:=h;vstack[s]:=v; +wstack[s]:=w;xstack[s]:=x;ystack[s]:=y;zstack[s]:=z;hhstack[s]:=hh; +vvstack[s]:=vv;s:=s+1;ss:=s-1;goto 45;end; +142:begin if outmode>0 then begin flushtext;showing:=true; +write(dvityout,a:1,': ','pop');end; +if s=0 then if not showing then begin flushtext;showing:=true; +write(dvityout,a:1,': ','(illegal at level zero)!'); +end else write(dvityout,' ','(illegal at level zero)!')else begin s:=s-1 +;hh:=hhstack[s];vv:=vvstack[s];h:=hstack[s];v:=vstack[s];w:=wstack[s]; +x:=xstack[s];y:=ystack[s];z:=zstack[s];end;ss:=s;goto 45;end;{:83}{84:} +143,144,145,146:begin if(p>=fontspace[curfont])or(p<=-4*fontspace[ +curfont])then begin outtext(32);hh:=round(conv*(h+p)); +end else hh:=hh+round(conv*(p));if outmode>1 then begin showing:=true; +write(dvityout,a:1,': ','right',o-142:1,' ',p:1);end;q:=p;goto 43;end; +147,148,149,150,151:begin w:=p; +if(p>=fontspace[curfont])or(p<=-4*fontspace[curfont])then begin outtext( +32);hh:=round(conv*(h+p));end else hh:=hh+round(conv*(p)); +if outmode>1 then begin showing:=true; +write(dvityout,a:1,': ','w',o-147:1,' ',p:1);end;q:=p;goto 43;end; +152,153,154,155,156:begin x:=p; +if(p>=fontspace[curfont])or(p<=-4*fontspace[curfont])then begin outtext( +32);hh:=round(conv*(h+p));end else hh:=hh+round(conv*(p)); +if outmode>1 then begin showing:=true; +write(dvityout,a:1,': ','x',o-152:1,' ',p:1);end;q:=p;goto 43;end;{:84} +otherwise if specialcases(o,p,a)then goto 30 else goto 9998 end{:81}; +41:{89:} +if p<0 then p:=255-((-1-p)mod 256)else if p>=256 then p:=p mod 256; +if(p<fontbc[curfont])or(p>fontec[curfont])then q:=2147483647 else q:= +width[widthbase[curfont]+p]; +if q=2147483647 then begin if not showing then begin flushtext; +showing:=true; +write(dvityout,a:1,': ','character ',p:1,' invalid in font '); +end else write(dvityout,' ','character ',p:1,' invalid in font '); +printfont(curfont);if curfont<>maxfonts then write(dvityout,'!');end; +if o>=133 then goto 30; +if q=2147483647 then q:=0 else hh:=hh+pixelwidth[widthbase[curfont]+p]; +goto 43{:89};42:{90:}q:=signedquad; +if showing then begin write(dvityout,' height ',p:1,', width ',q:1); +if outmode>2 then if(p<=0)or(q<=0)then write(dvityout,' (invisible)') +else write(dvityout,' (',rulepixels(p):1,'x',rulepixels(q):1,' pixels)') +;end;if o=137 then goto 30; +if showing then if outmode>2 then writeln(dvityout,' '); +hh:=hh+rulepixels(q);goto 43{:90};43:{91:} +if(h>0)and(q>0)then if h>2147483647-q then begin if not showing then +begin flushtext;showing:=true; +write(dvityout,a:1,': ','arithmetic overflow! parameter changed from ',q +:1,' to ',2147483647-h:1);end else write(dvityout,' ', +'arithmetic overflow! parameter changed from ',q:1,' to ',2147483647-h:1 +);q:=2147483647-h;end; +if(h<0)and(q<0)then if-h>q+2147483647 then begin if not showing then +begin flushtext;showing:=true; +write(dvityout,a:1,': ','arithmetic overflow! parameter changed from ',q +:1,' to ',(-h)-2147483647:1);end else write(dvityout,' ', +'arithmetic overflow! parameter changed from ',q:1,' to ',(-h) +-2147483647:1);q:=(-h)-2147483647;end;hhh:=round(conv*(h+q)); +if abs(hhh-hh)>2 then if hhh>hh then hh:=hhh-2 else hh:=hhh+2; +if showing then if outmode>2 then begin write(dvityout,' h:=',h:1); +if q>=0 then write(dvityout,'+'); +write(dvityout,q:1,'=',h+q:1,', hh:=',hh:1);end;h:=h+q; +if abs(h)>maxhsofar then begin if abs(h)>maxh+99 then begin if not +showing then begin flushtext;showing:=true; +write(dvityout,a:1,': ','warning: |h|>',maxh:1,'!'); +end else write(dvityout,' ','warning: |h|>',maxh:1,'!');maxh:=abs(h); +end;maxhsofar:=abs(h);end;goto 30{:91};45:{93:} +if showing then if outmode>2 then begin writeln(dvityout,' '); +write(dvityout,'level ',ss:1,':(h=',h:1,',v=',v:1,',w=',w:1,',x=',x:1, +',y=',y:1,',z=',z:1,',hh=',hh:1,',vv=',vv:1,')');end;goto 30{:93}; +30:if showing then writeln(dvityout,' ');end{:80}; +9998:writeln(dvityout,'!');dopage:=false;9999:end;{:79}{95:}{99:} +procedure scanbop;var k:0..255; +begin repeat if eof(dvifile)then begin write(dvityout,' ', +'Bad DVI file: ','the file ended prematurely','!');jumpout;end; +k:=getbyte;if(k>=243)and(k<247)then begin definefont(firstpar(k)); +k:=138;end;until k<>138; +if k=248 then inpostamble:=true else begin if k<>139 then begin write( +dvityout,' ','Bad DVI file: ','byte ',curloc-1:1,' is not bop','!'); +jumpout;end;newbackpointer:=curloc-1;pagecount:=pagecount+1; +for k:=0 to 9 do count[k]:=signedquad; +if signedquad<>oldbackpointer then writeln(dvityout, +'backpointer in byte ',curloc-4:1,' should be ',oldbackpointer:1,'!'); +oldbackpointer:=newbackpointer;end;end;{:99} +procedure skippages(bopseen:boolean);label 9999;var p:integer;k:0..255; +downthedrain:integer;begin showing:=false; +while true do begin if not bopseen then begin scanbop; +if inpostamble then goto 9999; +if not started then if startmatch then begin started:=true;goto 9999; +end;end;{96:} +repeat if eof(dvifile)then begin write(dvityout,' ','Bad DVI file: ', +'the file ended prematurely','!');jumpout;end;k:=getbyte;p:=firstpar(k); +case k of 132,137:downthedrain:=signedquad; +243,244,245,246:begin definefont(p);writeln(dvityout,' ');end; +239,240,241,242:while p>0 do begin downthedrain:=getbyte;p:=p-1;end; +139,247,248,249,250,251,252,253,254,255:begin write(dvityout,' ', +'Bad DVI file: ','illegal command at byte ',curloc-1:1,'!');jumpout;end; +otherwise end;until k=140;{:96};bopseen:=false;end;9999:end;{:95}{103:} +procedure readpostamble;var k:integer;p,q,m:integer; +begin showing:=false;postloc:=curloc-5; +writeln(dvityout,'Postamble starts at byte ',postloc:1,'.'); +if signedquad<>numerator then writeln(dvityout, +'numerator doesn''t match the preamble!'); +if signedquad<>denominator then writeln(dvityout, +'denominator doesn''t match the preamble!'); +if signedquad<>mag then if newmag=0 then writeln(dvityout, +'magnification doesn''t match the preamble!');maxv:=signedquad; +maxh:=signedquad;write(dvityout,'maxv=',maxv:1,', maxh=',maxh:1); +maxs:=gettwobytes;totalpages:=gettwobytes; +writeln(dvityout,', maxstackdepth=',maxs:1,', totalpages=',totalpages:1) +;if outmode<4 then{104:} +begin if maxv+99<maxvsofar then writeln(dvityout, +'warning: observed maxv was ',maxvsofar:1); +if maxh+99<maxhsofar then writeln(dvityout,'warning: observed maxh was ' +,maxhsofar:1);if maxs<maxssofar then writeln(dvityout, +'warning: observed maxstackdepth was ',maxssofar:1); +if pagecount<>totalpages then writeln(dvityout,'there are really ', +pagecount:1,' pages, not ',totalpages:1,'!');end{:104};{106:} +repeat k:=getbyte;if(k>=243)and(k<247)then begin p:=firstpar(k); +definefont(p);writeln(dvityout,' ');k:=138;end;until k<>138; +if k<>249 then writeln(dvityout,'byte ',curloc-1:1,' is not postpost!'){ +:106};{105:}q:=signedquad; +if q<>postloc then writeln(dvityout,'bad postamble pointer in byte ', +curloc-4:1,'!');m:=getbyte; +if m<>2 then writeln(dvityout,'identification in byte ',curloc-1:1, +' should be ',2:1,'!');k:=curloc;m:=223; +while(m=223)and not eof(dvifile)do m:=getbyte; +if not eof(dvifile)then begin write(dvityout,' ','Bad DVI file: ', +'signature in byte ',curloc-1:1,' should be 223','!');jumpout;end; +if curloc<k+4 then writeln(dvityout, +'not enough signature bytes at end of file (',curloc-k:1,')'); +reset(dvifile,dviname){:105};end;{:103}{107:}begin initialize; +if argc<>2 then begin writeln('Usage: dvitype <dvi-file>');goto 9999; +end;firstinput:=true;dialog;{109:}opendvifile;p:=getbyte; +if p<>247 then begin write(dvityout,' ','Bad DVI file: ', +'First byte isn''t start of preamble!','!');jumpout;end;p:=getbyte; +if p<>2 then writeln(dvityout,'identification in byte 1 should be ',2:1, +'!');{110:}numerator:=signedquad;denominator:=signedquad; +if numerator<=0 then begin write(dvityout,' ','Bad DVI file: ', +'numerator is ',numerator:1,'!');jumpout;end; +if denominator<=0 then begin write(dvityout,' ','Bad DVI file: ', +'denominator is ',denominator:1,'!');jumpout;end; +writeln(dvityout,'numerator/denominator=',numerator:1,'/',denominator:1) +;tfmconv:=(25400000.0/numerator)*(denominator/473628672)/16.0; +conv:=(numerator/254000.0)*(resolution/denominator);mag:=signedquad; +if newmag>0 then mag:=newmag else if mag<=0 then begin write(dvityout, +' ','Bad DVI file: ','magnification is ',mag:1,'!');jumpout;end; +trueconv:=conv;conv:=trueconv*(mag/1000.0); +writeln(dvityout,'magnification=',mag:1,'; ',conv:16:8, +' pixels per DVI unit'){:110};p:=getbyte;write(dvityout,''''); +while p>0 do begin p:=p-1;write(dvityout,xchr[getbyte]);end; +writeln(dvityout,'''');afterpre:=curloc{:109}; +if outmode=4 then begin{100:}n:=dvilength; +if n<53 then begin write(dvityout,' ','Bad DVI file: ','only ',n:1, +' bytes long','!');jumpout;end;m:=n-4; +repeat if m=0 then begin write(dvityout,' ','Bad DVI file: ','all 223s', +'!');jumpout;end;movetobyte(m);k:=getbyte;m:=m-1;until k<>223; +if k<>2 then begin write(dvityout,' ','Bad DVI file: ','ID byte is ',k:1 +,'!');jumpout;end;movetobyte(m-3);q:=signedquad; +if(q<0)or(q>m-33)then begin write(dvityout,' ','Bad DVI file: ', +'post pointer ',q:1,' at byte ',m-3:1,'!');jumpout;end;movetobyte(q); +k:=getbyte; +if k<>248 then begin write(dvityout,' ','Bad DVI file: ','byte ',q:1, +' is not post','!');jumpout;end;postloc:=q; +firstbackpointer:=signedquad{:100};inpostamble:=true;readpostamble; +inpostamble:=false;{102:}q:=postloc;p:=firstbackpointer;startloc:=-1; +if p<0 then inpostamble:=true else begin repeat if p>q-46 then begin +write(dvityout,' ','Bad DVI file: ','page link ',p:1,' after byte ',q:1, +'!');jumpout;end;q:=p;movetobyte(q);k:=getbyte; +if k=139 then pagecount:=pagecount+1 else begin write(dvityout,' ', +'Bad DVI file: ','byte ',q:1,' is not bop','!');jumpout;end; +for k:=0 to 9 do count[k]:=signedquad;p:=signedquad; +if startmatch then begin startloc:=q;oldbackpointer:=p;end;until p<0; +if startloc<0 then begin write(dvityout,' ', +'starting page number could not be found!');jumpout;end; +if oldbackpointer<0 then startloc:=afterpre;movetobyte(startloc);end; +if pagecount<>totalpages then writeln(dvityout,'there are really ', +pagecount:1,' pages, not ',totalpages:1,'!'){:102};end;skippages(false); +if not inpostamble then{111:} +begin while maxpages>0 do begin maxpages:=maxpages-1; +writeln(dvityout,' '); +write(dvityout,curloc-45:1,': beginning of page '); +for k:=0 to startvals do begin write(dvityout,count[k]:1); +if k<startvals then write(dvityout,'.')else writeln(dvityout,' ');end; +if not dopage then begin write(dvityout,' ','Bad DVI file: ', +'page ended unexpectedly','!');jumpout;end;scanbop; +if inpostamble then goto 30;end;30:end{:111}; +if outmode<4 then begin if not inpostamble then skippages(true); +if signedquad<>oldbackpointer then writeln(dvityout, +'backpointer in byte ',curloc-4:1,' should be ',oldbackpointer:1,'!'); +readpostamble;end;9999:writeln(dvityout,' ');end.{:107} diff --git a/systems/knuth/local/texware/pltotf.ch b/systems/knuth/local/texware/pltotf.ch new file mode 100644 index 0000000000..72afbe0f3a --- /dev/null +++ b/systems/knuth/local/texware/pltotf.ch @@ -0,0 +1,118 @@ +% Change file for the PLtoTF processor, for use with GNU Pascal. +% (by Don Knuth, based on the work of Pavel Curtis in ../texware-sparc) + +% History: +% 2000.04.30 Original version + +% The section numbers used in this file refer to the current nunmbers, +% and, where different, also to those in the standard TeXware report (CS1097). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [0] WEAVE: print changes only +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +\pageno=\contentspagenumber \advance\pageno by 1 +@y +\pageno=\contentspagenumber \advance\pageno by 1 +\let\maybe=\iffalse +\def\title{PL\lowercase{to}TF changes for GNU Pascal} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1] Change banner string +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d banner=='This is PLtoTF, Version 3.5' {printed when the program starts} +@y +@d banner=='This is PLtoTF, Version 3.5 for Linux' + {printed when the program starts} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [2] Fix filenames in program statement; add `final_end' label; add access +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p program PLtoTF(@!pl_file,@!tfm_file,@!output); +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +@y +@d final_end==9999 + +@p program PLtoTF(@!output); +label final_end; +const @<Constants in the outer block@>@/ +type UNIX_file_name=packed array[1..100] of char; + @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +@\ +@=#include "texwarext.h"@> +@\@/ +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [6] Open PL file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +reset(pl_file); +@y +if argc < 3 then begin + print_ln('Usage: pltotf <pl-file> <tfm-file>'); + goto final_end; +end; +argv(1, pl_name); +if testreadaccess(pl_name) then reset(pl_file, pl_name) +else begin print_ln('I can''t read the PL file!'); goto final_end; + end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [15] Change type of tfm_file and declare extra TFM-file variables +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!tfm_file:packed file of 0..255; +@y +@!tfm_file : packed file of ByteCard; +@!tfm_name, +@!pl_name : UNIX_file_name; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [16] Open TFM file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ On some systems you may have to do something special to write a +packed file of bytes. For example, the following code didn't work +when it was first tried at Stanford, because packed files have to be +opened with a special switch setting on the \PASCAL\ that was used. +@^system dependencies@> + +@<Set init...@>= +rewrite(tfm_file); +@y +@ On some systems you may have to do something special to write a +packed file of bytes. +@^system dependencies@> + +@<Set init...@>= +argv(2, tfm_name); +rewrite(tfm_file, tfm_name); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [17] Make byte a byte +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!byte=0..255; {unsigned eight-bit quantity} +@y +@!byte=ByteCard; {unsigned eight-bit quantity} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [147, was 135] Define label `final_end'; print newline at end of program +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +end. +@y +final_end: print_ln(' '); end. +@z diff --git a/systems/knuth/local/texware/pltotf.p b/systems/knuth/local/texware/pltotf.p new file mode 100644 index 0000000000..6001876228 --- /dev/null +++ b/systems/knuth/local/texware/pltotf.p @@ -0,0 +1,830 @@ +{2:}program PLtoTF(output);label 9999;const{3:}bufsize=60; +maxheaderbytes=100;maxparamwords=30;maxligsteps=5000;maxkerns=500; +hashsize=5003;{:3}type UNIXfilename=packed array[1..100]of char;{17:} +byte=ByteCard;ASCIIcode=32..127;{:17}{57:}fourbytes=record b0:byte; +b1:byte;b2:byte;b3:byte;end;{:57}{61:}fixword=integer;{:61}{68:} +headerindex=0..maxheaderbytes;indx=0..32767;{:68}{71:}pointer=0..1032; +{:71}var{5:}plfile:text;{:5}{15:}tfmfile:packed file of ByteCard; +tfmname,plname:UNIXfilename;{:15}{18:}xord:array[char]of ASCIIcode;{:18} +{21:}line:integer;goodindent:integer;indent:integer;level:integer;{:21} +{23:}leftln,rightln:boolean;limit:0..bufsize;loc:0..bufsize; +buffer:array[1..bufsize]of char;inputhasended:boolean;{:23}{25:} +charsonline:0..8;{:25}{30:}curchar:ASCIIcode;{:30}{36:} +start:array[1..88]of 0..600;dictionary:array[0..600]of ASCIIcode; +startptr:0..88;dictptr:0..600;{:36}{38:} +curname:array[1..20]of ASCIIcode;namelength:0..20;nameptr:0..88;{:38} +{39:}nhash:array[0..100]of 0..88;curhash:0..100;{:39}{44:} +equiv:array[0..88]of byte;curcode:byte;{:44}{58:}curbytes:fourbytes; +{:58}{65:}fractiondigits:array[1..7]of integer;{:65}{67:} +headerbytes:array[headerindex]of byte;headerptr:headerindex; +designsize:fixword;designunits:fixword;sevenbitsafeflag:boolean; +ligkern:array[0..maxligsteps]of fourbytes;nl:0..32767;minnl:0..32767; +kern:array[0..maxkerns]of fixword;nk:0..maxkerns; +exten:array[0..255]of fourbytes;ne:0..256; +param:array[1..maxparamwords]of fixword;np:0..maxparamwords; +checksumspecified:boolean;bchar:0..256;{:67}{72:} +memory:array[pointer]of fixword;memptr:pointer; +link:array[pointer]of pointer;charwd:array[byte]of pointer; +charht:array[byte]of pointer;chardp:array[byte]of pointer; +charic:array[byte]of pointer;chartag:array[byte]of 0..3; +charremainder:array[0..256]of 0..65535;{:72}{76:}nextd:fixword;{:76} +{79:}index:array[pointer]of byte;excess:byte;{:79}{81:}c:byte;{:81}{98:} +lkstepended:boolean;krnptr:0..maxkerns;{:98}{109:}sevenunsafe:boolean; +{:109}{114:}delta:fixword;{:114}{118:}ligptr:0..maxligsteps; +hash:array[0..hashsize]of 0..66048;class:array[0..hashsize]of 0..4; +ligz:array[0..hashsize]of 0..257;hashptr:0..hashsize; +hashlist:array[0..hashsize]of 0..hashsize;h,hh:0..hashsize;tt:indx; +xligcycle,yligcycle:0..256;{:118}{129:}bc:byte;ec:byte;lh:byte; +lf:0..32767;notfound:boolean;tempwidth:fixword;{:129}{132:} +j:0..maxheaderbytes;p:pointer;q:1..4;parptr:0..maxparamwords;{:132} +{138:}labeltable:array[0..256]of record rr:-1..32767;cc:byte;end; +labelptr:0..256;sortptr:0..256;lkoffset:0..256;t:0..32767; +extralocneeded:boolean;{:138} +#include "texwarext.h" +procedure initialize;var{19:}k:integer;{:19}{40:}h:0..100;{:40}{69:} +d:headerindex;{:69}{73:}c:byte;{:73} +begin writeln('This is PLtoTF, Version 3.5 for Linux');{6:} +if argc<3 then begin writeln('Usage: pltotf <pl-file> <tfm-file>'); +goto 9999;end;argv(1,plname); +if testreadaccess(plname)then reset(plfile,plname)else begin writeln( +'I can''t read the PL file!');goto 9999;end;{:6}{16:}argv(2,tfmname); +rewrite(tfmfile,tfmname);{:16}{20:}for k:=0 to 127 do xord[chr(k)]:=127; +xord[' ']:=32;xord['!']:=33;xord['"']:=34;xord['#']:=35;xord['$']:=36; +xord['%']:=37;xord['&']:=38;xord['''']:=39;xord['(']:=40;xord[')']:=41; +xord['*']:=42;xord['+']:=43;xord[',']:=44;xord['-']:=45;xord['.']:=46; +xord['/']:=47;xord['0']:=48;xord['1']:=49;xord['2']:=50;xord['3']:=51; +xord['4']:=52;xord['5']:=53;xord['6']:=54;xord['7']:=55;xord['8']:=56; +xord['9']:=57;xord[':']:=58;xord[';']:=59;xord['<']:=60;xord['=']:=61; +xord['>']:=62;xord['?']:=63;xord['@']:=64;xord['A']:=65;xord['B']:=66; +xord['C']:=67;xord['D']:=68;xord['E']:=69;xord['F']:=70;xord['G']:=71; +xord['H']:=72;xord['I']:=73;xord['J']:=74;xord['K']:=75;xord['L']:=76; +xord['M']:=77;xord['N']:=78;xord['O']:=79;xord['P']:=80;xord['Q']:=81; +xord['R']:=82;xord['S']:=83;xord['T']:=84;xord['U']:=85;xord['V']:=86; +xord['W']:=87;xord['X']:=88;xord['Y']:=89;xord['Z']:=90;xord['[']:=91; +xord['\']:=92;xord[']']:=93;xord['^']:=94;xord['_']:=95;xord['`']:=96; +xord['a']:=97;xord['b']:=98;xord['c']:=99;xord['d']:=100;xord['e']:=101; +xord['f']:=102;xord['g']:=103;xord['h']:=104;xord['i']:=105; +xord['j']:=106;xord['k']:=107;xord['l']:=108;xord['m']:=109; +xord['n']:=110;xord['o']:=111;xord['p']:=112;xord['q']:=113; +xord['r']:=114;xord['s']:=115;xord['t']:=116;xord['u']:=117; +xord['v']:=118;xord['w']:=119;xord['x']:=120;xord['y']:=121; +xord['z']:=122;xord['{']:=123;xord['|']:=124;xord['}']:=125; +xord['~']:=126;{:20}{22:}line:=0;goodindent:=0;indent:=0;level:=0;{:22} +{24:}limit:=0;loc:=0;leftln:=true;rightln:=true;inputhasended:=false; +{:24}{26:}charsonline:=0;{:26}{37:}startptr:=1;start[1]:=0;dictptr:=0; +{:37}{41:}for h:=0 to 100 do nhash[h]:=0;{:41}{70:} +for d:=0 to 18*4-1 do headerbytes[d]:=0;headerbytes[8]:=11; +headerbytes[9]:=85;headerbytes[10]:=78;headerbytes[11]:=83; +headerbytes[12]:=80;headerbytes[13]:=69;headerbytes[14]:=67; +headerbytes[15]:=73;headerbytes[16]:=70;headerbytes[17]:=73; +headerbytes[18]:=69;headerbytes[19]:=68; +for d:=48 to 59 do headerbytes[d]:=headerbytes[d-40]; +designsize:=10*1048576;designunits:=1048576;sevenbitsafeflag:=false; +headerptr:=18*4;nl:=0;minnl:=0;nk:=0;ne:=0;np:=0; +checksumspecified:=false;bchar:=256;{:70}{74:}charremainder[256]:=32767; +for c:=0 to 255 do begin charwd[c]:=0;charht[c]:=0;chardp[c]:=0; +charic[c]:=0;chartag[c]:=0;charremainder[c]:=0;end; +memory[0]:=2147483647;memory[1]:=0;link[1]:=0;memory[2]:=0;link[2]:=0; +memory[3]:=0;link[3]:=0;memory[4]:=0;link[4]:=0;memptr:=4;{:74}{119:} +hashptr:=0;yligcycle:=256;for k:=0 to hashsize do hash[k]:=0;{:119}end; +{:2}{27:}procedure showerrorcontext;var k:0..bufsize; +begin writeln(' (line ',line:1,').');if not leftln then write('...'); +for k:=1 to loc do write(buffer[k]);writeln(' '); +if not leftln then write(' ');for k:=1 to loc do write(' '); +for k:=loc+1 to limit do write(buffer[k]); +if rightln then writeln(' ')else writeln('...');charsonline:=0;end;{:27} +{28:}procedure fillbuffer;begin leftln:=rightln;limit:=0;loc:=0; +if leftln then begin if line>0 then readln(plfile);line:=line+1;end; +if eof(plfile)then begin limit:=1;buffer[1]:=')';rightln:=false; +inputhasended:=true; +end else begin while(limit<bufsize-1)and(not eoln(plfile))do begin limit +:=limit+1;read(plfile,buffer[limit]);end;buffer[limit+1]:=' '; +rightln:=eoln(plfile);if leftln then{29:} +begin while(loc<limit)and(buffer[loc+1]=' ')do loc:=loc+1; +if loc<limit then begin if level=0 then if loc=0 then goodindent:= +goodindent+1 else begin if goodindent>=10 then begin if charsonline>0 +then writeln(' '); +write('Warning: Indented line occurred at level zero');showerrorcontext; +end;goodindent:=0;indent:=0; +end else if indent=0 then if loc mod level=0 then begin indent:=loc div +level;goodindent:=1; +end else goodindent:=0 else if indent*level=loc then goodindent:= +goodindent+1 else begin if goodindent>=10 then begin if charsonline>0 +then writeln(' ');write('Warning: Inconsistent indentation; ', +'you are at parenthesis level ',level:1);showerrorcontext;end; +goodindent:=0;indent:=0;end;end;end{:29};end;end;{:28}{31:} +procedure getkeywordchar; +begin while(loc=limit)and(not rightln)do fillbuffer; +if loc=limit then curchar:=32 else begin curchar:=xord[buffer[loc+1]]; +if curchar>=97 then curchar:=curchar-32; +if((curchar>=48)and(curchar<=57))then loc:=loc+1 else if((curchar>=65) +and(curchar<=90))then loc:=loc+1 else if curchar=47 then loc:=loc+1 else +if curchar=62 then loc:=loc+1 else curchar:=32;end;end;{:31}{32:} +procedure getnext;begin while loc=limit do fillbuffer;loc:=loc+1; +curchar:=xord[buffer[loc]]; +if curchar>=97 then if curchar<=122 then curchar:=curchar-32 else begin +if curchar=127 then begin begin if charsonline>0 then writeln(' '); +write('Illegal character in the file');showerrorcontext;end;curchar:=63; +end;end else if(curchar<=41)and(curchar>=40)then loc:=loc-1;end;{:32} +{33:}procedure skiptoendofitem;var l:integer;begin l:=level; +while level>=l do begin while loc=limit do fillbuffer;loc:=loc+1; +if buffer[loc]=')'then level:=level-1 else if buffer[loc]='('then level +:=level+1;end; +if inputhasended then begin if charsonline>0 then writeln(' '); +write('File ended unexpectedly: No closing ")"');showerrorcontext;end; +curchar:=32;end;{:33}{35:}procedure finishtheproperty; +begin while curchar=32 do getnext; +if curchar<>41 then begin if charsonline>0 then writeln(' '); +write('Junk after property value will be ignored');showerrorcontext;end; +skiptoendofitem;end;{:35}{42:}procedure lookup;var k:0..20;j:0..600; +notfound:boolean;begin{43:}curhash:=curname[1]; +for k:=2 to namelength do curhash:=(curhash+curhash+curname[k])mod 101{: +43};notfound:=true; +while notfound do begin if curhash=0 then curhash:=100 else curhash:= +curhash-1; +if nhash[curhash]=0 then notfound:=false else begin j:=start[nhash[ +curhash]]; +if start[nhash[curhash]+1]=j+namelength then begin notfound:=false; +for k:=1 to namelength do if dictionary[j+k-1]<>curname[k]then notfound +:=true;end;end;end;nameptr:=nhash[curhash];end;{:42}{45:} +procedure entername(v:byte);var k:0..20; +begin for k:=1 to namelength do curname[k]:=curname[k+20-namelength]; +lookup;nhash[curhash]:=startptr;equiv[startptr]:=v; +for k:=1 to namelength do begin dictionary[dictptr]:=curname[k]; +dictptr:=dictptr+1;end;startptr:=startptr+1;start[startptr]:=dictptr; +end;{:45}{49:}procedure getname;begin loc:=loc+1;level:=level+1; +curchar:=32;while curchar=32 do getnext; +if(curchar>41)or(curchar<40)then loc:=loc-1;namelength:=0; +getkeywordchar; +while curchar<>32 do begin if namelength=20 then curname[1]:=88 else +namelength:=namelength+1;curname[namelength]:=curchar;getkeywordchar; +end;lookup;if nameptr=0 then begin if charsonline>0 then writeln(' '); +write('Sorry, I don''t know that property name');showerrorcontext;end; +curcode:=equiv[nameptr];end;{:49}{51:}function getbyte:byte; +var acc:integer;t:ASCIIcode;begin repeat getnext;until curchar<>32; +t:=curchar;acc:=0;repeat getnext;until curchar<>32;if t=67 then{52:} +if(curchar>=33)and(curchar<=126)and((curchar<40)or(curchar>41))then acc +:=xord[buffer[loc]]else begin begin if charsonline>0 then writeln(' '); +write('"C" value must be standard ASCII and not a paren'); +showerrorcontext;end;repeat getnext until(curchar=40)or(curchar=41); +end{:52}else if t=68 then{53:} +begin while(curchar>=48)and(curchar<=57)do begin acc:=acc*10+curchar-48; +if acc>255 then begin begin begin if charsonline>0 then writeln(' '); +write('This value shouldn''t exceed 255');showerrorcontext;end; +repeat getnext until(curchar=40)or(curchar=41);end;acc:=0;curchar:=32; +end else getnext;end;begin if(curchar>41)or(curchar<40)then loc:=loc-1; +end;end{:53}else if t=79 then{54:} +begin while(curchar>=48)and(curchar<=55)do begin acc:=acc*8+curchar-48; +if acc>255 then begin begin begin if charsonline>0 then writeln(' '); +write('This value shouldn''t exceed ''377');showerrorcontext;end; +repeat getnext until(curchar=40)or(curchar=41);end;acc:=0;curchar:=32; +end else getnext;end;begin if(curchar>41)or(curchar<40)then loc:=loc-1; +end;end{:54}else if t=72 then{55:} +begin while((curchar>=48)and(curchar<=57))or((curchar>=65)and(curchar<= +70))do begin if curchar>=65 then curchar:=curchar-7; +acc:=acc*16+curchar-48; +if acc>255 then begin begin begin if charsonline>0 then writeln(' '); +write('This value shouldn''t exceed "FF');showerrorcontext;end; +repeat getnext until(curchar=40)or(curchar=41);end;acc:=0;curchar:=32; +end else getnext;end;begin if(curchar>41)or(curchar<40)then loc:=loc-1; +end;end{:55}else if t=70 then{56:} +begin if curchar=66 then acc:=2 else if curchar=76 then acc:=4 else if +curchar<>77 then acc:=18;getnext; +if curchar=73 then acc:=acc+1 else if curchar<>82 then acc:=18;getnext; +if curchar=67 then acc:=acc+6 else if curchar=69 then acc:=acc+12 else +if curchar<>82 then acc:=18; +if acc>=18 then begin begin begin if charsonline>0 then writeln(' '); +write('Illegal face code, I changed it to MRR');showerrorcontext;end; +repeat getnext until(curchar=40)or(curchar=41);end;acc:=0;end;end{:56} +else begin begin if charsonline>0 then writeln(' '); +write('You need "C" or "D" or "O" or "H" or "F" here');showerrorcontext; +end;repeat getnext until(curchar=40)or(curchar=41);end;curchar:=32; +getbyte:=acc;end;{:51}{59:}procedure getfourbytes;var c:integer; +r:integer;q:integer;begin repeat getnext;until curchar<>32;r:=0; +curbytes.b0:=0;curbytes.b1:=0;curbytes.b2:=0;curbytes.b3:=0; +if curchar=72 then r:=16 else if curchar=79 then r:=8 else begin begin +if charsonline>0 then writeln(' '); +write('An octal ("O") or hex ("H") value is needed here'); +showerrorcontext;end;repeat getnext until(curchar=40)or(curchar=41);end; +if r>0 then begin q:=256 div r;repeat getnext;until curchar<>32; +while((curchar>=48)and(curchar<=57))or((curchar>=65)and(curchar<=70))do{ +60:}begin if curchar>=65 then curchar:=curchar-7; +c:=(r*curbytes.b0)+(curbytes.b1 div q); +if c>255 then begin curbytes.b0:=0;curbytes.b1:=0;curbytes.b2:=0; +curbytes.b3:=0; +if r=8 then begin begin if charsonline>0 then writeln(' '); +write('Sorry, the maximum octal value is O 37777777777'); +showerrorcontext;end;repeat getnext until(curchar=40)or(curchar=41); +end else begin begin if charsonline>0 then writeln(' '); +write('Sorry, the maximum hex value is H FFFFFFFF');showerrorcontext; +end;repeat getnext until(curchar=40)or(curchar=41);end; +end else if curchar>=48+r then begin begin if charsonline>0 then writeln +(' ');write('Illegal digit');showerrorcontext;end; +repeat getnext until(curchar=40)or(curchar=41); +end else begin curbytes.b0:=c; +curbytes.b1:=(r*(curbytes.b1 mod q))+(curbytes.b2 div q); +curbytes.b2:=(r*(curbytes.b2 mod q))+(curbytes.b3 div q); +curbytes.b3:=(r*(curbytes.b3 mod q))+curchar-48;getnext;end;end{:60}; +end;end;{:59}{62:}function getfix:fixword;var negative:boolean; +acc:integer;intpart:integer;j:0..7;begin repeat getnext; +until curchar<>32;negative:=false;acc:=0; +if(curchar<>82)and(curchar<>68)then begin begin if charsonline>0 then +writeln(' ');write('An "R" or "D" value is needed here'); +showerrorcontext;end;repeat getnext until(curchar=40)or(curchar=41); +end else begin{63:}repeat getnext;if curchar=45 then begin curchar:=32; +negative:=true;end else if curchar=43 then curchar:=32; +until curchar<>32{:63};while(curchar>=48)and(curchar<=57)do{64:} +begin acc:=acc*10+curchar-48; +if acc>=2048 then begin begin begin if charsonline>0 then writeln(' '); +write('Real constants must be less than 2048');showerrorcontext;end; +repeat getnext until(curchar=40)or(curchar=41);end;acc:=0;curchar:=32; +end else getnext;end{:64};intpart:=acc;acc:=0;if curchar=46 then{66:} +begin j:=0;getnext; +while(curchar>=48)and(curchar<=57)do begin if j<7 then begin j:=j+1; +fractiondigits[j]:=2097152*(curchar-48);end;getnext;end;acc:=0; +while j>0 do begin acc:=fractiondigits[j]+(acc div 10);j:=j-1;end; +acc:=(acc+10)div 20;end{:66}; +if(acc>=1048576)and(intpart=2047)then begin begin if charsonline>0 then +writeln(' ');write('Real constants must be less than 2048'); +showerrorcontext;end;repeat getnext until(curchar=40)or(curchar=41); +end else acc:=intpart*1048576+acc;end; +if negative then getfix:=-acc else getfix:=acc;end;{:62}{75:} +function sortin(h:pointer;d:fixword):pointer;var p:pointer; +begin if(d=0)and(h<>1)then sortin:=0 else begin p:=h; +while d>=memory[link[p]]do p:=link[p]; +if(d=memory[p])and(p<>h)then sortin:=p else if memptr=1032 then begin +begin if charsonline>0 then writeln(' '); +write('Memory overflow: more than 1028 widths, etc');showerrorcontext; +end;writeln('Congratulations! It''s hard to make this error.'); +sortin:=p;end else begin memptr:=memptr+1;memory[memptr]:=d; +link[memptr]:=link[p];link[p]:=memptr;memory[h]:=memory[h]+1; +sortin:=memptr;end;end;end;{:75}{77:}function mincover(h:pointer; +d:fixword):integer;var p:pointer;l:fixword;m:integer;begin m:=0; +p:=link[h];nextd:=memory[0];while p<>0 do begin m:=m+1;l:=memory[p]; +while memory[link[p]]<=l+d do p:=link[p];p:=link[p]; +if memory[p]-l<nextd then nextd:=memory[p]-l;end;mincover:=m;end;{:77} +{78:}function shorten(h:pointer;m:integer):fixword;var d:fixword; +k:integer;begin if memory[h]>m then begin excess:=memory[h]-m; +k:=mincover(h,0);d:=nextd;repeat d:=d+d;k:=mincover(h,d);until k<=m; +d:=d div 2;k:=mincover(h,d);while k>m do begin d:=nextd; +k:=mincover(h,d);end;shorten:=d;end else shorten:=0;end;{:78}{80:} +procedure setindices(h:pointer;d:fixword);var p:pointer;q:pointer; +m:byte;l:fixword;begin q:=h;p:=link[q];m:=0;while p<>0 do begin m:=m+1; +l:=memory[p];index[p]:=m;while memory[link[p]]<=l+d do begin p:=link[p]; +index[p]:=m;excess:=excess-1;if excess=0 then d:=0;end;link[q]:=p; +memory[p]:=l+(memory[p]-l)div 2;q:=p;p:=link[p];end;memory[h]:=m;end; +{:80}{83:}procedure junkerror; +begin begin if charsonline>0 then writeln(' '); +write('There''s junk here that is not in parentheses');showerrorcontext; +end;repeat getnext until(curchar=40)or(curchar=41);end;{:83}{86:} +procedure readfourbytes(l:headerindex);begin getfourbytes; +headerbytes[l]:=curbytes.b0;headerbytes[l+1]:=curbytes.b1; +headerbytes[l+2]:=curbytes.b2;headerbytes[l+3]:=curbytes.b3;end;{:86} +{87:}procedure readBCPL(l:headerindex;n:byte);var k:headerindex; +begin k:=l;while curchar=32 do getnext; +while(curchar<>40)and(curchar<>41)do begin if k<l+n then k:=k+1; +if k<l+n then headerbytes[k]:=curchar;getnext;end; +if k=l+n then begin begin if charsonline>0 then writeln(' '); +write('String is too long; its first ',n-1:1,' characters will be kept') +;showerrorcontext;end;k:=k-1;end;headerbytes[l]:=k-l; +while k<l+n-1 do begin k:=k+1;headerbytes[k]:=0;end;end;{:87}{96:} +procedure checktag(c:byte);begin case chartag[c]of 0:; +1:begin if charsonline>0 then writeln(' '); +write('This character already appeared in a LIGTABLE LABEL'); +showerrorcontext;end;2:begin if charsonline>0 then writeln(' '); +write('This character already has a NEXTLARGER spec');showerrorcontext; +end;3:begin if charsonline>0 then writeln(' '); +write('This character already has a VARCHAR spec');showerrorcontext;end; +end;end;{:96}{107:}procedure printoctal(c:byte); +begin write('''',(c div 64):1,((c div 8)mod 8):1,(c mod 8):1);end;{:107} +{121:}function hashinput(p,c:indx):boolean;label 30;var cc:0..3; +zz:0..255;y:0..255;key:integer;t:integer; +begin if hashptr=hashsize then begin hashinput:=false;goto 30;end;{122:} +y:=ligkern[p].b1;t:=ligkern[p].b2;cc:=0;zz:=ligkern[p].b3; +if t>=128 then zz:=y else begin case t of 0,6:;5,11:zz:=y;1,7:cc:=1; +2:cc:=2;3:cc:=3;end;end{:122};key:=256*c+y+1;h:=(1009*key)mod hashsize; +while hash[h]>0 do begin if hash[h]<=key then begin if hash[h]=key then +begin hashinput:=false;goto 30;end;t:=hash[h];hash[h]:=key;key:=t; +t:=class[h];class[h]:=cc;cc:=t;t:=ligz[h];ligz[h]:=zz;zz:=t;end; +if h>0 then h:=h-1 else h:=hashsize;end;hash[h]:=key;class[h]:=cc; +ligz[h]:=zz;hashptr:=hashptr+1;hashlist[hashptr]:=h;hashinput:=true; +30:end;{:121}{123:}function f(h,x,y:indx):indx;forward; +function eval(x,y:indx):indx;var key:integer;begin key:=256*x+y+1; +h:=(1009*key)mod hashsize; +while hash[h]>key do if h>0 then h:=h-1 else h:=hashsize; +if hash[h]<key then eval:=y else eval:=f(h,x,y);end;{:123}{124:} +function f;begin case class[h]of 0:;1:begin class[h]:=4; +ligz[h]:=eval(ligz[h],y);class[h]:=0;end;2:begin class[h]:=4; +ligz[h]:=eval(x,ligz[h]);class[h]:=0;end;3:begin class[h]:=4; +ligz[h]:=eval(eval(x,ligz[h]),y);class[h]:=0;end;4:begin xligcycle:=x; +yligcycle:=y;ligz[h]:=257;class[h]:=0;end;end;f:=ligz[h];end;{:124} +{136:}procedure outscaled(x:fixword);var n:byte;m:0..65535; +begin if abs(x/designunits)>=16.0 then begin writeln( +'The relative dimension ',x/1048576:1:3,' is too large.'); +write(' (Must be less than 16*designsize'); +if designunits<>1048576 then write(' =',designunits/65536:1:3, +' designunits');writeln(')');x:=0;end; +if designunits<>1048576 then x:=round((x/designunits)*1048576.0); +if x<0 then begin write(tfmfile,255);x:=x+16777216;if x<=0 then x:=1; +end else begin write(tfmfile,0);if x>=16777216 then x:=16777215;end; +n:=x div 65536;m:=x mod 65536;write(tfmfile,n);write(tfmfile,m div 256); +write(tfmfile,m mod 256);end;{:136}{146:}procedure paramenter;begin{48:} +namelength:=5;curname[16]:=83;curname[17]:=76;curname[18]:=65; +curname[19]:=78;curname[20]:=84;entername(21);namelength:=5; +curname[16]:=83;curname[17]:=80;curname[18]:=65;curname[19]:=67; +curname[20]:=69;entername(22);namelength:=7;curname[14]:=83; +curname[15]:=84;curname[16]:=82;curname[17]:=69;curname[18]:=84; +curname[19]:=67;curname[20]:=72;entername(23);namelength:=6; +curname[15]:=83;curname[16]:=72;curname[17]:=82;curname[18]:=73; +curname[19]:=78;curname[20]:=75;entername(24);namelength:=7; +curname[14]:=88;curname[15]:=72;curname[16]:=69;curname[17]:=73; +curname[18]:=71;curname[19]:=72;curname[20]:=84;entername(25); +namelength:=4;curname[17]:=81;curname[18]:=85;curname[19]:=65; +curname[20]:=68;entername(26);namelength:=10;curname[11]:=69; +curname[12]:=88;curname[13]:=84;curname[14]:=82;curname[15]:=65; +curname[16]:=83;curname[17]:=80;curname[18]:=65;curname[19]:=67; +curname[20]:=69;entername(27);namelength:=4;curname[17]:=78; +curname[18]:=85;curname[19]:=77;curname[20]:=49;entername(28); +namelength:=4;curname[17]:=78;curname[18]:=85;curname[19]:=77; +curname[20]:=50;entername(29);namelength:=4;curname[17]:=78; +curname[18]:=85;curname[19]:=77;curname[20]:=51;entername(30); +namelength:=6;curname[15]:=68;curname[16]:=69;curname[17]:=78; +curname[18]:=79;curname[19]:=77;curname[20]:=49;entername(31); +namelength:=6;curname[15]:=68;curname[16]:=69;curname[17]:=78; +curname[18]:=79;curname[19]:=77;curname[20]:=50;entername(32); +namelength:=4;curname[17]:=83;curname[18]:=85;curname[19]:=80; +curname[20]:=49;entername(33);namelength:=4;curname[17]:=83; +curname[18]:=85;curname[19]:=80;curname[20]:=50;entername(34); +namelength:=4;curname[17]:=83;curname[18]:=85;curname[19]:=80; +curname[20]:=51;entername(35);namelength:=4;curname[17]:=83; +curname[18]:=85;curname[19]:=66;curname[20]:=49;entername(36); +namelength:=4;curname[17]:=83;curname[18]:=85;curname[19]:=66; +curname[20]:=50;entername(37);namelength:=7;curname[14]:=83; +curname[15]:=85;curname[16]:=80;curname[17]:=68;curname[18]:=82; +curname[19]:=79;curname[20]:=80;entername(38);namelength:=7; +curname[14]:=83;curname[15]:=85;curname[16]:=66;curname[17]:=68; +curname[18]:=82;curname[19]:=79;curname[20]:=80;entername(39); +namelength:=6;curname[15]:=68;curname[16]:=69;curname[17]:=76; +curname[18]:=73;curname[19]:=77;curname[20]:=49;entername(40); +namelength:=6;curname[15]:=68;curname[16]:=69;curname[17]:=76; +curname[18]:=73;curname[19]:=77;curname[20]:=50;entername(41); +namelength:=10;curname[11]:=65;curname[12]:=88;curname[13]:=73; +curname[14]:=83;curname[15]:=72;curname[16]:=69;curname[17]:=73; +curname[18]:=71;curname[19]:=72;curname[20]:=84;entername(42); +namelength:=20;curname[1]:=68;curname[2]:=69;curname[3]:=70; +curname[4]:=65;curname[5]:=85;curname[6]:=76;curname[7]:=84; +curname[8]:=82;curname[9]:=85;curname[10]:=76;curname[11]:=69; +curname[12]:=84;curname[13]:=72;curname[14]:=73;curname[15]:=67; +curname[16]:=75;curname[17]:=78;curname[18]:=69;curname[19]:=83; +curname[20]:=83;entername(28);namelength:=13;curname[8]:=66; +curname[9]:=73;curname[10]:=71;curname[11]:=79;curname[12]:=80; +curname[13]:=83;curname[14]:=80;curname[15]:=65;curname[16]:=67; +curname[17]:=73;curname[18]:=78;curname[19]:=71;curname[20]:=49; +entername(29);namelength:=13;curname[8]:=66;curname[9]:=73; +curname[10]:=71;curname[11]:=79;curname[12]:=80;curname[13]:=83; +curname[14]:=80;curname[15]:=65;curname[16]:=67;curname[17]:=73; +curname[18]:=78;curname[19]:=71;curname[20]:=50;entername(30); +namelength:=13;curname[8]:=66;curname[9]:=73;curname[10]:=71; +curname[11]:=79;curname[12]:=80;curname[13]:=83;curname[14]:=80; +curname[15]:=65;curname[16]:=67;curname[17]:=73;curname[18]:=78; +curname[19]:=71;curname[20]:=51;entername(31);namelength:=13; +curname[8]:=66;curname[9]:=73;curname[10]:=71;curname[11]:=79; +curname[12]:=80;curname[13]:=83;curname[14]:=80;curname[15]:=65; +curname[16]:=67;curname[17]:=73;curname[18]:=78;curname[19]:=71; +curname[20]:=52;entername(32);namelength:=13;curname[8]:=66; +curname[9]:=73;curname[10]:=71;curname[11]:=79;curname[12]:=80; +curname[13]:=83;curname[14]:=80;curname[15]:=65;curname[16]:=67; +curname[17]:=73;curname[18]:=78;curname[19]:=71;curname[20]:=53; +entername(33);{:48};end;procedure nameenter;begin{47:}equiv[0]:=0; +namelength:=8;curname[13]:=67;curname[14]:=72;curname[15]:=69; +curname[16]:=67;curname[17]:=75;curname[18]:=83;curname[19]:=85; +curname[20]:=77;entername(1);namelength:=10;curname[11]:=68; +curname[12]:=69;curname[13]:=83;curname[14]:=73;curname[15]:=71; +curname[16]:=78;curname[17]:=83;curname[18]:=73;curname[19]:=90; +curname[20]:=69;entername(2);namelength:=11;curname[10]:=68; +curname[11]:=69;curname[12]:=83;curname[13]:=73;curname[14]:=71; +curname[15]:=78;curname[16]:=85;curname[17]:=78;curname[18]:=73; +curname[19]:=84;curname[20]:=83;entername(3);namelength:=12; +curname[9]:=67;curname[10]:=79;curname[11]:=68;curname[12]:=73; +curname[13]:=78;curname[14]:=71;curname[15]:=83;curname[16]:=67; +curname[17]:=72;curname[18]:=69;curname[19]:=77;curname[20]:=69; +entername(4);namelength:=6;curname[15]:=70;curname[16]:=65; +curname[17]:=77;curname[18]:=73;curname[19]:=76;curname[20]:=89; +entername(5);namelength:=4;curname[17]:=70;curname[18]:=65; +curname[19]:=67;curname[20]:=69;entername(6);namelength:=16; +curname[5]:=83;curname[6]:=69;curname[7]:=86;curname[8]:=69; +curname[9]:=78;curname[10]:=66;curname[11]:=73;curname[12]:=84; +curname[13]:=83;curname[14]:=65;curname[15]:=70;curname[16]:=69; +curname[17]:=70;curname[18]:=76;curname[19]:=65;curname[20]:=71; +entername(7);namelength:=6;curname[15]:=72;curname[16]:=69; +curname[17]:=65;curname[18]:=68;curname[19]:=69;curname[20]:=82; +entername(8);namelength:=9;curname[12]:=70;curname[13]:=79; +curname[14]:=78;curname[15]:=84;curname[16]:=68;curname[17]:=73; +curname[18]:=77;curname[19]:=69;curname[20]:=78;entername(9); +namelength:=8;curname[13]:=76;curname[14]:=73;curname[15]:=71; +curname[16]:=84;curname[17]:=65;curname[18]:=66;curname[19]:=76; +curname[20]:=69;entername(10);namelength:=12;curname[9]:=66; +curname[10]:=79;curname[11]:=85;curname[12]:=78;curname[13]:=68; +curname[14]:=65;curname[15]:=82;curname[16]:=89;curname[17]:=67; +curname[18]:=72;curname[19]:=65;curname[20]:=82;entername(11); +namelength:=9;curname[12]:=67;curname[13]:=72;curname[14]:=65; +curname[15]:=82;curname[16]:=65;curname[17]:=67;curname[18]:=84; +curname[19]:=69;curname[20]:=82;entername(12);namelength:=9; +curname[12]:=80;curname[13]:=65;curname[14]:=82;curname[15]:=65; +curname[16]:=77;curname[17]:=69;curname[18]:=84;curname[19]:=69; +curname[20]:=82;entername(20);namelength:=6;curname[15]:=67; +curname[16]:=72;curname[17]:=65;curname[18]:=82;curname[19]:=87; +curname[20]:=68;entername(51);namelength:=6;curname[15]:=67; +curname[16]:=72;curname[17]:=65;curname[18]:=82;curname[19]:=72; +curname[20]:=84;entername(52);namelength:=6;curname[15]:=67; +curname[16]:=72;curname[17]:=65;curname[18]:=82;curname[19]:=68; +curname[20]:=80;entername(53);namelength:=6;curname[15]:=67; +curname[16]:=72;curname[17]:=65;curname[18]:=82;curname[19]:=73; +curname[20]:=67;entername(54);namelength:=10;curname[11]:=78; +curname[12]:=69;curname[13]:=88;curname[14]:=84;curname[15]:=76; +curname[16]:=65;curname[17]:=82;curname[18]:=71;curname[19]:=69; +curname[20]:=82;entername(55);namelength:=7;curname[14]:=86; +curname[15]:=65;curname[16]:=82;curname[17]:=67;curname[18]:=72; +curname[19]:=65;curname[20]:=82;entername(56);namelength:=3; +curname[18]:=84;curname[19]:=79;curname[20]:=80;entername(57); +namelength:=3;curname[18]:=77;curname[19]:=73;curname[20]:=68; +entername(58);namelength:=3;curname[18]:=66;curname[19]:=79; +curname[20]:=84;entername(59);namelength:=3;curname[18]:=82; +curname[19]:=69;curname[20]:=80;entername(60);namelength:=3; +curname[18]:=69;curname[19]:=88;curname[20]:=84;entername(60); +namelength:=7;curname[14]:=67;curname[15]:=79;curname[16]:=77; +curname[17]:=77;curname[18]:=69;curname[19]:=78;curname[20]:=84; +entername(0);namelength:=5;curname[16]:=76;curname[17]:=65; +curname[18]:=66;curname[19]:=69;curname[20]:=76;entername(70); +namelength:=4;curname[17]:=83;curname[18]:=84;curname[19]:=79; +curname[20]:=80;entername(71);namelength:=4;curname[17]:=83; +curname[18]:=75;curname[19]:=73;curname[20]:=80;entername(72); +namelength:=3;curname[18]:=75;curname[19]:=82;curname[20]:=78; +entername(73);namelength:=3;curname[18]:=76;curname[19]:=73; +curname[20]:=71;entername(74);namelength:=4;curname[17]:=47; +curname[18]:=76;curname[19]:=73;curname[20]:=71;entername(76); +namelength:=5;curname[16]:=47;curname[17]:=76;curname[18]:=73; +curname[19]:=71;curname[20]:=62;entername(80);namelength:=4; +curname[17]:=76;curname[18]:=73;curname[19]:=71;curname[20]:=47; +entername(75);namelength:=5;curname[16]:=76;curname[17]:=73; +curname[18]:=71;curname[19]:=47;curname[20]:=62;entername(79); +namelength:=5;curname[16]:=47;curname[17]:=76;curname[18]:=73; +curname[19]:=71;curname[20]:=47;entername(77);namelength:=6; +curname[15]:=47;curname[16]:=76;curname[17]:=73;curname[18]:=71; +curname[19]:=47;curname[20]:=62;entername(81);namelength:=7; +curname[14]:=47;curname[15]:=76;curname[16]:=73;curname[17]:=71; +curname[18]:=47;curname[19]:=62;curname[20]:=62;entername(85);{:47}; +paramenter;end;procedure readligkern;var krnptr:0..maxkerns;c:byte; +begin{94:}begin lkstepended:=false; +while level=1 do begin while curchar=32 do getnext; +if curchar=40 then{95:}begin getname; +if curcode=0 then skiptoendofitem else if curcode<70 then begin begin if +charsonline>0 then writeln(' '); +write('This property name doesn''t belong in a LIGTABLE list'); +showerrorcontext;end;skiptoendofitem; +end else begin case curcode of 70:{97:} +begin while curchar=32 do getnext; +if curchar=66 then begin charremainder[256]:=nl; +repeat getnext until(curchar=40)or(curchar=41); +end else begin begin if(curchar>41)or(curchar<40)then loc:=loc-1;end; +c:=getbyte;checktag(c);chartag[c]:=1;charremainder[c]:=nl;end; +if minnl<=nl then minnl:=nl+1;lkstepended:=false;end{:97};71:{99:} +if not lkstepended then begin if charsonline>0 then writeln(' '); +write('STOP must follow LIG or KRN');showerrorcontext; +end else begin ligkern[nl-1].b0:=128;lkstepended:=false;end{:99}; +72:{100:} +if not lkstepended then begin if charsonline>0 then writeln(' '); +write('SKIP must follow LIG or KRN');showerrorcontext; +end else begin c:=getbyte; +if c>=128 then begin if charsonline>0 then writeln(' '); +write('Maximum SKIP amount is 127');showerrorcontext; +end else if nl+c>=maxligsteps then begin if charsonline>0 then writeln( +' ');write('Sorry, LIGTABLE too long for me to handle'); +showerrorcontext;end else begin ligkern[nl-1].b0:=c; +if minnl<=nl+c then minnl:=nl+c+1;end;lkstepended:=false;end{:100}; +73:{102:}begin ligkern[nl].b0:=0;ligkern[nl].b1:=getbyte; +kern[nk]:=getfix;krnptr:=0; +while kern[krnptr]<>kern[nk]do krnptr:=krnptr+1; +if krnptr=nk then begin if nk<maxkerns then nk:=nk+1 else begin begin if +charsonline>0 then writeln(' '); +write('Sorry, too many different kerns for me to handle'); +showerrorcontext;end;krnptr:=krnptr-1;end;end; +ligkern[nl].b2:=128+(krnptr div 256);ligkern[nl].b3:=krnptr mod 256; +if nl>=maxligsteps-1 then begin if charsonline>0 then writeln(' '); +write('Sorry, LIGTABLE too long for me to handle');showerrorcontext; +end else nl:=nl+1;lkstepended:=true;end{:102}; +74,75,76,77,79,80,81,85:{101:}begin ligkern[nl].b0:=0; +ligkern[nl].b2:=curcode-74;ligkern[nl].b1:=getbyte; +ligkern[nl].b3:=getbyte; +if nl>=maxligsteps-1 then begin if charsonline>0 then writeln(' '); +write('Sorry, LIGTABLE too long for me to handle');showerrorcontext; +end else nl:=nl+1;lkstepended:=true;end{:101};end;finishtheproperty;end; +end{:95}else if curchar=41 then skiptoendofitem else junkerror;end; +begin loc:=loc-1;level:=level+1;curchar:=41;end;end{:94};end; +procedure readcharinfo;var c:byte;begin{103:}begin c:=getbyte;{108:} +begin if charsonline=8 then begin writeln(' ');charsonline:=1; +end else begin if charsonline>0 then write(' '); +charsonline:=charsonline+1;end;printoctal(c);end{:108}; +while level=1 do begin while curchar=32 do getnext; +if curchar=40 then{104:}begin getname; +if curcode=0 then skiptoendofitem else if(curcode<51)or(curcode>56)then +begin begin if charsonline>0 then writeln(' '); +write('This property name doesn''t belong in a CHARACTER list'); +showerrorcontext;end;skiptoendofitem; +end else begin case curcode of 51:charwd[c]:=sortin(1,getfix); +52:charht[c]:=sortin(2,getfix);53:chardp[c]:=sortin(3,getfix); +54:charic[c]:=sortin(4,getfix);55:begin checktag(c);chartag[c]:=2; +charremainder[c]:=getbyte;end;56:{105:} +begin if ne=256 then begin if charsonline>0 then writeln(' '); +write('At most 256 VARCHAR specs are allowed');showerrorcontext; +end else begin checktag(c);chartag[c]:=3;charremainder[c]:=ne; +exten[ne].b0:=0;exten[ne].b1:=0;exten[ne].b2:=0;exten[ne].b3:=0; +while level=2 do begin while curchar=32 do getnext; +if curchar=40 then{106:}begin getname; +if curcode=0 then skiptoendofitem else if(curcode<57)or(curcode>60)then +begin begin if charsonline>0 then writeln(' '); +write('This property name doesn''t belong in a VARCHAR list'); +showerrorcontext;end;skiptoendofitem; +end else begin case curcode-(57)of 0:exten[ne].b0:=getbyte; +1:exten[ne].b1:=getbyte;2:exten[ne].b2:=getbyte;3:exten[ne].b3:=getbyte; +end;finishtheproperty;end;end{:106} +else if curchar=41 then skiptoendofitem else junkerror;end;ne:=ne+1; +begin loc:=loc-1;level:=level+1;curchar:=41;end;end;end{:105};end; +finishtheproperty;end;end{:104} +else if curchar=41 then skiptoendofitem else junkerror;end; +if charwd[c]=0 then charwd[c]:=sortin(1,0);begin loc:=loc-1; +level:=level+1;curchar:=41;end;end{:103};end;procedure readinput; +var c:byte;begin{82:}curchar:=32;repeat while curchar=32 do getnext; +if curchar=40 then{84:}begin getname; +if curcode=0 then skiptoendofitem else if curcode>12 then begin begin if +charsonline>0 then writeln(' '); +write('This property name doesn''t belong on the outer level'); +showerrorcontext;end;skiptoendofitem;end else begin{85:} +case curcode of 1:begin checksumspecified:=true;readfourbytes(0);end; +2:{88:}begin nextd:=getfix; +if nextd<1048576 then begin if charsonline>0 then writeln(' '); +write('The design size must be at least 1');showerrorcontext; +end else designsize:=nextd;end{:88};3:{89:}begin nextd:=getfix; +if nextd<=0 then begin if charsonline>0 then writeln(' '); +write('The number of units per design size must be positive'); +showerrorcontext;end else designunits:=nextd;end{:89};4:readBCPL(8,40); +5:readBCPL(48,20);6:headerbytes[71]:=getbyte;7:{90:} +begin while curchar=32 do getnext; +if curchar=84 then sevenbitsafeflag:=true else if curchar=70 then +sevenbitsafeflag:=false else begin if charsonline>0 then writeln(' '); +write('The flag value should be "TRUE" or "FALSE"');showerrorcontext; +end;repeat getnext until(curchar=40)or(curchar=41);end{:90};8:{91:} +begin c:=getbyte; +if c<18 then begin begin if charsonline>0 then writeln(' '); +write('HEADER indices should be 18 or more');showerrorcontext;end; +repeat getnext until(curchar=40)or(curchar=41); +end else if 4*c+4>maxheaderbytes then begin begin if charsonline>0 then +writeln(' '); +write('This HEADER index is too big for my present table size'); +showerrorcontext;end;repeat getnext until(curchar=40)or(curchar=41); +end else begin while headerptr<4*c+4 do begin headerbytes[headerptr]:=0; +headerptr:=headerptr+1;end;readfourbytes(4*c);end;end{:91};9:{92:} +begin while level=1 do begin while curchar=32 do getnext; +if curchar=40 then{93:}begin getname; +if curcode=0 then skiptoendofitem else if(curcode<20)or(curcode>=51)then +begin begin if charsonline>0 then writeln(' '); +write('This property name doesn''t belong in a FONTDIMEN list'); +showerrorcontext;end;skiptoendofitem; +end else begin if curcode=20 then c:=getbyte else c:=curcode-20; +if c=0 then begin begin if charsonline>0 then writeln(' '); +write('PARAMETER index must not be zero');showerrorcontext;end; +skiptoendofitem; +end else if c>maxparamwords then begin begin if charsonline>0 then +writeln(' '); +write('This PARAMETER index is too big for my present table size'); +showerrorcontext;end;skiptoendofitem; +end else begin while np<c do begin np:=np+1;param[np]:=0;end; +param[c]:=getfix;finishtheproperty;end;end;end{:93} +else if curchar=41 then skiptoendofitem else junkerror;end; +begin loc:=loc-1;level:=level+1;curchar:=41;end;end{:92};10:readligkern; +11:bchar:=getbyte;12:readcharinfo;end{:85};finishtheproperty;end; +end{:84} +else if(curchar=41)and not inputhasended then begin begin if charsonline +>0 then writeln(' ');write('Extra right parenthesis');showerrorcontext; +end;loc:=loc+1;curchar:=32;end else if not inputhasended then junkerror; +until inputhasended{:82};end;procedure corrandcheck;var c:0..256; +hh:0..hashsize;ligptr:0..maxligsteps;g:byte;begin{110:} +if nl>0 then{116:} +begin if charremainder[256]<32767 then begin ligkern[nl].b0:=255; +ligkern[nl].b1:=0;ligkern[nl].b2:=0;ligkern[nl].b3:=0;nl:=nl+1;end; +while minnl>nl do begin ligkern[nl].b0:=255;ligkern[nl].b1:=0; +ligkern[nl].b2:=0;ligkern[nl].b3:=0;nl:=nl+1;end; +if ligkern[nl-1].b0=0 then ligkern[nl-1].b0:=128;end{:116}; +sevenunsafe:=false;for c:=0 to 255 do if charwd[c]<>0 then{111:} +case chartag[c]of 0:;1:{120:}begin ligptr:=charremainder[c]; +repeat if hashinput(ligptr,c)then begin if ligkern[ligptr].b2<128 then +begin if ligkern[ligptr].b1<>bchar then begin g:=ligkern[ligptr].b1; +if charwd[g]=0 then begin charwd[g]:=sortin(1,0); +write('LIG character examined by',' ');printoctal(c); +writeln(' had no CHARACTER spec.');end;end;begin g:=ligkern[ligptr].b3; +if charwd[g]=0 then begin charwd[g]:=sortin(1,0); +write('LIG character generated by',' ');printoctal(c); +writeln(' had no CHARACTER spec.');end;end; +if ligkern[ligptr].b3>=128 then if(c<128)or(c=256)then if(ligkern[ligptr +].b1<128)or(ligkern[ligptr].b1=bchar)then sevenunsafe:=true; +end else if ligkern[ligptr].b1<>bchar then begin g:=ligkern[ligptr].b1; +if charwd[g]=0 then begin charwd[g]:=sortin(1,0); +write('KRN character examined by',' ');printoctal(c); +writeln(' had no CHARACTER spec.');end;end;end; +if ligkern[ligptr].b0>=128 then ligptr:=nl else ligptr:=ligptr+1+ligkern +[ligptr].b0;until ligptr>=nl;end{:120};2:begin g:=charremainder[c]; +if(g>=128)and(c<128)then sevenunsafe:=true; +if charwd[g]=0 then begin charwd[g]:=sortin(1,0); +write('The character NEXTLARGER than',' ');printoctal(c); +writeln(' had no CHARACTER spec.');end;end;3:{112:} +begin if exten[charremainder[c]].b0>0 then begin g:=exten[charremainder[ +c]].b0;if(g>=128)and(c<128)then sevenunsafe:=true; +if charwd[g]=0 then begin charwd[g]:=sortin(1,0); +write('TOP piece of character',' ');printoctal(c); +writeln(' had no CHARACTER spec.');end;end; +if exten[charremainder[c]].b1>0 then begin g:=exten[charremainder[c]].b1 +;if(g>=128)and(c<128)then sevenunsafe:=true; +if charwd[g]=0 then begin charwd[g]:=sortin(1,0); +write('MID piece of character',' ');printoctal(c); +writeln(' had no CHARACTER spec.');end;end; +if exten[charremainder[c]].b2>0 then begin g:=exten[charremainder[c]].b2 +;if(g>=128)and(c<128)then sevenunsafe:=true; +if charwd[g]=0 then begin charwd[g]:=sortin(1,0); +write('BOT piece of character',' ');printoctal(c); +writeln(' had no CHARACTER spec.');end;end; +begin g:=exten[charremainder[c]].b3; +if(g>=128)and(c<128)then sevenunsafe:=true; +if charwd[g]=0 then begin charwd[g]:=sortin(1,0); +write('REP piece of character',' ');printoctal(c); +writeln(' had no CHARACTER spec.');end;end;end{:112};end{:111}; +if charremainder[256]<32767 then begin c:=256;{120:} +begin ligptr:=charremainder[c]; +repeat if hashinput(ligptr,c)then begin if ligkern[ligptr].b2<128 then +begin if ligkern[ligptr].b1<>bchar then begin g:=ligkern[ligptr].b1; +if charwd[g]=0 then begin charwd[g]:=sortin(1,0); +write('LIG character examined by',' ');printoctal(c); +writeln(' had no CHARACTER spec.');end;end;begin g:=ligkern[ligptr].b3; +if charwd[g]=0 then begin charwd[g]:=sortin(1,0); +write('LIG character generated by',' ');printoctal(c); +writeln(' had no CHARACTER spec.');end;end; +if ligkern[ligptr].b3>=128 then if(c<128)or(c=256)then if(ligkern[ligptr +].b1<128)or(ligkern[ligptr].b1=bchar)then sevenunsafe:=true; +end else if ligkern[ligptr].b1<>bchar then begin g:=ligkern[ligptr].b1; +if charwd[g]=0 then begin charwd[g]:=sortin(1,0); +write('KRN character examined by',' ');printoctal(c); +writeln(' had no CHARACTER spec.');end;end;end; +if ligkern[ligptr].b0>=128 then ligptr:=nl else ligptr:=ligptr+1+ligkern +[ligptr].b0;until ligptr>=nl;end{:120};end; +if sevenbitsafeflag and sevenunsafe then writeln( +'The font is not really seven-bit-safe!');{125:} +if hashptr<hashsize then for hh:=1 to hashptr do begin tt:=hashlist[hh]; +if class[tt]>0 then tt:=f(tt,(hash[tt]-1)div 256,(hash[tt]-1)mod 256); +end; +if(hashptr=hashsize)or(yligcycle<256)then begin if hashptr<hashsize then +begin write('Infinite ligature loop starting with '); +if xligcycle=256 then write('boundary')else printoctal(xligcycle); +write(' and ');printoctal(yligcycle);writeln('!'); +end else writeln( +'Sorry, I haven''t room for so many ligature/kern pairs!'); +writeln('All ligatures will be cleared.'); +for c:=0 to 255 do if chartag[c]=1 then begin chartag[c]:=0; +charremainder[c]:=0;end;nl:=0;bchar:=256;charremainder[256]:=32767; +end{:125};{126:} +if nl>0 then for ligptr:=0 to nl-1 do if ligkern[ligptr].b2<128 then +begin if ligkern[ligptr].b0<255 then begin begin c:=ligkern[ligptr].b1; +if charwd[c]=0 then if c<>bchar then begin ligkern[ligptr].b1:=0; +if charwd[0]=0 then charwd[0]:=sortin(1,0); +write('Unused ','LIG step',' refers to nonexistent character '); +printoctal(c);writeln('!');end;end;begin c:=ligkern[ligptr].b3; +if charwd[c]=0 then if c<>bchar then begin ligkern[ligptr].b3:=0; +if charwd[0]=0 then charwd[0]:=sortin(1,0); +write('Unused ','LIG step',' refers to nonexistent character '); +printoctal(c);writeln('!');end;end;end; +end else begin c:=ligkern[ligptr].b1; +if charwd[c]=0 then if c<>bchar then begin ligkern[ligptr].b1:=0; +if charwd[0]=0 then charwd[0]:=sortin(1,0); +write('Unused ','KRN step',' refers to nonexistent character '); +printoctal(c);writeln('!');end;end; +if ne>0 then for g:=0 to ne-1 do begin begin c:=exten[g].b0; +if c>0 then if charwd[c]=0 then begin exten[g].b0:=0; +if charwd[0]=0 then charwd[0]:=sortin(1,0); +write('Unused ','VARCHAR TOP',' refers to nonexistent character '); +printoctal(c);writeln('!');end;end;begin c:=exten[g].b1; +if c>0 then if charwd[c]=0 then begin exten[g].b1:=0; +if charwd[0]=0 then charwd[0]:=sortin(1,0); +write('Unused ','VARCHAR MID',' refers to nonexistent character '); +printoctal(c);writeln('!');end;end;begin c:=exten[g].b2; +if c>0 then if charwd[c]=0 then begin exten[g].b2:=0; +if charwd[0]=0 then charwd[0]:=sortin(1,0); +write('Unused ','VARCHAR BOT',' refers to nonexistent character '); +printoctal(c);writeln('!');end;end;begin c:=exten[g].b3; +if charwd[c]=0 then begin exten[g].b3:=0; +if charwd[0]=0 then charwd[0]:=sortin(1,0); +write('Unused ','VARCHAR REP',' refers to nonexistent character '); +printoctal(c);writeln('!');end;end;end{:126};for c:=0 to 255 do{113:} +if chartag[c]=2 then begin g:=charremainder[c]; +while(g<c)and(chartag[g]=2)do g:=charremainder[g]; +if g=c then begin chartag[c]:=0; +write('A cycle of NEXTLARGER characters has been broken at '); +printoctal(c);writeln('.');end;end{:113};{115:}delta:=shorten(1,255); +setindices(1,delta); +if delta>0 then writeln('I had to round some ','width','s by ',(((delta ++1)div 2)/1048576):1:7,' units.');delta:=shorten(2,15); +setindices(2,delta); +if delta>0 then writeln('I had to round some ','height','s by ',(((delta ++1)div 2)/1048576):1:7,' units.');delta:=shorten(3,15); +setindices(3,delta); +if delta>0 then writeln('I had to round some ','depth','s by ',(((delta ++1)div 2)/1048576):1:7,' units.');delta:=shorten(4,63); +setindices(4,delta); +if delta>0 then writeln('I had to round some ','italic correction', +'s by ',(((delta+1)div 2)/1048576):1:7,' units.');{:115}{:110}end;{:146} +{147:}begin initialize;nameenter;readinput;writeln('.');corrandcheck; +{128:}{130:}lh:=headerptr div 4;notfound:=true;bc:=0; +while notfound do if(charwd[bc]>0)or(bc=255)then notfound:=false else bc +:=bc+1;notfound:=true;ec:=255; +while notfound do if(charwd[ec]>0)or(ec=0)then notfound:=false else ec:= +ec-1;if bc>ec then bc:=1;memory[1]:=memory[1]+1;memory[2]:=memory[2]+1; +memory[3]:=memory[3]+1;memory[4]:=memory[4]+1;{139:}{140:}labelptr:=0; +labeltable[0].rr:=-1; +for c:=bc to ec do if chartag[c]=1 then begin sortptr:=labelptr; +while labeltable[sortptr].rr>charremainder[c]do begin labeltable[sortptr ++1]:=labeltable[sortptr];sortptr:=sortptr-1;end; +labeltable[sortptr+1].cc:=c;labeltable[sortptr+1].rr:=charremainder[c]; +labelptr:=labelptr+1;end{:140}; +if bchar<256 then begin extralocneeded:=true;lkoffset:=1; +end else begin extralocneeded:=false;lkoffset:=0;end;{141:} +begin sortptr:=labelptr; +if labeltable[sortptr].rr+lkoffset>255 then begin lkoffset:=0; +extralocneeded:=false; +repeat charremainder[labeltable[sortptr].cc]:=lkoffset; +while labeltable[sortptr-1].rr=labeltable[sortptr].rr do begin sortptr:= +sortptr-1;charremainder[labeltable[sortptr].cc]:=lkoffset;end; +lkoffset:=lkoffset+1;sortptr:=sortptr-1; +until lkoffset+labeltable[sortptr].rr<256;end; +if lkoffset>0 then while sortptr>0 do begin charremainder[labeltable[ +sortptr].cc]:=charremainder[labeltable[sortptr].cc]+lkoffset; +sortptr:=sortptr-1;end;end{:141}; +if charremainder[256]<32767 then begin ligkern[nl-1].b2:=(charremainder[ +256]+lkoffset)div 256; +ligkern[nl-1].b3:=(charremainder[256]+lkoffset)mod 256;end{:139}; +lf:=6+lh+(ec-bc+1)+memory[1]+memory[2]+memory[3]+memory[4]+nl+lkoffset+ +nk+ne+np;{:130};{131:}write(tfmfile,(lf)div 256); +write(tfmfile,(lf)mod 256);write(tfmfile,(lh)div 256); +write(tfmfile,(lh)mod 256);write(tfmfile,(bc)div 256); +write(tfmfile,(bc)mod 256);write(tfmfile,(ec)div 256); +write(tfmfile,(ec)mod 256);write(tfmfile,(memory[1])div 256); +write(tfmfile,(memory[1])mod 256);write(tfmfile,(memory[2])div 256); +write(tfmfile,(memory[2])mod 256);write(tfmfile,(memory[3])div 256); +write(tfmfile,(memory[3])mod 256);write(tfmfile,(memory[4])div 256); +write(tfmfile,(memory[4])mod 256);write(tfmfile,(nl+lkoffset)div 256); +write(tfmfile,(nl+lkoffset)mod 256);write(tfmfile,(nk)div 256); +write(tfmfile,(nk)mod 256);write(tfmfile,(ne)div 256); +write(tfmfile,(ne)mod 256);write(tfmfile,(np)div 256); +write(tfmfile,(np)mod 256);{:131};{133:} +if not checksumspecified then{134:}begin curbytes.b0:=bc; +curbytes.b1:=ec;curbytes.b2:=bc;curbytes.b3:=ec; +for c:=bc to ec do if charwd[c]>0 then begin tempwidth:=memory[charwd[c] +];if designunits<>1048576 then tempwidth:=round((tempwidth/designunits) +*1048576.0);tempwidth:=tempwidth+(c+4)*4194304; +curbytes.b0:=(curbytes.b0+curbytes.b0+tempwidth)mod 255; +curbytes.b1:=(curbytes.b1+curbytes.b1+tempwidth)mod 253; +curbytes.b2:=(curbytes.b2+curbytes.b2+tempwidth)mod 251; +curbytes.b3:=(curbytes.b3+curbytes.b3+tempwidth)mod 247;end; +headerbytes[0]:=curbytes.b0;headerbytes[1]:=curbytes.b1; +headerbytes[2]:=curbytes.b2;headerbytes[3]:=curbytes.b3;end{:134}; +headerbytes[4]:=designsize div 16777216; +headerbytes[5]:=(designsize div 65536)mod 256; +headerbytes[6]:=(designsize div 256)mod 256; +headerbytes[7]:=designsize mod 256; +if not sevenunsafe then headerbytes[68]:=128; +for j:=0 to headerptr-1 do write(tfmfile,headerbytes[j]);{:133};{135:} +index[0]:=0;for c:=bc to ec do begin write(tfmfile,index[charwd[c]]); +write(tfmfile,index[charht[c]]*16+index[chardp[c]]); +write(tfmfile,index[charic[c]]*4+chartag[c]); +write(tfmfile,charremainder[c]);end{:135};{137:} +for q:=1 to 4 do begin write(tfmfile,0);write(tfmfile,0); +write(tfmfile,0);write(tfmfile,0);p:=link[q]; +while p>0 do begin outscaled(memory[p]);p:=link[p];end;end;{:137};{142:} +if extralocneeded then begin write(tfmfile,255);write(tfmfile,bchar); +write(tfmfile,0);write(tfmfile,0); +end else for sortptr:=1 to lkoffset do begin t:=labeltable[labelptr].rr; +if bchar<256 then begin write(tfmfile,255);write(tfmfile,bchar); +end else begin write(tfmfile,254);write(tfmfile,0);end; +write(tfmfile,(t+lkoffset)div 256);write(tfmfile,(t+lkoffset)mod 256); +repeat labelptr:=labelptr-1;until labeltable[labelptr].rr<t;end; +if nl>0 then for ligptr:=0 to nl-1 do begin write(tfmfile,ligkern[ligptr +].b0);write(tfmfile,ligkern[ligptr].b1); +write(tfmfile,ligkern[ligptr].b2);write(tfmfile,ligkern[ligptr].b3);end; +if nk>0 then for krnptr:=0 to nk-1 do outscaled(kern[krnptr]){:142}; +{143:}if ne>0 then for c:=0 to ne-1 do begin write(tfmfile,exten[c].b0); +write(tfmfile,exten[c].b1);write(tfmfile,exten[c].b2); +write(tfmfile,exten[c].b3);end;{:143};{144:} +for parptr:=1 to np do begin if parptr=1 then{145:} +begin if param[1]<0 then begin param[1]:=param[1]+1073741824; +write(tfmfile,(param[1]div 16777216)+192); +end else write(tfmfile,param[1]div 16777216); +write(tfmfile,(param[1]div 65536)mod 256); +write(tfmfile,(param[1]div 256)mod 256);write(tfmfile,param[1]mod 256); +end{:145}else outscaled(param[parptr]);end{:144}{:128}; +9999:writeln(' ');end.{:147} diff --git a/systems/knuth/local/texware/pooltype.ch b/systems/knuth/local/texware/pooltype.ch new file mode 100644 index 0000000000..c96ec0c8cb --- /dev/null +++ b/systems/knuth/local/texware/pooltype.ch @@ -0,0 +1,92 @@ +% Change file for the Pooltype processor +% Hacked together by don on 8/7/89 since the old pooltype.ch seems lost +% 8-bit modifications made 9/11/89 + +% Module numbers are from the standard TeXware report (CS1097) + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [0] WEAVE: print changes only +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +\pageno=\contentspagenumber \advance\pageno by 1 +@y +\pageno=\contentspagenumber \advance\pageno by 1 +\let\maybe=\iffalse +\def\title{POOLTYPE changes for GNU Pascal} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [2] Program header +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +@x +@p program POOLtype(@!pool_file,@!output); +label 9999; {this labels the end of the program} +type @<Types in the outer block@>@/ +@y +@p program POOLtype(@!output); +label 9999; {this labels the end of the program} +type UNIX_file_name=packed array[1..100] of char; +@<Types in the outer block@>@/ +@z +@x +procedure initialize; {this procedure gets things started properly} +@y +@\ +@=#include "texwarext.h"@> +@\@/ +procedure initialize; {this procedure gets things started properly} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [5] Bytes +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!ASCII_code=0..255; {eight-bit numbers} +@y +@!ASCII_code=ByteCard; {eight-bit numbers} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [12] Permissiveness +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +for i:=0 to @'37 do xchr[i]:=' '; +for i:=@'177 to @'377 do xchr[i]:=' '; +@y +for i:=0 to @'37 do xchr[i]:=chr(i); +for i:=@'177 to @'377 do xchr[i]:=chr(i); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [15] Beginning of main program +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +@x +@p begin initialize;@/ +@y +@p begin if argc < 2 then + abort('Usage: pooltype <pool-file>'); +initialize;@/ +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [18] Input file declaration needs also a string +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +@x +@!pool_file:packed file of text_char; +@y +@!pool_file:text; {GNU Pascal needs this simplication} +@!pool_name:UNIX_file_name; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [19] Opening the input file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +@x +reset(pool_file); xsum:=false; +@y +argv(1,pool_name); reset(pool_file,pool_name); xsum:=false; +@z diff --git a/systems/knuth/local/texware/pooltype.p b/systems/knuth/local/texware/pooltype.p new file mode 100644 index 0000000000..c6526499f3 --- /dev/null +++ b/systems/knuth/local/texware/pooltype.p @@ -0,0 +1,57 @@ +{2:}program POOLtype(output);label 9999; +type UNIXfilename=packed array[1..100]of char;{5:}ASCIIcode=ByteCard; +{:5}var{7:}xord:array[char]of ASCIIcode;xchr:array[ASCIIcode]of char; +{:7}{12:}k,l:0..255;m,n:char;s:integer;{:12}{13:}count:integer;{:13} +{18:}poolfile:text;poolname:UNIXfilename;xsum:boolean;{:18} +#include "dvityext.h" +procedure initialize;var{6:}i:integer;{:6}begin{8:}xchr[32]:=' '; +xchr[33]:='!';xchr[34]:='"';xchr[35]:='#';xchr[36]:='$';xchr[37]:='%'; +xchr[38]:='&';xchr[39]:='''';xchr[40]:='(';xchr[41]:=')';xchr[42]:='*'; +xchr[43]:='+';xchr[44]:=',';xchr[45]:='-';xchr[46]:='.';xchr[47]:='/'; +xchr[48]:='0';xchr[49]:='1';xchr[50]:='2';xchr[51]:='3';xchr[52]:='4'; +xchr[53]:='5';xchr[54]:='6';xchr[55]:='7';xchr[56]:='8';xchr[57]:='9'; +xchr[58]:=':';xchr[59]:=';';xchr[60]:='<';xchr[61]:='=';xchr[62]:='>'; +xchr[63]:='?';xchr[64]:='@';xchr[65]:='A';xchr[66]:='B';xchr[67]:='C'; +xchr[68]:='D';xchr[69]:='E';xchr[70]:='F';xchr[71]:='G';xchr[72]:='H'; +xchr[73]:='I';xchr[74]:='J';xchr[75]:='K';xchr[76]:='L';xchr[77]:='M'; +xchr[78]:='N';xchr[79]:='O';xchr[80]:='P';xchr[81]:='Q';xchr[82]:='R'; +xchr[83]:='S';xchr[84]:='T';xchr[85]:='U';xchr[86]:='V';xchr[87]:='W'; +xchr[88]:='X';xchr[89]:='Y';xchr[90]:='Z';xchr[91]:='[';xchr[92]:='\'; +xchr[93]:=']';xchr[94]:='^';xchr[95]:='_';xchr[96]:='`';xchr[97]:='a'; +xchr[98]:='b';xchr[99]:='c';xchr[100]:='d';xchr[101]:='e'; +xchr[102]:='f';xchr[103]:='g';xchr[104]:='h';xchr[105]:='i'; +xchr[106]:='j';xchr[107]:='k';xchr[108]:='l';xchr[109]:='m'; +xchr[110]:='n';xchr[111]:='o';xchr[112]:='p';xchr[113]:='q'; +xchr[114]:='r';xchr[115]:='s';xchr[116]:='t';xchr[117]:='u'; +xchr[118]:='v';xchr[119]:='w';xchr[120]:='x';xchr[121]:='y'; +xchr[122]:='z';xchr[123]:='{';xchr[124]:='|';xchr[125]:='}'; +xchr[126]:='~';{:8}{10:}for i:=0 to 31 do xchr[i]:=chr(i); +for i:=127 to 255 do xchr[i]:=chr(i);{:10}{11:} +for i:=0 to 255 do xord[chr(i)]:=127; +for i:=128 to 255 do xord[xchr[i]]:=i; +for i:=0 to 126 do xord[xchr[i]]:=i;{:11}{14:}count:=0;{:14}end;{:2} +{15:}begin if argc<2 then begin writeln('Usage: pooltype <pool-file>'); +goto 9999;end;initialize;{16:}for k:=0 to 255 do begin write(k:3,': "'); +l:=k;if({17:}(k<32)or(k>126){:17})then begin write(xchr[94],xchr[94]); +if k<64 then l:=k+64 else if k<128 then l:=k-64 else begin l:=k div 16; +if l<10 then l:=l+48 else l:=l+87;write(xchr[l]);l:=k mod 16; +if l<10 then l:=l+48 else l:=l+87;count:=count+1;end;count:=count+2;end; +if l=34 then write(xchr[l],xchr[l])else write(xchr[l]);count:=count+1; +writeln('"');end{:16};s:=256;{19:}argv(1,poolname); +reset(poolfile,poolname);xsum:=false; +if eof(poolfile)then begin writeln('! I can''t read the POOL file.'); +goto 9999;end;repeat{20:} +if eof(poolfile)then begin writeln('! POOL file contained no check sum') +;goto 9999;end;read(poolfile,m,n); +if m<>'*'then begin if(xord[m]<48)or(xord[m]>57)or(xord[n]<48)or(xord[n] +>57)then begin writeln('! POOL line doesn''t begin with two digits'); +goto 9999;end;l:=xord[m]*10+xord[n]-48*11;write(s:3,': "'); +count:=count+l; +for k:=1 to l do begin if eoln(poolfile)then begin writeln('"'); +begin writeln('! That POOL line was too short');goto 9999;end;end; +read(poolfile,m);write(xchr[xord[m]]); +if xord[m]=34 then write(xchr[34]);end;writeln('"');s:=s+1; +end else xsum:=true;readln(poolfile){:20};until xsum; +if not eof(poolfile)then begin writeln( +'! There''s junk after the check sum');goto 9999;end{:19}; +writeln('(',count:1,' characters in all.)');9999:end.{:15} diff --git a/systems/knuth/local/texware/texwarext.h b/systems/knuth/local/texware/texwarext.h new file mode 100644 index 0000000000..a183a12814 --- /dev/null +++ b/systems/knuth/local/texware/texwarext.h @@ -0,0 +1,5 @@ +argc:asmname '_p_argc' Integer; + +procedure argv(no:Integer;var str:UNIXfilename); external; + +function testreadaccess(var a:UNIXfilename):boolean; external; diff --git a/systems/knuth/local/texware/tftopl.ch b/systems/knuth/local/texware/tftopl.ch new file mode 100644 index 0000000000..2c1304d3b5 --- /dev/null +++ b/systems/knuth/local/texware/tftopl.ch @@ -0,0 +1,128 @@ +% Change file for the TFtoPL processor, for use with GNU Pascal. +% (by Don Knuth, based on the work of Pavel Curtis in ../texware-sparc) + +% History: +% 2000.04.30 Original version + +% The section numbers used in this file refer to the current numbers, +% and, where different, also to those in the standard TeXware report (CS1097). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [0] WEAVE: print changes only +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +\pageno=\contentspagenumber \advance\pageno by 1 +@y +\pageno=\contentspagenumber \advance\pageno by 1 +\let\maybe=\iffalse +\def\title{TF\lowercase{to}PL changes for GNU Pascal} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1] Change banner string +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d banner=='This is TFtoPL, Version 3.1' {printed when the program starts} +@y +@d banner=='This is TFtoPL, Version 3.1 for Linux' + {printed when the program starts} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [2] Fix files in program statement; add external access procedure +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p program TFtoPL(@!tfm_file,@!pl_file,@!output); +label @<Labels in the outer block@>@/ +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +@y +@p program TFtoPL(@!output); +label @<Labels in the outer block@>@/ +const @<Constants in the outer block@>@/ +type UNIX_file_name=packed array[1..100] of char; + @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +@\ +@=#include "texwarext.h"@> +@\@/ +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [6] Fix declaration of tfm_file; declare extra TFM-file variables +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!tfm_file:packed file of 0..255; +@y +@!tfm_file:packed file of ByteCard; {files that contain binary data} +@!tfm_name:UNIX_file_name; +@!tfm_byte:integer; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [7] Open TFM file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ On some systems you may have to do something special to read a +packed file of bytes. For example, the following code didn't work +when it was first tried at Stanford, because packed files have to be +opened with a special switch setting on the \PASCAL\ that was used. +@^system dependencies@> + +@<Set init...@>= +reset(tfm_file); +@y +@ On some systems you may have to do something special to read a +packed file of bytes. + +@<Set init...@>= +if argc < 3 then begin + print_ln('Usage: tftopl <tfm-file> <pl-file>'); + goto final_end; +end; +argv(1, tfm_name); +if testreadaccess(tfm_name) then reset(tfm_file, tfm_name) +else begin print_ln('I can''t read the TFM file!'); goto final_end; + end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [16] Declare pl_name +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!pl_file:text; +@y +@!pl_file:text; +@!pl_name: UNIX_file_name; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [17] Open PL file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ @<Set init...@>= +rewrite(pl_file); +@y +@ @<Set init...@>= +argv(2, pl_name); +rewrite(pl_file, pl_name); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [18] Fix definition of byte +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!byte=0..255; {unsigned eight-bit quantity} +@y +@!byte=ByteCard; {unsigned eight-bit quantity} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [99, was 88] Add printing of newline at end of program +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +final_end:end. +@y +final_end: print_ln(' '); end. +@z diff --git a/systems/knuth/local/texware/tftopl.p b/systems/knuth/local/texware/tftopl.p new file mode 100644 index 0000000000..4aaa676b47 --- /dev/null +++ b/systems/knuth/local/texware/tftopl.p @@ -0,0 +1,504 @@ +{2:}program TFtoPL(output);label{3:}9999;{:3}const{4:}tfmsize=30000; +ligsize=5000;hashsize=5003;{:4} +type UNIXfilename=packed array[1..100]of char;{18:}byte=ByteCard; +index=0..tfmsize;{:18}var{6:}tfmfile:packed file of ByteCard; +tfmname:UNIXfilename;tfmbyte:integer;{:6}{8:} +lf,lh,bc,ec,nw,nh,nd,ni,nl,nk,ne,np:0..32767;{:8}{16:}plfile:text; +plname:UNIXfilename;{:16}{19:}tfm:array[-1000..tfmsize]of byte;{:19} +{22:} +charbase,widthbase,heightbase,depthbase,italicbase,ligkernbase,kernbase, +extenbase,parambase:integer;{:22}{25:}fonttype:0..2;{:25}{27:} +ASCII04,ASCII10,ASCII14:packed array[1..32]of char; +MBLstring,RIstring,RCEstring:packed array[1..3]of char;{:27}{29:} +dig:array[0..11]of 0..9;{:29}{32:}level:0..5;{:32}{45:}charsonline:0..8; +perfect:boolean;{:45}{47:}i:0..32767;c:0..256;d:0..3;k:index;r:0..65535; +count:0..127;{:47}{63:}labeltable:array[0..258]of record cc:0..256; +rr:0..ligsize;end;labelptr:0..257;sortptr:0..257;boundarychar:0..256; +bcharlabel:0..32767;{:63}{65:}activity:array[0..ligsize]of 0..2; +ai,acti:0..ligsize;{:65}{89:}hash:array[0..hashsize]of 0..66048; +class:array[0..hashsize]of 0..4;ligz:array[0..hashsize]of 0..257; +hashptr:0..hashsize;hashlist:array[0..hashsize]of 0..hashsize; +h,hh:0..hashsize;xligcycle,yligcycle:0..256;{:89} +#include "texwarext.h" +procedure initialize; +begin writeln('This is TFtoPL, Version 3.1 for Linux');{7:} +if argc<3 then begin writeln('Usage: tftopl <tfm-file> <pl-file>'); +goto 9999;end;argv(1,tfmname); +if testreadaccess(tfmname)then reset(tfmfile,tfmname)else begin writeln( +'I can''t read the TFM file!');goto 9999;end;{:7}{17:}argv(2,plname); +rewrite(plfile,plname);{:17}{28:} +ASCII04:=' !"#$%&''()*+,-./0123456789:;<=>?'; +ASCII10:='@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_'; +ASCII14:='`abcdefghijklmnopqrstuvwxyz{|}~ ';MBLstring:='MBL'; +RIstring:='RI ';RCEstring:='RCE';{:28}{33:}level:=0;{:33}{46:} +charsonline:=0;perfect:=true;{:46}{64:}boundarychar:=256; +bcharlabel:=32767;labelptr:=0;labeltable[0].rr:=0;{:64}end;{:2}{30:} +procedure outdigs(j:integer);begin repeat j:=j-1;write(plfile,dig[j]:1); +until j=0;end;procedure printdigs(j:integer);begin repeat j:=j-1; +write(dig[j]:1);until j=0;end;{:30}{31:}procedure printoctal(c:byte); +var j:0..2;begin write('''');for j:=0 to 2 do begin dig[j]:=c mod 8; +c:=c div 8;end;printdigs(3);end;{:31}{34:}procedure outln;var l:0..5; +begin writeln(plfile);for l:=1 to level do write(plfile,' ');end; +procedure left;begin level:=level+1;write(plfile,'(');end; +procedure right;begin level:=level-1;write(plfile,')');outln;end;{:34} +{35:}procedure outBCPL(k:index);var l:0..39;begin write(plfile,' '); +l:=tfm[k];while l>0 do begin k:=k+1;l:=l-1; +case tfm[k]div 32 of 1:write(plfile,ASCII04[1+(tfm[k]mod 32)]); +2:write(plfile,ASCII10[1+(tfm[k]mod 32)]); +3:write(plfile,ASCII14[1+(tfm[k]mod 32)]);end;end;end;{:35}{36:} +procedure outoctal(k,l:index);var a:0..1023;b:0..32;j:0..11; +begin write(plfile,' O ');a:=0;b:=0;j:=0;while l>0 do{37:}begin l:=l-1; +if tfm[k+l]<>0 then begin while b>2 do begin dig[j]:=a mod 8;a:=a div 8; +b:=b-3;j:=j+1;end;case b of 0:a:=tfm[k+l];1:a:=a+2*tfm[k+l]; +2:a:=a+4*tfm[k+l];end;end;b:=b+8;end{:37}; +while(a>0)or(j=0)do begin dig[j]:=a mod 8;a:=a div 8;j:=j+1;end; +outdigs(j);end;{:36}{38:}procedure outchar(c:byte); +begin if fonttype>0 then begin tfm[0]:=c; +outoctal(0,1)end else if(c>=48)and(c<=57)then write(plfile,' C ',c-48:1) +else if(c>=65)and(c<=90)then write(plfile,' C ',ASCII10[c-63])else if(c +>=97)and(c<=122)then write(plfile,' C ',ASCII14[c-95])else begin tfm[0] +:=c;outoctal(0,1);end;end;{:38}{39:}procedure outface(k:index); +var s:0..1;b:0..8; +begin if tfm[k]>=18 then outoctal(k,1)else begin write(plfile,' F '); +s:=tfm[k]mod 2;b:=tfm[k]div 2;write(plfile,MBLstring[1+(b mod 3)]); +write(plfile,RIstring[1+s]);write(plfile,RCEstring[1+(b div 3)]);end; +end;{:39}{40:}procedure outfix(k:index);var a:0..4095;f:integer;j:0..12; +delta:integer;begin write(plfile,' R ');a:=(tfm[k]*16)+(tfm[k+1]div 16); +f:=((tfm[k+1]mod 16)*256+tfm[k+2])*256+tfm[k+3];if a>2047 then{43:} +begin write(plfile,'-');a:=4096-a;if f>0 then begin f:=1048576-f;a:=a-1; +end;end{:43};{41:}begin j:=0;repeat dig[j]:=a mod 10;a:=a div 10;j:=j+1; +until a=0;outdigs(j);end{:41};{42:}begin write(plfile,'.');f:=10*f+5; +delta:=10;repeat if delta>1048576 then f:=f+524288-(delta div 2); +write(plfile,f div 1048576:1);f:=10*(f mod 1048576);delta:=delta*10; +until f<=delta;end;{:42};end;{:40}{52:}procedure checkBCPL(k,l:index); +var j:index;c:byte;begin if tfm[k]>=l then begin begin perfect:=false; +if charsonline>0 then writeln(' ');charsonline:=0; +writeln('Bad TFM file: ', +'String is too long; I''ve shortened it drastically.');end;tfm[k]:=1; +end;for j:=k+1 to k+tfm[k]do begin c:=tfm[j]; +if(c=40)or(c=41)then begin begin perfect:=false; +if charsonline>0 then writeln(' ');charsonline:=0; +writeln('Bad TFM file: ', +'Parenthesis in string has been changed to slash.');end;tfm[j]:=47; +end else if(c<32)or(c>126)then begin begin perfect:=false; +if charsonline>0 then writeln(' ');charsonline:=0; +writeln('Bad TFM file: ','Nonstandard ASCII code has been blotted out.') +;end;tfm[j]:=63;end else if(c>=97)and(c<=122)then tfm[j]:=c-32;end;end; +{:52}{92:}procedure hashinput;label 30;var cc:0..3;zz:0..255;y:0..255; +key:integer;t:integer;begin if hashptr=hashsize then goto 30;{93:} +k:=4*(ligkernbase+(i));y:=tfm[k+1];t:=tfm[k+2];cc:=0;zz:=tfm[k+3]; +if t>=128 then zz:=y else begin case t of 0,6:;5,11:zz:=y;1,7:cc:=1; +2:cc:=2;3:cc:=3;end;end{:93};key:=256*c+y+1;h:=(1009*key)mod hashsize; +while hash[h]>0 do begin if hash[h]<=key then begin if hash[h]=key then +goto 30;t:=hash[h];hash[h]:=key;key:=t;t:=class[h];class[h]:=cc;cc:=t; +t:=ligz[h];ligz[h]:=zz;zz:=t;end;if h>0 then h:=h-1 else h:=hashsize; +end;hash[h]:=key;class[h]:=cc;ligz[h]:=zz;hashptr:=hashptr+1; +hashlist[hashptr]:=h;30:end;{:92}{94:}function f(h,x,y:index):index; +forward;function eval(x,y:index):index;var key:integer; +begin key:=256*x+y+1;h:=(1009*key)mod hashsize; +while hash[h]>key do if h>0 then h:=h-1 else h:=hashsize; +if hash[h]<key then eval:=y else eval:=f(h,x,y);end;{:94}{95:} +function f;begin case class[h]of 0:;1:begin class[h]:=4; +ligz[h]:=eval(ligz[h],y);class[h]:=0;end;2:begin class[h]:=4; +ligz[h]:=eval(x,ligz[h]);class[h]:=0;end;3:begin class[h]:=4; +ligz[h]:=eval(eval(x,ligz[h]),y);class[h]:=0;end;4:begin xligcycle:=x; +yligcycle:=y;ligz[h]:=257;class[h]:=0;end;end;f:=ligz[h];end;{:95}{96:} +function organize:boolean;label 9999,30;var tfmptr:index;begin{20:} +read(tfmfile,tfm[0]);if tfm[0]>127 then begin writeln( +'The first byte of the input file exceeds 127!'); +writeln('Sorry, but I can''t go on; are you sure this is a TFM?'); +goto 9999;end;if eof(tfmfile)then begin writeln( +'The input file is only one byte long!'); +writeln('Sorry, but I can''t go on; are you sure this is a TFM?'); +goto 9999;end;read(tfmfile,tfm[1]);lf:=tfm[0]*256+tfm[1]; +if lf=0 then begin writeln( +'The file claims to have length zero, but that''s impossible!'); +writeln('Sorry, but I can''t go on; are you sure this is a TFM?'); +goto 9999;end;if 4*lf-1>tfmsize then begin writeln( +'The file is bigger than I can handle!'); +writeln('Sorry, but I can''t go on; are you sure this is a TFM?'); +goto 9999;end; +for tfmptr:=2 to 4*lf-1 do begin if eof(tfmfile)then begin writeln( +'The file has fewer bytes than it claims!'); +writeln('Sorry, but I can''t go on; are you sure this is a TFM?'); +goto 9999;end;read(tfmfile,tfm[tfmptr]);end; +if not eof(tfmfile)then begin writeln( +'There''s some extra junk at the end of the TFM file,'); +writeln('but I''ll proceed as if it weren''t there.');end{:20};{21:} +begin tfmptr:=2;begin if tfm[tfmptr]>127 then begin writeln( +'One of the subfile sizes is negative!'); +writeln('Sorry, but I can''t go on; are you sure this is a TFM?'); +goto 9999;end;lh:=tfm[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end; +begin if tfm[tfmptr]>127 then begin writeln( +'One of the subfile sizes is negative!'); +writeln('Sorry, but I can''t go on; are you sure this is a TFM?'); +goto 9999;end;bc:=tfm[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end; +begin if tfm[tfmptr]>127 then begin writeln( +'One of the subfile sizes is negative!'); +writeln('Sorry, but I can''t go on; are you sure this is a TFM?'); +goto 9999;end;ec:=tfm[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end; +begin if tfm[tfmptr]>127 then begin writeln( +'One of the subfile sizes is negative!'); +writeln('Sorry, but I can''t go on; are you sure this is a TFM?'); +goto 9999;end;nw:=tfm[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end; +begin if tfm[tfmptr]>127 then begin writeln( +'One of the subfile sizes is negative!'); +writeln('Sorry, but I can''t go on; are you sure this is a TFM?'); +goto 9999;end;nh:=tfm[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end; +begin if tfm[tfmptr]>127 then begin writeln( +'One of the subfile sizes is negative!'); +writeln('Sorry, but I can''t go on; are you sure this is a TFM?'); +goto 9999;end;nd:=tfm[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end; +begin if tfm[tfmptr]>127 then begin writeln( +'One of the subfile sizes is negative!'); +writeln('Sorry, but I can''t go on; are you sure this is a TFM?'); +goto 9999;end;ni:=tfm[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end; +begin if tfm[tfmptr]>127 then begin writeln( +'One of the subfile sizes is negative!'); +writeln('Sorry, but I can''t go on; are you sure this is a TFM?'); +goto 9999;end;nl:=tfm[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end; +begin if tfm[tfmptr]>127 then begin writeln( +'One of the subfile sizes is negative!'); +writeln('Sorry, but I can''t go on; are you sure this is a TFM?'); +goto 9999;end;nk:=tfm[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end; +begin if tfm[tfmptr]>127 then begin writeln( +'One of the subfile sizes is negative!'); +writeln('Sorry, but I can''t go on; are you sure this is a TFM?'); +goto 9999;end;ne:=tfm[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end; +begin if tfm[tfmptr]>127 then begin writeln( +'One of the subfile sizes is negative!'); +writeln('Sorry, but I can''t go on; are you sure this is a TFM?'); +goto 9999;end;np:=tfm[tfmptr]*256+tfm[tfmptr+1];tfmptr:=tfmptr+2;end; +if lh<2 then begin writeln('The header length is only ',lh:1,'!'); +writeln('Sorry, but I can''t go on; are you sure this is a TFM?'); +goto 9999;end;if nl>4*ligsize then begin writeln( +'The lig/kern program is longer than I can handle!'); +writeln('Sorry, but I can''t go on; are you sure this is a TFM?'); +goto 9999;end; +if(bc>ec+1)or(ec>255)then begin writeln('The character code range ',bc:1 +,'..',ec:1,'is illegal!'); +writeln('Sorry, but I can''t go on; are you sure this is a TFM?'); +goto 9999;end;if(nw=0)or(nh=0)or(nd=0)or(ni=0)then begin writeln( +'Incomplete subfiles for character dimensions!'); +writeln('Sorry, but I can''t go on; are you sure this is a TFM?'); +goto 9999;end; +if ne>256 then begin writeln('There are ',ne:1,' extensible recipes!'); +writeln('Sorry, but I can''t go on; are you sure this is a TFM?'); +goto 9999;end; +if lf<>6+lh+(ec-bc+1)+nw+nh+nd+ni+nl+nk+ne+np then begin writeln( +'Subfile sizes don''t add up to the stated total!'); +writeln('Sorry, but I can''t go on; are you sure this is a TFM?'); +goto 9999;end;end{:21};{23:}begin charbase:=6+lh-bc; +widthbase:=charbase+ec+1;heightbase:=widthbase+nw; +depthbase:=heightbase+nh;italicbase:=depthbase+nd; +ligkernbase:=italicbase+ni;kernbase:=ligkernbase+nl; +extenbase:=kernbase+nk;parambase:=extenbase+ne-1;end{:23}; +organize:=true;goto 30;9999:organize:=false;30:end;{:96}{97:} +procedure dosimplethings;var i:0..32767;begin{48:}begin fonttype:=0; +if lh>=12 then begin{53:}begin checkBCPL(32,40); +if(tfm[32]>=11)and(tfm[33]=84)and(tfm[34]=69)and(tfm[35]=88)and(tfm[36]= +32)and(tfm[37]=77)and(tfm[38]=65)and(tfm[39]=84)and(tfm[40]=72)and(tfm[ +41]=32)then begin if(tfm[42]=83)and(tfm[43]=89)then fonttype:=1 else if( +tfm[42]=69)and(tfm[43]=88)then fonttype:=2;end;end{:53}; +if lh>=17 then begin{55:}left;write(plfile,'FAMILY');checkBCPL(72,20); +outBCPL(72);right{:55};if lh>=18 then{56:}begin left; +write(plfile,'FACE');outface(95);right;for i:=18 to lh-1 do begin left; +write(plfile,'HEADER D ',i:1);outoctal(24+4*i,4);right;end;end{:56};end; +{54:}left;write(plfile,'CODINGSCHEME');outBCPL(32);right{:54};end;{51:} +left;write(plfile,'DESIGNSIZE'); +if tfm[28]>127 then begin begin perfect:=false; +if charsonline>0 then writeln(' ');charsonline:=0; +writeln('Bad TFM file: ','Design size ','negative','!');end; +writeln('I''ve set it to 10 points.');write(plfile,' D 10'); +end else if(tfm[28]=0)and(tfm[29]<16)then begin begin perfect:=false; +if charsonline>0 then writeln(' ');charsonline:=0; +writeln('Bad TFM file: ','Design size ','too small','!');end; +writeln('I''ve set it to 10 points.');write(plfile,' D 10'); +end else outfix(28);right; +write(plfile,'(COMMENT DESIGNSIZE IS IN POINTS)');outln; +write(plfile,'(COMMENT OTHER SIZES ARE MULTIPLES OF DESIGNSIZE)'); +outln{:51};{49:}left;write(plfile,'CHECKSUM');outoctal(24,4);right{:49}; +{57:}if(lh>17)and(tfm[92]>127)then begin left; +write(plfile,'SEVENBITSAFEFLAG TRUE');right;end{:57};end{:48};{58:} +if np>0 then begin left;write(plfile,'FONTDIMEN');outln; +for i:=1 to np do{60:}begin left; +if i=1 then write(plfile,'SLANT')else begin if(tfm[4*(parambase+i)]>0) +and(tfm[4*(parambase+i)]<255)then begin tfm[4*(parambase+i)]:=0; +tfm[(4*(parambase+i))+1]:=0;tfm[(4*(parambase+i))+2]:=0; +tfm[(4*(parambase+i))+3]:=0;begin perfect:=false; +if charsonline>0 then writeln(' ');charsonline:=0; +writeln('Bad TFM file: ','Parameter',' ',i:1,' is too big;');end; +writeln('I have set it to zero.');end;{61:} +if i<=7 then case i of 2:write(plfile,'SPACE'); +3:write(plfile,'STRETCH');4:write(plfile,'SHRINK'); +5:write(plfile,'XHEIGHT');6:write(plfile,'QUAD'); +7:write(plfile,'EXTRASPACE')end else if(i<=22)and(fonttype=1)then case i +of 8:write(plfile,'NUM1');9:write(plfile,'NUM2'); +10:write(plfile,'NUM3');11:write(plfile,'DENOM1'); +12:write(plfile,'DENOM2');13:write(plfile,'SUP1'); +14:write(plfile,'SUP2');15:write(plfile,'SUP3');16:write(plfile,'SUB1'); +17:write(plfile,'SUB2');18:write(plfile,'SUPDROP'); +19:write(plfile,'SUBDROP');20:write(plfile,'DELIM1'); +21:write(plfile,'DELIM2'); +22:write(plfile,'AXISHEIGHT')end else if(i<=13)and(fonttype=2)then if i= +8 then write(plfile,'DEFAULTRULETHICKNESS')else write(plfile, +'BIGOPSPACING',i-8:1)else write(plfile,'PARAMETER D ',i:1){:61};end; +outfix(4*(parambase+i));right;end{:60};right;end;{59:} +if(fonttype=1)and(np<>22)then writeln( +'Unusual number of fontdimen parameters for a math symbols font (',np:1, +' not 22).')else if(fonttype=2)and(np<>13)then writeln( +'Unusual number of fontdimen parameters for an extension font (',np:1, +' not 13).'){:59};{:58};{62:} +if(tfm[4*widthbase]>0)or(tfm[4*widthbase+1]>0)or(tfm[4*widthbase+2]>0)or +(tfm[4*widthbase+3]>0)then begin perfect:=false; +if charsonline>0 then writeln(' ');charsonline:=0; +writeln('Bad TFM file: ','width[0] should be zero.');end; +if(tfm[4*heightbase]>0)or(tfm[4*heightbase+1]>0)or(tfm[4*heightbase+2]>0 +)or(tfm[4*heightbase+3]>0)then begin perfect:=false; +if charsonline>0 then writeln(' ');charsonline:=0; +writeln('Bad TFM file: ','height[0] should be zero.');end; +if(tfm[4*depthbase]>0)or(tfm[4*depthbase+1]>0)or(tfm[4*depthbase+2]>0)or +(tfm[4*depthbase+3]>0)then begin perfect:=false; +if charsonline>0 then writeln(' ');charsonline:=0; +writeln('Bad TFM file: ','depth[0] should be zero.');end; +if(tfm[4*italicbase]>0)or(tfm[4*italicbase+1]>0)or(tfm[4*italicbase+2]>0 +)or(tfm[4*italicbase+3]>0)then begin perfect:=false; +if charsonline>0 then writeln(' ');charsonline:=0; +writeln('Bad TFM file: ','italic[0] should be zero.');end; +for i:=0 to nw-1 do if(tfm[4*(widthbase+i)]>0)and(tfm[4*(widthbase+i)]< +255)then begin tfm[4*(widthbase+i)]:=0;tfm[(4*(widthbase+i))+1]:=0; +tfm[(4*(widthbase+i))+2]:=0;tfm[(4*(widthbase+i))+3]:=0; +begin perfect:=false;if charsonline>0 then writeln(' ');charsonline:=0; +writeln('Bad TFM file: ','Width',' ',i:1,' is too big;');end; +writeln('I have set it to zero.');end; +for i:=0 to nh-1 do if(tfm[4*(heightbase+i)]>0)and(tfm[4*(heightbase+i)] +<255)then begin tfm[4*(heightbase+i)]:=0;tfm[(4*(heightbase+i))+1]:=0; +tfm[(4*(heightbase+i))+2]:=0;tfm[(4*(heightbase+i))+3]:=0; +begin perfect:=false;if charsonline>0 then writeln(' ');charsonline:=0; +writeln('Bad TFM file: ','Height',' ',i:1,' is too big;');end; +writeln('I have set it to zero.');end; +for i:=0 to nd-1 do if(tfm[4*(depthbase+i)]>0)and(tfm[4*(depthbase+i)]< +255)then begin tfm[4*(depthbase+i)]:=0;tfm[(4*(depthbase+i))+1]:=0; +tfm[(4*(depthbase+i))+2]:=0;tfm[(4*(depthbase+i))+3]:=0; +begin perfect:=false;if charsonline>0 then writeln(' ');charsonline:=0; +writeln('Bad TFM file: ','Depth',' ',i:1,' is too big;');end; +writeln('I have set it to zero.');end; +for i:=0 to ni-1 do if(tfm[4*(italicbase+i)]>0)and(tfm[4*(italicbase+i)] +<255)then begin tfm[4*(italicbase+i)]:=0;tfm[(4*(italicbase+i))+1]:=0; +tfm[(4*(italicbase+i))+2]:=0;tfm[(4*(italicbase+i))+3]:=0; +begin perfect:=false;if charsonline>0 then writeln(' ');charsonline:=0; +writeln('Bad TFM file: ','Italic correction',' ',i:1,' is too big;'); +end;writeln('I have set it to zero.');end; +if nk>0 then for i:=0 to nk-1 do if(tfm[4*(kernbase+i)]>0)and(tfm[4*( +kernbase+i)]<255)then begin tfm[4*(kernbase+i)]:=0; +tfm[(4*(kernbase+i))+1]:=0;tfm[(4*(kernbase+i))+2]:=0; +tfm[(4*(kernbase+i))+3]:=0;begin perfect:=false; +if charsonline>0 then writeln(' ');charsonline:=0; +writeln('Bad TFM file: ','Kern',' ',i:1,' is too big;');end; +writeln('I have set it to zero.');end;{:62}end;{:97}{98:} +procedure docharacters;var c:byte;k:index;ai:0..ligsize;begin{78:} +sortptr:=0; +for c:=bc to ec do if tfm[4*(charbase+c)]>0 then begin if charsonline=8 +then begin writeln(' ');charsonline:=1; +end else begin if charsonline>0 then write(' '); +charsonline:=charsonline+1;end;printoctal(c);left; +write(plfile,'CHARACTER');outchar(c);outln;{79:}begin left; +write(plfile,'CHARWD'); +if tfm[4*(charbase+c)]>=nw then begin perfect:=false;writeln(' '); +write('Width',' index for character ');printoctal(c); +writeln(' is too large;');writeln('so I reset it to zero.'); +end else outfix(4*(widthbase+tfm[4*(charbase+c)]));right;end{:79}; +if(tfm[4*(charbase+c)+1]div 16)>0 then{80:} +if(tfm[4*(charbase+c)+1]div 16)>=nh then begin perfect:=false; +writeln(' ');write('Height',' index for character ');printoctal(c); +writeln(' is too large;');writeln('so I reset it to zero.'); +end else begin left;write(plfile,'CHARHT'); +outfix(4*(heightbase+(tfm[4*(charbase+c)+1]div 16)));right;end{:80}; +if(tfm[4*(charbase+c)+1]mod 16)>0 then{81:} +if(tfm[4*(charbase+c)+1]mod 16)>=nd then begin perfect:=false; +writeln(' ');write('Depth',' index for character ');printoctal(c); +writeln(' is too large;');writeln('so I reset it to zero.'); +end else begin left;write(plfile,'CHARDP'); +outfix(4*(depthbase+(tfm[4*(charbase+c)+1]mod 16)));right;end{:81}; +if(tfm[4*(charbase+c)+2]div 4)>0 then{82:} +if(tfm[4*(charbase+c)+2]div 4)>=ni then begin perfect:=false; +writeln(' ');write('Italic correction',' index for character '); +printoctal(c);writeln(' is too large;'); +writeln('so I reset it to zero.');end else begin left; +write(plfile,'CHARIC'); +outfix(4*(italicbase+(tfm[4*(charbase+c)+2]div 4)));right;end{:82}; +case(tfm[4*(charbase+c)+2]mod 4)of 0:;1:{83:}begin left; +write(plfile,'COMMENT');outln;i:=tfm[4*(charbase+c)+3]; +r:=4*(ligkernbase+(i));if tfm[r]>128 then i:=256*tfm[r+2]+tfm[r+3]; +repeat{74:}begin k:=4*(ligkernbase+(i)); +if tfm[k]>128 then begin if 256*tfm[k+2]+tfm[k+3]>=nl then begin perfect +:=false;if charsonline>0 then writeln(' ');charsonline:=0; +writeln('Bad TFM file: ', +'Ligature unconditional stop command address is too big.');end; +end else if tfm[k+2]>=128 then{76:} +begin if((tfm[k+1]<bc)or(tfm[k+1]>ec)or(tfm[4*(charbase+tfm[k+1])]=0)) +then if tfm[k+1]<>boundarychar then begin perfect:=false; +if charsonline>0 then writeln(' ');charsonline:=0; +write('Bad TFM file: ','Kern step for',' nonexistent character '); +printoctal(tfm[k+1]);writeln('.');tfm[k+1]:=bc;end;left; +write(plfile,'KRN');outchar(tfm[k+1]);r:=256*(tfm[k+2]-128)+tfm[k+3]; +if r>=nk then begin begin perfect:=false; +if charsonline>0 then writeln(' ');charsonline:=0; +writeln('Bad TFM file: ','Kern index too large.');end; +write(plfile,' R 0.0');end else outfix(4*(kernbase+r));right;end{:76} +else{77:} +begin if((tfm[k+1]<bc)or(tfm[k+1]>ec)or(tfm[4*(charbase+tfm[k+1])]=0)) +then if tfm[k+1]<>boundarychar then begin perfect:=false; +if charsonline>0 then writeln(' ');charsonline:=0; +write('Bad TFM file: ','Ligature step for',' nonexistent character '); +printoctal(tfm[k+1]);writeln('.');tfm[k+1]:=bc;end; +if((tfm[k+3]<bc)or(tfm[k+3]>ec)or(tfm[4*(charbase+tfm[k+3])]=0))then +begin perfect:=false;if charsonline>0 then writeln(' ');charsonline:=0; +write('Bad TFM file: ','Ligature step produces the', +' nonexistent character ');printoctal(tfm[k+3]);writeln('.'); +tfm[k+3]:=bc;end;left;r:=tfm[k+2]; +if(r=4)or((r>7)and(r<>11))then begin writeln( +'Ligature step with nonstandard code changed to LIG');r:=0;tfm[k+2]:=0; +end;if r mod 4>1 then write(plfile,'/');write(plfile,'LIG'); +if odd(r)then write(plfile,'/');while r>3 do begin write(plfile,'>'); +r:=r-4;end;outchar(tfm[k+1]);outchar(tfm[k+3]);right;end{:77}; +if tfm[k]>0 then if level=1 then{75:} +begin if tfm[k]>=128 then write(plfile,'(STOP)')else begin count:=0; +for ai:=i+1 to i+tfm[k]do if activity[ai]=2 then count:=count+1; +write(plfile,'(SKIP D ',count:1,')');end;outln;end{:75};end{:74}; +if tfm[k]>=128 then i:=nl else i:=i+1+tfm[k];until i>=nl;right;end{:83}; +2:{84:}begin r:=tfm[4*(charbase+c)+3]; +if((r<bc)or(r>ec)or(tfm[4*(charbase+r)]=0))then begin begin perfect:= +false;if charsonline>0 then writeln(' ');charsonline:=0; +write('Bad TFM file: ','Character list link to', +' nonexistent character ');printoctal(r);writeln('.');end; +tfm[4*(charbase+c)+2]:=4*(tfm[4*(charbase+c)+2]div 4)+0; +end else begin while(r<c)and((tfm[4*(charbase+r)+2]mod 4)=2)do r:=tfm[4* +(charbase+r)+3];if r=c then begin begin perfect:=false; +if charsonline>0 then writeln(' ');charsonline:=0; +writeln('Bad TFM file: ','Cycle in a character list!');end; +write('Character ');printoctal(c);writeln(' now ends the list.'); +tfm[4*(charbase+c)+2]:=4*(tfm[4*(charbase+c)+2]div 4)+0; +end else begin left;write(plfile,'NEXTLARGER'); +outchar(tfm[4*(charbase+c)+3]);right;end;end;end{:84};3:{85:} +if tfm[4*(charbase+c)+3]>=ne then begin begin perfect:=false; +writeln(' ');write('Extensible',' index for character ');printoctal(c); +writeln(' is too large;');writeln('so I reset it to zero.');end; +tfm[4*(charbase+c)+2]:=4*(tfm[4*(charbase+c)+2]div 4)+0; +end else begin left;write(plfile,'VARCHAR');outln;{86:} +for k:=0 to 3 do if(k=3)or(tfm[4*(extenbase+tfm[4*(charbase+c)+3])+k]>0) +then begin left;case k of 0:write(plfile,'TOP');1:write(plfile,'MID'); +2:write(plfile,'BOT');3:write(plfile,'REP')end; +if((tfm[4*(extenbase+tfm[4*(charbase+c)+3])+k]<bc)or(tfm[4*(extenbase+ +tfm[4*(charbase+c)+3])+k]>ec)or(tfm[4*(charbase+tfm[4*(extenbase+tfm[4*( +charbase+c)+3])+k])]=0))then outchar(c)else outchar(tfm[4*(extenbase+tfm +[4*(charbase+c)+3])+k]);right;end{:86};right;end{:85};end;right;end{:78} +;end;{:98}{99:}begin initialize;if not organize then goto 9999; +dosimplethings;{66:} +if nl>0 then begin for ai:=0 to nl-1 do activity[ai]:=0;{69:} +if tfm[4*(ligkernbase+(0))]=255 then begin left; +write(plfile,'BOUNDARYCHAR');boundarychar:=tfm[4*(ligkernbase+(0))+1]; +outchar(boundarychar);right;activity[0]:=1;end; +if tfm[4*(ligkernbase+(nl-1))]=255 then begin r:=256*tfm[4*(ligkernbase+ +(nl-1))+2]+tfm[4*(ligkernbase+(nl-1))+3]; +if r>=nl then begin perfect:=false;writeln(' '); +write('Ligature/kern starting index for boundarychar is too large;'); +writeln('so I removed it.');end else begin labelptr:=1; +labeltable[1].cc:=256;labeltable[1].rr:=r;bcharlabel:=r;activity[r]:=2; +end;activity[nl-1]:=1;end{:69};end;{67:} +for c:=bc to ec do if(tfm[4*(charbase+c)+2]mod 4)=1 then begin r:=tfm[4* +(charbase+c)+3]; +if r<nl then begin if tfm[4*(ligkernbase+(r))]>128 then begin r:=256*tfm +[4*(ligkernbase+(r))+2]+tfm[4*(ligkernbase+(r))+3]; +if r<nl then if activity[tfm[4*(charbase+c)+3]]=0 then activity[tfm[4*( +charbase+c)+3]]:=1;end;end;if r>=nl then begin perfect:=false; +writeln(' ');write('Ligature/kern starting index for character '); +printoctal(c);writeln(' is too large;');writeln('so I removed it.'); +tfm[4*(charbase+c)+2]:=4*(tfm[4*(charbase+c)+2]div 4)+0;end else{68:} +begin sortptr:=labelptr; +while labeltable[sortptr].rr>r do begin labeltable[sortptr+1]:= +labeltable[sortptr];sortptr:=sortptr-1;end;labeltable[sortptr+1].cc:=c; +labeltable[sortptr+1].rr:=r;labelptr:=labelptr+1;activity[r]:=2;end{:68} +;end;labeltable[labelptr+1].rr:=ligsize;{:67};if nl>0 then begin left; +write(plfile,'LIGTABLE');outln;{70:} +for ai:=0 to nl-1 do if activity[ai]=2 then begin r:=tfm[4*(ligkernbase+ +(ai))];if r<128 then begin r:=r+ai+1; +if r>=nl then begin begin perfect:=false; +if charsonline>0 then writeln(' ');charsonline:=0; +writeln('Bad TFM file: ','Ligature/kern step ',ai:1,' skips too far;'); +end;writeln('I made it stop.');tfm[4*(ligkernbase+(ai))]:=128; +end else activity[r]:=2;end;end{:70};{71:}sortptr:=1; +for acti:=0 to nl-1 do if activity[acti]<>1 then begin i:=acti;{73:} +if activity[i]=0 then begin if level=1 then begin left; +write(plfile,'COMMENT THIS PART OF THE PROGRAM IS NEVER USED!');outln; +end end else if level=2 then right{:73};{72:} +while i=labeltable[sortptr].rr do begin left;write(plfile,'LABEL'); +if labeltable[sortptr].cc=256 then write(plfile,' BOUNDARYCHAR')else +outchar(labeltable[sortptr].cc);right;sortptr:=sortptr+1;end{:72};{74:} +begin k:=4*(ligkernbase+(i)); +if tfm[k]>128 then begin if 256*tfm[k+2]+tfm[k+3]>=nl then begin perfect +:=false;if charsonline>0 then writeln(' ');charsonline:=0; +writeln('Bad TFM file: ', +'Ligature unconditional stop command address is too big.');end; +end else if tfm[k+2]>=128 then{76:} +begin if((tfm[k+1]<bc)or(tfm[k+1]>ec)or(tfm[4*(charbase+tfm[k+1])]=0)) +then if tfm[k+1]<>boundarychar then begin perfect:=false; +if charsonline>0 then writeln(' ');charsonline:=0; +write('Bad TFM file: ','Kern step for',' nonexistent character '); +printoctal(tfm[k+1]);writeln('.');tfm[k+1]:=bc;end;left; +write(plfile,'KRN');outchar(tfm[k+1]);r:=256*(tfm[k+2]-128)+tfm[k+3]; +if r>=nk then begin begin perfect:=false; +if charsonline>0 then writeln(' ');charsonline:=0; +writeln('Bad TFM file: ','Kern index too large.');end; +write(plfile,' R 0.0');end else outfix(4*(kernbase+r));right;end{:76} +else{77:} +begin if((tfm[k+1]<bc)or(tfm[k+1]>ec)or(tfm[4*(charbase+tfm[k+1])]=0)) +then if tfm[k+1]<>boundarychar then begin perfect:=false; +if charsonline>0 then writeln(' ');charsonline:=0; +write('Bad TFM file: ','Ligature step for',' nonexistent character '); +printoctal(tfm[k+1]);writeln('.');tfm[k+1]:=bc;end; +if((tfm[k+3]<bc)or(tfm[k+3]>ec)or(tfm[4*(charbase+tfm[k+3])]=0))then +begin perfect:=false;if charsonline>0 then writeln(' ');charsonline:=0; +write('Bad TFM file: ','Ligature step produces the', +' nonexistent character ');printoctal(tfm[k+3]);writeln('.'); +tfm[k+3]:=bc;end;left;r:=tfm[k+2]; +if(r=4)or((r>7)and(r<>11))then begin writeln( +'Ligature step with nonstandard code changed to LIG');r:=0;tfm[k+2]:=0; +end;if r mod 4>1 then write(plfile,'/');write(plfile,'LIG'); +if odd(r)then write(plfile,'/');while r>3 do begin write(plfile,'>'); +r:=r-4;end;outchar(tfm[k+1]);outchar(tfm[k+3]);right;end{:77}; +if tfm[k]>0 then if level=1 then{75:} +begin if tfm[k]>=128 then write(plfile,'(STOP)')else begin count:=0; +for ai:=i+1 to i+tfm[k]do if activity[ai]=2 then count:=count+1; +write(plfile,'(SKIP D ',count:1,')');end;outln;end{:75};end{:74};end; +if level=2 then right{:71};right;{90:}hashptr:=0;yligcycle:=256; +for hh:=0 to hashsize do hash[hh]:=0; +for c:=bc to ec do if(tfm[4*(charbase+c)+2]mod 4)=1 then begin i:=tfm[4* +(charbase+c)+3]; +if tfm[4*(ligkernbase+(i))]>128 then i:=256*tfm[4*(ligkernbase+(i))+2]+ +tfm[4*(ligkernbase+(i))+3];{91:}repeat hashinput; +k:=tfm[4*(ligkernbase+(i))];if k>=128 then i:=nl else i:=i+1+k; +until i>=nl{:91};end;if bcharlabel<nl then begin c:=256;i:=bcharlabel; +{91:}repeat hashinput;k:=tfm[4*(ligkernbase+(i))]; +if k>=128 then i:=nl else i:=i+1+k;until i>=nl{:91};end; +if hashptr=hashsize then begin writeln( +'Sorry, I haven''t room for so many ligature/kern pairs!');goto 9999; +end;for hh:=1 to hashptr do begin r:=hashlist[hh]; +if class[r]>0 then r:=f(r,(hash[r]-1)div 256,(hash[r]-1)mod 256);end; +if yligcycle<256 then begin write( +'Infinite ligature loop starting with '); +if xligcycle=256 then write('boundary')else printoctal(xligcycle); +write(' and ');printoctal(yligcycle);writeln('!'); +write(plfile,'(INFINITE LIGATURE LOOP MUST BE BROKEN!)');goto 9999; +end{:90};end{:66};{87:} +if ne>0 then for c:=0 to ne-1 do for d:=0 to 3 do begin k:=4*(extenbase+ +c)+d;if(tfm[k]>0)or(d=3)then begin if((tfm[k]<bc)or(tfm[k]>ec)or(tfm[4*( +charbase+tfm[k])]=0))then begin begin perfect:=false; +if charsonline>0 then writeln(' ');charsonline:=0; +write('Bad TFM file: ','Extensible recipe involves the', +' nonexistent character ');printoctal(tfm[k]);writeln('.');end; +if d<3 then tfm[k]:=0;end;end;end{:87};docharacters;writeln('.'); +if level<>0 then writeln('This program isn''t working!'); +if not perfect then write(plfile, +'(COMMENT THE TFM FILE WAS BAD, SO THE DATA HAS BEEN CHANGED!)'); +9999:writeln(' ');end.{:99} diff --git a/systems/knuth/local/texware/tftopl.pool b/systems/knuth/local/texware/tftopl.pool new file mode 100644 index 0000000000..f6df1aa211 --- /dev/null +++ b/systems/knuth/local/texware/tftopl.pool @@ -0,0 +1,2 @@ +11texwarext.h +*039917878 diff --git a/systems/knuth/local/web-sparc/Makefile b/systems/knuth/local/web-sparc/Makefile new file mode 100644 index 0000000000..74811857a3 --- /dev/null +++ b/systems/knuth/local/web-sparc/Makefile @@ -0,0 +1,33 @@ +# Make executable files for this workstation, using the master TeX sources + +PFLAGS= -O -I.. -temp=. +CFLAGS= -O -I.. +PC= time pc + +all: tangle weave + +%.p: %.ch + tangle ../../dist/web/$*.web $*.ch + mv ../../dist/web/$*.p . + +%.ch: ../../dist/web/%.web + touch $*.ch + +%.o: %.p + ${PC} ${PFLAGS} -c $*.p + +tangle: tangle.o tangext.o tangext.h + pc ${PFLAGS} -o tangle tangle.o tangext.o + +tangext.o: tangext.c ../h00vars.h + +weave: weave.o weavext.o tangext.h + pc ${PFLAGS} -o weave weave.o weavext.o + +weavext.o: weavext.c ../h00vars.h + +install: # doit make install PROG=tangle + mv ${PROG} /usr/local/bin/${PROG} + +clean: # we save tangle.p for emergency rebooting + rm -f weave.p *.o *~ ../../dist/web/*.pool diff --git a/systems/knuth/local/web-sparc/tangext.c b/systems/knuth/local/web-sparc/tangext.c new file mode 100644 index 0000000000..bcbe6e1ffc --- /dev/null +++ b/systems/knuth/local/web-sparc/tangext.c @@ -0,0 +1,109 @@ +/* External procedures for tangle/weave */ +/* Written by: H. Trickey, 11/17/83 */ +/* Modified for 8-bit input by don, 8/31/89 */ + +/* Note: these procedures aren't necessary; the default input_ln and + * flush_buffer routines in tangle/weave work fine on UNIX. + * However a very big time improvement is achieved by using these. + */ + +#define BUF_SIZE 100 /* should agree with tangle.web */ + +#include "h00vars.h" /* defines Pascal I/O structure */ + +extern short buffer[]; /* 0..BUF_SIZE. Input goes here */ +extern short outbuf[]; /* 0..OUT_BUF_SIZE. Output from here */ +extern short xord[]; +extern char xchr[]; /* character translation arrays */ +extern char limit; /* index into buffer, defined in the range + 0..BUF_SIZE (and note that this is a + char rather than a short because BUF_SIZE + is 100) */ + +/* + * lineread reads from the Pascal text file with iorec pointer filep + * into buffer[0], buffer[1],..., buffer[limit-1] (and + * setting "limit"). + * Characters are read until a newline is found (which isn't put in the + * buffer) or until the next character would go into buffer[BUF_SIZE]. + * And trailing blanks are to be ignored, so limit is really set to + * one past the last non-blank. + * The characters need to be translated, so really xord[c] is put into + * the buffer when c is read. + * If end-of-file is encountered, the funit field of *filep is set + * appropriately. + */ +lineread(filep) + struct iorec *filep; +{ + register int c; + register short *cs; /* pointer into buffer where next char goes */ + register short *cnb; /* last non-blank character input */ + register FILE *iop; /* stdio-style FILE pointer */ + register int l; /* how many chars before buffer overflow */ + + iop = filep->fbuf; + cnb = cs = &buffer[0]; + l = BUF_SIZE; + + /* overflow when next char would go into buffer[BUF_SIZE] */ + while ((--l >= 0) && ((c = getc(iop)) != EOF) && (c != '\n')) { + if ((*cs++ = xord[c]) != ' ') + cnb = cs; + } + + if (c == EOF) + filep->funit |= EOFF; /* we hit end-of-file */ + + limit = (cnb - &buffer[0]); +} + +/* + * linewrite writes to the Pascal text file with iorec pointer filep + * from outbuf[0], outbuf[1],..., outbuf[cnt-1]. + * Translation is done, so that xchr[c] is output instead of c. + */ +linewrite(filep, cnt) + struct iorec *filep; + int cnt; +{ + register FILE *iop; /* stdio-style FILE pointer */ + register short *cs; /* pointer to next character to output */ + register int l; /* how many characters left to output */ + + iop = filep->fbuf; + cs = &outbuf[0]; + l = cnt; + + while (--l >= 0) + putc(xchr[*cs++], iop); +} + +/* + * testeof(filep) + * + * Test whether or not the Pascal text file with iorec pointer filep + * has reached end-of-file (when the only I/O on it is done with + * lineread, above). + * We may have to read the next character and unget it to see if perhaps + * the end-of-file is next. + */ +bool +testeof(filep) + register struct iorec *filep; +{ + register char c; + register FILE *iop; /* stdio-style FILE pointer */ + if (filep->funit & EOFF) + return(TRUE); + else { /* check to see if next is EOF */ + iop = filep->fbuf; + c = getc(iop); + if (c == EOF) + return(TRUE); + else { + ungetc(c,iop); + return(FALSE); + } + } +} diff --git a/systems/knuth/local/web-sparc/tangext.h b/systems/knuth/local/web-sparc/tangext.h new file mode 100644 index 0000000000..e4a5fed066 --- /dev/null +++ b/systems/knuth/local/web-sparc/tangext.h @@ -0,0 +1,8 @@ +procedure exit(x : integer); + external; +procedure lineread(var f:textfile); + external; +procedure linewrite(var f:textfile; cnt:integer); + external; +function testeof(var f:textfile):boolean; + external; diff --git a/systems/knuth/local/web-sparc/tangle.ch b/systems/knuth/local/web-sparc/tangle.ch new file mode 100644 index 0000000000..99cd9c0de1 --- /dev/null +++ b/systems/knuth/local/web-sparc/tangle.ch @@ -0,0 +1,655 @@ +% Change file for the TANGLE processor, for use on Berkeley UNIX systems. +% This file was created by Howard Trickey and Pavel Curtis. +% Subsequent small updates (to match Stanford releases) by +% Richard Furuta and Pierre MacKay + +% History: +% 10/9/82 (HT) Original version +% 11/29 (HT) New version, with conversion to lowercase handled properly +% Also, new control sequence: +% @=...text...@> Put ...text... verbatim on a line +% by itself in the Pascal output. +% (argument must fit on one line) +% This control sequence facilitates putting #include "gcons.h" +% (for example) in files meant for the pc compiler. +% Also, changed command line usage, so that the absence of a +% change file implies no change file, rather than one with the +% same name as the web file, with .ch at the end. +% 1/15/83 (HT) Changed to work with version 1.2, which incorporates the +% above change (though unbundling the output line breaking), +% so mainly had to remove stuff. +% 2/17 (HT) Fixed bug that caused 0-9 in identifiers to be converted to +% Q-Y on output. +% 3/18 (HT) Brought up to work with Version 1.5. Added -r command line +% flag to cause a .rpl file to be written with all the lines +% of the .web file that were replaced because of the .ch file +% (useful for comparing with previous .rpl files, to see if a +% change file will still work with a new version of a .web file) +% Also, made it write a newline just before exit. +% 4/12 (PC) Merged with Pavel's version, including adding a call to exit() +% at the end depending upon the value of history. +% 4/16 (PC) Brought up to date with version 1.5 released April, 1983. +% 6/28 (HWT) Brought up to date with version 1.7 released June, 1983. +% With new change file format, the -r option is now unnecessary. +% 7/17 (HWT) Brought up to date with version 2.0 released July, 1983. +% 11/17 (HWT) Made some I/O use external C procedures, for speedup. +% 8/4/84 (RKF) To version 2.6 +% 9/3/85 (RKF) To version 2.7 +% 12/28/85(PAM) To version 2.8, and increase ww and zz so that METAFONT fits +% 8/10/89 (don) To version 3, with `otherwise' fixed too +% 8/31/89 (don) To version 4, with all possible characters enabled +% 10/6/89 (don) Removed changes for "unambig_length"; I must meet higher goals. +% Also fixed bugs related to uppercase +% 10/16/89 don fixed bug when ".web" and ".ch" are explicitly stated +% 9/6/90 (don) To version 4.1 +% 3/25/91 (don) To version 4.2 +% 9/19/91 (don) To version 4.3 +% 2/27/93 (don) To version 4.4 + +% NOTE: The module numbers refer to the standard WEB manual (CS 980). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [0] WEAVE: print changes only +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +\pageno=\contentspagenumber \advance\pageno by 1 +@y +\pageno=\contentspagenumber \advance\pageno by 1 +\let\maybe=\iffalse +\def\title{TANGLE changes for Berkeley {\mc UNIX}} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1] Change banner message +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d banner=='This is TANGLE, Version 4.4' +@y +@d banner=='This is TANGLE, Version 4.4 for SunOS' +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [2] add input and output, remove other files, add ref to scan_args, +% [2] and #include external definition for exit(), etc. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +program TANGLE(@!web_file,@!change_file,@!Pascal_file,@!pool); +label end_of_TANGLE; {go here to finish} +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +@<Error handling procedures@>@/ +@y +program TANGLE(@!input,@!output); +label end_of_TANGLE; {go here to finish} +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +@\ +@=#include "tangext.h"@> +@\@/ +@<Error handling procedures@>@/ +@<Declaration of |scan_args|@>@/ +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [4] compiler options +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead} +@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging} +@y +@=(*$C-*)@> {no range check} +@!debug @=(*$C+*)@>@+ gubed {but turn everything on when debugging} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [7] Fix others: +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d othercases == others: {default for cases not listed explicitly} +@y +@d othercases == otherwise {SunOS Pascal default cases} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [8] keep long identifier names +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!max_id_length=12; {long identifiers are chopped to this length, which must + not exceed |line_length|} +@y +@!max_id_length=50; {long identifiers are chopped to this length, which must + not exceed |line_length|} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [17] enable maximum character set +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +for i:=1 to @'37 do xchr[i]:=' '; +for i:=@'200 to @'377 do xchr[i]:=' '; +@y +for i:=1 to @'37 do xchr[i]:=chr(i); +for i:=@'200 to @'377 do xchr[i]:=chr(i); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [20] terminal output: use standard i/o +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d print(#)==write(term_out,#) {`|print|' means write on the terminal} +@y +@d term_out==output +@d print(#)==write(term_out,#) {`|print|' means write on the terminal} +@z + +@x +@<Globals...@>= +@!term_out:text_file; {the terminal as an output file} +@y + +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [21] init terminal +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ Different systems have different ways of specifying that the output on a +certain file will appear on the user's terminal. Here is one way to do this +on the \PASCAL\ system that was used in \.{TANGLE}'s initial development: +@^system dependencies@> + +@<Set init...@>= +rewrite(term_out,'TTY:'); {send |term_out| output to the terminal} +@y +@ Different systems have different ways of specifying that the output on a +certain file will appear on the user's terminal. +@^system dependencies@> + +@<Set init...@>= + {Nothing need be done on Berkeley UNIX} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [22] flush terminal buffer +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d update_terminal == break(term_out) {empty the terminal output buffer} +@y +@d update_terminal == flush(term_out) {empty the terminal output buffer} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [24] open input files +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The following code opens the input files. Since these files were listed +in the program header, we assume that the \PASCAL\ runtime system has +already checked that suitable file names have been given; therefore no +additional error checking needs to be done. +@^system dependencies@> + +@p procedure open_input; {prepare to read |web_file| and |change_file|} +begin reset(web_file); reset(change_file); +end; +@y +@ The following code opens the input files. +This happens after the initialize procedure has executed. +That will have called the |scan_args| procedure to set up the global +variables |web_name| and |change_name| to the appropriate file +names. +These globals, and the |scan_args| procedure will be defined at the end +where they won't disturb the module numbering. +@^system dependencies@> + +@p procedure open_input; {prepare to read |web_file| and |change_file|} +begin +reset(web_file,web_name); reset(change_file,change_name); +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [26] open output files +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The following code opens |Pascal_file| and |pool|. +Since these files were listed in the program header, we assume that the +\PASCAL\ runtime system has checked that suitable external file names have +been given. +@^system dependencies@> + +@<Set init...@>= +rewrite(Pascal_file); rewrite(pool); +@y +@ The following code opens |Pascal_file| and |pool|. +Use the |scan_args| procedure to fill the global file names, +according to the names given on the command line. +@^system dependencies@> + +@<Set init...@>= +scan_args; +rewrite(Pascal_file,Pascal_name); rewrite(pool,pool_name); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [28] faster input_ln +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p function input_ln(var f:text_file):boolean; + {inputs a line or returns |false|} +var final_limit:0..buf_size; {|limit| without trailing blanks} +begin limit:=0; final_limit:=0; +if eof(f) then input_ln:=false +else begin while not eoln(f) do + begin buffer[limit]:=xord[f^]; get(f); + incr(limit); + if buffer[limit-1]<>" " then final_limit:=limit; + if limit=buf_size then + begin while not eoln(f) do get(f); + decr(limit); {keep |buffer[buf_size]| empty} + if final_limit>limit then final_limit:=limit; + print_nl('! Input line too long'); loc:=0; error; +@.Input line too long@> + end; + end; + read_ln(f); limit:=final_limit; input_ln:=true; + end; +end; +@y +With Berkeley {\mc UNIX} we call an external C procedure, |line_read|. +That routine fills |buffer| from 0 onwards with the |xord|'ed values +of the next line, setting |limit| appropriately (ignoring trailing +blanks). +It will stop if |limit=buf_size|, and the following will cause an error +message. +Note: for bootstrapping purposes it is all right to use the original form +of |input_ln|; it will just run slower. + +@p function input_ln(var f:text_file):boolean; + {inputs a line or returns |false|} +begin limit:=0; +if test_eof(f) then input_ln:=false +else begin line_read(f); + if limit=buf_size then + begin + decr(limit); {keep |buffer[buf_size]| empty} + print_nl('! Input line too long'); loc:=0; error; +@.Input line too long@> + end; + input_ln:=true; + end; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [38] Data Structures: provide for larger |byte_mem| and |tok_mem| +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x Extra capacity: +@d ww=2 {we multiply the byte capacity by approximately this amount} +@d zz=3 {we multiply the token capacity by approximately this amount} +@y +@d ww=3 {we multiply the byte capacity by approximately this amount} +@d zz=4 {we multiply the token capacity by approximately this amount} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [96] faster flush_buffer +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d check_break==if out_ptr>line_length then flush_buffer + +@p procedure flush_buffer; {writes one line to output file} +var k:0..out_buf_size; {index into |out_buf|} +@!b:0..out_buf_size; {value of |break_ptr| upon entry} +begin b:=break_ptr; +if (semi_ptr<>0)and(out_ptr-semi_ptr<=line_length) then break_ptr:=semi_ptr; +for k:=1 to break_ptr do write(Pascal_file,xchr[out_buf[k-1]]); +@y +For Berkeley {\mc UNIX} we use an external C procedure, |line_write|, +to write the |xchr|'d version of characters to a file. +This improves the speed significantly. + +@d check_break==if out_ptr>line_length then flush_buffer + +@p procedure flush_buffer; {writes one line to output file} +var k:0..out_buf_size; {index into |out_buf|} +@!b:0..out_buf_size; {value of |break_ptr| upon entry} +begin b:=break_ptr; +if (semi_ptr<>0)and(out_ptr-semi_ptr<=line_length) then break_ptr:=semi_ptr; +line_write(Pascal_file,break_ptr); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [105] Accept DIV, div, MOD, and mod +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x + (((out_contrib[1]="D")and(out_contrib[2]="I")and(out_contrib[3]="V")) or@| + ((out_contrib[1]="M")and(out_contrib[2]="O")and(out_contrib[3]="D")) ))or@| +@^uppercase@> +@y + (((out_contrib[1]="D")and(out_contrib[2]="I")and(out_contrib[3]="V")) or@| + ((out_contrib[1]="d")and(out_contrib[2]="i")and(out_contrib[3]="v")) or@| + ((out_contrib[1]="M")and(out_contrib[2]="O")and(out_contrib[3]="D")) or@| + ((out_contrib[1]="m")and(out_contrib[2]="o")and(out_contrib[3]="d")) ))or@| +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [110] lowercase ids +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@^uppercase@> + if ((out_buf[out_ptr-3]="D")and(out_buf[out_ptr-2]="I")and + (out_buf[out_ptr-1]="V"))or @/ + ((out_buf[out_ptr-3]="M")and(out_buf[out_ptr-2]="O")and + (out_buf[out_ptr-1]="D")) then@/ goto bad_case +@y + if ((out_buf[out_ptr-3]="D")and(out_buf[out_ptr-2]="I")and + (out_buf[out_ptr-1]="V"))or @/ + ((out_buf[out_ptr-3]="d")and(out_buf[out_ptr-2]="i")and + (out_buf[out_ptr-1]="v"))or @/ + ((out_buf[out_ptr-3]="M")and(out_buf[out_ptr-2]="O")and + (out_buf[out_ptr-1]="D"))or @/ + ((out_buf[out_ptr-3]="m")and(out_buf[out_ptr-2]="o")and + (out_buf[out_ptr-1]="d")) then@/ goto bad_case +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [114] lowercase operators (`and', `or', etc.) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +and_sign: begin out_contrib[1]:="A"; out_contrib[2]:="N"; out_contrib[3]:="D"; +@^uppercase@> + send_out(ident,3); + end; +not_sign: begin out_contrib[1]:="N"; out_contrib[2]:="O"; out_contrib[3]:="T"; + send_out(ident,3); + end; +set_element_sign: begin out_contrib[1]:="I"; out_contrib[2]:="N"; + send_out(ident,2); + end; +or_sign: begin out_contrib[1]:="O"; out_contrib[2]:="R"; send_out(ident,2); +@y +and_sign: begin out_contrib[1]:="a"; out_contrib[2]:="n"; out_contrib[3]:="d"; + send_out(ident,3); + end; +not_sign: begin out_contrib[1]:="n"; out_contrib[2]:="o"; out_contrib[3]:="t"; + send_out(ident,3); + end; +set_element_sign: begin out_contrib[1]:="i"; out_contrib[2]:="n"; + send_out(ident,2); + end; +or_sign: begin out_contrib[1]:="o"; out_contrib[2]:="r"; send_out(ident,2); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [116] Remove conversion to uppercase +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ Single-character identifiers represent themselves, while longer ones +appear in |byte_mem|. All must be converted to uppercase, +with underlines removed. Extremely long identifiers must be chopped. + +(Some \PASCAL\ compilers work with lowercase letters instead of +uppercase. If this module of \.{TANGLE} is changed, it's also necessary +to change from uppercase to lowercase in the modules that are +listed in the index under ``uppercase''.) +@^system dependencies@> +@^uppercase@> + +@d up_to(#)==#-24,#-23,#-22,#-21,#-20,#-19,#-18,#-17,#-16,#-15,#-14, + #-13,#-12,#-11,#-10,#-9,#-8,#-7,#-6,#-5,#-4,#-3,#-2,#-1,# + +@<Cases related to identifiers@>= +"A",up_to("Z"): begin out_contrib[1]:=cur_char; send_out(ident,1); + end; +"a",up_to("z"): begin out_contrib[1]:=cur_char-@'40; send_out(ident,1); + end; +identifier: begin k:=0; j:=byte_start[cur_val]; w:=cur_val mod ww; + while (k<max_id_length)and(j<byte_start[cur_val+ww]) do + begin incr(k); out_contrib[k]:=byte_mem[w,j]; incr(j); + if out_contrib[k]>="a" then out_contrib[k]:=out_contrib[k]-@'40 + else if out_contrib[k]="_" then decr(k); + end; + send_out(ident,k); + end; +@y +@ Single-character identifiers represent themselves, while longer ones +appear in |byte_mem|. All must be converted to lowercase, +with underlines removed. Extremely long identifiers must be chopped. +@^system dependencies@> + +@d up_to(#)==#-24,#-23,#-22,#-21,#-20,#-19,#-18,#-17,#-16,#-15,#-14, + #-13,#-12,#-11,#-10,#-9,#-8,#-7,#-6,#-5,#-4,#-3,#-2,#-1,# + +@<Cases related to identifiers@>= +"A",up_to("Z"), +"a",up_to("z"): begin out_contrib[1]:=cur_char; send_out(ident,1); + end; +identifier: begin k:=0; j:=byte_start[cur_val]; w:=cur_val mod ww; + while (k<max_id_length)and(j<byte_start[cur_val+ww]) do + begin incr(k); out_contrib[k]:=byte_mem[w,j]; incr(j); + if out_contrib[k]="_" then decr(k); + end; + send_out(ident,k); + end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [179] make term_in = input +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +any error stop will set |debug_cycle| to zero. +@y +any error stop will set |debug_cycle| to zero. + +@d term_in==input +@z + +@x +@!term_in:text_file; {the user's terminal as an input file} +@y + +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [180] remove term_in reset +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +reset(term_in,'TTY:','/I'); {open |term_in| as the terminal, don't do a |get|} +@y + +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [182] write newline just before exit; use value of |history| +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +We have defined plenty of procedures, and it is time to put the last +pieces of the puzzle in place. Here is where \.{TANGLE} starts, and where +it ends. +@^system dependencies@> +@y +We have defined plenty of procedures, and it is time to put the last +pieces of the puzzle in place. Here is where \.{TANGLE} starts, and where +it ends. +@^system dependencies@> + +@d UNIXexit==e@&x@&i@&t +@z + +@x +@<Print the job |history|@>; +@y +@<Print the job |history|@>; +new_line; +if (history <> spotless) and (history <> harmless_message) then + UNIXexit(1) +else + UNIXexit(0); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [188] system dependent changes--the |scan_args| procedure. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@* System-dependent changes. +This module should be replaced, if necessary, by changes to the program +that are necessary to make \.{TANGLE} work at a particular installation. +It is usually best to design your change file so that all changes to +previous modules preserve the module numbering; then everybody's version +will be consistent with the printed program. More extensive changes, +which introduce new modules, can be inserted here; then only the index +itself will get a new module number. +@^system dependencies@> +@y +@* System-dependent changes. +@^system dependencies@> + +@ The user calls \.{TANGLE} with arguments on the command line. +These are either file names or flags (beginning with '-'). +The following globals are for communicating the user's desires to the rest +of the program. The various |file_name| variables contain strings with +the full names of those files, as UNIX knows them. + +There are no flags that affect \.{TANGLE} at the moment. + +@d max_file_name_length==60 + +@<Globals...@>= +@!web_name,@!change_name,@!Pascal_name,@!pool_name: + array[1..max_file_name_length] of char; + +@ The |scan_args| procedure looks at the command line arguments and sets +the |file_name| variables accordingly. +At least one file name must be present: the \.{WEB} file. It may have +an extension, or it may omit it to get |'.web'| added. +The \PASCAL\ output file name is formed by replacing the \.{WEB} file +name extension by |'.p'|. +Similarly, the pool file name is formed using a |'.pool'| extension. + +If there is another file name present among the arguments, it is the +change file, again either with an extension or without one to get |'.ch'| +An omitted change file argument means that |'/dev/null'| should be used, +when no changes are desired. + +@<Declaration of |scan_args|@>= +procedure scan_args; +var dot_pos,i,a: integer; {indices} +c: char; +@!fname: array[1..max_file_name_length-5] of char; {temporary argument holder} +@!found_web,@!found_change: boolean; {|true| when those file names have + been seen} +begin +found_web:=false; +found_change:=false; +for a:=1 to argc-1 do begin + argv(a,fname); {put argument number |a| into |fname|} + if fname[1]<>'-' then begin + if not found_web then + @<Get |web_name|, |Pascal_name|, and + | pool_name| variables from |fname|@> + else if not found_change then + @<Get |change_name| from |fname|@> + else @<Print usage error message and quit@>; + end + else @<Handle flag argument in |fname|@>; + end; +if not found_web then @<Print usage error message and quit@>; +if not found_change then @<Set up null change file@>; +end; + +@ Use all of |fname| for the |web_name| if there is a |'.'| in it, +otherwise add |'.web'|. +The other file names come from adding things after the dot. +The |argv| procedure will not put more than |max_file_name_length-5| +characters into |fname|, and this leaves enough room in the |file_name| +variables to add the extensions. + +The end of a file name is marked with a |' '|, the convention assumed by +the |reset| and |rewrite| procedures. + +@<Get |web_name|...@>= +begin +dot_pos:=-1; +i:=1; +while (fname[i]<>' ') and (i<=max_file_name_length-5) do begin + web_name[i]:=fname[i]; + if fname[i]='.' then dot_pos:=i; + incr(i); + end; +if dot_pos=-1 then begin + dot_pos:=i; + web_name[dot_pos]:='.'; + web_name[dot_pos+1]:='w'; + web_name[dot_pos+2]:='e'; + web_name[dot_pos+3]:='b'; + web_name[dot_pos+4]:=' '; + end +else web_name[i]:=' '; +for i:=1 to dot_pos do begin + c:=web_name[i]; + Pascal_name[i]:=c; + pool_name[i]:=c; + end; +Pascal_name[dot_pos+1]:='p'; +Pascal_name[dot_pos+2]:=' '; +pool_name[dot_pos+1]:='p'; +pool_name[dot_pos+2]:='o'; +pool_name[dot_pos+3]:='o'; +pool_name[dot_pos+4]:='l'; +pool_name[dot_pos+5]:=' '; +found_web:=true; +end + +@ @<Get |change_name|...@>= +begin +dot_pos:=-1; +i:=1; +while (fname[i]<>' ') and (i<=max_file_name_length-5) +do begin + change_name[i]:=fname[i]; + if fname[i]='.' then dot_pos:=i; + incr(i); + end; +if dot_pos=-1 then begin + dot_pos:=i; + change_name[dot_pos]:='.'; + change_name[dot_pos+1]:='c'; + change_name[dot_pos+2]:='h'; + change_name[dot_pos+3]:=' '; + end +else change_name[i]:=' '; +found_change:=true; +end + +@ @<Set up null...@>= +begin + change_name[1]:='/'; + change_name[2]:='d'; + change_name[3]:='e'; + change_name[4]:='v'; + change_name[5]:='/'; + change_name[6]:='n'; + change_name[7]:='u'; + change_name[8]:='l'; + change_name[9]:='l'; + change_name[10]:=' '; +end + +@ There are no flags currently used by \.{TANGLE}, but this module can be +used as a hook to introduce flags. + +@<Handle flag...@>= +begin + @<Print usage error message and quit@>; +end + +@ @<Print usage error message and quit@>= +begin +print_nl('! Usage: webfile[.web] [changefile[.ch]]'); +error; +jump_out; +end + +@z diff --git a/systems/knuth/local/web-sparc/tangle.p b/systems/knuth/local/web-sparc/tangle.p new file mode 100644 index 0000000000..30fe333069 --- /dev/null +++ b/systems/knuth/local/web-sparc/tangle.p @@ -0,0 +1,814 @@ +{2:}{4:}(*$C-*){(*$C+*)}{:4}program TANGLE(input,output);label 9999; +const{8:}bufsize=100;maxbytes=45000;maxtoks=50000;maxnames=4000; +maxtexts=2000;hashsize=353;longestname=400;linelength=72;outbufsize=144; +stacksize=50;maxidlength=50;unambiglength=7;{:8}type{11:} +ASCIIcode=0..255;{:11}{12:}textfile=packed file of char;{:12}{37:} +eightbits=0..255;sixteenbits=0..65535;{:37}{39:}namepointer=0..maxnames; +{:39}{43:}textpointer=0..maxtexts;{:43}{78:} +outputstate=record endfield:sixteenbits;bytefield:sixteenbits; +namefield:namepointer;replfield:textpointer;modfield:0..12287;end;{:78} +var{9:}history:0..3;{:9}{13:}xord:array[char]of ASCIIcode; +xchr:array[ASCIIcode]of char;{:13}{23:}webfile:textfile; +changefile:textfile;{:23}{25:}Pascalfile:textfile;pool:textfile;{:25} +{27:}buffer:array[0..bufsize]of ASCIIcode;{:27}{29:}phaseone:boolean; +{:29}{38:}bytemem:packed array[0..2,0..maxbytes]of ASCIIcode; +tokmem:packed array[0..3,0..maxtoks]of eightbits; +bytestart:array[0..maxnames]of sixteenbits; +tokstart:array[0..maxtexts]of sixteenbits; +link:array[0..maxnames]of sixteenbits; +ilk:array[0..maxnames]of sixteenbits; +equiv:array[0..maxnames]of sixteenbits; +textlink:array[0..maxtexts]of sixteenbits;{:38}{40:}nameptr:namepointer; +stringptr:namepointer;byteptr:array[0..2]of 0..maxbytes; +poolchecksum:integer;{:40}{44:}textptr:textpointer; +tokptr:array[0..3]of 0..maxtoks;z:0..3; +{maxtokptr:array[0..3]of 0..maxtoks;}{:44}{50:}idfirst:0..bufsize; +idloc:0..bufsize;doublechars:0..bufsize; +hash,chophash:array[0..hashsize]of sixteenbits; +choppedid:array[0..unambiglength]of ASCIIcode;{:50}{65:} +modtext:array[0..longestname]of ASCIIcode;{:65}{70:} +lastunnamed:textpointer;{:70}{79:}curstate:outputstate; +stack:array[1..stacksize]of outputstate;stackptr:0..stacksize;{:79}{80:} +zo:0..3;{:80}{82:}bracelevel:eightbits;{:82}{86:}curval:integer;{:86} +{94:}outbuf:array[0..outbufsize]of ASCIIcode;outptr:0..outbufsize; +breakptr:0..outbufsize;semiptr:0..outbufsize;{:94}{95:} +outstate:eightbits;outval,outapp:integer;outsign:ASCIIcode; +lastsign:-1..+1;{:95}{100:}outcontrib:array[1..linelength]of ASCIIcode; +{:100}{124:}ii:integer;line:integer;otherline:integer;templine:integer; +limit:0..bufsize;loc:0..bufsize;inputhasended:boolean;changing:boolean; +{:124}{126:}changebuffer:array[0..bufsize]of ASCIIcode; +changelimit:0..bufsize;{:126}{143:}curmodule:namepointer; +scanninghex:boolean;{:143}{156:}nextcontrol:eightbits;{:156}{164:} +currepltext:textpointer;{:164}{171:}modulecount:0..12287;{:171}{179:} +{troubleshooting:boolean;ddt:integer;dd:integer;debugcycle:integer; +debugskipped:integer;}{:179}{185:}{wo:0..2;}{:185}{189:} +webname,changename,Pascalname,poolname:array[1..60]of char;{:189} +#include "tangext.h" +{30:}{procedure debughelp;forward;}{:30}{31:}procedure error; +var j:0..outbufsize;k,l:0..bufsize;begin if phaseone then{32:} +begin if changing then write(output,'. (change file ')else write(output, +'. (');writeln(output,'l.',line:1,')'); +if loc>=limit then l:=limit else l:=loc; +for k:=1 to l do if buffer[k-1]=9 then write(output,' ')else write( +output,xchr[buffer[k-1]]);writeln(output); +for k:=1 to l do write(output,' '); +for k:=l+1 to limit do write(output,xchr[buffer[k-1]]); +write(output,' ');end{:32}else{33:} +begin writeln(output,'. (l.',line:1,')'); +for j:=1 to outptr do write(output,xchr[outbuf[j-1]]); +write(output,'... ');end{:33};flush(output);history:=2; +{debugskipped:=debugcycle;debughelp;}end;{:31}{34:}procedure jumpout; +begin goto 9999;end;{:34}{190:}procedure scanargs; +var dotpos,i,a:integer;c:char;fname:array[1..55]of char; +foundweb,foundchange:boolean;begin foundweb:=false;foundchange:=false; +for a:=1 to argc-1 do begin argv(a,fname); +if fname[1]<>'-'then begin if not foundweb then{191:}begin dotpos:=-1; +i:=1;while(fname[i]<>' ')and(i<=55)do begin webname[i]:=fname[i]; +if fname[i]='.'then dotpos:=i;i:=i+1;end; +if dotpos=-1 then begin dotpos:=i;webname[dotpos]:='.'; +webname[dotpos+1]:='w';webname[dotpos+2]:='e';webname[dotpos+3]:='b'; +webname[dotpos+4]:=' ';end else webname[i]:=' '; +for i:=1 to dotpos do begin c:=webname[i];Pascalname[i]:=c; +poolname[i]:=c;end;Pascalname[dotpos+1]:='p';Pascalname[dotpos+2]:=' '; +poolname[dotpos+1]:='p';poolname[dotpos+2]:='o';poolname[dotpos+3]:='o'; +poolname[dotpos+4]:='l';poolname[dotpos+5]:=' ';foundweb:=true;end{:191} +else if not foundchange then{192:}begin dotpos:=-1;i:=1; +while(fname[i]<>' ')and(i<=55)do begin changename[i]:=fname[i]; +if fname[i]='.'then dotpos:=i;i:=i+1;end; +if dotpos=-1 then begin dotpos:=i;changename[dotpos]:='.'; +changename[dotpos+1]:='c';changename[dotpos+2]:='h'; +changename[dotpos+3]:=' ';end else changename[i]:=' ';foundchange:=true; +end{:192}else{195:}begin begin writeln(output); +write(output,'! Usage: webfile[.web] [changefile[.ch]]');end;error; +jumpout;end{:195};end else{194:}begin{195:}begin begin writeln(output); +write(output,'! Usage: webfile[.web] [changefile[.ch]]');end;error; +jumpout;end{:195};end{:194};end;if not foundweb then{195:} +begin begin writeln(output); +write(output,'! Usage: webfile[.web] [changefile[.ch]]');end;error; +jumpout;end{:195};if not foundchange then{193:}begin changename[1]:='/'; +changename[2]:='d';changename[3]:='e';changename[4]:='v'; +changename[5]:='/';changename[6]:='n';changename[7]:='u'; +changename[8]:='l';changename[9]:='l';changename[10]:=' ';end{:193};end; +{:190}procedure initialize;var{16:}i:0..255;{:16}{41:}wi:0..2;{:41}{45:} +zi:0..3;{:45}{51:}h:0..hashsize;{:51}begin{10:}history:=0;{:10}{14:} +xchr[32]:=' ';xchr[33]:='!';xchr[34]:='"';xchr[35]:='#';xchr[36]:='$'; +xchr[37]:='%';xchr[38]:='&';xchr[39]:='''';xchr[40]:='(';xchr[41]:=')'; +xchr[42]:='*';xchr[43]:='+';xchr[44]:=',';xchr[45]:='-';xchr[46]:='.'; +xchr[47]:='/';xchr[48]:='0';xchr[49]:='1';xchr[50]:='2';xchr[51]:='3'; +xchr[52]:='4';xchr[53]:='5';xchr[54]:='6';xchr[55]:='7';xchr[56]:='8'; +xchr[57]:='9';xchr[58]:=':';xchr[59]:=';';xchr[60]:='<';xchr[61]:='='; +xchr[62]:='>';xchr[63]:='?';xchr[64]:='@';xchr[65]:='A';xchr[66]:='B'; +xchr[67]:='C';xchr[68]:='D';xchr[69]:='E';xchr[70]:='F';xchr[71]:='G'; +xchr[72]:='H';xchr[73]:='I';xchr[74]:='J';xchr[75]:='K';xchr[76]:='L'; +xchr[77]:='M';xchr[78]:='N';xchr[79]:='O';xchr[80]:='P';xchr[81]:='Q'; +xchr[82]:='R';xchr[83]:='S';xchr[84]:='T';xchr[85]:='U';xchr[86]:='V'; +xchr[87]:='W';xchr[88]:='X';xchr[89]:='Y';xchr[90]:='Z';xchr[91]:='['; +xchr[92]:='\';xchr[93]:=']';xchr[94]:='^';xchr[95]:='_';xchr[96]:='`'; +xchr[97]:='a';xchr[98]:='b';xchr[99]:='c';xchr[100]:='d';xchr[101]:='e'; +xchr[102]:='f';xchr[103]:='g';xchr[104]:='h';xchr[105]:='i'; +xchr[106]:='j';xchr[107]:='k';xchr[108]:='l';xchr[109]:='m'; +xchr[110]:='n';xchr[111]:='o';xchr[112]:='p';xchr[113]:='q'; +xchr[114]:='r';xchr[115]:='s';xchr[116]:='t';xchr[117]:='u'; +xchr[118]:='v';xchr[119]:='w';xchr[120]:='x';xchr[121]:='y'; +xchr[122]:='z';xchr[123]:='{';xchr[124]:='|';xchr[125]:='}'; +xchr[126]:='~';xchr[0]:=' ';xchr[127]:=' ';{:14}{17:} +for i:=1 to 31 do xchr[i]:=chr(i);for i:=128 to 255 do xchr[i]:=chr(i); +{:17}{18:}for i:=0 to 255 do xord[chr(i)]:=32; +for i:=1 to 255 do xord[xchr[i]]:=i;xord[' ']:=32;{:18}{21:}{:21}{26:} +scanargs;rewrite(Pascalfile,Pascalname);rewrite(pool,poolname);{:26} +{42:}for wi:=0 to 2 do begin bytestart[wi]:=0;byteptr[wi]:=0;end; +bytestart[3]:=0;nameptr:=1;stringptr:=256;poolchecksum:=271828;{:42} +{46:}for zi:=0 to 3 do begin tokstart[zi]:=0;tokptr[zi]:=0;end; +tokstart[4]:=0;textptr:=1;z:=1 mod 4;{:46}{48:}ilk[0]:=0;equiv[0]:=0; +{:48}{52:}for h:=0 to hashsize-1 do begin hash[h]:=0;chophash[h]:=0;end; +{:52}{71:}lastunnamed:=0;textlink[0]:=0;{:71}{144:}scanninghex:=false; +{:144}{152:}modtext[0]:=32;{:152}{180:}{troubleshooting:=true; +debugcycle:=1;debugskipped:=0;troubleshooting:=false;debugcycle:=99999;} +{:180}end;{:2}{24:}procedure openinput;begin reset(webfile,webname); +reset(changefile,changename);end;{:24}{28:} +function inputln(var f:textfile):boolean;begin limit:=0; +if testeof(f)then inputln:=false else begin lineread(f); +if limit=bufsize then begin limit:=limit-1;begin writeln(output); +write(output,'! Input line too long');end;loc:=0;error;end; +inputln:=true;end;end;{:28}{49:}procedure printid(p:namepointer); +var k:0..maxbytes;w:0..2; +begin if p>=nameptr then write(output,'IMPOSSIBLE')else begin w:=p mod 3 +; +for k:=bytestart[p]to bytestart[p+3]-1 do write(output,xchr[bytemem[w,k] +]);end;end;{:49}{53:}function idlookup(t:eightbits):namepointer; +label 31,32;var c:eightbits;i:0..bufsize;h:0..hashsize;k:0..maxbytes; +w:0..2;l:0..bufsize;p,q:namepointer;s:0..unambiglength; +begin l:=idloc-idfirst;{54:}h:=buffer[idfirst];i:=idfirst+1; +while i<idloc do begin h:=(h+h+buffer[i])mod hashsize;i:=i+1;end{:54}; +{55:}p:=hash[h]; +while p<>0 do begin if bytestart[p+3]-bytestart[p]=l then{56:} +begin i:=idfirst;k:=bytestart[p];w:=p mod 3; +while(i<idloc)and(buffer[i]=bytemem[w,k])do begin i:=i+1;k:=k+1;end; +if i=idloc then goto 31;end{:56};p:=link[p];end;p:=nameptr; +link[p]:=hash[h];hash[h]:=p;31:{:55};if(p=nameptr)or(t<>0)then{57:} +begin if((p<>nameptr)and(t<>0)and(ilk[p]=0))or((p=nameptr)and(t=0)and( +buffer[idfirst]<>34))then{58:}begin i:=idfirst;s:=0;h:=0; +while(i<idloc)and(s<unambiglength)do begin if buffer[i]<>95 then begin +if buffer[i]>=97 then choppedid[s]:=buffer[i]-32 else choppedid[s]:= +buffer[i];h:=(h+h+choppedid[s])mod hashsize;s:=s+1;end;i:=i+1;end; +choppedid[s]:=0;end{:58};if p<>nameptr then{59:} +begin if ilk[p]=0 then begin if t=1 then begin writeln(output); +write(output,'! This identifier has already appeared');error;end;{60:} +q:=chophash[h]; +if q=p then chophash[h]:=equiv[p]else begin while equiv[q]<>p do q:= +equiv[q];equiv[q]:=equiv[p];end{:60};end else begin writeln(output); +write(output,'! This identifier was defined before');error;end; +ilk[p]:=t;end{:59}else{61:} +begin if(t=0)and(buffer[idfirst]<>34)then{62:}begin q:=chophash[h]; +while q<>0 do begin{63:}begin k:=bytestart[q];s:=0;w:=q mod 3; +while(k<bytestart[q+3])and(s<unambiglength)do begin c:=bytemem[w,k]; +if c<>95 then begin if c>=97 then c:=c-32; +if choppedid[s]<>c then goto 32;s:=s+1;end;k:=k+1;end; +if(k=bytestart[q+3])and(choppedid[s]<>0)then goto 32; +begin writeln(output);write(output,'! Identifier conflict with ');end; +for k:=bytestart[q]to bytestart[q+3]-1 do write(output,xchr[bytemem[w,k] +]);error;q:=0;32:end{:63};q:=equiv[q];end;equiv[p]:=chophash[h]; +chophash[h]:=p;end{:62};w:=nameptr mod 3;k:=byteptr[w]; +if k+l>maxbytes then begin writeln(output); +write(output,'! Sorry, ','byte memory',' capacity exceeded');error; +history:=3;jumpout;end;if nameptr>maxnames-3 then begin writeln(output); +write(output,'! Sorry, ','name',' capacity exceeded');error;history:=3; +jumpout;end;i:=idfirst;while i<idloc do begin bytemem[w,k]:=buffer[i]; +k:=k+1;i:=i+1;end;byteptr[w]:=k;bytestart[nameptr+3]:=k; +nameptr:=nameptr+1;if buffer[idfirst]<>34 then ilk[p]:=t else{64:} +begin ilk[p]:=1; +if l-doublechars=2 then equiv[p]:=buffer[idfirst+1]+32768 else begin +equiv[p]:=stringptr+32768;l:=l-doublechars-1; +if l>99 then begin writeln(output); +write(output,'! Preprocessed string is too long');error;end; +stringptr:=stringptr+1;write(pool,xchr[48+l div 10],xchr[48+l mod 10]); +poolchecksum:=poolchecksum+poolchecksum+l; +while poolchecksum>536870839 do poolchecksum:=poolchecksum-536870839; +i:=idfirst+1;while i<idloc do begin write(pool,xchr[buffer[i]]); +poolchecksum:=poolchecksum+poolchecksum+buffer[i]; +while poolchecksum>536870839 do poolchecksum:=poolchecksum-536870839; +if(buffer[i]=34)or(buffer[i]=64)then i:=i+2 else i:=i+1;end; +writeln(pool);end;end{:64};end{:61};end{:57};idlookup:=p;end;{:53}{66:} +function modlookup(l:sixteenbits):namepointer;label 31;var c:0..4; +j:0..longestname;k:0..maxbytes;w:0..2;p:namepointer;q:namepointer; +begin c:=2;q:=0;p:=ilk[0];while p<>0 do begin{68:}begin k:=bytestart[p]; +w:=p mod 3;c:=1;j:=1; +while(k<bytestart[p+3])and(j<=l)and(modtext[j]=bytemem[w,k])do begin k:= +k+1;j:=j+1;end; +if k=bytestart[p+3]then if j>l then c:=1 else c:=4 else if j>l then c:=3 +else if modtext[j]<bytemem[w,k]then c:=0 else c:=2;end{:68};q:=p; +if c=0 then p:=link[q]else if c=2 then p:=ilk[q]else goto 31;end;{67:} +w:=nameptr mod 3;k:=byteptr[w]; +if k+l>maxbytes then begin writeln(output); +write(output,'! Sorry, ','byte memory',' capacity exceeded');error; +history:=3;jumpout;end;if nameptr>maxnames-3 then begin writeln(output); +write(output,'! Sorry, ','name',' capacity exceeded');error;history:=3; +jumpout;end;p:=nameptr;if c=0 then link[q]:=p else ilk[q]:=p;link[p]:=0; +ilk[p]:=0;c:=1;equiv[p]:=0; +for j:=1 to l do bytemem[w,k+j-1]:=modtext[j];byteptr[w]:=k+l; +bytestart[nameptr+3]:=k+l;nameptr:=nameptr+1;{:67}; +31:if c<>1 then begin begin writeln(output); +write(output,'! Incompatible section names');error;end;p:=0;end; +modlookup:=p;end;{:66}{69:} +function prefixlookup(l:sixteenbits):namepointer;var c:0..4; +count:0..maxnames;j:0..longestname;k:0..maxbytes;w:0..2;p:namepointer; +q:namepointer;r:namepointer;begin q:=0;p:=ilk[0];count:=0;r:=0; +while p<>0 do begin{68:}begin k:=bytestart[p];w:=p mod 3;c:=1;j:=1; +while(k<bytestart[p+3])and(j<=l)and(modtext[j]=bytemem[w,k])do begin k:= +k+1;j:=j+1;end; +if k=bytestart[p+3]then if j>l then c:=1 else c:=4 else if j>l then c:=3 +else if modtext[j]<bytemem[w,k]then c:=0 else c:=2;end{:68}; +if c=0 then p:=link[p]else if c=2 then p:=ilk[p]else begin r:=p; +count:=count+1;q:=ilk[p];p:=link[p];end;if p=0 then begin p:=q;q:=0;end; +end;if count<>1 then if count=0 then begin writeln(output); +write(output,'! Name does not match');error; +end else begin writeln(output);write(output,'! Ambiguous prefix');error; +end;prefixlookup:=r;end;{:69}{73:} +procedure storetwobytes(x:sixteenbits); +begin if tokptr[z]+2>maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=x div 256; +tokmem[z,tokptr[z]+1]:=x mod 256;tokptr[z]:=tokptr[z]+2;end;{:73}{74:} +{procedure printrepl(p:textpointer);var k:0..maxtoks;a:sixteenbits; +zp:0..3; +begin if p>=textptr then write(output,'BAD')else begin k:=tokstart[p]; +zp:=p mod 4;while k<tokstart[p+4]do begin a:=tokmem[zp,k]; +if a>=128 then[75:]begin k:=k+1; +if a<168 then begin a:=(a-128)*256+tokmem[zp,k];printid(a); +if bytemem[a mod 3,bytestart[a]]=34 then write(output,'"')else write( +output,' ');end else if a<208 then begin write(output,'@<'); +printid((a-168)*256+tokmem[zp,k]);write(output,'@>'); +end else begin a:=(a-208)*256+tokmem[zp,k]; +write(output,'@',xchr[123],a:1,'@',xchr[125]);end; +end[:75]else[76:]case a of 9:write(output,'@',xchr[123]); +10:write(output,'@',xchr[125]);12:write(output,'@'''); +13:write(output,'@"');125:write(output,'@$');0:write(output,'#'); +64:write(output,'@@');2:write(output,'@=');3:write(output,'@\'); +otherwise write(output,xchr[a])end[:76];k:=k+1;end;end;end;}{:74}{84:} +procedure pushlevel(p:namepointer); +begin if stackptr=stacksize then begin writeln(output); +write(output,'! Sorry, ','stack',' capacity exceeded');error;history:=3; +jumpout;end else begin stack[stackptr]:=curstate;stackptr:=stackptr+1; +curstate.namefield:=p;curstate.replfield:=equiv[p]; +zo:=curstate.replfield mod 4; +curstate.bytefield:=tokstart[curstate.replfield]; +curstate.endfield:=tokstart[curstate.replfield+4];curstate.modfield:=0; +end;end;{:84}{85:}procedure poplevel;label 10; +begin if textlink[curstate.replfield]=0 then begin if ilk[curstate. +namefield]=3 then{91:}begin nameptr:=nameptr-1;textptr:=textptr-1; +z:=textptr mod 4;{if tokptr[z]>maxtokptr[z]then maxtokptr[z]:=tokptr[z]; +}tokptr[z]:=tokstart[textptr]; +{byteptr[nameptr mod 3]:=byteptr[nameptr mod 3]-1;}end{:91}; +end else if textlink[curstate.replfield]<maxtexts then begin curstate. +replfield:=textlink[curstate.replfield];zo:=curstate.replfield mod 4; +curstate.bytefield:=tokstart[curstate.replfield]; +curstate.endfield:=tokstart[curstate.replfield+4];goto 10;end; +stackptr:=stackptr-1;if stackptr>0 then begin curstate:=stack[stackptr]; +zo:=curstate.replfield mod 4;end;10:end;{:85}{87:} +function getoutput:sixteenbits;label 20,30,31;var a:sixteenbits; +b:eightbits;bal:sixteenbits;k:0..maxbytes;w:0..2; +begin 20:if stackptr=0 then begin a:=0;goto 31;end; +if curstate.bytefield=curstate.endfield then begin curval:=-curstate. +modfield;poplevel;if curval=0 then goto 20;a:=129;goto 31;end; +a:=tokmem[zo,curstate.bytefield]; +curstate.bytefield:=curstate.bytefield+1;if a<128 then if a=0 then{92:} +begin pushlevel(nameptr-1);goto 20;end{:92}else goto 31; +a:=(a-128)*256+tokmem[zo,curstate.bytefield]; +curstate.bytefield:=curstate.bytefield+1;if a<10240 then{89:} +begin case ilk[a]of 0:begin curval:=a;a:=130;end; +1:begin curval:=equiv[a]-32768;a:=128;end;2:begin pushlevel(a);goto 20; +end;3:begin{90:} +while(curstate.bytefield=curstate.endfield)and(stackptr>0)do poplevel; +if(stackptr=0)or(tokmem[zo,curstate.bytefield]<>40)then begin begin +writeln(output);write(output,'! No parameter given for ');end; +printid(a);error;goto 20;end;{93:}bal:=1; +curstate.bytefield:=curstate.bytefield+1; +while true do begin b:=tokmem[zo,curstate.bytefield]; +curstate.bytefield:=curstate.bytefield+1; +if b=0 then storetwobytes(nameptr+32767)else begin if b>=128 then begin +begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1;end; +b:=tokmem[zo,curstate.bytefield]; +curstate.bytefield:=curstate.bytefield+1; +end else case b of 40:bal:=bal+1;41:begin bal:=bal-1; +if bal=0 then goto 30;end; +39:repeat begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1;end; +b:=tokmem[zo,curstate.bytefield]; +curstate.bytefield:=curstate.bytefield+1;until b=39;otherwise end; +begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1;end;end;end; +30:{:93};equiv[nameptr]:=textptr;ilk[nameptr]:=2;w:=nameptr mod 3; +k:=byteptr[w];{if k=maxbytes then begin writeln(output); +write(output,'! Sorry, ','byte memory',' capacity exceeded');error; +history:=3;jumpout;end;bytemem[w,k]:=35;k:=k+1;byteptr[w]:=k;} +if nameptr>maxnames-3 then begin writeln(output); +write(output,'! Sorry, ','name',' capacity exceeded');error;history:=3; +jumpout;end;bytestart[nameptr+3]:=k;nameptr:=nameptr+1; +if textptr>maxtexts-4 then begin writeln(output); +write(output,'! Sorry, ','text',' capacity exceeded');error;history:=3; +jumpout;end;textlink[textptr]:=0;tokstart[textptr+4]:=tokptr[z]; +textptr:=textptr+1;z:=textptr mod 4{:90};pushlevel(a);goto 20;end; +otherwise begin writeln(output); +write(output,'! This can''t happen (','output',')');error;history:=3; +jumpout;end end;goto 31;end{:89};if a<20480 then{88:}begin a:=a-10240; +if equiv[a]<>0 then pushlevel(a)else if a<>0 then begin begin writeln( +output);write(output,'! Not present: <');end;printid(a); +write(output,'>');error;end;goto 20;end{:88};curval:=a-20480;a:=129; +curstate.modfield:=curval;31:{if troubleshooting then debughelp;} +getoutput:=a;end;{:87}{97:}procedure flushbuffer;var k:0..outbufsize; +b:0..outbufsize;begin b:=breakptr; +if(semiptr<>0)and(outptr-semiptr<=linelength)then breakptr:=semiptr; +linewrite(Pascalfile,breakptr);writeln(Pascalfile);line:=line+1; +if line mod 100=0 then begin write(output,'.'); +if line mod 500=0 then write(output,line:1);flush(output);end; +if breakptr<outptr then begin if outbuf[breakptr]=32 then begin breakptr +:=breakptr+1;if breakptr>b then b:=breakptr;end; +for k:=breakptr to outptr-1 do outbuf[k-breakptr]:=outbuf[k];end; +outptr:=outptr-breakptr;breakptr:=b-breakptr;semiptr:=0; +if outptr>linelength then begin begin writeln(output); +write(output,'! Long line must be truncated');error;end; +outptr:=linelength;end;end;{:97}{99:}procedure appval(v:integer); +var k:0..outbufsize;begin k:=outbufsize;repeat outbuf[k]:=v mod 10; +v:=v div 10;k:=k-1;until v=0;repeat k:=k+1; +begin outbuf[outptr]:=outbuf[k]+48;outptr:=outptr+1;end; +until k=outbufsize;end;{:99}{101:}procedure sendout(t:eightbits; +v:sixteenbits);label 20;var k:0..linelength;begin{102:} +20:case outstate of 1:if t<>3 then begin breakptr:=outptr; +if t=2 then begin outbuf[outptr]:=32;outptr:=outptr+1;end;end; +2:begin begin outbuf[outptr]:=44-outapp;outptr:=outptr+1;end; +if outptr>linelength then flushbuffer;breakptr:=outptr;end; +3,4:begin{103:} +if(outval<0)or((outval=0)and(lastsign<0))then begin outbuf[outptr]:=45; +outptr:=outptr+1; +end else if outsign>0 then begin outbuf[outptr]:=outsign; +outptr:=outptr+1;end;appval(abs(outval)); +if outptr>linelength then flushbuffer;{:103};outstate:=outstate-2; +goto 20;end;5:{104:}begin if(t=3)or({105:} +((t=2)and(v=3)and(((outcontrib[1]=68)and(outcontrib[2]=73)and(outcontrib +[3]=86))or((outcontrib[1]=100)and(outcontrib[2]=105)and(outcontrib[3]= +118))or((outcontrib[1]=77)and(outcontrib[2]=79)and(outcontrib[3]=68))or( +(outcontrib[1]=109)and(outcontrib[2]=111)and(outcontrib[3]=100))))or((t= +0)and((v=42)or(v=47))){:105})then begin{103:} +if(outval<0)or((outval=0)and(lastsign<0))then begin outbuf[outptr]:=45; +outptr:=outptr+1; +end else if outsign>0 then begin outbuf[outptr]:=outsign; +outptr:=outptr+1;end;appval(abs(outval)); +if outptr>linelength then flushbuffer;{:103};outsign:=43;outval:=outapp; +end else outval:=outval+outapp;outstate:=3;goto 20;end{:104}; +0:if t<>3 then breakptr:=outptr;otherwise end{:102}; +if t<>0 then for k:=1 to v do begin outbuf[outptr]:=outcontrib[k]; +outptr:=outptr+1;end else begin outbuf[outptr]:=v;outptr:=outptr+1;end; +if outptr>linelength then flushbuffer; +if(t=0)and((v=59)or(v=125))then begin semiptr:=outptr;breakptr:=outptr; +end;if t>=2 then outstate:=1 else outstate:=0 end;{:101}{106:} +procedure sendsign(v:integer); +begin case outstate of 2,4:outapp:=outapp*v;3:begin outapp:=v; +outstate:=4;end;5:begin outval:=outval+outapp;outapp:=v;outstate:=4;end; +otherwise begin breakptr:=outptr;outapp:=v;outstate:=2;end end; +lastsign:=outapp;end;{:106}{107:}procedure sendval(v:integer); +label 666,10;begin case outstate of 1:begin{110:} +if(outptr=breakptr+3)or((outptr=breakptr+4)and(outbuf[breakptr]=32))then +if((outbuf[outptr-3]=68)and(outbuf[outptr-2]=73)and(outbuf[outptr-1]=86) +)or((outbuf[outptr-3]=100)and(outbuf[outptr-2]=105)and(outbuf[outptr-1]= +118))or((outbuf[outptr-3]=77)and(outbuf[outptr-2]=79)and(outbuf[outptr-1 +]=68))or((outbuf[outptr-3]=109)and(outbuf[outptr-2]=111)and(outbuf[ +outptr-1]=100))then goto 666{:110};outsign:=32;outstate:=3;outval:=v; +breakptr:=outptr;lastsign:=+1;end;0:begin{109:} +if(outptr=breakptr+1)and((outbuf[breakptr]=42)or(outbuf[breakptr]=47)) +then goto 666{:109};outsign:=0;outstate:=3;outval:=v;breakptr:=outptr; +lastsign:=+1;end;{108:}2:begin outsign:=43;outstate:=3;outval:=outapp*v; +end;3:begin outstate:=5;outapp:=v;begin writeln(output); +write(output,'! Two numbers occurred without a sign between them'); +error;end;end;4:begin outstate:=5;outapp:=outapp*v;end; +5:begin outval:=outval+outapp;outapp:=v;begin writeln(output); +write(output,'! Two numbers occurred without a sign between them'); +error;end;end;{:108}otherwise goto 666 end;goto 10;666:{111:} +if v>=0 then begin if outstate=1 then begin breakptr:=outptr; +begin outbuf[outptr]:=32;outptr:=outptr+1;end;end;appval(v); +if outptr>linelength then flushbuffer;outstate:=1; +end else begin begin outbuf[outptr]:=40;outptr:=outptr+1;end; +begin outbuf[outptr]:=45;outptr:=outptr+1;end;appval(-v); +begin outbuf[outptr]:=41;outptr:=outptr+1;end; +if outptr>linelength then flushbuffer;outstate:=0;end{:111};10:end; +{:107}{113:}procedure sendtheoutput;label 2,21,22;var curchar:eightbits; +k:0..linelength;j:0..maxbytes;w:0..2;n:integer; +begin while stackptr>0 do begin curchar:=getoutput; +21:case curchar of 0:;{116:} +65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88, +89,90,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113, +114,115,116,117,118,119,120,121,122:begin outcontrib[1]:=curchar; +sendout(2,1);end;130:begin k:=0;j:=bytestart[curval];w:=curval mod 3; +while(k<maxidlength)and(j<bytestart[curval+3])do begin k:=k+1; +outcontrib[k]:=bytemem[w,j];j:=j+1;if outcontrib[k]=95 then k:=k-1;end; +sendout(2,k);end;{:116}{119:}48,49,50,51,52,53,54,55,56,57:begin n:=0; +repeat curchar:=curchar-48;if n>=214748364 then begin writeln(output); +write(output,'! Constant too big');error;end else n:=10*n+curchar; +curchar:=getoutput;until(curchar>57)or(curchar<48);sendval(n);k:=0; +if curchar=101 then curchar:=69;if curchar=69 then goto 2 else goto 21; +end;125:sendval(poolchecksum);12:begin n:=0;curchar:=48; +repeat curchar:=curchar-48;if n>=268435456 then begin writeln(output); +write(output,'! Constant too big');error;end else n:=8*n+curchar; +curchar:=getoutput;until(curchar>55)or(curchar<48);sendval(n);goto 21; +end;13:begin n:=0;curchar:=48; +repeat if curchar>=65 then curchar:=curchar-55 else curchar:=curchar-48; +if n>=134217728 then begin writeln(output); +write(output,'! Constant too big');error;end else n:=16*n+curchar; +curchar:=getoutput; +until(curchar>70)or(curchar<48)or((curchar>57)and(curchar<65)); +sendval(n);goto 21;end;128:sendval(curval);46:begin k:=1; +outcontrib[1]:=46;curchar:=getoutput; +if curchar=46 then begin outcontrib[2]:=46;sendout(1,2); +end else if(curchar>=48)and(curchar<=57)then goto 2 else begin sendout(0 +,46);goto 21;end;end;{:119}43,45:sendsign(44-curchar);{114:} +4:begin outcontrib[1]:=97;outcontrib[2]:=110;outcontrib[3]:=100; +sendout(2,3);end;5:begin outcontrib[1]:=110;outcontrib[2]:=111; +outcontrib[3]:=116;sendout(2,3);end;6:begin outcontrib[1]:=105; +outcontrib[2]:=110;sendout(2,2);end;31:begin outcontrib[1]:=111; +outcontrib[2]:=114;sendout(2,2);end;24:begin outcontrib[1]:=58; +outcontrib[2]:=61;sendout(1,2);end;26:begin outcontrib[1]:=60; +outcontrib[2]:=62;sendout(1,2);end;28:begin outcontrib[1]:=60; +outcontrib[2]:=61;sendout(1,2);end;29:begin outcontrib[1]:=62; +outcontrib[2]:=61;sendout(1,2);end;30:begin outcontrib[1]:=61; +outcontrib[2]:=61;sendout(1,2);end;32:begin outcontrib[1]:=46; +outcontrib[2]:=46;sendout(1,2);end;{:114}39:{117:}begin k:=1; +outcontrib[1]:=39;repeat if k<linelength then k:=k+1; +outcontrib[k]:=getoutput;until(outcontrib[k]=39)or(stackptr=0); +if k=linelength then begin writeln(output); +write(output,'! String too long');error;end;sendout(1,k); +curchar:=getoutput;if curchar=39 then outstate:=6;goto 21;end{:117}; +{115:} +33,34,35,36,37,38,40,41,42,44,47,58,59,60,61,62,63,64,91,92,93,94,95,96, +123,124{:115}:sendout(0,curchar);{121:} +9:begin if bracelevel=0 then sendout(0,123)else sendout(0,91); +bracelevel:=bracelevel+1;end; +10:if bracelevel>0 then begin bracelevel:=bracelevel-1; +if bracelevel=0 then sendout(0,125)else sendout(0,93); +end else begin writeln(output);write(output,'! Extra @}');error;end; +129:begin if bracelevel=0 then sendout(0,123)else sendout(0,91); +if curval<0 then begin sendout(0,58);sendval(-curval); +end else begin sendval(curval);sendout(0,58);end; +if bracelevel=0 then sendout(0,125)else sendout(0,93);end;{:121} +127:begin sendout(3,0);outstate:=6;end;2:{118:}begin k:=0; +repeat if k<linelength then k:=k+1;outcontrib[k]:=getoutput; +until(outcontrib[k]=2)or(stackptr=0); +if k=linelength then begin writeln(output); +write(output,'! Verbatim string too long');error;end;sendout(1,k-1); +end{:118};3:{122:}begin sendout(1,0); +while outptr>0 do begin if outptr<=linelength then breakptr:=outptr; +flushbuffer;end;outstate:=0;end{:122};otherwise begin writeln(output); +write(output,'! Can''t output ASCII code ',curchar:1);error;end end; +goto 22;2:{120:}repeat if k<linelength then k:=k+1; +outcontrib[k]:=curchar;curchar:=getoutput; +if(outcontrib[k]=69)and((curchar=43)or(curchar=45))then begin if k< +linelength then k:=k+1;outcontrib[k]:=curchar;curchar:=getoutput; +end else if curchar=101 then curchar:=69; +until(curchar<>69)and((curchar<48)or(curchar>57)); +if k=linelength then begin writeln(output); +write(output,'! Fraction too long');error;end;sendout(3,k);goto 21{:120} +;22:end;end;{:113}{127:}function linesdontmatch:boolean;label 10; +var k:0..bufsize;begin linesdontmatch:=true; +if changelimit<>limit then goto 10; +if limit>0 then for k:=0 to limit-1 do if changebuffer[k]<>buffer[k]then +goto 10;linesdontmatch:=false;10:end;{:127}{128:} +procedure primethechangebuffer;label 22,30,10;var k:0..bufsize; +begin changelimit:=0;{129:}while true do begin line:=line+1; +if not inputln(changefile)then goto 10;if limit<2 then goto 22; +if buffer[0]<>64 then goto 22; +if(buffer[1]>=88)and(buffer[1]<=90)then buffer[1]:=buffer[1]+32; +if buffer[1]=120 then goto 30; +if(buffer[1]=121)or(buffer[1]=122)then begin loc:=2; +begin writeln(output);write(output,'! Where is the matching @x?');error; +end;end;22:end;30:{:129};{130:}repeat line:=line+1; +if not inputln(changefile)then begin begin writeln(output); +write(output,'! Change file ended after @x');error;end;goto 10;end; +until limit>0;{:130};{131:}begin changelimit:=limit; +if limit>0 then for k:=0 to limit-1 do changebuffer[k]:=buffer[k]; +end{:131};10:end;{:128}{132:}procedure checkchange;label 10; +var n:integer;k:0..bufsize;begin if linesdontmatch then goto 10;n:=0; +while true do begin changing:=not changing;templine:=otherline; +otherline:=line;line:=templine;line:=line+1; +if not inputln(changefile)then begin begin writeln(output); +write(output,'! Change file ended before @y');error;end;changelimit:=0; +changing:=not changing;templine:=otherline;otherline:=line; +line:=templine;goto 10;end;{133:} +if limit>1 then if buffer[0]=64 then begin if(buffer[1]>=88)and(buffer[1 +]<=90)then buffer[1]:=buffer[1]+32; +if(buffer[1]=120)or(buffer[1]=122)then begin loc:=2; +begin writeln(output);write(output,'! Where is the matching @y?');error; +end;end else if buffer[1]=121 then begin if n>0 then begin loc:=2; +begin writeln(output); +write(output,'! Hmm... ',n:1,' of the preceding lines failed to match'); +error;end;end;goto 10;end;end{:133};{131:}begin changelimit:=limit; +if limit>0 then for k:=0 to limit-1 do changebuffer[k]:=buffer[k]; +end{:131};changing:=not changing;templine:=otherline;otherline:=line; +line:=templine;line:=line+1; +if not inputln(webfile)then begin begin writeln(output); +write(output,'! WEB file ended during a change');error;end; +inputhasended:=true;goto 10;end;if linesdontmatch then n:=n+1;end; +10:end;{:132}{135:}procedure getline;label 20; +begin 20:if changing then{137:}begin line:=line+1; +if not inputln(changefile)then begin begin writeln(output); +write(output,'! Change file ended without @z');error;end;buffer[0]:=64; +buffer[1]:=122;limit:=2;end; +if limit>1 then if buffer[0]=64 then begin if(buffer[1]>=88)and(buffer[1 +]<=90)then buffer[1]:=buffer[1]+32; +if(buffer[1]=120)or(buffer[1]=121)then begin loc:=2; +begin writeln(output);write(output,'! Where is the matching @z?');error; +end;end else if buffer[1]=122 then begin primethechangebuffer; +changing:=not changing;templine:=otherline;otherline:=line; +line:=templine;end;end;end{:137};if not changing then begin{136:} +begin line:=line+1; +if not inputln(webfile)then inputhasended:=true else if limit= +changelimit then if buffer[0]=changebuffer[0]then if changelimit>0 then +checkchange;end{:136};if changing then goto 20;end;loc:=0; +buffer[limit]:=32;end;{:135}{139:} +function controlcode(c:ASCIIcode):eightbits; +begin case c of 64:controlcode:=64;39:controlcode:=12; +34:controlcode:=13;36:controlcode:=125;32,9:controlcode:=136; +42:begin write(output,'*',modulecount+1:1);flush(output); +controlcode:=136;end;68,100:controlcode:=133;70,102:controlcode:=132; +123:controlcode:=9;125:controlcode:=10;80,112:controlcode:=134; +84,116,94,46,58:controlcode:=131;38:controlcode:=127; +60:controlcode:=135;61:controlcode:=2;92:controlcode:=3; +otherwise controlcode:=0 end;end;{:139}{140:} +function skipahead:eightbits;label 30;var c:eightbits; +begin while true do begin if loc>limit then begin getline; +if inputhasended then begin c:=136;goto 30;end;end;buffer[limit+1]:=64; +while buffer[loc]<>64 do loc:=loc+1;if loc<=limit then begin loc:=loc+2; +c:=controlcode(buffer[loc-1]);if(c<>0)or(buffer[loc-1]=62)then goto 30; +end;end;30:skipahead:=c;end;{:140}{141:}procedure skipcomment;label 10; +var bal:eightbits;c:ASCIIcode;begin bal:=0; +while true do begin if loc>limit then begin getline; +if inputhasended then begin begin writeln(output); +write(output,'! Input ended in mid-comment');error;end;goto 10;end;end; +c:=buffer[loc];loc:=loc+1;{142:}if c=64 then begin c:=buffer[loc]; +if(c<>32)and(c<>9)and(c<>42)and(c<>122)and(c<>90)then loc:=loc+1 else +begin begin writeln(output); +write(output,'! Section ended in mid-comment');error;end;loc:=loc-1; +goto 10; +end end else if(c=92)and(buffer[loc]<>64)then loc:=loc+1 else if c=123 +then bal:=bal+1 else if c=125 then begin if bal=0 then goto 10; +bal:=bal-1;end{:142};end;10:end;{:141}{145:}function getnext:eightbits; +label 20,30,31;var c:eightbits;d:eightbits;j,k:0..longestname; +begin 20:if loc>limit then begin getline; +if inputhasended then begin c:=136;goto 31;end;end;c:=buffer[loc]; +loc:=loc+1;if scanninghex then{146:} +if((c>=48)and(c<=57))or((c>=65)and(c<=70))then goto 31 else scanninghex +:=false{:146}; +case c of 65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85 +,86,87,88,89,90,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111 +,112,113,114,115,116,117,118,119,120,121,122:{148:} +begin if((c=101)or(c=69))and(loc>1)then if(buffer[loc-2]<=57)and(buffer[ +loc-2]>=48)then c:=0;if c<>0 then begin loc:=loc-1;idfirst:=loc; +repeat loc:=loc+1;d:=buffer[loc]; +until((d<48)or((d>57)and(d<65))or((d>90)and(d<97))or(d>122))and(d<>95); +if loc>idfirst+1 then begin c:=130;idloc:=loc;end;end else c:=69; +end{:148};34:{149:}begin doublechars:=0;idfirst:=loc-1; +repeat d:=buffer[loc];loc:=loc+1; +if(d=34)or(d=64)then if buffer[loc]=d then begin loc:=loc+1;d:=0; +doublechars:=doublechars+1; +end else begin if d=64 then begin writeln(output); +write(output,'! Double @ sign missing');error; +end end else if loc>limit then begin begin writeln(output); +write(output,'! String constant didn''t end');error;end;d:=34;end; +until d=34;idloc:=loc-1;c:=130;end{:149};64:{150:} +begin c:=controlcode(buffer[loc]);loc:=loc+1; +if c=0 then goto 20 else if c=13 then scanninghex:=true else if c=135 +then{151:}begin{153:}k:=0; +while true do begin if loc>limit then begin getline; +if inputhasended then begin begin writeln(output); +write(output,'! Input ended in section name');error;end;goto 30;end;end; +d:=buffer[loc];{154:}if d=64 then begin d:=buffer[loc+1]; +if d=62 then begin loc:=loc+2;goto 30;end; +if(d=32)or(d=9)or(d=42)then begin begin writeln(output); +write(output,'! Section name didn''t end');error;end;goto 30;end;k:=k+1; +modtext[k]:=64;loc:=loc+1;end{:154};loc:=loc+1; +if k<longestname-1 then k:=k+1;if(d=32)or(d=9)then begin d:=32; +if modtext[k-1]=32 then k:=k-1;end;modtext[k]:=d;end;30:{155:} +if k>=longestname-2 then begin begin writeln(output); +write(output,'! Section name too long: ');end; +for j:=1 to 25 do write(output,xchr[modtext[j]]);write(output,'...'); +if history=0 then history:=1;end{:155}; +if(modtext[k]=32)and(k>0)then k:=k-1;{:153}; +if k>3 then begin if(modtext[k]=46)and(modtext[k-1]=46)and(modtext[k-2]= +46)then curmodule:=prefixlookup(k-3)else curmodule:=modlookup(k); +end else curmodule:=modlookup(k);end{:151} +else if c=131 then begin repeat c:=skipahead;until c<>64; +if buffer[loc-1]<>62 then begin writeln(output); +write(output,'! Improper @ within control text');error;end;goto 20;end; +end{:150};{147:} +46:if buffer[loc]=46 then begin if loc<=limit then begin c:=32; +loc:=loc+1;end; +end else if buffer[loc]=41 then begin if loc<=limit then begin c:=93; +loc:=loc+1;end;end; +58:if buffer[loc]=61 then begin if loc<=limit then begin c:=24; +loc:=loc+1;end;end; +61:if buffer[loc]=61 then begin if loc<=limit then begin c:=30; +loc:=loc+1;end;end; +62:if buffer[loc]=61 then begin if loc<=limit then begin c:=29; +loc:=loc+1;end;end; +60:if buffer[loc]=61 then begin if loc<=limit then begin c:=28; +loc:=loc+1;end; +end else if buffer[loc]=62 then begin if loc<=limit then begin c:=26; +loc:=loc+1;end;end; +40:if buffer[loc]=42 then begin if loc<=limit then begin c:=9; +loc:=loc+1;end; +end else if buffer[loc]=46 then begin if loc<=limit then begin c:=91; +loc:=loc+1;end;end; +42:if buffer[loc]=41 then begin if loc<=limit then begin c:=10; +loc:=loc+1;end;end;{:147}32,9:goto 20;123:begin skipcomment;goto 20;end; +125:begin begin writeln(output);write(output,'! Extra }');error;end; +goto 20;end;otherwise if c>=128 then goto 20 else end; +31:{if troubleshooting then debughelp;}getnext:=c;end;{:145}{157:} +procedure scannumeric(p:namepointer);label 21,30; +var accumulator:integer;nextsign:-1..+1;q:namepointer;val:integer; +begin{158:}accumulator:=0;nextsign:=+1; +while true do begin nextcontrol:=getnext; +21:case nextcontrol of 48,49,50,51,52,53,54,55,56,57:begin{160:}val:=0; +repeat val:=10*val+nextcontrol-48;nextcontrol:=getnext; +until(nextcontrol>57)or(nextcontrol<48){:160}; +begin accumulator:=accumulator+nextsign*(val);nextsign:=+1;end;goto 21; +end;12:begin{161:}val:=0;nextcontrol:=48; +repeat val:=8*val+nextcontrol-48;nextcontrol:=getnext; +until(nextcontrol>55)or(nextcontrol<48){:161}; +begin accumulator:=accumulator+nextsign*(val);nextsign:=+1;end;goto 21; +end;13:begin{162:}val:=0;nextcontrol:=48; +repeat if nextcontrol>=65 then nextcontrol:=nextcontrol-7; +val:=16*val+nextcontrol-48;nextcontrol:=getnext; +until(nextcontrol>70)or(nextcontrol<48)or((nextcontrol>57)and( +nextcontrol<65)){:162};begin accumulator:=accumulator+nextsign*(val); +nextsign:=+1;end;goto 21;end;130:begin q:=idlookup(0); +if ilk[q]<>1 then begin nextcontrol:=42;goto 21;end; +begin accumulator:=accumulator+nextsign*(equiv[q]-32768);nextsign:=+1; +end;end;43:;45:nextsign:=-nextsign;132,133,135,134,136:goto 30; +59:begin writeln(output); +write(output,'! Omit semicolon in numeric definition');error;end; +otherwise{159:}begin begin writeln(output); +write(output,'! Improper numeric definition will be flushed');error;end; +repeat nextcontrol:=skipahead until(nextcontrol>=132); +if nextcontrol=135 then begin loc:=loc-2;nextcontrol:=getnext;end; +accumulator:=0;goto 30;end{:159}end;end;30:{:158}; +if abs(accumulator)>=32768 then begin begin writeln(output); +write(output,'! Value too big: ',accumulator:1);error;end; +accumulator:=0;end;equiv[p]:=accumulator+32768;end;{:157}{165:} +procedure scanrepl(t:eightbits);label 22,30,31,21;var a:sixteenbits; +b:ASCIIcode;bal:eightbits;begin bal:=0; +while true do begin 22:a:=getnext;case a of 40:bal:=bal+1; +41:if bal=0 then begin writeln(output);write(output,'! Extra )');error; +end else bal:=bal-1;39:{168:}begin b:=39; +while true do begin begin if tokptr[z]=maxtoks then begin writeln(output +);write(output,'! Sorry, ','token',' capacity exceeded');error; +history:=3;jumpout;end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1; +end; +if b=64 then if buffer[loc]=64 then loc:=loc+1 else begin writeln(output +);write(output,'! You should double @ signs in strings');error;end; +if loc=limit then begin begin writeln(output); +write(output,'! String didn''t end');error;end;buffer[loc]:=39; +buffer[loc+1]:=0;end;b:=buffer[loc];loc:=loc+1; +if b=39 then begin if buffer[loc]<>39 then goto 31 else begin loc:=loc+1 +;begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=39;tokptr[z]:=tokptr[z]+1;end;end;end; +end;31:end{:168};35:if t=3 then a:=0;{167:}130:begin a:=idlookup(0); +begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=(a div 256)+128;tokptr[z]:=tokptr[z]+1; +end;a:=a mod 256;end; +135:if t<>135 then goto 30 else begin begin if tokptr[z]=maxtoks then +begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=(curmodule div 256)+168; +tokptr[z]:=tokptr[z]+1;end;a:=curmodule mod 256;end;2:{169:} +begin begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=2;tokptr[z]:=tokptr[z]+1;end; +buffer[limit+1]:=64; +21:if buffer[loc]=64 then begin if loc<limit then if buffer[loc+1]=64 +then begin begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=64;tokptr[z]:=tokptr[z]+1;end; +loc:=loc+2;goto 21;end; +end else begin begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=buffer[loc];tokptr[z]:=tokptr[z]+1;end; +loc:=loc+1;goto 21;end;if loc>=limit then begin writeln(output); +write(output,'! Verbatim string didn''t end');error; +end else if buffer[loc+1]<>62 then begin writeln(output); +write(output,'! You should double @ signs in verbatim strings');error; +end;loc:=loc+2;end{:169}; +133,132,134:if t<>135 then goto 30 else begin begin writeln(output); +write(output,'! @',xchr[buffer[loc-1]],' is ignored in Pascal text'); +error;end;goto 22;end;136:goto 30;{:167}otherwise end; +begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=a;tokptr[z]:=tokptr[z]+1;end;end; +30:nextcontrol:=a;{166:} +if bal>0 then begin if bal=1 then begin writeln(output); +write(output,'! Missing )');error;end else begin writeln(output); +write(output,'! Missing ',bal:1,' )''s');error;end; +while bal>0 do begin begin if tokptr[z]=maxtoks then begin writeln( +output);write(output,'! Sorry, ','token',' capacity exceeded');error; +history:=3;jumpout;end;tokmem[z,tokptr[z]]:=41;tokptr[z]:=tokptr[z]+1; +end;bal:=bal-1;end;end{:166}; +if textptr>maxtexts-4 then begin writeln(output); +write(output,'! Sorry, ','text',' capacity exceeded');error;history:=3; +jumpout;end;currepltext:=textptr;tokstart[textptr+4]:=tokptr[z]; +textptr:=textptr+1;if z=3 then z:=0 else z:=z+1;end;{:165}{170:} +procedure definemacro(t:eightbits);var p:namepointer; +begin p:=idlookup(t);scanrepl(t);equiv[p]:=currepltext; +textlink[currepltext]:=0;end;{:170}{172:}procedure scanmodule; +label 22,30,10;var p:namepointer;begin modulecount:=modulecount+1;{173:} +nextcontrol:=0; +while true do begin 22:while nextcontrol<=132 do begin nextcontrol:= +skipahead;if nextcontrol=135 then begin loc:=loc-2;nextcontrol:=getnext; +end;end;if nextcontrol<>133 then goto 30;nextcontrol:=getnext; +if nextcontrol<>130 then begin begin writeln(output); +write(output,'! Definition flushed, must start with ', +'identifier of length > 1');error;end;goto 22;end;nextcontrol:=getnext; +if nextcontrol=61 then begin scannumeric(idlookup(1));goto 22; +end else if nextcontrol=30 then begin definemacro(2);goto 22; +end else{174:}if nextcontrol=40 then begin nextcontrol:=getnext; +if nextcontrol=35 then begin nextcontrol:=getnext; +if nextcontrol=41 then begin nextcontrol:=getnext; +if nextcontrol=61 then begin begin writeln(output); +write(output,'! Use == for macros');error;end;nextcontrol:=30;end; +if nextcontrol=30 then begin definemacro(3);goto 22;end;end;end;end; +{:174};begin writeln(output); +write(output,'! Definition flushed since it starts badly');error;end; +end;30:{:173};{175:}case nextcontrol of 134:p:=0;135:begin p:=curmodule; +{176:}repeat nextcontrol:=getnext;until nextcontrol<>43; +if(nextcontrol<>61)and(nextcontrol<>30)then begin begin writeln(output); +write(output,'! Pascal text flushed, = sign is missing');error;end; +repeat nextcontrol:=skipahead;until nextcontrol=136;goto 10;end{:176}; +end;otherwise goto 10 end;{177:}storetwobytes(53248+modulecount);{:177}; +scanrepl(135);{178:} +if p=0 then begin textlink[lastunnamed]:=currepltext; +lastunnamed:=currepltext; +end else if equiv[p]=0 then equiv[p]:=currepltext else begin p:=equiv[p] +;while textlink[p]<maxtexts do p:=textlink[p];textlink[p]:=currepltext; +end;textlink[currepltext]:=maxtexts;{:178};{:175};10:end;{:172}{181:} +{procedure debughelp;label 888,10;var k:integer; +begin debugskipped:=debugskipped+1; +if debugskipped<debugcycle then goto 10;debugskipped:=0; +while true do begin write(output,'#');flush(output);read(input,ddt); +if ddt<0 then goto 10 else if ddt=0 then begin goto 888; +888:ddt:=0; +end else begin read(input,dd);case ddt of 1:printid(dd);2:printrepl(dd); +3:for k:=1 to dd do write(output,xchr[buffer[k]]); +4:for k:=1 to dd do write(output,xchr[modtext[k]]); +5:for k:=1 to outptr do write(output,xchr[outbuf[k]]); +6:for k:=1 to dd do write(output,xchr[outcontrib[k]]); +otherwise write(output,'?')end;end;end;10:end;}{:181}{182:} +begin initialize;{134:}openinput;line:=0;otherline:=0;changing:=true; +primethechangebuffer;changing:=not changing;templine:=otherline; +otherline:=line;line:=templine;limit:=0;loc:=1;buffer[0]:=32; +inputhasended:=false;{:134}; +writeln(output,'This is TANGLE, Version 4.4 for SunOS');{183:} +phaseone:=true;modulecount:=0;repeat nextcontrol:=skipahead; +until nextcontrol=136;while not inputhasended do scanmodule;{138:} +if changelimit<>0 then begin for ii:=0 to changelimit do buffer[ii]:= +changebuffer[ii];limit:=changelimit;changing:=true;line:=otherline; +loc:=changelimit;begin writeln(output); +write(output,'! Change file entry did not match');error;end;end{:138}; +phaseone:=false;{:183};{for ii:=0 to 3 do maxtokptr[ii]:=tokptr[ii];} +{112:}if textlink[0]=0 then begin begin writeln(output); +write(output,'! No output was specified.');end; +if history=0 then history:=1;end else begin begin writeln(output); +write(output,'Writing the output file');end;flush(output);{83:} +stackptr:=1;bracelevel:=0;curstate.namefield:=0; +curstate.replfield:=textlink[0];zo:=curstate.replfield mod 4; +curstate.bytefield:=tokstart[curstate.replfield]; +curstate.endfield:=tokstart[curstate.replfield+4];curstate.modfield:=0; +{:83};{96:}outstate:=0;outptr:=0;breakptr:=0;semiptr:=0;outbuf[0]:=0; +line:=1;{:96};sendtheoutput;{98:}breakptr:=outptr;semiptr:=0; +flushbuffer;if bracelevel<>0 then begin writeln(output); +write(output,'! Program ended at brace level ',bracelevel:1);error;end; +{:98};begin writeln(output);write(output,'Done.');end;end{:112}; +9999:if stringptr>256 then{184:}begin begin writeln(output); +write(output,stringptr-256:1,' strings written to string pool file.'); +end;write(pool,'*'); +for ii:=1 to 9 do begin outbuf[ii]:=poolchecksum mod 10; +poolchecksum:=poolchecksum div 10;end; +for ii:=9 downto 1 do write(pool,xchr[48+outbuf[ii]]);writeln(pool); +end{:184};{[186:]begin writeln(output); +write(output,'Memory usage statistics:');end;begin writeln(output); +write(output,nameptr:1,' names, ',textptr:1,' replacement texts;');end; +begin writeln(output);write(output,byteptr[0]:1);end; +for wo:=1 to 2 do write(output,'+',byteptr[wo]:1); +if phaseone then for ii:=0 to 3 do maxtokptr[ii]:=tokptr[ii]; +write(output,' bytes, ',maxtokptr[0]:1); +for ii:=1 to 3 do write(output,'+',maxtokptr[ii]:1); +write(output,' tokens.');[:186];}{187:} +case history of 0:begin writeln(output); +write(output,'(No errors were found.)');end;1:begin writeln(output); +write(output,'(Did you see the warning message above?)');end; +2:begin writeln(output); +write(output,'(Pardon me, but I think I spotted something wrong.)');end; +3:begin writeln(output); +write(output,'(That was a fatal error, my friend.)');end;end{:187}; +writeln(output);if(history<>0)and(history<>1)then exit(1)else exit(0); +end.{:182} diff --git a/systems/knuth/local/web-sparc/weave.ch b/systems/knuth/local/web-sparc/weave.ch new file mode 100644 index 0000000000..87c0e0e674 --- /dev/null +++ b/systems/knuth/local/web-sparc/weave.ch @@ -0,0 +1,591 @@ +% Change file for the WEAVE processor, for use on Berkeley UNIX systems. +% This file was created by Howard Trickey and Pavel Curtis. + +% History: +% 11/29/82 HWT Original version. This modifies weave to allow a new +% control sequence: +% @=...text...@> Put ...text... verbatim on a line +% by itself in the Pascal output. +% (argument must fit on one line) +% This control sequence facilitates putting #include "gcons.h" +% (for example) in files meant for the pc compiler. +% Also, there is a command line option, -c, which means that +% only the modules affected by the change file are to generate +% TeX output. (All the limbo stuff still goes to the output +% file, as does the index and table of contents.) +% +% 2/12/83 HWT Brought up for use with version 1.3. Uses Knuth's new +% control sequences for verbatim Pascal (as above, without +% the "on one line" part), and the force_line (@\) primitive. +% Also, he added stuff to keep track of changed modules, and +% output enough information that macros can choose only to +% print changed modules. This isn't as efficient as my +% implementation because I avoided outputting the text for +% non-changed modules altogether, but this feature won't be +% used too often (just for TeX and TeXware), so Knuth's +% solution is accepted. +% The change file changes that used +% to implement these features have been removed. +% There is a -x flag to cause WEAVE to omit cross referencing +% of identifiers, and index and T.of.C. processing. +% This, too, is unnecessary, for one could simply redefine some +% WEB macros to avoid the printing, but there are only a couple +% of easy changes, so they have been made. +% +% 2/18 HWT Increased stack size to 400 (not for TeX-related programs). +% +% 3/18 HWT Brought up for Version 1.5. Made it print newline at end of +% run. +% +% 4/13 PC Merged with Pavel's version, including adding a call to +% exit() at the end of the program, based upon the value of +% `history'. +% 4/16 PC Brought up to version 1.5 released with TeX 0.97 in April 1983 +% 6/29 HWT Brought up to version 1.7 released with TeX 0.99 in June 1983, +% introducing a new change file format +% 7/17 HWT Brought up to version 2.0 released with TeX 0.999 in July 1983 +% 7/29 HWT Brought up to version 2.1 +% 11/17 HWT Brought up to version 2.4 released with TeX 1.0. Made +% changes to use C routines for I/O, for speedup. +% 1/31 HWT Brought up to version 2.6 +% 12/28/85 PAM Brought up to version 2.8 (like 2.7, version number only) +% 3/6/87 PAM Brought up to version 2.9 (like 2.8, version number only) +% 8/10/89 don Brought up to version 3.1, with `otherwise' fixed too +% 8/31/89 don Brought up to version 4, with all possible characters enabled +% 10/16/89 don fixed bug when ".web" and ".ch" are explicitly stated +% 3/25/90 don changed version number to 4.1 +% 9/6/90 don changed version number to 4.2 +% 9/19/91 don changed version number to 4.3 +% 1/12/92 don changed version number to 4.4 + +% NOTE: The module numbers refer to the standard WEB manual (CS 980). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [0] WEAVE: print changes only +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +\pageno=\contentspagenumber \advance\pageno by 1 +@y +\pageno=\contentspagenumber \advance\pageno by 1 +\let\maybe=\iffalse +\def\title{WEAVE changes for Berkeley {\mc UNIX}} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1] Change banner message +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d banner=='This is WEAVE, Version 4.4' +@y +@d banner=='This is WEAVE, Version 4.4 for SunOS' +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [2] add input and output, remove other files, add ref to scan_args, +% [2] and #include external definition for exit(), etc. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +program WEAVE(@!web_file,@!change_file,@!tex_file); +label end_of_WEAVE; {go here to finish} +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +@<Error handling procedures@>@/ +@y +program WEAVE(@!input,@!output); +label end_of_WEAVE; {go here to finish} +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +@\ +@=#include "tangext.h"@> +@\@/ +@<Error handling procedures@>@/ +@<|scan_args| procedure@>@/ +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3] Show statistics +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d stat==@{ {change this to `$\\{stat}\equiv\null$' + when gathering usage statistics} +@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$' + when gathering usage statistics} +@y +@d stat== {I'm gathering usage statistics} +@d tats== {because I have to know how close \TeX\ comes to the limits} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [4] compiler options +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead} +@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging} +@y +@=(*$C-*)@> {no range check} +@!debug @=(*$C+*)@>@+ gubed {but turn everything on when debugging} +@\ +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [7] Fix others: +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d othercases == others: {default for cases not listed explicitly} +@y +@d othercases == otherwise {SunOS Pascal default cases} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [8] Constants: Make stack_size=400 instead of 200 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!stack_size=200; {number of simultaneous output levels} +@y +@!stack_size=400; {number of simultaneous output levels} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [17] enable maximum character set +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +for i:=1 to @'37 do xchr[i]:=' '; +for i:=@'200 to @'377 do xchr[i]:=' '; +@y +for i:=1 to @'37 do xchr[i]:=chr(i); +for i:=@'200 to @'377 do xchr[i]:=chr(i); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [20] terminal output: use standard i/o +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d print(#)==write(term_out,#) {`|print|' means write on the terminal} +@y +@d term_out==output +@d print(#)==write(term_out,#) {`|print|' means write on the terminal} +@z + +@x +@<Globals...@>= +@!term_out:text_file; {the terminal as an output file} +@y + +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [21] init terminal +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ Different systems have different ways of specifying that the output on a +certain file will appear on the user's terminal. Here is one way to do this +on the \PASCAL\ system that was used in \.{TANGLE}'s initial development: +@^system dependencies@> + +@<Set init...@>= +rewrite(term_out,'TTY:'); {send |term_out| output to the terminal} +@y +@ Different systems have different ways of specifying that the output on a +certain file will appear on the user's terminal. +@^system dependencies@> + +@<Set init...@>= +; {nothing need be done} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [22] flush terminal buffer +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d update_terminal == break(term_out) {empty the terminal output buffer} +@y +@d update_terminal == flush(term_out) {empty the terminal output buffer} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [24] open input files +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The following code opens the input files. Since these files were listed +in the program header, we assume that the \PASCAL\ runtime system has +already checked that suitable file names have been given; therefore no +additional error checking needs to be done. We will see below that +\.{WEAVE} reads through the entire input twice. +@^system dependencies@> + +@p procedure open_input; {prepare to read |web_file| and |change_file|} +begin reset(web_file); reset(change_file); +end; +@y +@ The following code opens the input files. +This is called after |scan_args| has filled the file name variables +appropriately. +@^system dependencies@> + +@p procedure open_input; {prepare to read |web_file| and |change_file|} +begin reset(web_file,web_name); + reset(change_file,change_name); +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [26] opening tex file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The following code opens |tex_file|. +Since this file was listed in the program header, we assume that the +\PASCAL\ runtime system has checked that a suitable external file name has +been given. +@^system dependencies@> + +@<Set init...@>= +rewrite(tex_file); +@y +@ The following code opens |tex_file|. +The |scan_args| procedure is used to set up |tex_name| as required. +@^system dependencies@> + +@<Set init...@>= +scan_args; +rewrite(tex_file,tex_name); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [28] faster input_ln +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p function input_ln(var f:text_file):boolean; + {inputs a line or returns |false|} +var final_limit:0..buf_size; {|limit| without trailing blanks} +begin limit:=0; final_limit:=0; +if eof(f) then input_ln:=false +else begin while not eoln(f) do + begin buffer[limit]:=xord[f^]; get(f); + incr(limit); + if buffer[limit-1]<>" " then final_limit:=limit; + if limit=buf_size then + begin while not eoln(f) do get(f); + decr(limit); {keep |buffer[buf_size]| empty} + if final_limit>limit then final_limit:=limit; + print_nl('! Input line too long'); loc:=0; error; +@.Input line too long@> + end; + end; + read_ln(f); limit:=final_limit; input_ln:=true; + end; +end; +@y +With Berkeley {\mc UNIX} we call an external C procedure, |line_read|. +That routine fills |buffer| from 0 onwards with the |xord|'ed values +of the next line, setting |limit| appropriately (ignoring trailing +blanks). +It will stop if |limit=buf_size|, and the following will cause an error +message. +Note: for bootstrapping purposes it is all right to use the original form +of |input_ln|; it will just run slower. + +@p function input_ln(var f:text_file):boolean; + {inputs a line or returns |false|} +begin limit:=0; +if test_eof(f) then input_ln:=false +else begin line_read(f); + if limit=buf_size then + begin + decr(limit); {keep |buffer[buf_size]| empty} + print_nl('! Input line too long'); loc:=0; error; +@.Input line too long@> + end; + input_ln:=true; + end; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [50] don't enter xrefs if no_xref set +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d append_xref(#)==if xref_ptr=max_refs then overflow('cross reference') + else begin incr(xref_ptr); num(xref_ptr):=#; + end + +@p procedure new_xref(@!p:name_pointer); +label exit; +var q:xref_number; {pointer to previous cross reference} +@!m,@!n: sixteen_bits; {new and previous cross-reference value} +begin if (reserved(p)or(byte_start[p]+1=byte_start[p+ww]))and +@y +If the user has sent the |no_xref| flag (the -x option of the command line), +then it is unnecessary to keep track of cross references for identifers. +If one were careful, one could probably make more changes around module +100 to avoid a lot of identifier looking up. + +@d append_xref(#)==if xref_ptr=max_refs then overflow('cross reference') + else begin incr(xref_ptr); num(xref_ptr):=#; + end + +@p procedure new_xref(@!p:name_pointer); +label exit; +var q:xref_number; {pointer to previous cross-reference} +@!m,@!n: sixteen_bits; {new and previous cross-reference value} +begin if no_xref then return; +if (reserved(p)or(byte_start[p]+1=byte_start[p+ww]))and +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [122] faster flush_buffer +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +done: for k:=1 to j do write(tex_file,xchr[out_buf[k]]); +@y +done: linewrite(tex_file,j); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [239] omit index and module names if no_xref set +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@<Phase III: Output the cross-reference index@>= +@y +If the user has set the |no_xref| flag (the -x option on the command line), +just finish off the page, omitting the index, module name list, and table of +contents. + +@<Phase III: Output the cross-reference index@>= +if no_xref then begin + finish_line; + out("\"); out5("v")("f")("i")("l")("l"); + out4("\")("e")("n")("d"); + finish_line; + end +else begin +@z + +@x +print('Done.'); +@y +end; +print('Done.'); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [258] term_in == input, when debugging +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +any error stop will set |debug_cycle| to zero. +@y +any error stop will set |debug_cycle| to zero. + +@d term_in==input +@z + +@x +@!term_in:text_file; {the user's terminal as an input file} +@y + +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [259] Take out reset(term_in) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +reset(term_in,'TTY:','/I'); {open |term_in| as the terminal, don't do a |get|} +@y + +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [261] print newline at end of run and exit based upon value of history +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p procedure Phase_I; +@y +@d UNIXexit==e@&x@&i@&t + +@p procedure Phase_I; +@z + +@x +end. +@y +new_line; +if (history <> spotless) and (history <> harmless_message) then + UNIXexit(1) +else + UNIXexit(0); +end. +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [264] system dependent changes--the scan_args procedure +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@* System-dependent changes. +This module should be replaced, if necessary, by changes to the program +that are necessary to make \.{WEAVE} work at a particular installation. +It is usually best to design your change file so that all changes to +previous modules preserve the module numbering; then everybody's version +will be consistent with the printed program. More extensive changes, +which introduce new modules, can be inserted here; then only the index +itself will get a new module number. +@^system dependencies@> +@y +@* System-dependent changes. +The user calls \.{WEAVE} with arguments on the command line. +These are either file names or flags (beginning with '-'). +The following globals are for communicating the user's desires to the rest +of the program. The various |file_name| variables contain strings with +the full names of those files, as UNIX knows them. + +The only flag that affects weave is |'-x'| whose status is kept in |no_xref|. + +@d max_file_name_length==60 + +@<Globals...@>= +@!web_name,@!change_name,@!tex_name: + array[1..max_file_name_length] of char; +@!no_xref:boolean; + +@ The |scan_args| procedure looks at the command line arguments and sets +the |file_name| variables accordingly. +At least one file name must be present: the \.{WEB} file. It may have +an extension, or it may omit it to get |'.web'| added. +The \TeX\ output file name is formed by replacing the \.{WEB} file +name extension by |'.tex'|. + +If there is another file name present among the arguments, it is the +change file, again either with an extension or without one to get |'.ch'| +An omitted change file argument means that |'/dev/null'| should be used, +when no changes are desired. + +An argument beginning with a minus sign is a flag. +Any letters following the minus sign may cause global flag variables to be +set. +Currently, an |x| means that the cross referencing information---the index, +the module name list, and the table of contents---is to be suppressed. + +@<|scan_args|...@>= +procedure scan_args; +var dot_pos,i,a: integer; {indices} +@!fname: array[1..max_file_name_length-5] of char; {temporary argument holder} +@!found_web,@!found_change: boolean; {|true| when those file names have + been seen} +begin +found_web:=false; +found_change:=false; +no_xref:=false; +for a:=1 to argc-1 do begin + argv(a,fname); {put argument number |a| into |fname|} + if fname[1]<>'-' then begin + if not found_web then + @<Get |web_name|, |pascal_name|, and + | pool_name| variables from |fname|@> + else if not found_change then + @<Get |change_name| from |fname|@> + else @<Print usage error message and quit@>; + end + else @<Handle flag argument in |fname|@>; + end; +if not found_web then @<Print usage error message and quit@>; +if not found_change then @<Set up null change file@>; +end; + +@ Use all of |fname| for the |web_name| if there is a |'.'| in it, +otherwise add |'.web'|. +The other file names come from adding things after the dot. +The |argv| procedure will not put more than |max_file_name_length-5| +characters into |fname|, and this leaves enough room in the |file_name| +variables to add the extensions. + +The end of a file name is marked with a |' '|, the convention assumed by +the |reset| and |rewrite| procedures. + +@<Get |web_name|...@>= +begin +dot_pos:=-1; +i:=1; +while (fname[i]<>' ') and (i<=max_file_name_length-5) do begin + web_name[i]:=fname[i]; + if fname[i]='.' then dot_pos:=i; + incr(i); + end; +if dot_pos=-1 then begin + dot_pos:=i; + web_name[dot_pos]:='.'; + web_name[dot_pos+1]:='w'; + web_name[dot_pos+2]:='e'; + web_name[dot_pos+3]:='b'; + web_name[dot_pos+4]:=' '; + end +else web_name[i]:=' '; +for i:=1 to dot_pos do begin + tex_name[i]:=web_name[i]; + end; +tex_name[dot_pos+1]:='t'; +tex_name[dot_pos+2]:='e'; +tex_name[dot_pos+3]:='x'; +tex_name[dot_pos+4]:=' '; +found_web:=true; +end + +@ + +@<Get |change_name|...@>= +begin +dot_pos:=-1; +i:=1; +while (fname[i]<>' ') and (i<=max_file_name_length-5) +do begin + change_name[i]:=fname[i]; + if fname[i]='.' then dot_pos:=i; + incr(i); + end; +if dot_pos=-1 then begin + dot_pos:=i; + change_name[dot_pos]:='.'; + change_name[dot_pos+1]:='c'; + change_name[dot_pos+2]:='h'; + change_name[dot_pos+3]:=' '; + end +else change_name[i]:=' '; +found_change:=true; +end + +@ + +@<Set up null...@>= +begin + change_name[1]:='/'; + change_name[2]:='d'; + change_name[3]:='e'; + change_name[4]:='v'; + change_name[5]:='/'; + change_name[6]:='n'; + change_name[7]:='u'; + change_name[8]:='l'; + change_name[9]:='l'; + change_name[10]:=' '; +end + +@ + +@<Handle flag...@>= +begin +i:=2; +while (fname[i]<>' ') and (i<=max_file_name_length-5) do begin + if fname[i]='x' then no_xref:=true; + incr(i); + end; +end + +@ + +@<Print usage error message and quit@>= +begin +print_nl('! Usage: weave webfile[.web] [changefile[.ch]] [-x]'); +error; +jump_out; +end + +@z diff --git a/systems/knuth/local/web-sparc/weavext.c b/systems/knuth/local/web-sparc/weavext.c new file mode 100644 index 0000000000..87f1c99b22 --- /dev/null +++ b/systems/knuth/local/web-sparc/weavext.c @@ -0,0 +1,107 @@ +/* External procedures for weave */ +/* Written by: H. Trickey, 11/17/83 */ + +/* Modified for 8-bit input --- don 8/31/89 */ + +/* Note: these procedures aren't necessary; the default input_ln and + * flush_buffer routines in tangle/weave work fine on UNIX. + * However a very big time improvement is achieved by using these. + * + * These procedures are the same as for tangle, except for a slight offset + * in which characters are output from outbuf in linewrite. + */ + +#define BUF_SIZE 100 /* should agree with tangle.web */ + +#include "h00vars.h" /* defines Pascal I/O structure */ + +extern short buffer[]; /* 0..BUF_SIZE. Input goes here */ +extern short outbuf[]; /* 0..OUT_BUF_SIZE. Output from here */ +extern short xord[]; +extern char xchr[]; /* character translation arrays */ +extern short limit; /* index into buffer. Note that limit + is 0..long_buf_size in weave.web; this + differs from the definition in tangle.web */ + +/* + * lineread reads from the Pascal text file with iorec pointer filep + * into buffer[0], buffer[1],..., buffer[limit-1] (and + * setting "limit"). + * Characters are read until a newline is found (which isn't put in the + * buffer) or until the next character would go into buffer[BUF_SIZE]. + * And trailing blanks are to be ignored, so limit is really set to + * one past the last non-blank. + * The characters need to be translated, so really xord[c] is put into + * the buffer when c is read. + * If end-of-file is encountered, the funit field of *filep is set + * appropriately. + */ +lineread(filep) +struct iorec *filep; +{ + register c; + register short *cs; /* pointer into buffer where next char goes */ + register short *cnb; /* last non-blank character input */ + register FILE *iop; /* stdio-style FILE pointer */ + register int l; /* how many chars allowed before buffer overflow */ + + iop = filep->fbuf; + cnb = cs = &(buffer[0]); + l = BUF_SIZE; + /* overflow when next char would go into buffer[BUF_SIZE] */ + while (--l>=0 && (c = getc(iop)) != EOF && c!='\n') + if((*cs++ = xord[c])!=' ') cnb = cs; + if (c == EOF) + filep->funit |= EOFF; /* we hit end-of-file */ + limit = cnb-&(buffer[0]); +} + +/* + * linewrite writes to the Pascal text file with iorec pointer filep + * from outbuf[1], outbuf[1],..., outbuf[cnt]. + * (Note the offset of indices vis a vis the tangext version of this.) + * Translation is done, so that xchr[c] is output instead of c. + */ + linewrite(filep,cnt) + struct iorec *filep; + int cnt; + { + register FILE *iop; /* stdio-style FILE pointer */ + register short *cs; /* pointer to next character to output */ + register int l; /* how many characters left to output */ + + iop = filep->fbuf; + cs = &(outbuf[1]); + l = cnt; + while (--l>=0) putc(xchr[*cs++],iop); +} + +/* +** testeof(filep) +** +** Test whether or not the Pascal text file with iorec pointer filep +** has reached end-of-file (when the only I/O on it is done with +** lineread, above). +** We may have to read the next character and unget it to see if perhaps +** the end-of-file is next. +*/ + +bool +testeof(filep) +register struct iorec *filep; +{ + register char c; + register FILE *iop; /* stdio-style FILE pointer */ + if (filep->funit & EOFF) + return(TRUE); + else { /* check to see if next is EOF */ + iop = filep->fbuf; + c = getc(iop); + if (c == EOF) + return(TRUE); + else { + ungetc(c,iop); + return(FALSE); + } + } +} diff --git a/systems/knuth/local/web/Makefile b/systems/knuth/local/web/Makefile new file mode 100644 index 0000000000..5a71f3c71a --- /dev/null +++ b/systems/knuth/local/web/Makefile @@ -0,0 +1,34 @@ +# Make executable files for this workstation, using the master TeX sources + +PFLAGS= -g -I.. +CFLAGS= -g -I.. +PC= gpc + +all: tangle weave + +%.p: %.ch + tangle ../../dist/web/$*.web $*.ch +# the next line formerly necessary; but not with Linux's (Web2C) tangle +# mv ../../dist/web/$*.p . + +%.ch: ../../dist/web/%.web + touch $*.ch + +%.o: %.p + ${PC} ${PFLAGS} -c $*.p + +tangle: tangle.o tangext.o tangext.h + pc ${PFLAGS} -o tangle tangle.o tangext.o + +tangext.o: tangext.c ../GPCtypes.h + +weave: weave.o tangext.o tangext.h + pc ${PFLAGS} -o weave weave.o tangext.o + +install: # doit make install PROG=tangle + mv ${PROG} /usr/local/bin/${PROG} + +clean: # we save tangle.p for emergency rebooting +# rm -f weave.p *.o *~ ../../dist/web/*.pool + rm -f weave.p *.o *~ *.pool + diff --git a/systems/knuth/local/web/tangext.c b/systems/knuth/local/web/tangext.c new file mode 100644 index 0000000000..2a8a88d292 --- /dev/null +++ b/systems/knuth/local/web/tangext.c @@ -0,0 +1,106 @@ +/* External procedures for tangle/weave */ +/* Written by Don Knuth, 29 April 2000, based on Howard Trickey's code of 83 */ + +/* Note: The input files are read directly with C routines, instead + of using the Pascal runtime system. So we do our own EOF testing. + The GNU Pascal routines are used only to open ("reset") the files. */ + +#define BUF_SIZE 500 /* should agree with long_buf_size in weave.web */ +#define max_file_name_length 60 /* should agree with tangle.ch */ + +#include "GPCtypes.h" /* defines GNU Pascal I/O structure */ +#include <string.h> + +void Argv(int n, char* str) +{ + register char *s,*t; + if (n<0 || n>=_p_argc) return; + s=_p_argv[n]; + if (strlen(s) >= max_file_name_length-5) { + str[0]='\0'; return; /* TANGLE doesn't want it too long */ + } + for (t=str; *s; s++,t++) *t=*s; + *t='\0'; +} + +void Flushstdout() +{ + fflush(stdout); +} + +#define buffer Buffer /* GNU Pascal likes to capitalize */ +#define xord Xord +#define xchr Xchr +#define limit Limit + +unsigned char buffer[BUF_SIZE+1]; /* 0..BUF_SIZE. Input goes here */ +unsigned char xord[256]; +unsigned char xchr[256]; /* character translation arrays */ +int limit; /* index into buffer */ + +/* + * lineread reads from the Pascal text file with iorec pointer filep + * into buffer[0], buffer[1],..., buffer[limit-1] (and + * setting "limit"). + * Characters are read until a newline is found (which isn't put in the + * buffer) or until the next character would go into buffer[BUF_SIZE]. + * And trailing blanks are to be ignored, so limit is really set to + * one past the last non-blank. + * The characters need to be translated, so really xord[c] is put into + * the buffer when c is read. + * If end-of-file is encountered, the FilSta field of *filep is set + * appropriately. + */ +void Lineread(FDR filep) +{ + register int c; + register unsigned char *cs; /* points to where next char goes */ + register unsigned char *cnb; /* last non-blank character input */ + register FILE *iop; /* stdio-style FILE pointer */ + register int l; /* how many chars before buffer overflow */ + + iop = filep->FilJfn; + cnb = cs = &buffer[0]; + l = BUF_SIZE; + + /* overflow when next char would go into buffer[BUF_SIZE] */ + while ((--l >= 0) && ((c = getc(iop)) != EOF) && (c != '\n')) { + if ((*cs++ = xord[c]) != ' ') + cnb = cs; + } + + if (c == EOF) + filep->FilSta |= FiEof; /* we hit end-of-file */ + /* actually that wasn't necessary, since testeof uses feof */ + + limit = (cnb - &buffer[0]); +} + +/* + * testeof(filep) + * + * Test whether or not the Pascal text file with iorec pointer filep + * has reached end-of-file (when the only I/O on it is done with + * lineread, above). + * We may have to read the next character and unget it to see if perhaps + * the end-of-file is next. + */ +bool Testeof(FDR filep) +{ + register int c; + register FILE *iop; /* stdio-style FILE pointer */ + + iop = filep->FilJfn; + if (feof(iop)) return TRUE; + c = getc(iop); + if (c == EOF) return TRUE; + else { + ungetc(c,iop); + return FALSE; + } +} + +void Exit(int c) +{ + exit(c); +} diff --git a/systems/knuth/local/web/tangext.h b/systems/knuth/local/web/tangext.h new file mode 100644 index 0000000000..c460a973c5 --- /dev/null +++ b/systems/knuth/local/web/tangext.h @@ -0,0 +1,13 @@ +argc:asmname '_p_argc' Integer; + +procedure argv(no:Integer;var str:UNIXfilename); external; + +procedure flushstdout; external; + +procedure exit(x : integer); external; + +procedure lineread(var f:text); external; + +procedure linewrite(var f:text; cnt:integer); external; + +function testeof(var f:text):boolean; external; diff --git a/systems/knuth/local/web/tangle.ch b/systems/knuth/local/web/tangle.ch new file mode 100644 index 0000000000..83351de0a2 --- /dev/null +++ b/systems/knuth/local/web/tangle.ch @@ -0,0 +1,654 @@ +% Change file for the TANGLE processor, for use with GNU Pascal. +% This file was created by Don Knuth, based on the original +% UNIX port by Howard Trickey, Pavel Curtis, et al. +% (See ../web-sparc for details of that work.) + +% History: +% 2000.04.29 Original version + +% NOTE: The module numbers refer to the standard WEB manual (CS 980). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [0] WEAVE: print changes only +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +\pageno=\contentspagenumber \advance\pageno by 1 +@y +\pageno=\contentspagenumber \advance\pageno by 1 +\let\maybe=\iffalse +\def\title{TANGLE changes for {\mc GNU} Pascal} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1] Change banner message +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d banner=='This is TANGLE, Version 4.5' +@y +@d banner=='This is TANGLE, Version 4.5 for Linux' +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [2] add input and output, remove other files, add ref to scan_args, +% [2] and #include external definition for exit(), etc. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +program TANGLE(@!web_file,@!change_file,@!Pascal_file,@!pool); +label end_of_TANGLE; {go here to finish} +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +@<Error handling procedures@>@/ +@y +program TANGLE(@!input,@!output); +label end_of_TANGLE; {go here to finish} +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +@\ +@=#include "tangext.h"@> +@\@/ +@<Error handling procedures@>@/ +@<Declaration of |scan_args|@>@/ +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [4] compiler options +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead} +@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging} +@y +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [7] Fix others: +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d othercases == others: {default for cases not listed explicitly} +@y +@d othercases == otherwise {ISO extended Pascal default cases} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [8] keep long identifier names +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!max_id_length=12; {long identifiers are chopped to this length, which must + not exceed |line_length|} +@y +@!max_id_length=50; {long identifiers are chopped to this length, which must + not exceed |line_length|} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [11] make ASCII codes take 1 byte (not 4 or more!) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!ASCII_code=0..255; {eight-bit numbers, a subrange of the integers} +@y +@!ASCII_code=ByteCard; {eight-bit numbers, a subrange of the integers} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [12] make the compiler recognize a text file as text +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d text_char == char {the data type of characters in text files} +@d first_text_char=0 {ordinal number of the smallest element of |text_char|} +@d last_text_char=255 {ordinal number of the largest element of |text_char|} + +@<Types...@>= +@!text_file=packed file of text_char; +@y +@d text_char == char {the data type of characters in text files} +@d first_text_char=0 {ordinal number of the smallest element of |text_char|} +@d last_text_char=255 {ordinal number of the largest element of |text_char|} +@d text_file==text +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [13] xchr and xord now external +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!xord: array [text_char] of ASCII_code; + {specifies conversion of input characters} +@!xchr: array [ASCII_code] of text_char; + {specifies conversion of output characters} +@y +@!xord: external array [text_char] of ASCII_code; + {specifies conversion of input characters} +@!xchr: external array [ASCII_code] of text_char; + {specifies conversion of output characters} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [17] enable maximum character set +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +for i:=1 to @'37 do xchr[i]:=' '; +for i:=@'200 to @'377 do xchr[i]:=' '; +@y +for i:=1 to @'37 do xchr[i]:=chr(i); +for i:=@'200 to @'377 do xchr[i]:=chr(i); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [20] terminal output: use standard i/o +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d print(#)==write(term_out,#) {`|print|' means write on the terminal} +@y +@d term_out==output +@d print(#)==write(term_out,#) {`|print|' means write on the terminal} +@z + +@x +@<Globals...@>= +@!term_out:text_file; {the terminal as an output file} +@y + +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [21] init terminal +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ Different systems have different ways of specifying that the output on a +certain file will appear on the user's terminal. Here is one way to do this +on the \PASCAL\ system that was used in \.{TANGLE}'s initial development: +@^system dependencies@> + +@<Set init...@>= +rewrite(term_out,'TTY:'); {send |term_out| output to the terminal} +@y +@ Different systems have different ways of specifying that the output on a +certain file will appear on the user's terminal. +@^system dependencies@> + +@<Set init...@>= + {Nothing need be done on Linux} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [22] flush terminal buffer +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d update_terminal == break(term_out) {empty the terminal output buffer} +@y +@d update_terminal == flush_stdout {empty the terminal output buffer} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [24] open input files +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The following code opens the input files. Since these files were listed +in the program header, we assume that the \PASCAL\ runtime system has +already checked that suitable file names have been given; therefore no +additional error checking needs to be done. +@^system dependencies@> + +@p procedure open_input; {prepare to read |web_file| and |change_file|} +begin reset(web_file); reset(change_file); +end; +@y +@ The following code opens the input files. +This happens after the initialize procedure has executed. +That will have called the |scan_args| procedure to set up the global +variables |web_name| and |change_name| to the appropriate file +names. +These globals, and the |scan_args| procedure will be defined at the end +where they won't disturb the module numbering. +@^system dependencies@> + +@p procedure open_input; {prepare to read |web_file| and |change_file|} +begin +reset(web_file,web_name); reset(change_file,change_name); +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [26] open output files +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The following code opens |Pascal_file| and |pool|. +Since these files were listed in the program header, we assume that the +\PASCAL\ runtime system has checked that suitable external file names have +been given. +@^system dependencies@> + +@<Set init...@>= +rewrite(Pascal_file); rewrite(pool); +@y +@ The following code opens |Pascal_file| and |pool|. +Use the |scan_args| procedure to fill the global file names, +according to the names given on the command line. +@^system dependencies@> + +@<Set init...@>= +scan_args; +rewrite(Pascal_file,Pascal_name); rewrite(pool,pool_name); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [27] buffer now external +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@<Globals...@>=@!buffer: array[0..buf_size] of ASCII_code; +@y +@<Globals...@>=@!buffer: external array[0..buf_size] of ASCII_code; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [28] faster input_ln +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p function input_ln(var f:text_file):boolean; + {inputs a line or returns |false|} +var final_limit:0..buf_size; {|limit| without trailing blanks} +begin limit:=0; final_limit:=0; +if eof(f) then input_ln:=false +else begin while not eoln(f) do + begin buffer[limit]:=xord[f^]; get(f); + incr(limit); + if buffer[limit-1]<>" " then final_limit:=limit; + if limit=buf_size then + begin while not eoln(f) do get(f); + decr(limit); {keep |buffer[buf_size]| empty} + if final_limit>limit then final_limit:=limit; + print_nl('! Input line too long'); loc:=0; error; +@.Input line too long@> + end; + end; + read_ln(f); limit:=final_limit; input_ln:=true; + end; +end; +@y +With Linux we call an external C procedure, |line_read|. +That routine fills |buffer| from 0 onwards with the |xord|'ed values +of the next line, setting |limit| appropriately (ignoring trailing +blanks). +It will stop if |limit=buf_size|, and the following will cause an error +message. + +@p function input_ln(var f:text_file):boolean; + {inputs a line or returns |false|} +begin limit:=0; +if test_eof(f) then input_ln:=false +else begin line_read(f); + if limit=buf_size then + begin + decr(limit); {keep |buffer[buf_size]| empty} + print_nl('! Input line too long'); loc:=0; error; +@.Input line too long@> + end; + input_ln:=true; + end; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [38] Data Structures: provide for larger |byte_mem| and |tok_mem| +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x Extra capacity: +@d ww=2 {we multiply the byte capacity by approximately this amount} +@d zz=3 {we multiply the token capacity by approximately this amount} +@y +@d ww=3 {we multiply the byte capacity by approximately this amount} +@d zz=4 {we multiply the token capacity by approximately this amount} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [89] Work around a bug in GPC version 2.8.1 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +othercases confusion('output') +@y ('otherwise' syntax not recognized when there's a case inside a case!) +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [105] Accept DIV, div, MOD, and mod +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x + (((out_contrib[1]="D")and(out_contrib[2]="I")and(out_contrib[3]="V")) or@| + ((out_contrib[1]="M")and(out_contrib[2]="O")and(out_contrib[3]="D")) ))or@| +@^uppercase@> +@y + (((out_contrib[1]="D")and(out_contrib[2]="I")and(out_contrib[3]="V")) or@| + ((out_contrib[1]="d")and(out_contrib[2]="i")and(out_contrib[3]="v")) or@| + ((out_contrib[1]="M")and(out_contrib[2]="O")and(out_contrib[3]="D")) or@| + ((out_contrib[1]="m")and(out_contrib[2]="o")and(out_contrib[3]="d")) ))or@| +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [110] lowercase ids +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@^uppercase@> + if ((out_buf[out_ptr-3]="D")and(out_buf[out_ptr-2]="I")and + (out_buf[out_ptr-1]="V"))or @/ + ((out_buf[out_ptr-3]="M")and(out_buf[out_ptr-2]="O")and + (out_buf[out_ptr-1]="D")) then@/ goto bad_case +@y + if ((out_buf[out_ptr-3]="D")and(out_buf[out_ptr-2]="I")and + (out_buf[out_ptr-1]="V"))or @/ + ((out_buf[out_ptr-3]="d")and(out_buf[out_ptr-2]="i")and + (out_buf[out_ptr-1]="v"))or @/ + ((out_buf[out_ptr-3]="M")and(out_buf[out_ptr-2]="O")and + (out_buf[out_ptr-1]="D"))or @/ + ((out_buf[out_ptr-3]="m")and(out_buf[out_ptr-2]="o")and + (out_buf[out_ptr-1]="d")) then@/ goto bad_case +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [114] lowercase operators (`and', `or', etc.) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +and_sign: begin out_contrib[1]:="A"; out_contrib[2]:="N"; out_contrib[3]:="D"; +@^uppercase@> + send_out(ident,3); + end; +not_sign: begin out_contrib[1]:="N"; out_contrib[2]:="O"; out_contrib[3]:="T"; + send_out(ident,3); + end; +set_element_sign: begin out_contrib[1]:="I"; out_contrib[2]:="N"; + send_out(ident,2); + end; +or_sign: begin out_contrib[1]:="O"; out_contrib[2]:="R"; send_out(ident,2); +@y +and_sign: begin out_contrib[1]:="a"; out_contrib[2]:="n"; out_contrib[3]:="d"; + send_out(ident,3); + end; +not_sign: begin out_contrib[1]:="n"; out_contrib[2]:="o"; out_contrib[3]:="t"; + send_out(ident,3); + end; +set_element_sign: begin out_contrib[1]:="i"; out_contrib[2]:="n"; + send_out(ident,2); + end; +or_sign: begin out_contrib[1]:="o"; out_contrib[2]:="r"; send_out(ident,2); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [116] Remove conversion to uppercase +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ Single-character identifiers represent themselves, while longer ones +appear in |byte_mem|. All must be converted to uppercase, +with underlines removed. Extremely long identifiers must be chopped. + +(Some \PASCAL\ compilers work with lowercase letters instead of +uppercase. If this module of \.{TANGLE} is changed, it's also necessary +to change from uppercase to lowercase in the modules that are +listed in the index under ``uppercase''.) +@^system dependencies@> +@^uppercase@> + +@d up_to(#)==#-24,#-23,#-22,#-21,#-20,#-19,#-18,#-17,#-16,#-15,#-14, + #-13,#-12,#-11,#-10,#-9,#-8,#-7,#-6,#-5,#-4,#-3,#-2,#-1,# + +@<Cases related to identifiers@>= +"A",up_to("Z"): begin out_contrib[1]:=cur_char; send_out(ident,1); + end; +"a",up_to("z"): begin out_contrib[1]:=cur_char-@'40; send_out(ident,1); + end; +identifier: begin k:=0; j:=byte_start[cur_val]; w:=cur_val mod ww; + while (k<max_id_length)and(j<byte_start[cur_val+ww]) do + begin incr(k); out_contrib[k]:=byte_mem[w,j]; incr(j); + if out_contrib[k]>="a" then out_contrib[k]:=out_contrib[k]-@'40 + else if out_contrib[k]="_" then decr(k); + end; + send_out(ident,k); + end; +@y +@ Single-character identifiers represent themselves, while longer ones +appear in |byte_mem|. All must be converted to lowercase, +with underlines removed. Extremely long identifiers must be chopped. +@^system dependencies@> + +@d up_to(#)==#-24,#-23,#-22,#-21,#-20,#-19,#-18,#-17,#-16,#-15,#-14, + #-13,#-12,#-11,#-10,#-9,#-8,#-7,#-6,#-5,#-4,#-3,#-2,#-1,# + +@<Cases related to identifiers@>= +"A",up_to("Z"), +"a",up_to("z"): begin out_contrib[1]:=cur_char; send_out(ident,1); + end; +identifier: begin k:=0; j:=byte_start[cur_val]; w:=cur_val mod ww; + while (k<max_id_length)and(j<byte_start[cur_val+ww]) do + begin incr(k); out_contrib[k]:=byte_mem[w,j]; incr(j); + if out_contrib[k]="_" then decr(k); + end; + send_out(ident,k); + end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [124] limit is now set by lineread procedure +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!limit:0..buf_size; {the last character position occupied in the buffer} +@y +@!limit:external integer; {the last character position occupied in the buffer} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [179] make term_in = input +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +any error stop will set |debug_cycle| to zero. +@y +any error stop will set |debug_cycle| to zero. + +@d term_in==input +@z + +@x +@!term_in:text_file; {the user's terminal as an input file} +@y + +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [180] remove term_in reset +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +reset(term_in,'TTY:','/I'); {open |term_in| as the terminal, don't do a |get|} +@y + +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [182] write newline just before exit; use value of |history| +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +We have defined plenty of procedures, and it is time to put the last +pieces of the puzzle in place. Here is where \.{TANGLE} starts, and where +it ends. +@^system dependencies@> +@y +We have defined plenty of procedures, and it is time to put the last +pieces of the puzzle in place. Here is where \.{TANGLE} starts, and where +it ends. +@^system dependencies@> + +@d UNIXexit==e@&x@&i@&t +@z + +@x +@<Print the job |history|@>; +@y +@<Print the job |history|@>; +new_line; +if (history <> spotless) and (history <> harmless_message) then + UNIXexit(1) +else + UNIXexit(0); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [188] system dependent changes--the |scan_args| procedure. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@* System-dependent changes. +This module should be replaced, if necessary, by changes to the program +that are necessary to make \.{TANGLE} work at a particular installation. +It is usually best to design your change file so that all changes to +previous modules preserve the module numbering; then everybody's version +will be consistent with the printed program. More extensive changes, +which introduce new modules, can be inserted here; then only the index +itself will get a new module number. +@^system dependencies@> +@y +@* System-dependent changes. +@^system dependencies@> + +@ The user calls \.{TANGLE} with arguments on the command line. +These are either file names or flags (beginning with '-'). +The following globals are for communicating the user's desires to the rest +of the program. The various |file_name| variables contain strings with +the full names of those files, as UNIX knows them. + +There are no flags that affect \.{TANGLE} at the moment. + +@d max_file_name_length==60 + +@<Globals...@>= +@!web_name,@!change_name,@!Pascal_name,@!pool_name: + UNIX_filename; + +@ @<Types...@>= +UNIX_filename=packed array[1..max_file_name_length] of char; + +@ The |scan_args| procedure looks at the command line arguments and sets +the |file_name| variables accordingly. +At least one file name must be present: the \.{WEB} file. It may have +an extension, or it may omit it to get |'.web'| added. +The \PASCAL\ output file name is formed by replacing the \.{WEB} file +name extension by |'.p'|. +Similarly, the pool file name is formed using a |'.pool'| extension. + +If there is another file name present among the arguments, it is the +change file, again either with an extension or without one to get |'.ch'| +An omitted change file argument means that |'/dev/null'| should be used, +when no changes are desired. + +@<Declaration of |scan_args|@>= +procedure scan_args; +var dot_pos,i,a: integer; {indices} +c: char; +@!fname: UNIX_filename; {temporary argument holder} +@!found_web,@!found_change: boolean; {|true| when those file names have + been seen} +begin +found_web:=false; +found_change:=false; +for a:=1 to argc-1 do begin + argv(a,fname); {put argument number |a| into |fname|} + if fname[1]<>'-' then begin + if not found_web then + @<Get |web_name|, |Pascal_name|, and + | pool_name| variables from |fname|@> + else if not found_change then + @<Get |change_name| from |fname|@> + else @<Print usage error message and quit@>; + end + else @<Handle flag argument in |fname|@>; + end; +if not found_web then @<Print usage error message and quit@>; +if not found_change then @<Set up null change file@>; +end; + +@ Use all of |fname| for the |web_name| if there is a |'.'| in it, +otherwise add |'.web'|. +The other file names come from adding things after the dot. +The |argv| procedure will not put more than |max_file_name_length-5| +characters into |fname|, and this leaves enough room in the |file_name| +variables to add the extensions. + +The end of a file name is marked with a |chr(0)|, the convention assumed by +the |argv| and |reset| and |rewrite| procedures. + +@<Get |web_name|...@>= +begin +dot_pos:=-1; +i:=1; +while (fname[i]<>chr(0)) and (i<=max_file_name_length-5) do begin + web_name[i]:=fname[i]; + if fname[i]='.' then dot_pos:=i; + incr(i); + end; +if dot_pos=-1 then begin + dot_pos:=i; + web_name[dot_pos]:='.'; + web_name[dot_pos+1]:='w'; + web_name[dot_pos+2]:='e'; + web_name[dot_pos+3]:='b'; + web_name[dot_pos+4]:=chr(0); + end +else web_name[i]:=chr(0); +for i:=1 to dot_pos do begin + c:=web_name[i]; + Pascal_name[i]:=c; + pool_name[i]:=c; + end; +Pascal_name[dot_pos+1]:='p'; +Pascal_name[dot_pos+2]:=chr(0); +pool_name[dot_pos+1]:='p'; +pool_name[dot_pos+2]:='o'; +pool_name[dot_pos+3]:='o'; +pool_name[dot_pos+4]:='l'; +pool_name[dot_pos+5]:=chr(0); +found_web:=true; +end + +@ @<Get |change_name|...@>= +begin +dot_pos:=-1; +i:=1; +while (fname[i]<>chr(0)) and (i<=max_file_name_length-5) +do begin + change_name[i]:=fname[i]; + if fname[i]='.' then dot_pos:=i; + incr(i); + end; +if dot_pos=-1 then begin + dot_pos:=i; + change_name[dot_pos]:='.'; + change_name[dot_pos+1]:='c'; + change_name[dot_pos+2]:='h'; + change_name[dot_pos+3]:=chr(0); + end +else change_name[i]:=chr(0); +found_change:=true; +end + +@ @<Set up null...@>= +begin + change_name[1]:='/'; + change_name[2]:='d'; + change_name[3]:='e'; + change_name[4]:='v'; + change_name[5]:='/'; + change_name[6]:='n'; + change_name[7]:='u'; + change_name[8]:='l'; + change_name[9]:='l'; + change_name[10]:=chr(0); +end + +@ There are no flags currently used by \.{TANGLE}, but this module can be +used as a hook to introduce flags. + +@<Handle flag...@>= +begin + @<Print usage error message and quit@>; +end + +@ @<Print usage error message and quit@>= +begin +print_nl('! Usage: tangle webfile[.web] [changefile[.ch]]'); +error; +jump_out; +end + +@z diff --git a/systems/knuth/local/web/tangle.p b/systems/knuth/local/web/tangle.p new file mode 100644 index 0000000000..48232b026f --- /dev/null +++ b/systems/knuth/local/web/tangle.p @@ -0,0 +1,821 @@ +{2:}{4:}{:4}program TANGLE(input,output);label 9999;const{8:} +bufsize=100;maxbytes=45000;maxtoks=50000;maxnames=4000;maxtexts=2000; +hashsize=353;longestname=400;linelength=72;outbufsize=144;stacksize=50; +maxidlength=50;unambiglength=7;{:8}type{11:}ASCIIcode=ByteCard;{:11} +{37:}eightbits=0..255;sixteenbits=0..65535;{:37}{39:} +namepointer=0..maxnames;{:39}{43:}textpointer=0..maxtexts;{:43}{78:} +outputstate=record endfield:sixteenbits;bytefield:sixteenbits; +namefield:namepointer;replfield:textpointer;modfield:0..12287;end;{:78} +{190:}UNIXfilename=packed array[1..60]of char;{:190}var{9:}history:0..3; +{:9}{13:}xord:external array[char]of ASCIIcode; +xchr:external array[ASCIIcode]of char;{:13}{23:}webfile:text; +changefile:text;{:23}{25:}Pascalfile:text;pool:text;{:25}{27:} +buffer:external array[0..bufsize]of ASCIIcode;{:27}{29:} +phaseone:boolean;{:29}{38:} +bytemem:packed array[0..2,0..maxbytes]of ASCIIcode; +tokmem:packed array[0..3,0..maxtoks]of eightbits; +bytestart:array[0..maxnames]of sixteenbits; +tokstart:array[0..maxtexts]of sixteenbits; +link:array[0..maxnames]of sixteenbits; +ilk:array[0..maxnames]of sixteenbits; +equiv:array[0..maxnames]of sixteenbits; +textlink:array[0..maxtexts]of sixteenbits;{:38}{40:}nameptr:namepointer; +stringptr:namepointer;byteptr:array[0..2]of 0..maxbytes; +poolchecksum:integer;{:40}{44:}textptr:textpointer; +tokptr:array[0..3]of 0..maxtoks;z:0..3; +{maxtokptr:array[0..3]of 0..maxtoks;}{:44}{50:}idfirst:0..bufsize; +idloc:0..bufsize;doublechars:0..bufsize; +hash,chophash:array[0..hashsize]of sixteenbits; +choppedid:array[0..unambiglength]of ASCIIcode;{:50}{65:} +modtext:array[0..longestname]of ASCIIcode;{:65}{70:} +lastunnamed:textpointer;{:70}{79:}curstate:outputstate; +stack:array[1..stacksize]of outputstate;stackptr:0..stacksize;{:79}{80:} +zo:0..3;{:80}{82:}bracelevel:eightbits;{:82}{86:}curval:integer;{:86} +{94:}outbuf:array[0..outbufsize]of ASCIIcode;outptr:0..outbufsize; +breakptr:0..outbufsize;semiptr:0..outbufsize;{:94}{95:} +outstate:eightbits;outval,outapp:integer;outsign:ASCIIcode; +lastsign:-1..+1;{:95}{100:}outcontrib:array[1..linelength]of ASCIIcode; +{:100}{124:}ii:integer;line:integer;otherline:integer;templine:integer; +limit:external integer;loc:0..bufsize;inputhasended:boolean; +changing:boolean;{:124}{126:}changebuffer:array[0..bufsize]of ASCIIcode; +changelimit:0..bufsize;{:126}{143:}curmodule:namepointer; +scanninghex:boolean;{:143}{156:}nextcontrol:eightbits;{:156}{164:} +currepltext:textpointer;{:164}{171:}modulecount:0..12287;{:171}{179:} +{troubleshooting:boolean;ddt:integer;dd:integer;debugcycle:integer; +debugskipped:integer;}{:179}{185:}{wo:0..2;}{:185}{189:} +webname,changename,Pascalname,poolname:UNIXfilename;{:189} +#include "tangext.h" +{30:}{procedure debughelp;forward;}{:30}{31:}procedure error; +var j:0..outbufsize;k,l:0..bufsize;begin if phaseone then{32:} +begin if changing then write(output,'. (change file ')else write(output, +'. (');writeln(output,'l.',line:1,')'); +if loc>=limit then l:=limit else l:=loc; +for k:=1 to l do if buffer[k-1]=9 then write(output,' ')else write( +output,xchr[buffer[k-1]]);writeln(output); +for k:=1 to l do write(output,' '); +for k:=l+1 to limit do write(output,xchr[buffer[k-1]]); +write(output,' ');end{:32}else{33:} +begin writeln(output,'. (l.',line:1,')'); +for j:=1 to outptr do write(output,xchr[outbuf[j-1]]); +write(output,'... ');end{:33};flushstdout;history:=2; +{debugskipped:=debugcycle;debughelp;}end;{:31}{34:}procedure jumpout; +begin goto 9999;end;{:34}{191:}procedure scanargs; +var dotpos,i,a:integer;c:char;fname:UNIXfilename; +foundweb,foundchange:boolean;begin foundweb:=false;foundchange:=false; +for a:=1 to argc-1 do begin argv(a,fname); +if fname[1]<>'-'then begin if not foundweb then{192:}begin dotpos:=-1; +i:=1;while(fname[i]<>chr(0))and(i<=55)do begin webname[i]:=fname[i]; +if fname[i]='.'then dotpos:=i;i:=i+1;end; +if dotpos=-1 then begin dotpos:=i;webname[dotpos]:='.'; +webname[dotpos+1]:='w';webname[dotpos+2]:='e';webname[dotpos+3]:='b'; +webname[dotpos+4]:=chr(0);end else webname[i]:=chr(0); +for i:=1 to dotpos do begin c:=webname[i];Pascalname[i]:=c; +poolname[i]:=c;end;Pascalname[dotpos+1]:='p'; +Pascalname[dotpos+2]:=chr(0);poolname[dotpos+1]:='p'; +poolname[dotpos+2]:='o';poolname[dotpos+3]:='o';poolname[dotpos+4]:='l'; +poolname[dotpos+5]:=chr(0);foundweb:=true;end{:192} +else if not foundchange then{193:}begin dotpos:=-1;i:=1; +while(fname[i]<>chr(0))and(i<=55)do begin changename[i]:=fname[i]; +if fname[i]='.'then dotpos:=i;i:=i+1;end; +if dotpos=-1 then begin dotpos:=i;changename[dotpos]:='.'; +changename[dotpos+1]:='c';changename[dotpos+2]:='h'; +changename[dotpos+3]:=chr(0);end else changename[i]:=chr(0); +foundchange:=true;end{:193}else{196:}begin begin writeln(output); +write(output,'! Usage: tangle webfile[.web] [changefile[.ch]]');end; +error;jumpout;end{:196};end else{195:}begin{196:} +begin begin writeln(output); +write(output,'! Usage: tangle webfile[.web] [changefile[.ch]]');end; +error;jumpout;end{:196};end{:195};end;if not foundweb then{196:} +begin begin writeln(output); +write(output,'! Usage: tangle webfile[.web] [changefile[.ch]]');end; +error;jumpout;end{:196};if not foundchange then{194:} +begin changename[1]:='/';changename[2]:='d';changename[3]:='e'; +changename[4]:='v';changename[5]:='/';changename[6]:='n'; +changename[7]:='u';changename[8]:='l';changename[9]:='l'; +changename[10]:=chr(0);end{:194};end;{:191}procedure initialize;var{16:} +i:0..255;{:16}{41:}wi:0..2;{:41}{45:}zi:0..3;{:45}{51:}h:0..hashsize; +{:51}begin{10:}history:=0;{:10}{14:}xchr[32]:=' ';xchr[33]:='!'; +xchr[34]:='"';xchr[35]:='#';xchr[36]:='$';xchr[37]:='%';xchr[38]:='&'; +xchr[39]:='''';xchr[40]:='(';xchr[41]:=')';xchr[42]:='*';xchr[43]:='+'; +xchr[44]:=',';xchr[45]:='-';xchr[46]:='.';xchr[47]:='/';xchr[48]:='0'; +xchr[49]:='1';xchr[50]:='2';xchr[51]:='3';xchr[52]:='4';xchr[53]:='5'; +xchr[54]:='6';xchr[55]:='7';xchr[56]:='8';xchr[57]:='9';xchr[58]:=':'; +xchr[59]:=';';xchr[60]:='<';xchr[61]:='=';xchr[62]:='>';xchr[63]:='?'; +xchr[64]:='@';xchr[65]:='A';xchr[66]:='B';xchr[67]:='C';xchr[68]:='D'; +xchr[69]:='E';xchr[70]:='F';xchr[71]:='G';xchr[72]:='H';xchr[73]:='I'; +xchr[74]:='J';xchr[75]:='K';xchr[76]:='L';xchr[77]:='M';xchr[78]:='N'; +xchr[79]:='O';xchr[80]:='P';xchr[81]:='Q';xchr[82]:='R';xchr[83]:='S'; +xchr[84]:='T';xchr[85]:='U';xchr[86]:='V';xchr[87]:='W';xchr[88]:='X'; +xchr[89]:='Y';xchr[90]:='Z';xchr[91]:='[';xchr[92]:='\';xchr[93]:=']'; +xchr[94]:='^';xchr[95]:='_';xchr[96]:='`';xchr[97]:='a';xchr[98]:='b'; +xchr[99]:='c';xchr[100]:='d';xchr[101]:='e';xchr[102]:='f'; +xchr[103]:='g';xchr[104]:='h';xchr[105]:='i';xchr[106]:='j'; +xchr[107]:='k';xchr[108]:='l';xchr[109]:='m';xchr[110]:='n'; +xchr[111]:='o';xchr[112]:='p';xchr[113]:='q';xchr[114]:='r'; +xchr[115]:='s';xchr[116]:='t';xchr[117]:='u';xchr[118]:='v'; +xchr[119]:='w';xchr[120]:='x';xchr[121]:='y';xchr[122]:='z'; +xchr[123]:='{';xchr[124]:='|';xchr[125]:='}';xchr[126]:='~'; +xchr[0]:=' ';xchr[127]:=' ';{:14}{17:}for i:=1 to 31 do xchr[i]:=chr(i); +for i:=128 to 255 do xchr[i]:=chr(i);{:17}{18:} +for i:=0 to 255 do xord[chr(i)]:=32;for i:=1 to 255 do xord[xchr[i]]:=i; +xord[' ']:=32;{:18}{21:}{:21}{26:}scanargs; +rewrite(Pascalfile,Pascalname);rewrite(pool,poolname);{:26}{42:} +for wi:=0 to 2 do begin bytestart[wi]:=0;byteptr[wi]:=0;end; +bytestart[3]:=0;nameptr:=1;stringptr:=256;poolchecksum:=271828;{:42} +{46:}for zi:=0 to 3 do begin tokstart[zi]:=0;tokptr[zi]:=0;end; +tokstart[4]:=0;textptr:=1;z:=1 mod 4;{:46}{48:}ilk[0]:=0;equiv[0]:=0; +{:48}{52:}for h:=0 to hashsize-1 do begin hash[h]:=0;chophash[h]:=0;end; +{:52}{71:}lastunnamed:=0;textlink[0]:=0;{:71}{144:}scanninghex:=false; +{:144}{152:}modtext[0]:=32;{:152}{180:}{troubleshooting:=true; +debugcycle:=1;debugskipped:=0;troubleshooting:=false;debugcycle:=99999;} +{:180}end;{:2}{24:}procedure openinput;begin reset(webfile,webname); +reset(changefile,changename);end;{:24}{28:} +function inputln(var f:text):boolean;begin limit:=0; +if testeof(f)then inputln:=false else begin lineread(f); +if limit=bufsize then begin limit:=limit-1;begin writeln(output); +write(output,'! Input line too long');end;loc:=0;error;end; +inputln:=true;end;end;{:28}{49:}procedure printid(p:namepointer); +var k:0..maxbytes;w:0..2; +begin if p>=nameptr then write(output,'IMPOSSIBLE')else begin w:=p mod 3 +; +for k:=bytestart[p]to bytestart[p+3]-1 do write(output,xchr[bytemem[w,k] +]);end;end;{:49}{53:}function idlookup(t:eightbits):namepointer; +label 31,32;var c:eightbits;i:0..bufsize;h:0..hashsize;k:0..maxbytes; +w:0..2;l:0..bufsize;p,q:namepointer;s:0..unambiglength; +begin l:=idloc-idfirst;{54:}h:=buffer[idfirst];i:=idfirst+1; +while i<idloc do begin h:=(h+h+buffer[i])mod hashsize;i:=i+1;end{:54}; +{55:}p:=hash[h]; +while p<>0 do begin if bytestart[p+3]-bytestart[p]=l then{56:} +begin i:=idfirst;k:=bytestart[p];w:=p mod 3; +while(i<idloc)and(buffer[i]=bytemem[w,k])do begin i:=i+1;k:=k+1;end; +if i=idloc then goto 31;end{:56};p:=link[p];end;p:=nameptr; +link[p]:=hash[h];hash[h]:=p;31:{:55};if(p=nameptr)or(t<>0)then{57:} +begin if((p<>nameptr)and(t<>0)and(ilk[p]=0))or((p=nameptr)and(t=0)and( +buffer[idfirst]<>34))then{58:}begin i:=idfirst;s:=0;h:=0; +while(i<idloc)and(s<unambiglength)do begin if buffer[i]<>95 then begin +if buffer[i]>=97 then choppedid[s]:=buffer[i]-32 else choppedid[s]:= +buffer[i];h:=(h+h+choppedid[s])mod hashsize;s:=s+1;end;i:=i+1;end; +choppedid[s]:=0;end{:58};if p<>nameptr then{59:} +begin if ilk[p]=0 then begin if t=1 then begin writeln(output); +write(output,'! This identifier has already appeared');error;end;{60:} +q:=chophash[h]; +if q=p then chophash[h]:=equiv[p]else begin while equiv[q]<>p do q:= +equiv[q];equiv[q]:=equiv[p];end{:60};end else begin writeln(output); +write(output,'! This identifier was defined before');error;end; +ilk[p]:=t;end{:59}else{61:} +begin if(t=0)and(buffer[idfirst]<>34)then{62:}begin q:=chophash[h]; +while q<>0 do begin{63:}begin k:=bytestart[q];s:=0;w:=q mod 3; +while(k<bytestart[q+3])and(s<unambiglength)do begin c:=bytemem[w,k]; +if c<>95 then begin if c>=97 then c:=c-32; +if choppedid[s]<>c then goto 32;s:=s+1;end;k:=k+1;end; +if(k=bytestart[q+3])and(choppedid[s]<>0)then goto 32; +begin writeln(output);write(output,'! Identifier conflict with ');end; +for k:=bytestart[q]to bytestart[q+3]-1 do write(output,xchr[bytemem[w,k] +]);error;q:=0;32:end{:63};q:=equiv[q];end;equiv[p]:=chophash[h]; +chophash[h]:=p;end{:62};w:=nameptr mod 3;k:=byteptr[w]; +if k+l>maxbytes then begin writeln(output); +write(output,'! Sorry, ','byte memory',' capacity exceeded');error; +history:=3;jumpout;end;if nameptr>maxnames-3 then begin writeln(output); +write(output,'! Sorry, ','name',' capacity exceeded');error;history:=3; +jumpout;end;i:=idfirst;while i<idloc do begin bytemem[w,k]:=buffer[i]; +k:=k+1;i:=i+1;end;byteptr[w]:=k;bytestart[nameptr+3]:=k; +nameptr:=nameptr+1;if buffer[idfirst]<>34 then ilk[p]:=t else{64:} +begin ilk[p]:=1; +if l-doublechars=2 then equiv[p]:=buffer[idfirst+1]+32768 else begin +equiv[p]:=stringptr+32768;l:=l-doublechars-1; +if l>99 then begin writeln(output); +write(output,'! Preprocessed string is too long');error;end; +stringptr:=stringptr+1;write(pool,xchr[48+l div 10],xchr[48+l mod 10]); +poolchecksum:=poolchecksum+poolchecksum+l; +while poolchecksum>536870839 do poolchecksum:=poolchecksum-536870839; +i:=idfirst+1;while i<idloc do begin write(pool,xchr[buffer[i]]); +poolchecksum:=poolchecksum+poolchecksum+buffer[i]; +while poolchecksum>536870839 do poolchecksum:=poolchecksum-536870839; +if(buffer[i]=34)or(buffer[i]=64)then i:=i+2 else i:=i+1;end; +writeln(pool);end;end{:64};end{:61};end{:57};idlookup:=p;end;{:53}{66:} +function modlookup(l:sixteenbits):namepointer;label 31;var c:0..4; +j:0..longestname;k:0..maxbytes;w:0..2;p:namepointer;q:namepointer; +begin c:=2;q:=0;p:=ilk[0];while p<>0 do begin{68:}begin k:=bytestart[p]; +w:=p mod 3;c:=1;j:=1; +while(k<bytestart[p+3])and(j<=l)and(modtext[j]=bytemem[w,k])do begin k:= +k+1;j:=j+1;end; +if k=bytestart[p+3]then if j>l then c:=1 else c:=4 else if j>l then c:=3 +else if modtext[j]<bytemem[w,k]then c:=0 else c:=2;end{:68};q:=p; +if c=0 then p:=link[q]else if c=2 then p:=ilk[q]else goto 31;end;{67:} +w:=nameptr mod 3;k:=byteptr[w]; +if k+l>maxbytes then begin writeln(output); +write(output,'! Sorry, ','byte memory',' capacity exceeded');error; +history:=3;jumpout;end;if nameptr>maxnames-3 then begin writeln(output); +write(output,'! Sorry, ','name',' capacity exceeded');error;history:=3; +jumpout;end;p:=nameptr;if c=0 then link[q]:=p else ilk[q]:=p;link[p]:=0; +ilk[p]:=0;c:=1;equiv[p]:=0; +for j:=1 to l do bytemem[w,k+j-1]:=modtext[j];byteptr[w]:=k+l; +bytestart[nameptr+3]:=k+l;nameptr:=nameptr+1;{:67}; +31:if c<>1 then begin begin writeln(output); +write(output,'! Incompatible section names');error;end;p:=0;end; +modlookup:=p;end;{:66}{69:} +function prefixlookup(l:sixteenbits):namepointer;var c:0..4; +count:0..maxnames;j:0..longestname;k:0..maxbytes;w:0..2;p:namepointer; +q:namepointer;r:namepointer;begin q:=0;p:=ilk[0];count:=0;r:=0; +while p<>0 do begin{68:}begin k:=bytestart[p];w:=p mod 3;c:=1;j:=1; +while(k<bytestart[p+3])and(j<=l)and(modtext[j]=bytemem[w,k])do begin k:= +k+1;j:=j+1;end; +if k=bytestart[p+3]then if j>l then c:=1 else c:=4 else if j>l then c:=3 +else if modtext[j]<bytemem[w,k]then c:=0 else c:=2;end{:68}; +if c=0 then p:=link[p]else if c=2 then p:=ilk[p]else begin r:=p; +count:=count+1;q:=ilk[p];p:=link[p];end;if p=0 then begin p:=q;q:=0;end; +end;if count<>1 then if count=0 then begin writeln(output); +write(output,'! Name does not match');error; +end else begin writeln(output);write(output,'! Ambiguous prefix');error; +end;prefixlookup:=r;end;{:69}{73:} +procedure storetwobytes(x:sixteenbits); +begin if tokptr[z]+2>maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=x div 256; +tokmem[z,tokptr[z]+1]:=x mod 256;tokptr[z]:=tokptr[z]+2;end;{:73}{74:} +{procedure printrepl(p:textpointer);var k:0..maxtoks;a:sixteenbits; +zp:0..3; +begin if p>=textptr then write(output,'BAD')else begin k:=tokstart[p]; +zp:=p mod 4;while k<tokstart[p+4]do begin a:=tokmem[zp,k]; +if a>=128 then[75:]begin k:=k+1; +if a<168 then begin a:=(a-128)*256+tokmem[zp,k];printid(a); +if bytemem[a mod 3,bytestart[a]]=34 then write(output,'"')else write( +output,' ');end else if a<208 then begin write(output,'@<'); +printid((a-168)*256+tokmem[zp,k]);write(output,'@>'); +end else begin a:=(a-208)*256+tokmem[zp,k]; +write(output,'@',xchr[123],a:1,'@',xchr[125]);end; +end[:75]else[76:]case a of 9:write(output,'@',xchr[123]); +10:write(output,'@',xchr[125]);12:write(output,'@'''); +13:write(output,'@"');125:write(output,'@$');0:write(output,'#'); +64:write(output,'@@');2:write(output,'@=');3:write(output,'@\'); +otherwise write(output,xchr[a])end[:76];k:=k+1;end;end;end;}{:74}{84:} +procedure pushlevel(p:namepointer); +begin if stackptr=stacksize then begin writeln(output); +write(output,'! Sorry, ','stack',' capacity exceeded');error;history:=3; +jumpout;end else begin stack[stackptr]:=curstate;stackptr:=stackptr+1; +curstate.namefield:=p;curstate.replfield:=equiv[p]; +zo:=curstate.replfield mod 4; +curstate.bytefield:=tokstart[curstate.replfield]; +curstate.endfield:=tokstart[curstate.replfield+4];curstate.modfield:=0; +end;end;{:84}{85:}procedure poplevel;label 10; +begin if textlink[curstate.replfield]=0 then begin if ilk[curstate. +namefield]=3 then{91:}begin nameptr:=nameptr-1;textptr:=textptr-1; +z:=textptr mod 4;{if tokptr[z]>maxtokptr[z]then maxtokptr[z]:=tokptr[z]; +}tokptr[z]:=tokstart[textptr]; +{byteptr[nameptr mod 3]:=byteptr[nameptr mod 3]-1;}end{:91}; +end else if textlink[curstate.replfield]<maxtexts then begin curstate. +replfield:=textlink[curstate.replfield];zo:=curstate.replfield mod 4; +curstate.bytefield:=tokstart[curstate.replfield]; +curstate.endfield:=tokstart[curstate.replfield+4];goto 10;end; +stackptr:=stackptr-1;if stackptr>0 then begin curstate:=stack[stackptr]; +zo:=curstate.replfield mod 4;end;10:end;{:85}{87:} +function getoutput:sixteenbits;label 20,30,31;var a:sixteenbits; +b:eightbits;bal:sixteenbits;k:0..maxbytes;w:0..2; +begin 20:if stackptr=0 then begin a:=0;goto 31;end; +if curstate.bytefield=curstate.endfield then begin curval:=-curstate. +modfield;poplevel;if curval=0 then goto 20;a:=129;goto 31;end; +a:=tokmem[zo,curstate.bytefield]; +curstate.bytefield:=curstate.bytefield+1;if a<128 then if a=0 then{92:} +begin pushlevel(nameptr-1);goto 20;end{:92}else goto 31; +a:=(a-128)*256+tokmem[zo,curstate.bytefield]; +curstate.bytefield:=curstate.bytefield+1;if a<10240 then{89:} +begin case ilk[a]of 0:begin curval:=a;a:=130;end; +1:begin curval:=equiv[a]-32768;a:=128;end;2:begin pushlevel(a);goto 20; +end;3:begin{90:} +while(curstate.bytefield=curstate.endfield)and(stackptr>0)do poplevel; +if(stackptr=0)or(tokmem[zo,curstate.bytefield]<>40)then begin begin +writeln(output);write(output,'! No parameter given for ');end; +printid(a);error;goto 20;end;{93:}bal:=1; +curstate.bytefield:=curstate.bytefield+1; +while true do begin b:=tokmem[zo,curstate.bytefield]; +curstate.bytefield:=curstate.bytefield+1; +if b=0 then storetwobytes(nameptr+32767)else begin if b>=128 then begin +begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1;end; +b:=tokmem[zo,curstate.bytefield]; +curstate.bytefield:=curstate.bytefield+1; +end else case b of 40:bal:=bal+1;41:begin bal:=bal-1; +if bal=0 then goto 30;end; +39:repeat begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1;end; +b:=tokmem[zo,curstate.bytefield]; +curstate.bytefield:=curstate.bytefield+1;until b=39;otherwise end; +begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1;end;end;end; +30:{:93};equiv[nameptr]:=textptr;ilk[nameptr]:=2;w:=nameptr mod 3; +k:=byteptr[w];{if k=maxbytes then begin writeln(output); +write(output,'! Sorry, ','byte memory',' capacity exceeded');error; +history:=3;jumpout;end;bytemem[w,k]:=35;k:=k+1;byteptr[w]:=k;} +if nameptr>maxnames-3 then begin writeln(output); +write(output,'! Sorry, ','name',' capacity exceeded');error;history:=3; +jumpout;end;bytestart[nameptr+3]:=k;nameptr:=nameptr+1; +if textptr>maxtexts-4 then begin writeln(output); +write(output,'! Sorry, ','text',' capacity exceeded');error;history:=3; +jumpout;end;textlink[textptr]:=0;tokstart[textptr+4]:=tokptr[z]; +textptr:=textptr+1;z:=textptr mod 4{:90};pushlevel(a);goto 20;end;end; +goto 31;end{:89};if a<20480 then{88:}begin a:=a-10240; +if equiv[a]<>0 then pushlevel(a)else if a<>0 then begin begin writeln( +output);write(output,'! Not present: <');end;printid(a); +write(output,'>');error;end;goto 20;end{:88};curval:=a-20480;a:=129; +curstate.modfield:=curval;31:{if troubleshooting then debughelp;} +getoutput:=a;end;{:87}{97:}procedure flushbuffer;var k:0..outbufsize; +b:0..outbufsize;begin b:=breakptr; +if(semiptr<>0)and(outptr-semiptr<=linelength)then breakptr:=semiptr; +for k:=1 to breakptr do write(Pascalfile,xchr[outbuf[k-1]]); +writeln(Pascalfile);line:=line+1; +if line mod 100=0 then begin write(output,'.'); +if line mod 500=0 then write(output,line:1);flushstdout;end; +if breakptr<outptr then begin if outbuf[breakptr]=32 then begin breakptr +:=breakptr+1;if breakptr>b then b:=breakptr;end; +for k:=breakptr to outptr-1 do outbuf[k-breakptr]:=outbuf[k];end; +outptr:=outptr-breakptr;breakptr:=b-breakptr;semiptr:=0; +if outptr>linelength then begin begin writeln(output); +write(output,'! Long line must be truncated');error;end; +outptr:=linelength;end;end;{:97}{99:}procedure appval(v:integer); +var k:0..outbufsize;begin k:=outbufsize;repeat outbuf[k]:=v mod 10; +v:=v div 10;k:=k-1;until v=0;repeat k:=k+1; +begin outbuf[outptr]:=outbuf[k]+48;outptr:=outptr+1;end; +until k=outbufsize;end;{:99}{101:}procedure sendout(t:eightbits; +v:sixteenbits);label 20;var k:0..linelength;begin{102:} +20:case outstate of 1:if t<>3 then begin breakptr:=outptr; +if t=2 then begin outbuf[outptr]:=32;outptr:=outptr+1;end;end; +2:begin begin outbuf[outptr]:=44-outapp;outptr:=outptr+1;end; +if outptr>linelength then flushbuffer;breakptr:=outptr;end; +3,4:begin{103:} +if(outval<0)or((outval=0)and(lastsign<0))then begin outbuf[outptr]:=45; +outptr:=outptr+1; +end else if outsign>0 then begin outbuf[outptr]:=outsign; +outptr:=outptr+1;end;appval(abs(outval)); +if outptr>linelength then flushbuffer;{:103};outstate:=outstate-2; +goto 20;end;5:{104:}begin if(t=3)or({105:} +((t=2)and(v=3)and(((outcontrib[1]=68)and(outcontrib[2]=73)and(outcontrib +[3]=86))or((outcontrib[1]=100)and(outcontrib[2]=105)and(outcontrib[3]= +118))or((outcontrib[1]=77)and(outcontrib[2]=79)and(outcontrib[3]=68))or( +(outcontrib[1]=109)and(outcontrib[2]=111)and(outcontrib[3]=100))))or((t= +0)and((v=42)or(v=47))){:105})then begin{103:} +if(outval<0)or((outval=0)and(lastsign<0))then begin outbuf[outptr]:=45; +outptr:=outptr+1; +end else if outsign>0 then begin outbuf[outptr]:=outsign; +outptr:=outptr+1;end;appval(abs(outval)); +if outptr>linelength then flushbuffer;{:103};outsign:=43;outval:=outapp; +end else outval:=outval+outapp;outstate:=3;goto 20;end{:104}; +0:if t<>3 then breakptr:=outptr;otherwise end{:102}; +if t<>0 then for k:=1 to v do begin outbuf[outptr]:=outcontrib[k]; +outptr:=outptr+1;end else begin outbuf[outptr]:=v;outptr:=outptr+1;end; +if outptr>linelength then flushbuffer; +if(t=0)and((v=59)or(v=125))then begin semiptr:=outptr;breakptr:=outptr; +end;if t>=2 then outstate:=1 else outstate:=0 end;{:101}{106:} +procedure sendsign(v:integer); +begin case outstate of 2,4:outapp:=outapp*v;3:begin outapp:=v; +outstate:=4;end;5:begin outval:=outval+outapp;outapp:=v;outstate:=4;end; +otherwise begin breakptr:=outptr;outapp:=v;outstate:=2;end end; +lastsign:=outapp;end;{:106}{107:}procedure sendval(v:integer); +label 666,10;begin case outstate of 1:begin{110:} +if(outptr=breakptr+3)or((outptr=breakptr+4)and(outbuf[breakptr]=32))then +if((outbuf[outptr-3]=68)and(outbuf[outptr-2]=73)and(outbuf[outptr-1]=86) +)or((outbuf[outptr-3]=100)and(outbuf[outptr-2]=105)and(outbuf[outptr-1]= +118))or((outbuf[outptr-3]=77)and(outbuf[outptr-2]=79)and(outbuf[outptr-1 +]=68))or((outbuf[outptr-3]=109)and(outbuf[outptr-2]=111)and(outbuf[ +outptr-1]=100))then goto 666{:110};outsign:=32;outstate:=3;outval:=v; +breakptr:=outptr;lastsign:=+1;end;0:begin{109:} +if(outptr=breakptr+1)and((outbuf[breakptr]=42)or(outbuf[breakptr]=47)) +then goto 666{:109};outsign:=0;outstate:=3;outval:=v;breakptr:=outptr; +lastsign:=+1;end;{108:}2:begin outsign:=43;outstate:=3;outval:=outapp*v; +end;3:begin outstate:=5;outapp:=v;begin writeln(output); +write(output,'! Two numbers occurred without a sign between them'); +error;end;end;4:begin outstate:=5;outapp:=outapp*v;end; +5:begin outval:=outval+outapp;outapp:=v;begin writeln(output); +write(output,'! Two numbers occurred without a sign between them'); +error;end;end;{:108}otherwise goto 666 end;goto 10;666:{111:} +if v>=0 then begin if outstate=1 then begin breakptr:=outptr; +begin outbuf[outptr]:=32;outptr:=outptr+1;end;end;appval(v); +if outptr>linelength then flushbuffer;outstate:=1; +end else begin begin outbuf[outptr]:=40;outptr:=outptr+1;end; +begin outbuf[outptr]:=45;outptr:=outptr+1;end;appval(-v); +begin outbuf[outptr]:=41;outptr:=outptr+1;end; +if outptr>linelength then flushbuffer;outstate:=0;end{:111};10:end; +{:107}{113:}procedure sendtheoutput;label 2,21,22;var curchar:eightbits; +k:0..linelength;j:0..maxbytes;w:0..2;n:integer; +begin while stackptr>0 do begin curchar:=getoutput; +21:case curchar of 0:;{116:} +65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88, +89,90,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113, +114,115,116,117,118,119,120,121,122:begin outcontrib[1]:=curchar; +sendout(2,1);end;130:begin k:=0;j:=bytestart[curval];w:=curval mod 3; +while(k<maxidlength)and(j<bytestart[curval+3])do begin k:=k+1; +outcontrib[k]:=bytemem[w,j];j:=j+1;if outcontrib[k]=95 then k:=k-1;end; +sendout(2,k);end;{:116}{119:}48,49,50,51,52,53,54,55,56,57:begin n:=0; +repeat curchar:=curchar-48;if n>=214748364 then begin writeln(output); +write(output,'! Constant too big');error;end else n:=10*n+curchar; +curchar:=getoutput;until(curchar>57)or(curchar<48);sendval(n);k:=0; +if curchar=101 then curchar:=69;if curchar=69 then goto 2 else goto 21; +end;125:sendval(poolchecksum);12:begin n:=0;curchar:=48; +repeat curchar:=curchar-48;if n>=268435456 then begin writeln(output); +write(output,'! Constant too big');error;end else n:=8*n+curchar; +curchar:=getoutput;until(curchar>55)or(curchar<48);sendval(n);goto 21; +end;13:begin n:=0;curchar:=48; +repeat if curchar>=65 then curchar:=curchar-55 else curchar:=curchar-48; +if n>=134217728 then begin writeln(output); +write(output,'! Constant too big');error;end else n:=16*n+curchar; +curchar:=getoutput; +until(curchar>70)or(curchar<48)or((curchar>57)and(curchar<65)); +sendval(n);goto 21;end;128:sendval(curval);46:begin k:=1; +outcontrib[1]:=46;curchar:=getoutput; +if curchar=46 then begin outcontrib[2]:=46;sendout(1,2); +end else if(curchar>=48)and(curchar<=57)then goto 2 else begin sendout(0 +,46);goto 21;end;end;{:119}43,45:sendsign(44-curchar);{114:} +4:begin outcontrib[1]:=97;outcontrib[2]:=110;outcontrib[3]:=100; +sendout(2,3);end;5:begin outcontrib[1]:=110;outcontrib[2]:=111; +outcontrib[3]:=116;sendout(2,3);end;6:begin outcontrib[1]:=105; +outcontrib[2]:=110;sendout(2,2);end;31:begin outcontrib[1]:=111; +outcontrib[2]:=114;sendout(2,2);end;24:begin outcontrib[1]:=58; +outcontrib[2]:=61;sendout(1,2);end;26:begin outcontrib[1]:=60; +outcontrib[2]:=62;sendout(1,2);end;28:begin outcontrib[1]:=60; +outcontrib[2]:=61;sendout(1,2);end;29:begin outcontrib[1]:=62; +outcontrib[2]:=61;sendout(1,2);end;30:begin outcontrib[1]:=61; +outcontrib[2]:=61;sendout(1,2);end;32:begin outcontrib[1]:=46; +outcontrib[2]:=46;sendout(1,2);end;{:114}39:{117:}begin k:=1; +outcontrib[1]:=39;repeat if k<linelength then k:=k+1; +outcontrib[k]:=getoutput;until(outcontrib[k]=39)or(stackptr=0); +if k=linelength then begin writeln(output); +write(output,'! String too long');error;end;sendout(1,k); +curchar:=getoutput;if curchar=39 then outstate:=6;goto 21;end{:117}; +{115:} +33,34,35,36,37,38,40,41,42,44,47,58,59,60,61,62,63,64,91,92,93,94,95,96, +123,124{:115}:sendout(0,curchar);{121:} +9:begin if bracelevel=0 then sendout(0,123)else sendout(0,91); +bracelevel:=bracelevel+1;end; +10:if bracelevel>0 then begin bracelevel:=bracelevel-1; +if bracelevel=0 then sendout(0,125)else sendout(0,93); +end else begin writeln(output);write(output,'! Extra @}');error;end; +129:begin k:=2; +if bracelevel=0 then outcontrib[1]:=123 else outcontrib[1]:=91; +if curval<0 then begin outcontrib[k]:=58;curval:=-curval;k:=k+1;end; +n:=10;while curval>=n do n:=10*n;repeat n:=n div 10; +outcontrib[k]:=48+(curval div n);curval:=curval mod n;k:=k+1;until n=1; +if outcontrib[2]<>58 then begin outcontrib[k]:=58;k:=k+1;end; +if bracelevel=0 then outcontrib[k]:=125 else outcontrib[k]:=93; +sendout(1,k);end;{:121}127:begin sendout(3,0);outstate:=6;end;2:{118:} +begin k:=0;repeat if k<linelength then k:=k+1;outcontrib[k]:=getoutput; +until(outcontrib[k]=2)or(stackptr=0); +if k=linelength then begin writeln(output); +write(output,'! Verbatim string too long');error;end;sendout(1,k-1); +end{:118};3:{122:}begin sendout(1,0); +while outptr>0 do begin if outptr<=linelength then breakptr:=outptr; +flushbuffer;end;outstate:=0;end{:122};otherwise begin writeln(output); +write(output,'! Can''t output ASCII code ',curchar:1);error;end end; +goto 22;2:{120:}repeat if k<linelength then k:=k+1; +outcontrib[k]:=curchar;curchar:=getoutput; +if(outcontrib[k]=69)and((curchar=43)or(curchar=45))then begin if k< +linelength then k:=k+1;outcontrib[k]:=curchar;curchar:=getoutput; +end else if curchar=101 then curchar:=69; +until(curchar<>69)and((curchar<48)or(curchar>57)); +if k=linelength then begin writeln(output); +write(output,'! Fraction too long');error;end;sendout(3,k);goto 21{:120} +;22:end;end;{:113}{127:}function linesdontmatch:boolean;label 10; +var k:0..bufsize;begin linesdontmatch:=true; +if changelimit<>limit then goto 10; +if limit>0 then for k:=0 to limit-1 do if changebuffer[k]<>buffer[k]then +goto 10;linesdontmatch:=false;10:end;{:127}{128:} +procedure primethechangebuffer;label 22,30,10;var k:0..bufsize; +begin changelimit:=0;{129:}while true do begin line:=line+1; +if not inputln(changefile)then goto 10;if limit<2 then goto 22; +if buffer[0]<>64 then goto 22; +if(buffer[1]>=88)and(buffer[1]<=90)then buffer[1]:=buffer[1]+32; +if buffer[1]=120 then goto 30; +if(buffer[1]=121)or(buffer[1]=122)then begin loc:=2; +begin writeln(output);write(output,'! Where is the matching @x?');error; +end;end;22:end;30:{:129};{130:}repeat line:=line+1; +if not inputln(changefile)then begin begin writeln(output); +write(output,'! Change file ended after @x');error;end;goto 10;end; +until limit>0;{:130};{131:}begin changelimit:=limit; +if limit>0 then for k:=0 to limit-1 do changebuffer[k]:=buffer[k]; +end{:131};10:end;{:128}{132:}procedure checkchange;label 10; +var n:integer;k:0..bufsize;begin if linesdontmatch then goto 10;n:=0; +while true do begin changing:=not changing;templine:=otherline; +otherline:=line;line:=templine;line:=line+1; +if not inputln(changefile)then begin begin writeln(output); +write(output,'! Change file ended before @y');error;end;changelimit:=0; +changing:=not changing;templine:=otherline;otherline:=line; +line:=templine;goto 10;end;{133:} +if limit>1 then if buffer[0]=64 then begin if(buffer[1]>=88)and(buffer[1 +]<=90)then buffer[1]:=buffer[1]+32; +if(buffer[1]=120)or(buffer[1]=122)then begin loc:=2; +begin writeln(output);write(output,'! Where is the matching @y?');error; +end;end else if buffer[1]=121 then begin if n>0 then begin loc:=2; +begin writeln(output); +write(output,'! Hmm... ',n:1,' of the preceding lines failed to match'); +error;end;end;goto 10;end;end{:133};{131:}begin changelimit:=limit; +if limit>0 then for k:=0 to limit-1 do changebuffer[k]:=buffer[k]; +end{:131};changing:=not changing;templine:=otherline;otherline:=line; +line:=templine;line:=line+1; +if not inputln(webfile)then begin begin writeln(output); +write(output,'! WEB file ended during a change');error;end; +inputhasended:=true;goto 10;end;if linesdontmatch then n:=n+1;end; +10:end;{:132}{135:}procedure getline;label 20; +begin 20:if changing then{137:}begin line:=line+1; +if not inputln(changefile)then begin begin writeln(output); +write(output,'! Change file ended without @z');error;end;buffer[0]:=64; +buffer[1]:=122;limit:=2;end; +if limit>1 then if buffer[0]=64 then begin if(buffer[1]>=88)and(buffer[1 +]<=90)then buffer[1]:=buffer[1]+32; +if(buffer[1]=120)or(buffer[1]=121)then begin loc:=2; +begin writeln(output);write(output,'! Where is the matching @z?');error; +end;end else if buffer[1]=122 then begin primethechangebuffer; +changing:=not changing;templine:=otherline;otherline:=line; +line:=templine;end;end;end{:137};if not changing then begin{136:} +begin line:=line+1; +if not inputln(webfile)then inputhasended:=true else if limit= +changelimit then if buffer[0]=changebuffer[0]then if changelimit>0 then +checkchange;end{:136};if changing then goto 20;end;loc:=0; +buffer[limit]:=32;end;{:135}{139:} +function controlcode(c:ASCIIcode):eightbits; +begin case c of 64:controlcode:=64;39:controlcode:=12; +34:controlcode:=13;36:controlcode:=125;32,9:controlcode:=136; +42:begin write(output,'*',modulecount+1:1);flushstdout;controlcode:=136; +end;68,100:controlcode:=133;70,102:controlcode:=132;123:controlcode:=9; +125:controlcode:=10;80,112:controlcode:=134; +84,116,94,46,58:controlcode:=131;38:controlcode:=127; +60:controlcode:=135;61:controlcode:=2;92:controlcode:=3; +otherwise controlcode:=0 end;end;{:139}{140:} +function skipahead:eightbits;label 30;var c:eightbits; +begin while true do begin if loc>limit then begin getline; +if inputhasended then begin c:=136;goto 30;end;end;buffer[limit+1]:=64; +while buffer[loc]<>64 do loc:=loc+1;if loc<=limit then begin loc:=loc+2; +c:=controlcode(buffer[loc-1]);if(c<>0)or(buffer[loc-1]=62)then goto 30; +end;end;30:skipahead:=c;end;{:140}{141:}procedure skipcomment;label 10; +var bal:eightbits;c:ASCIIcode;begin bal:=0; +while true do begin if loc>limit then begin getline; +if inputhasended then begin begin writeln(output); +write(output,'! Input ended in mid-comment');error;end;goto 10;end;end; +c:=buffer[loc];loc:=loc+1;{142:}if c=64 then begin c:=buffer[loc]; +if(c<>32)and(c<>9)and(c<>42)and(c<>122)and(c<>90)then loc:=loc+1 else +begin begin writeln(output); +write(output,'! Section ended in mid-comment');error;end;loc:=loc-1; +goto 10; +end end else if(c=92)and(buffer[loc]<>64)then loc:=loc+1 else if c=123 +then bal:=bal+1 else if c=125 then begin if bal=0 then goto 10; +bal:=bal-1;end{:142};end;10:end;{:141}{145:}function getnext:eightbits; +label 20,30,31;var c:eightbits;d:eightbits;j,k:0..longestname; +begin 20:if loc>limit then begin getline; +if inputhasended then begin c:=136;goto 31;end;end;c:=buffer[loc]; +loc:=loc+1;if scanninghex then{146:} +if((c>=48)and(c<=57))or((c>=65)and(c<=70))then goto 31 else scanninghex +:=false{:146}; +case c of 65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85 +,86,87,88,89,90,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111 +,112,113,114,115,116,117,118,119,120,121,122:{148:} +begin if((c=101)or(c=69))and(loc>1)then if(buffer[loc-2]<=57)and(buffer[ +loc-2]>=48)then c:=0;if c<>0 then begin loc:=loc-1;idfirst:=loc; +repeat loc:=loc+1;d:=buffer[loc]; +until((d<48)or((d>57)and(d<65))or((d>90)and(d<97))or(d>122))and(d<>95); +if loc>idfirst+1 then begin c:=130;idloc:=loc;end;end else c:=69; +end{:148};34:{149:}begin doublechars:=0;idfirst:=loc-1; +repeat d:=buffer[loc];loc:=loc+1; +if(d=34)or(d=64)then if buffer[loc]=d then begin loc:=loc+1;d:=0; +doublechars:=doublechars+1; +end else begin if d=64 then begin writeln(output); +write(output,'! Double @ sign missing');error; +end end else if loc>limit then begin begin writeln(output); +write(output,'! String constant didn''t end');error;end;d:=34;end; +until d=34;idloc:=loc-1;c:=130;end{:149};64:{150:} +begin c:=controlcode(buffer[loc]);loc:=loc+1; +if c=0 then goto 20 else if c=13 then scanninghex:=true else if c=135 +then{151:}begin{153:}k:=0; +while true do begin if loc>limit then begin getline; +if inputhasended then begin begin writeln(output); +write(output,'! Input ended in section name');error;end;goto 30;end;end; +d:=buffer[loc];{154:}if d=64 then begin d:=buffer[loc+1]; +if d=62 then begin loc:=loc+2;goto 30;end; +if(d=32)or(d=9)or(d=42)then begin begin writeln(output); +write(output,'! Section name didn''t end');error;end;goto 30;end;k:=k+1; +modtext[k]:=64;loc:=loc+1;end{:154};loc:=loc+1; +if k<longestname-1 then k:=k+1;if(d=32)or(d=9)then begin d:=32; +if modtext[k-1]=32 then k:=k-1;end;modtext[k]:=d;end;30:{155:} +if k>=longestname-2 then begin begin writeln(output); +write(output,'! Section name too long: ');end; +for j:=1 to 25 do write(output,xchr[modtext[j]]);write(output,'...'); +if history=0 then history:=1;end{:155}; +if(modtext[k]=32)and(k>0)then k:=k-1;{:153}; +if k>3 then begin if(modtext[k]=46)and(modtext[k-1]=46)and(modtext[k-2]= +46)then curmodule:=prefixlookup(k-3)else curmodule:=modlookup(k); +end else curmodule:=modlookup(k);end{:151} +else if c=131 then begin repeat c:=skipahead;until c<>64; +if buffer[loc-1]<>62 then begin writeln(output); +write(output,'! Improper @ within control text');error;end;goto 20;end; +end{:150};{147:} +46:if buffer[loc]=46 then begin if loc<=limit then begin c:=32; +loc:=loc+1;end; +end else if buffer[loc]=41 then begin if loc<=limit then begin c:=93; +loc:=loc+1;end;end; +58:if buffer[loc]=61 then begin if loc<=limit then begin c:=24; +loc:=loc+1;end;end; +61:if buffer[loc]=61 then begin if loc<=limit then begin c:=30; +loc:=loc+1;end;end; +62:if buffer[loc]=61 then begin if loc<=limit then begin c:=29; +loc:=loc+1;end;end; +60:if buffer[loc]=61 then begin if loc<=limit then begin c:=28; +loc:=loc+1;end; +end else if buffer[loc]=62 then begin if loc<=limit then begin c:=26; +loc:=loc+1;end;end; +40:if buffer[loc]=42 then begin if loc<=limit then begin c:=9; +loc:=loc+1;end; +end else if buffer[loc]=46 then begin if loc<=limit then begin c:=91; +loc:=loc+1;end;end; +42:if buffer[loc]=41 then begin if loc<=limit then begin c:=10; +loc:=loc+1;end;end;{:147}32,9:goto 20;123:begin skipcomment;goto 20;end; +125:begin begin writeln(output);write(output,'! Extra }');error;end; +goto 20;end;otherwise if c>=128 then goto 20 else end; +31:{if troubleshooting then debughelp;}getnext:=c;end;{:145}{157:} +procedure scannumeric(p:namepointer);label 21,30; +var accumulator:integer;nextsign:-1..+1;q:namepointer;val:integer; +begin{158:}accumulator:=0;nextsign:=+1; +while true do begin nextcontrol:=getnext; +21:case nextcontrol of 48,49,50,51,52,53,54,55,56,57:begin{160:}val:=0; +repeat val:=10*val+nextcontrol-48;nextcontrol:=getnext; +until(nextcontrol>57)or(nextcontrol<48){:160}; +begin accumulator:=accumulator+nextsign*(val);nextsign:=+1;end;goto 21; +end;12:begin{161:}val:=0;nextcontrol:=48; +repeat val:=8*val+nextcontrol-48;nextcontrol:=getnext; +until(nextcontrol>55)or(nextcontrol<48){:161}; +begin accumulator:=accumulator+nextsign*(val);nextsign:=+1;end;goto 21; +end;13:begin{162:}val:=0;nextcontrol:=48; +repeat if nextcontrol>=65 then nextcontrol:=nextcontrol-7; +val:=16*val+nextcontrol-48;nextcontrol:=getnext; +until(nextcontrol>70)or(nextcontrol<48)or((nextcontrol>57)and( +nextcontrol<65)){:162};begin accumulator:=accumulator+nextsign*(val); +nextsign:=+1;end;goto 21;end;130:begin q:=idlookup(0); +if ilk[q]<>1 then begin nextcontrol:=42;goto 21;end; +begin accumulator:=accumulator+nextsign*(equiv[q]-32768);nextsign:=+1; +end;end;43:;45:nextsign:=-nextsign;132,133,135,134,136:goto 30; +59:begin writeln(output); +write(output,'! Omit semicolon in numeric definition');error;end; +otherwise{159:}begin begin writeln(output); +write(output,'! Improper numeric definition will be flushed');error;end; +repeat nextcontrol:=skipahead until(nextcontrol>=132); +if nextcontrol=135 then begin loc:=loc-2;nextcontrol:=getnext;end; +accumulator:=0;goto 30;end{:159}end;end;30:{:158}; +if abs(accumulator)>=32768 then begin begin writeln(output); +write(output,'! Value too big: ',accumulator:1);error;end; +accumulator:=0;end;equiv[p]:=accumulator+32768;end;{:157}{165:} +procedure scanrepl(t:eightbits);label 22,30,31,21;var a:sixteenbits; +b:ASCIIcode;bal:eightbits;begin bal:=0; +while true do begin 22:a:=getnext;case a of 40:bal:=bal+1; +41:if bal=0 then begin writeln(output);write(output,'! Extra )');error; +end else bal:=bal-1;39:{168:}begin b:=39; +while true do begin begin if tokptr[z]=maxtoks then begin writeln(output +);write(output,'! Sorry, ','token',' capacity exceeded');error; +history:=3;jumpout;end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1; +end; +if b=64 then if buffer[loc]=64 then loc:=loc+1 else begin writeln(output +);write(output,'! You should double @ signs in strings');error;end; +if loc=limit then begin begin writeln(output); +write(output,'! String didn''t end');error;end;buffer[loc]:=39; +buffer[loc+1]:=0;end;b:=buffer[loc];loc:=loc+1; +if b=39 then begin if buffer[loc]<>39 then goto 31 else begin loc:=loc+1 +;begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=39;tokptr[z]:=tokptr[z]+1;end;end;end; +end;31:end{:168};35:if t=3 then a:=0;{167:}130:begin a:=idlookup(0); +begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=(a div 256)+128;tokptr[z]:=tokptr[z]+1; +end;a:=a mod 256;end; +135:if t<>135 then goto 30 else begin begin if tokptr[z]=maxtoks then +begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=(curmodule div 256)+168; +tokptr[z]:=tokptr[z]+1;end;a:=curmodule mod 256;end;2:{169:} +begin begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=2;tokptr[z]:=tokptr[z]+1;end; +buffer[limit+1]:=64; +21:if buffer[loc]=64 then begin if loc<limit then if buffer[loc+1]=64 +then begin begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=64;tokptr[z]:=tokptr[z]+1;end; +loc:=loc+2;goto 21;end; +end else begin begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=buffer[loc];tokptr[z]:=tokptr[z]+1;end; +loc:=loc+1;goto 21;end;if loc>=limit then begin writeln(output); +write(output,'! Verbatim string didn''t end');error; +end else if buffer[loc+1]<>62 then begin writeln(output); +write(output,'! You should double @ signs in verbatim strings');error; +end;loc:=loc+2;end{:169}; +133,132,134:if t<>135 then goto 30 else begin begin writeln(output); +write(output,'! @',xchr[buffer[loc-1]],' is ignored in Pascal text'); +error;end;goto 22;end;136:goto 30;{:167}otherwise end; +begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=a;tokptr[z]:=tokptr[z]+1;end;end; +30:nextcontrol:=a;{166:} +if bal>0 then begin if bal=1 then begin writeln(output); +write(output,'! Missing )');error;end else begin writeln(output); +write(output,'! Missing ',bal:1,' )''s');error;end; +while bal>0 do begin begin if tokptr[z]=maxtoks then begin writeln( +output);write(output,'! Sorry, ','token',' capacity exceeded');error; +history:=3;jumpout;end;tokmem[z,tokptr[z]]:=41;tokptr[z]:=tokptr[z]+1; +end;bal:=bal-1;end;end{:166}; +if textptr>maxtexts-4 then begin writeln(output); +write(output,'! Sorry, ','text',' capacity exceeded');error;history:=3; +jumpout;end;currepltext:=textptr;tokstart[textptr+4]:=tokptr[z]; +textptr:=textptr+1;if z=3 then z:=0 else z:=z+1;end;{:165}{170:} +procedure definemacro(t:eightbits);var p:namepointer; +begin p:=idlookup(t);scanrepl(t);equiv[p]:=currepltext; +textlink[currepltext]:=0;end;{:170}{172:}procedure scanmodule; +label 22,30,10;var p:namepointer;begin modulecount:=modulecount+1;{173:} +nextcontrol:=0; +while true do begin 22:while nextcontrol<=132 do begin nextcontrol:= +skipahead;if nextcontrol=135 then begin loc:=loc-2;nextcontrol:=getnext; +end;end;if nextcontrol<>133 then goto 30;nextcontrol:=getnext; +if nextcontrol<>130 then begin begin writeln(output); +write(output,'! Definition flushed, must start with ', +'identifier of length > 1');error;end;goto 22;end;nextcontrol:=getnext; +if nextcontrol=61 then begin scannumeric(idlookup(1));goto 22; +end else if nextcontrol=30 then begin definemacro(2);goto 22; +end else{174:}if nextcontrol=40 then begin nextcontrol:=getnext; +if nextcontrol=35 then begin nextcontrol:=getnext; +if nextcontrol=41 then begin nextcontrol:=getnext; +if nextcontrol=61 then begin begin writeln(output); +write(output,'! Use == for macros');error;end;nextcontrol:=30;end; +if nextcontrol=30 then begin definemacro(3);goto 22;end;end;end;end; +{:174};begin writeln(output); +write(output,'! Definition flushed since it starts badly');error;end; +end;30:{:173};{175:}case nextcontrol of 134:p:=0;135:begin p:=curmodule; +{176:}repeat nextcontrol:=getnext;until nextcontrol<>43; +if(nextcontrol<>61)and(nextcontrol<>30)then begin begin writeln(output); +write(output,'! Pascal text flushed, = sign is missing');error;end; +repeat nextcontrol:=skipahead;until nextcontrol=136;goto 10;end{:176}; +end;otherwise goto 10 end;{177:}storetwobytes(53248+modulecount);{:177}; +scanrepl(135);{178:} +if p=0 then begin textlink[lastunnamed]:=currepltext; +lastunnamed:=currepltext; +end else if equiv[p]=0 then equiv[p]:=currepltext else begin p:=equiv[p] +;while textlink[p]<maxtexts do p:=textlink[p];textlink[p]:=currepltext; +end;textlink[currepltext]:=maxtexts;{:178};{:175};10:end;{:172}{181:} +{procedure debughelp;label 888,10;var k:integer; +begin debugskipped:=debugskipped+1; +if debugskipped<debugcycle then goto 10;debugskipped:=0; +while true do begin begin writeln(output);write(output,'#');end; +flushstdout;read(input,ddt); +if ddt<0 then goto 10 else if ddt=0 then begin goto 888; +888:ddt:=0; +end else begin read(input,dd);case ddt of 1:printid(dd);2:printrepl(dd); +3:for k:=1 to dd do write(output,xchr[buffer[k]]); +4:for k:=1 to dd do write(output,xchr[modtext[k]]); +5:for k:=1 to outptr do write(output,xchr[outbuf[k]]); +6:for k:=1 to dd do write(output,xchr[outcontrib[k]]); +otherwise write(output,'?')end;end;end;10:end;}{:181}{182:} +begin initialize;{134:}openinput;line:=0;otherline:=0;changing:=true; +primethechangebuffer;changing:=not changing;templine:=otherline; +otherline:=line;line:=templine;limit:=0;loc:=1;buffer[0]:=32; +inputhasended:=false;{:134}; +writeln(output,'This is TANGLE, Version 4.5 for Linux');{183:} +phaseone:=true;modulecount:=0;repeat nextcontrol:=skipahead; +until nextcontrol=136;while not inputhasended do scanmodule;{138:} +if changelimit<>0 then begin for ii:=0 to changelimit do buffer[ii]:= +changebuffer[ii];limit:=changelimit;changing:=true;line:=otherline; +loc:=changelimit;begin writeln(output); +write(output,'! Change file entry did not match');error;end;end{:138}; +phaseone:=false;{:183};{for ii:=0 to 3 do maxtokptr[ii]:=tokptr[ii];} +{112:}if textlink[0]=0 then begin begin writeln(output); +write(output,'! No output was specified.');end; +if history=0 then history:=1;end else begin begin writeln(output); +write(output,'Writing the output file');end;flushstdout;{83:} +stackptr:=1;bracelevel:=0;curstate.namefield:=0; +curstate.replfield:=textlink[0];zo:=curstate.replfield mod 4; +curstate.bytefield:=tokstart[curstate.replfield]; +curstate.endfield:=tokstart[curstate.replfield+4];curstate.modfield:=0; +{:83};{96:}outstate:=0;outptr:=0;breakptr:=0;semiptr:=0;outbuf[0]:=0; +line:=1;{:96};sendtheoutput;{98:}breakptr:=outptr;semiptr:=0; +flushbuffer;if bracelevel<>0 then begin writeln(output); +write(output,'! Program ended at brace level ',bracelevel:1);error;end; +{:98};begin writeln(output);write(output,'Done.');end;end{:112}; +9999:if stringptr>256 then{184:}begin begin writeln(output); +write(output,stringptr-256:1,' strings written to string pool file.'); +end;write(pool,'*'); +for ii:=1 to 9 do begin outbuf[ii]:=poolchecksum mod 10; +poolchecksum:=poolchecksum div 10;end; +for ii:=9 downto 1 do write(pool,xchr[48+outbuf[ii]]);writeln(pool); +end{:184};{[186:]begin writeln(output); +write(output,'Memory usage statistics:');end;begin writeln(output); +write(output,nameptr:1,' names, ',textptr:1,' replacement texts;');end; +begin writeln(output);write(output,byteptr[0]:1);end; +for wo:=1 to 2 do write(output,'+',byteptr[wo]:1); +if phaseone then for ii:=0 to 3 do maxtokptr[ii]:=tokptr[ii]; +write(output,' bytes, ',maxtokptr[0]:1); +for ii:=1 to 3 do write(output,'+',maxtokptr[ii]:1); +write(output,' tokens.');[:186];}{187:} +case history of 0:begin writeln(output); +write(output,'(No errors were found.)');end;1:begin writeln(output); +write(output,'(Did you see the warning message above?)');end; +2:begin writeln(output); +write(output,'(Pardon me, but I think I spotted something wrong.)');end; +3:begin writeln(output); +write(output,'(That was a fatal error, my friend.)');end;end{:187}; +writeln(output);if(history<>0)and(history<>1)then exit(1)else exit(0); +end.{:182} diff --git a/systems/knuth/local/web/tangle.p-edited b/systems/knuth/local/web/tangle.p-edited new file mode 100644 index 0000000000..2588255865 --- /dev/null +++ b/systems/knuth/local/web/tangle.p-edited @@ -0,0 +1,816 @@ +{2:}{4:}{:4}program TANGLE(input,output);label 9999; +const{8:}bufsize=100;maxbytes=45000;maxtoks=50000;maxnames=4000; +maxtexts=2000;hashsize=353;longestname=400;linelength=72;outbufsize=144; +stacksize=50;maxidlength=50;unambiglength=7;{:8}type{11:} +ASCIIcode=integer(8);{:11}{12:}textfile=packed file of char;{:12}{37:} +eightbits=0..255;sixteenbits=0..65535;{:37}{39:}namepointer=0..maxnames; +UNIXfilename=packed array[1..60] of char; +{:39}{43:}textpointer=0..maxtexts;{:43}{78:} +outputstate=record endfield:sixteenbits;bytefield:sixteenbits; +namefield:namepointer;replfield:textpointer;modfield:0..12287;end;{:78} +var{9:}history:0..3;{:9}{13:}xord:array[char]of ASCIIcode; +xchr:array[ASCIIcode]of char;{:13}{23:}webfile:textfile; +changefile:textfile;{:23}{25:}Pascalfile:textfile;pool:textfile;{:25} +{27:}buffer:array[0..bufsize]of ASCIIcode;{:27}{29:}phaseone:boolean; +{:29}{38:}bytemem:packed array[0..2,0..maxbytes]of ASCIIcode; +tokmem:packed array[0..3,0..maxtoks]of eightbits; +bytestart:array[0..maxnames]of sixteenbits; +tokstart:array[0..maxtexts]of sixteenbits; +link:array[0..maxnames]of sixteenbits; +ilk:array[0..maxnames]of sixteenbits; +equiv:array[0..maxnames]of sixteenbits; +textlink:array[0..maxtexts]of sixteenbits;{:38}{40:}nameptr:namepointer; +stringptr:namepointer;byteptr:array[0..2]of 0..maxbytes; +poolchecksum:integer;{:40}{44:}textptr:textpointer; +tokptr:array[0..3]of 0..maxtoks;z:0..3; +{maxtokptr:array[0..3]of 0..maxtoks;}{:44}{50:}idfirst:0..bufsize; +idloc:0..bufsize;doublechars:0..bufsize; +hash,chophash:array[0..hashsize]of sixteenbits; +choppedid:array[0..unambiglength]of ASCIIcode;{:50}{65:} +modtext:array[0..longestname]of ASCIIcode;{:65}{70:} +lastunnamed:textpointer;{:70}{79:}curstate:outputstate; +stack:array[1..stacksize]of outputstate;stackptr:0..stacksize;{:79}{80:} +zo:0..3;{:80}{82:}bracelevel:eightbits;{:82}{86:}curval:integer;{:86} +{94:}outbuf:array[0..outbufsize]of ASCIIcode;outptr:0..outbufsize; +breakptr:0..outbufsize;semiptr:0..outbufsize;{:94}{95:} +outstate:eightbits;outval,outapp:integer;outsign:ASCIIcode; +lastsign:-1..+1;{:95}{100:}outcontrib:array[1..linelength]of ASCIIcode; +{:100}{124:}ii:integer;line:integer;otherline:integer;templine:integer; +limit:0..bufsize;loc:0..bufsize;inputhasended:boolean;changing:boolean; +{:124}{126:}changebuffer:array[0..bufsize]of ASCIIcode; +changelimit:0..bufsize;{:126}{143:}curmodule:namepointer; +scanninghex:boolean;{:143}{156:}nextcontrol:eightbits;{:156}{164:} +currepltext:textpointer;{:164}{171:}modulecount:0..12287;{:171}{179:} +{troubleshooting:boolean;ddt:integer;dd:integer;debugcycle:integer; +debugskipped:integer;}{:179}{185:}{wo:0..2;}{:185}{189:} +webname,changename,Pascalname,poolname:UNIXfilename;{:189} +#include "tangext.h" +{30:}{procedure debughelp;forward;}{:30}{31:}procedure error; +var j:0..outbufsize;k,l:0..bufsize;begin if phaseone then{32:} +begin if changing then write(output,'. (change file ')else write(output, +'. (');writeln(output,'l.',line:1,')'); +if loc>=limit then l:=limit else l:=loc; +for k:=1 to l do if buffer[k-1]=9 then write(output,' ')else write( +output,xchr[buffer[k-1]]);writeln(output); +for k:=1 to l do write(output,' '); +for k:=l+1 to limit do write(output,xchr[buffer[k-1]]); +write(output,' ');end{:32}else{33:} +begin writeln(output,'. (l.',line:1,')'); +for j:=1 to outptr do write(output,xchr[outbuf[j-1]]); +write(output,'... ');end{:33};flush(output);history:=2; +{debugskipped:=debugcycle;debughelp;}end;{:31}{34:}procedure jumpout; +begin goto 9999;end;{:34}{190:}procedure scanargs; +var dotpos,i,a:integer;c:char;fname:array[1..55]of char; +foundweb,foundchange:boolean;begin foundweb:=false;foundchange:=false; +for a:=1 to argc-1 do begin argv(a,fname); +if fname[1]<>'-'then begin if not foundweb then{191:}begin dotpos:=-1; +i:=1;while(fname[i]<>' ')and(i<=55)do begin webname[i]:=fname[i]; +if fname[i]='.'then dotpos:=i;i:=i+1;end; +if dotpos=-1 then begin dotpos:=i;webname[dotpos]:='.'; +webname[dotpos+1]:='w';webname[dotpos+2]:='e';webname[dotpos+3]:='b'; +webname[dotpos+4]:=' ';end else webname[i]:=' '; +for i:=1 to dotpos do begin c:=webname[i];Pascalname[i]:=c; +poolname[i]:=c;end;Pascalname[dotpos+1]:='p';Pascalname[dotpos+2]:=' '; +poolname[dotpos+1]:='p';poolname[dotpos+2]:='o';poolname[dotpos+3]:='o'; +poolname[dotpos+4]:='l';poolname[dotpos+5]:=' ';foundweb:=true;end{:191} +else if not foundchange then{192:}begin dotpos:=-1;i:=1; +while(fname[i]<>' ')and(i<=55)do begin changename[i]:=fname[i]; +if fname[i]='.'then dotpos:=i;i:=i+1;end; +if dotpos=-1 then begin dotpos:=i;changename[dotpos]:='.'; +changename[dotpos+1]:='c';changename[dotpos+2]:='h'; +changename[dotpos+3]:=' ';end else changename[i]:=' ';foundchange:=true; +end{:192}else{195:}begin begin writeln(output); +write(output,'! Usage: webfile[.web] [changefile[.ch]]');end;error; +jumpout;end{:195};end else{194:}begin{195:}begin begin writeln(output); +write(output,'! Usage: webfile[.web] [changefile[.ch]]');end;error; +jumpout;end{:195};end{:194};end;if not foundweb then{195:} +begin begin writeln(output); +write(output,'! Usage: webfile[.web] [changefile[.ch]]');end;error; +jumpout;end{:195};if not foundchange then{193:}begin changename[1]:='/'; +changename[2]:='d';changename[3]:='e';changename[4]:='v'; +changename[5]:='/';changename[6]:='n';changename[7]:='u'; +changename[8]:='l';changename[9]:='l';changename[10]:=' ';end{:193};end; +{:190}procedure initialize;var{16:}i:0..255;{:16}{41:}wi:0..2;{:41}{45:} +zi:0..3;{:45}{51:}h:0..hashsize;{:51}begin{10:}history:=0;{:10}{14:} +xchr[32]:=' ';xchr[33]:='!';xchr[34]:='"';xchr[35]:='#';xchr[36]:='$'; +xchr[37]:='%';xchr[38]:='&';xchr[39]:='''';xchr[40]:='(';xchr[41]:=')'; +xchr[42]:='*';xchr[43]:='+';xchr[44]:=',';xchr[45]:='-';xchr[46]:='.'; +xchr[47]:='/';xchr[48]:='0';xchr[49]:='1';xchr[50]:='2';xchr[51]:='3'; +xchr[52]:='4';xchr[53]:='5';xchr[54]:='6';xchr[55]:='7';xchr[56]:='8'; +xchr[57]:='9';xchr[58]:=':';xchr[59]:=';';xchr[60]:='<';xchr[61]:='='; +xchr[62]:='>';xchr[63]:='?';xchr[64]:='@';xchr[65]:='A';xchr[66]:='B'; +xchr[67]:='C';xchr[68]:='D';xchr[69]:='E';xchr[70]:='F';xchr[71]:='G'; +xchr[72]:='H';xchr[73]:='I';xchr[74]:='J';xchr[75]:='K';xchr[76]:='L'; +xchr[77]:='M';xchr[78]:='N';xchr[79]:='O';xchr[80]:='P';xchr[81]:='Q'; +xchr[82]:='R';xchr[83]:='S';xchr[84]:='T';xchr[85]:='U';xchr[86]:='V'; +xchr[87]:='W';xchr[88]:='X';xchr[89]:='Y';xchr[90]:='Z';xchr[91]:='['; +xchr[92]:='\';xchr[93]:=']';xchr[94]:='^';xchr[95]:='_';xchr[96]:='`'; +xchr[97]:='a';xchr[98]:='b';xchr[99]:='c';xchr[100]:='d';xchr[101]:='e'; +xchr[102]:='f';xchr[103]:='g';xchr[104]:='h';xchr[105]:='i'; +xchr[106]:='j';xchr[107]:='k';xchr[108]:='l';xchr[109]:='m'; +xchr[110]:='n';xchr[111]:='o';xchr[112]:='p';xchr[113]:='q'; +xchr[114]:='r';xchr[115]:='s';xchr[116]:='t';xchr[117]:='u'; +xchr[118]:='v';xchr[119]:='w';xchr[120]:='x';xchr[121]:='y'; +xchr[122]:='z';xchr[123]:='{';xchr[124]:='|';xchr[125]:='}'; +xchr[126]:='~';xchr[0]:=' ';xchr[127]:=' ';{:14}{17:} +for i:=1 to 31 do xchr[i]:=chr(i);for i:=128 to 255 do xchr[i]:=chr(i); +{:17}{18:}for i:=0 to 255 do xord[chr(i)]:=32; +for i:=1 to 255 do xord[xchr[i]]:=i;xord[' ']:=32;{:18}{21:}{:21}{26:} +scanargs;rewrite(Pascalfile,Pascalname);rewrite(pool,poolname);{:26} +{42:}for wi:=0 to 2 do begin bytestart[wi]:=0;byteptr[wi]:=0;end; +bytestart[3]:=0;nameptr:=1;stringptr:=256;poolchecksum:=271828;{:42} +{46:}for zi:=0 to 3 do begin tokstart[zi]:=0;tokptr[zi]:=0;end; +tokstart[4]:=0;textptr:=1;z:=1 mod 4;{:46}{48:}ilk[0]:=0;equiv[0]:=0; +{:48}{52:}for h:=0 to hashsize-1 do begin hash[h]:=0;chophash[h]:=0;end; +{:52}{71:}lastunnamed:=0;textlink[0]:=0;{:71}{144:}scanninghex:=false; +{:144}{152:}modtext[0]:=32;{:152}{180:}{troubleshooting:=true; +debugcycle:=1;debugskipped:=0;troubleshooting:=false;debugcycle:=99999;} +{:180}end;{:2}{24:}procedure openinput;begin reset(webfile,webname); +reset(changefile,changename);end;{:24}{28:} +function inputln(var f:textfile):boolean;begin limit:=0; +if testeof(f)then inputln:=false else begin lineread(f); +if limit=bufsize then begin limit:=limit-1;begin writeln(output); +write(output,'! Input line too long');end;loc:=0;error;end; +inputln:=true;end;end;{:28}{49:}procedure printid(p:namepointer); +var k:0..maxbytes;w:0..2; +begin if p>=nameptr then write(output,'IMPOSSIBLE')else begin w:=p mod 3 +; +for k:=bytestart[p]to bytestart[p+3]-1 do write(output,xchr[bytemem[w,k] +]);end;end;{:49}{53:}function idlookup(t:eightbits):namepointer; +label 31,32;var c:eightbits;i:0..bufsize;h:0..hashsize;k:0..maxbytes; +w:0..2;l:0..bufsize;p,q:namepointer;s:0..unambiglength; +begin l:=idloc-idfirst;{54:}h:=buffer[idfirst];i:=idfirst+1; +while i<idloc do begin h:=(h+h+buffer[i])mod hashsize;i:=i+1;end{:54}; +{55:}p:=hash[h]; +while p<>0 do begin if bytestart[p+3]-bytestart[p]=l then{56:} +begin i:=idfirst;k:=bytestart[p];w:=p mod 3; +while(i<idloc)and(buffer[i]=bytemem[w,k])do begin i:=i+1;k:=k+1;end; +if i=idloc then goto 31;end{:56};p:=link[p];end;p:=nameptr; +link[p]:=hash[h];hash[h]:=p;31:{:55};if(p=nameptr)or(t<>0)then{57:} +begin if((p<>nameptr)and(t<>0)and(ilk[p]=0))or((p=nameptr)and(t=0)and( +buffer[idfirst]<>34))then{58:}begin i:=idfirst;s:=0;h:=0; +while(i<idloc)and(s<unambiglength)do begin if buffer[i]<>95 then begin +if buffer[i]>=97 then choppedid[s]:=buffer[i]-32 else choppedid[s]:= +buffer[i];h:=(h+h+choppedid[s])mod hashsize;s:=s+1;end;i:=i+1;end; +choppedid[s]:=0;end{:58};if p<>nameptr then{59:} +begin if ilk[p]=0 then begin if t=1 then begin writeln(output); +write(output,'! This identifier has already appeared');error;end;{60:} +q:=chophash[h]; +if q=p then chophash[h]:=equiv[p]else begin while equiv[q]<>p do q:= +equiv[q];equiv[q]:=equiv[p];end{:60};end else begin writeln(output); +write(output,'! This identifier was defined before');error;end; +ilk[p]:=t;end{:59}else{61:} +begin if(t=0)and(buffer[idfirst]<>34)then{62:}begin q:=chophash[h]; +while q<>0 do begin{63:}begin k:=bytestart[q];s:=0;w:=q mod 3; +while(k<bytestart[q+3])and(s<unambiglength)do begin c:=bytemem[w,k]; +if c<>95 then begin if c>=97 then c:=c-32; +if choppedid[s]<>c then goto 32;s:=s+1;end;k:=k+1;end; +if(k=bytestart[q+3])and(choppedid[s]<>0)then goto 32; +begin writeln(output);write(output,'! Identifier conflict with ');end; +for k:=bytestart[q]to bytestart[q+3]-1 do write(output,xchr[bytemem[w,k] +]);error;q:=0;32:end{:63};q:=equiv[q];end;equiv[p]:=chophash[h]; +chophash[h]:=p;end{:62};w:=nameptr mod 3;k:=byteptr[w]; +if k+l>maxbytes then begin writeln(output); +write(output,'! Sorry, ','byte memory',' capacity exceeded');error; +history:=3;jumpout;end;if nameptr>maxnames-3 then begin writeln(output); +write(output,'! Sorry, ','name',' capacity exceeded');error;history:=3; +jumpout;end;i:=idfirst;while i<idloc do begin bytemem[w,k]:=buffer[i]; +k:=k+1;i:=i+1;end;byteptr[w]:=k;bytestart[nameptr+3]:=k; +nameptr:=nameptr+1;if buffer[idfirst]<>34 then ilk[p]:=t else{64:} +begin ilk[p]:=1; +if l-doublechars=2 then equiv[p]:=buffer[idfirst+1]+32768 else begin +equiv[p]:=stringptr+32768;l:=l-doublechars-1; +if l>99 then begin writeln(output); +write(output,'! Preprocessed string is too long');error;end; +stringptr:=stringptr+1;write(pool,xchr[48+l div 10],xchr[48+l mod 10]); +poolchecksum:=poolchecksum+poolchecksum+l; +while poolchecksum>536870839 do poolchecksum:=poolchecksum-536870839; +i:=idfirst+1;while i<idloc do begin write(pool,xchr[buffer[i]]); +poolchecksum:=poolchecksum+poolchecksum+buffer[i]; +while poolchecksum>536870839 do poolchecksum:=poolchecksum-536870839; +if(buffer[i]=34)or(buffer[i]=64)then i:=i+2 else i:=i+1;end; +writeln(pool);end;end{:64};end{:61};end{:57};idlookup:=p;end;{:53}{66:} +function modlookup(l:sixteenbits):namepointer;label 31;var c:0..4; +j:0..longestname;k:0..maxbytes;w:0..2;p:namepointer;q:namepointer; +begin c:=2;q:=0;p:=ilk[0];while p<>0 do begin{68:}begin k:=bytestart[p]; +w:=p mod 3;c:=1;j:=1; +while(k<bytestart[p+3])and(j<=l)and(modtext[j]=bytemem[w,k])do begin k:= +k+1;j:=j+1;end; +if k=bytestart[p+3]then if j>l then c:=1 else c:=4 else if j>l then c:=3 +else if modtext[j]<bytemem[w,k]then c:=0 else c:=2;end{:68};q:=p; +if c=0 then p:=link[q]else if c=2 then p:=ilk[q]else goto 31;end;{67:} +w:=nameptr mod 3;k:=byteptr[w]; +if k+l>maxbytes then begin writeln(output); +write(output,'! Sorry, ','byte memory',' capacity exceeded');error; +history:=3;jumpout;end;if nameptr>maxnames-3 then begin writeln(output); +write(output,'! Sorry, ','name',' capacity exceeded');error;history:=3; +jumpout;end;p:=nameptr;if c=0 then link[q]:=p else ilk[q]:=p;link[p]:=0; +ilk[p]:=0;c:=1;equiv[p]:=0; +for j:=1 to l do bytemem[w,k+j-1]:=modtext[j];byteptr[w]:=k+l; +bytestart[nameptr+3]:=k+l;nameptr:=nameptr+1;{:67}; +31:if c<>1 then begin begin writeln(output); +write(output,'! Incompatible section names');error;end;p:=0;end; +modlookup:=p;end;{:66}{69:} +function prefixlookup(l:sixteenbits):namepointer;var c:0..4; +count:0..maxnames;j:0..longestname;k:0..maxbytes;w:0..2;p:namepointer; +q:namepointer;r:namepointer;begin q:=0;p:=ilk[0];count:=0;r:=0; +while p<>0 do begin{68:}begin k:=bytestart[p];w:=p mod 3;c:=1;j:=1; +while(k<bytestart[p+3])and(j<=l)and(modtext[j]=bytemem[w,k])do begin k:= +k+1;j:=j+1;end; +if k=bytestart[p+3]then if j>l then c:=1 else c:=4 else if j>l then c:=3 +else if modtext[j]<bytemem[w,k]then c:=0 else c:=2;end{:68}; +if c=0 then p:=link[p]else if c=2 then p:=ilk[p]else begin r:=p; +count:=count+1;q:=ilk[p];p:=link[p];end;if p=0 then begin p:=q;q:=0;end; +end;if count<>1 then if count=0 then begin writeln(output); +write(output,'! Name does not match');error; +end else begin writeln(output);write(output,'! Ambiguous prefix');error; +end;prefixlookup:=r;end;{:69}{73:} +procedure storetwobytes(x:sixteenbits); +begin if tokptr[z]+2>maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=x div 256; +tokmem[z,tokptr[z]+1]:=x mod 256;tokptr[z]:=tokptr[z]+2;end;{:73}{74:} +{procedure printrepl(p:textpointer);var k:0..maxtoks;a:sixteenbits; +zp:0..3; +begin if p>=textptr then write(output,'BAD')else begin k:=tokstart[p]; +zp:=p mod 4;while k<tokstart[p+4]do begin a:=tokmem[zp,k]; +if a>=128 then[75:]begin k:=k+1; +if a<168 then begin a:=(a-128)*256+tokmem[zp,k];printid(a); +if bytemem[a mod 3,bytestart[a]]=34 then write(output,'"')else write( +output,' ');end else if a<208 then begin write(output,'@<'); +printid((a-168)*256+tokmem[zp,k]);write(output,'@>'); +end else begin a:=(a-208)*256+tokmem[zp,k]; +write(output,'@',xchr[123],a:1,'@',xchr[125]);end; +end[:75]else[76:]case a of 9:write(output,'@',xchr[123]); +10:write(output,'@',xchr[125]);12:write(output,'@'''); +13:write(output,'@"');125:write(output,'@$');0:write(output,'#'); +64:write(output,'@@');2:write(output,'@=');3:write(output,'@\'); +otherwise write(output,xchr[a])end[:76];k:=k+1;end;end;end;}{:74}{84:} +procedure pushlevel(p:namepointer); +begin if stackptr=stacksize then begin writeln(output); +write(output,'! Sorry, ','stack',' capacity exceeded');error;history:=3; +jumpout;end else begin stack[stackptr]:=curstate;stackptr:=stackptr+1; +curstate.namefield:=p;curstate.replfield:=equiv[p]; +zo:=curstate.replfield mod 4; +curstate.bytefield:=tokstart[curstate.replfield]; +curstate.endfield:=tokstart[curstate.replfield+4];curstate.modfield:=0; +end;end;{:84}{85:}procedure poplevel;label 10; +begin if textlink[curstate.replfield]=0 then begin if ilk[curstate. +namefield]=3 then{91:}begin nameptr:=nameptr-1;textptr:=textptr-1; +z:=textptr mod 4;{if tokptr[z]>maxtokptr[z]then maxtokptr[z]:=tokptr[z]; +}tokptr[z]:=tokstart[textptr]; +{byteptr[nameptr mod 3]:=byteptr[nameptr mod 3]-1;}end{:91}; +end else if textlink[curstate.replfield]<maxtexts then begin curstate. +replfield:=textlink[curstate.replfield];zo:=curstate.replfield mod 4; +curstate.bytefield:=tokstart[curstate.replfield]; +curstate.endfield:=tokstart[curstate.replfield+4];goto 10;end; +stackptr:=stackptr-1;if stackptr>0 then begin curstate:=stack[stackptr]; +zo:=curstate.replfield mod 4;end;10:end;{:85}{87:} +function getoutput:sixteenbits;label 20,30,31;var a:sixteenbits; +b:eightbits;bal:sixteenbits;k:0..maxbytes;w:0..2; +begin 20:if stackptr=0 then begin a:=0;goto 31;end; +if curstate.bytefield=curstate.endfield then begin curval:=-curstate. +modfield;poplevel;if curval=0 then goto 20;a:=129;goto 31;end; +a:=tokmem[zo,curstate.bytefield]; +curstate.bytefield:=curstate.bytefield+1;if a<128 then if a=0 then{92:} +begin pushlevel(nameptr-1);goto 20;end{:92}else goto 31; +a:=(a-128)*256+tokmem[zo,curstate.bytefield]; +curstate.bytefield:=curstate.bytefield+1;if a<10240 then{89:} +begin case ilk[a]of 0:begin curval:=a;a:=130;end; +1:begin curval:=equiv[a]-32768;a:=128;end;2:begin pushlevel(a);goto 20; +end;3:begin{90:} +while(curstate.bytefield=curstate.endfield)and(stackptr>0)do poplevel; +if(stackptr=0)or(tokmem[zo,curstate.bytefield]<>40)then begin begin +writeln(output);write(output,'! No parameter given for ');end; +printid(a);error;goto 20;end;{93:}bal:=1; +curstate.bytefield:=curstate.bytefield+1; +while true do begin b:=tokmem[zo,curstate.bytefield]; +curstate.bytefield:=curstate.bytefield+1; +if b=0 then storetwobytes(nameptr+32767)else begin if b>=128 then begin +begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1;end; +b:=tokmem[zo,curstate.bytefield]; +curstate.bytefield:=curstate.bytefield+1; +end else case b of 40:bal:=bal+1;41:begin bal:=bal-1; +if bal=0 then goto 30;end; +39:repeat begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1;end; +b:=tokmem[zo,curstate.bytefield]; +curstate.bytefield:=curstate.bytefield+1;until b=39;otherwise end; +begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1;end;end;end; +30:{:93};equiv[nameptr]:=textptr;ilk[nameptr]:=2;w:=nameptr mod 3; +k:=byteptr[w];{if k=maxbytes then begin writeln(output); +write(output,'! Sorry, ','byte memory',' capacity exceeded');error; +history:=3;jumpout;end;bytemem[w,k]:=35;k:=k+1;byteptr[w]:=k;} +if nameptr>maxnames-3 then begin writeln(output); +write(output,'! Sorry, ','name',' capacity exceeded');error;history:=3; +jumpout;end;bytestart[nameptr+3]:=k;nameptr:=nameptr+1; +if textptr>maxtexts-4 then begin writeln(output); +write(output,'! Sorry, ','text',' capacity exceeded');error;history:=3; +jumpout;end;textlink[textptr]:=0;tokstart[textptr+4]:=tokptr[z]; +textptr:=textptr+1;z:=textptr mod 4{:90};pushlevel(a);goto 20;end; +otherwise begin writeln(output); +write(output,'! This can''t happen (','output',')');error;history:=3; +jumpout;end end;goto 31;end{:89};if a<20480 then{88:}begin a:=a-10240; +if equiv[a]<>0 then pushlevel(a)else if a<>0 then begin begin writeln( +output);write(output,'! Not present: <');end;printid(a); +write(output,'>');error;end;goto 20;end{:88};curval:=a-20480;a:=129; +curstate.modfield:=curval;31:{if troubleshooting then debughelp;} +getoutput:=a;end;{:87}{97:}procedure flushbuffer;var k:0..outbufsize; +b:0..outbufsize;begin b:=breakptr; +if(semiptr<>0)and(outptr-semiptr<=linelength)then breakptr:=semiptr; +for k:=1 to break_ptr do write(Pascal_file,xchr[out_buf[k-1]]); +writeln(Pascalfile);line:=line+1; +if line mod 100=0 then begin write(output,'.'); +if line mod 500=0 then write(output,line:1);flush(output);end; +if breakptr<outptr then begin if outbuf[breakptr]=32 then begin breakptr +:=breakptr+1;if breakptr>b then b:=breakptr;end; +for k:=breakptr to outptr-1 do outbuf[k-breakptr]:=outbuf[k];end; +outptr:=outptr-breakptr;breakptr:=b-breakptr;semiptr:=0; +if outptr>linelength then begin begin writeln(output); +write(output,'! Long line must be truncated');error;end; +outptr:=linelength;end;end;{:97}{99:}procedure appval(v:integer); +var k:0..outbufsize;begin k:=outbufsize;repeat outbuf[k]:=v mod 10; +v:=v div 10;k:=k-1;until v=0;repeat k:=k+1; +begin outbuf[outptr]:=outbuf[k]+48;outptr:=outptr+1;end; +until k=outbufsize;end;{:99}{101:}procedure sendout(t:eightbits; +v:sixteenbits);label 20;var k:0..linelength;begin{102:} +20:case outstate of 1:if t<>3 then begin breakptr:=outptr; +if t=2 then begin outbuf[outptr]:=32;outptr:=outptr+1;end;end; +2:begin begin outbuf[outptr]:=44-outapp;outptr:=outptr+1;end; +if outptr>linelength then flushbuffer;breakptr:=outptr;end; +3,4:begin{103:} +if(outval<0)or((outval=0)and(lastsign<0))then begin outbuf[outptr]:=45; +outptr:=outptr+1; +end else if outsign>0 then begin outbuf[outptr]:=outsign; +outptr:=outptr+1;end;appval(abs(outval)); +if outptr>linelength then flushbuffer;{:103};outstate:=outstate-2; +goto 20;end;5:{104:}begin if(t=3)or({105:} +((t=2)and(v=3)and(((outcontrib[1]=68)and(outcontrib[2]=73)and(outcontrib +[3]=86))or((outcontrib[1]=100)and(outcontrib[2]=105)and(outcontrib[3]= +118))or((outcontrib[1]=77)and(outcontrib[2]=79)and(outcontrib[3]=68))or( +(outcontrib[1]=109)and(outcontrib[2]=111)and(outcontrib[3]=100))))or((t= +0)and((v=42)or(v=47))){:105})then begin{103:} +if(outval<0)or((outval=0)and(lastsign<0))then begin outbuf[outptr]:=45; +outptr:=outptr+1; +end else if outsign>0 then begin outbuf[outptr]:=outsign; +outptr:=outptr+1;end;appval(abs(outval)); +if outptr>linelength then flushbuffer;{:103};outsign:=43;outval:=outapp; +end else outval:=outval+outapp;outstate:=3;goto 20;end{:104}; +0:if t<>3 then breakptr:=outptr;otherwise end{:102}; +if t<>0 then for k:=1 to v do begin outbuf[outptr]:=outcontrib[k]; +outptr:=outptr+1;end else begin outbuf[outptr]:=v;outptr:=outptr+1;end; +if outptr>linelength then flushbuffer; +if(t=0)and((v=59)or(v=125))then begin semiptr:=outptr;breakptr:=outptr; +end;if t>=2 then outstate:=1 else outstate:=0 end;{:101}{106:} +procedure sendsign(v:integer); +begin case outstate of 2,4:outapp:=outapp*v;3:begin outapp:=v; +outstate:=4;end;5:begin outval:=outval+outapp;outapp:=v;outstate:=4;end; +otherwise begin breakptr:=outptr;outapp:=v;outstate:=2;end end; +lastsign:=outapp;end;{:106}{107:}procedure sendval(v:integer); +label 666,10;begin case outstate of 1:begin{110:} +if(outptr=breakptr+3)or((outptr=breakptr+4)and(outbuf[breakptr]=32))then +if((outbuf[outptr-3]=68)and(outbuf[outptr-2]=73)and(outbuf[outptr-1]=86) +)or((outbuf[outptr-3]=100)and(outbuf[outptr-2]=105)and(outbuf[outptr-1]= +118))or((outbuf[outptr-3]=77)and(outbuf[outptr-2]=79)and(outbuf[outptr-1 +]=68))or((outbuf[outptr-3]=109)and(outbuf[outptr-2]=111)and(outbuf[ +outptr-1]=100))then goto 666{:110};outsign:=32;outstate:=3;outval:=v; +breakptr:=outptr;lastsign:=+1;end;0:begin{109:} +if(outptr=breakptr+1)and((outbuf[breakptr]=42)or(outbuf[breakptr]=47)) +then goto 666{:109};outsign:=0;outstate:=3;outval:=v;breakptr:=outptr; +lastsign:=+1;end;{108:}2:begin outsign:=43;outstate:=3;outval:=outapp*v; +end;3:begin outstate:=5;outapp:=v;begin writeln(output); +write(output,'! Two numbers occurred without a sign between them'); +error;end;end;4:begin outstate:=5;outapp:=outapp*v;end; +5:begin outval:=outval+outapp;outapp:=v;begin writeln(output); +write(output,'! Two numbers occurred without a sign between them'); +error;end;end;{:108}otherwise goto 666 end;goto 10;666:{111:} +if v>=0 then begin if outstate=1 then begin breakptr:=outptr; +begin outbuf[outptr]:=32;outptr:=outptr+1;end;end;appval(v); +if outptr>linelength then flushbuffer;outstate:=1; +end else begin begin outbuf[outptr]:=40;outptr:=outptr+1;end; +begin outbuf[outptr]:=45;outptr:=outptr+1;end;appval(-v); +begin outbuf[outptr]:=41;outptr:=outptr+1;end; +if outptr>linelength then flushbuffer;outstate:=0;end{:111};10:end; +{:107}{113:}procedure sendtheoutput;label 2,21,22;var curchar:eightbits; +k:0..linelength;j:0..maxbytes;w:0..2;n:integer; +begin while stackptr>0 do begin curchar:=getoutput; +21:case curchar of 0:;{116:} +65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88, +89,90,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113, +114,115,116,117,118,119,120,121,122:begin outcontrib[1]:=curchar; +sendout(2,1);end;130:begin k:=0;j:=bytestart[curval];w:=curval mod 3; +while(k<maxidlength)and(j<bytestart[curval+3])do begin k:=k+1; +outcontrib[k]:=bytemem[w,j];j:=j+1;if outcontrib[k]=95 then k:=k-1;end; +sendout(2,k);end;{:116}{119:}48,49,50,51,52,53,54,55,56,57:begin n:=0; +repeat curchar:=curchar-48;if n>=214748364 then begin writeln(output); +write(output,'! Constant too big');error;end else n:=10*n+curchar; +curchar:=getoutput;until(curchar>57)or(curchar<48);sendval(n);k:=0; +if curchar=101 then curchar:=69;if curchar=69 then goto 2 else goto 21; +end;125:sendval(poolchecksum);12:begin n:=0;curchar:=48; +repeat curchar:=curchar-48;if n>=268435456 then begin writeln(output); +write(output,'! Constant too big');error;end else n:=8*n+curchar; +curchar:=getoutput;until(curchar>55)or(curchar<48);sendval(n);goto 21; +end;13:begin n:=0;curchar:=48; +repeat if curchar>=65 then curchar:=curchar-55 else curchar:=curchar-48; +if n>=134217728 then begin writeln(output); +write(output,'! Constant too big');error;end else n:=16*n+curchar; +curchar:=getoutput; +until(curchar>70)or(curchar<48)or((curchar>57)and(curchar<65)); +sendval(n);goto 21;end;128:sendval(curval);46:begin k:=1; +outcontrib[1]:=46;curchar:=getoutput; +if curchar=46 then begin outcontrib[2]:=46;sendout(1,2); +end else if(curchar>=48)and(curchar<=57)then goto 2 else begin sendout(0 +,46);goto 21;end;end;{:119}43,45:sendsign(44-curchar);{114:} +4:begin outcontrib[1]:=97;outcontrib[2]:=110;outcontrib[3]:=100; +sendout(2,3);end;5:begin outcontrib[1]:=110;outcontrib[2]:=111; +outcontrib[3]:=116;sendout(2,3);end;6:begin outcontrib[1]:=105; +outcontrib[2]:=110;sendout(2,2);end;31:begin outcontrib[1]:=111; +outcontrib[2]:=114;sendout(2,2);end;24:begin outcontrib[1]:=58; +outcontrib[2]:=61;sendout(1,2);end;26:begin outcontrib[1]:=60; +outcontrib[2]:=62;sendout(1,2);end;28:begin outcontrib[1]:=60; +outcontrib[2]:=61;sendout(1,2);end;29:begin outcontrib[1]:=62; +outcontrib[2]:=61;sendout(1,2);end;30:begin outcontrib[1]:=61; +outcontrib[2]:=61;sendout(1,2);end;32:begin outcontrib[1]:=46; +outcontrib[2]:=46;sendout(1,2);end;{:114}39:{117:}begin k:=1; +outcontrib[1]:=39;repeat if k<linelength then k:=k+1; +outcontrib[k]:=getoutput;until(outcontrib[k]=39)or(stackptr=0); +if k=linelength then begin writeln(output); +write(output,'! String too long');error;end;sendout(1,k); +curchar:=getoutput;if curchar=39 then outstate:=6;goto 21;end{:117}; +{115:} +33,34,35,36,37,38,40,41,42,44,47,58,59,60,61,62,63,64,91,92,93,94,95,96, +123,124{:115}:sendout(0,curchar);{121:} +9:begin if bracelevel=0 then sendout(0,123)else sendout(0,91); +bracelevel:=bracelevel+1;end; +10:if bracelevel>0 then begin bracelevel:=bracelevel-1; +if bracelevel=0 then sendout(0,125)else sendout(0,93); +end else begin writeln(output);write(output,'! Extra @}');error;end; +129:begin if bracelevel=0 then sendout(0,123)else sendout(0,91); +if curval<0 then begin sendout(0,58);sendval(-curval); +end else begin sendval(curval);sendout(0,58);end; +if bracelevel=0 then sendout(0,125)else sendout(0,93);end;{:121} +127:begin sendout(3,0);outstate:=6;end;2:{118:}begin k:=0; +repeat if k<linelength then k:=k+1;outcontrib[k]:=getoutput; +until(outcontrib[k]=2)or(stackptr=0); +if k=linelength then begin writeln(output); +write(output,'! Verbatim string too long');error;end;sendout(1,k-1); +end{:118};3:{122:}begin sendout(1,0); +while outptr>0 do begin if outptr<=linelength then breakptr:=outptr; +flushbuffer;end;outstate:=0;end{:122};otherwise begin writeln(output); +write(output,'! Can''t output ASCII code ',curchar:1);error;end end; +goto 22;2:{120:}repeat if k<linelength then k:=k+1; +outcontrib[k]:=curchar;curchar:=getoutput; +if(outcontrib[k]=69)and((curchar=43)or(curchar=45))then begin if k< +linelength then k:=k+1;outcontrib[k]:=curchar;curchar:=getoutput; +end else if curchar=101 then curchar:=69; +until(curchar<>69)and((curchar<48)or(curchar>57)); +if k=linelength then begin writeln(output); +write(output,'! Fraction too long');error;end;sendout(3,k);goto 21{:120} +;22:end;end;{:113}{127:}function linesdontmatch:boolean;label 10; +var k:0..bufsize;begin linesdontmatch:=true; +if changelimit<>limit then goto 10; +if limit>0 then for k:=0 to limit-1 do if changebuffer[k]<>buffer[k]then +goto 10;linesdontmatch:=false;10:end;{:127}{128:} +procedure primethechangebuffer;label 22,30,10;var k:0..bufsize; +begin changelimit:=0;{129:}while true do begin line:=line+1; +if not inputln(changefile)then goto 10;if limit<2 then goto 22; +if buffer[0]<>64 then goto 22; +if(buffer[1]>=88)and(buffer[1]<=90)then buffer[1]:=buffer[1]+32; +if buffer[1]=120 then goto 30; +if(buffer[1]=121)or(buffer[1]=122)then begin loc:=2; +begin writeln(output);write(output,'! Where is the matching @x?');error; +end;end;22:end;30:{:129};{130:}repeat line:=line+1; +if not inputln(changefile)then begin begin writeln(output); +write(output,'! Change file ended after @x');error;end;goto 10;end; +until limit>0;{:130};{131:}begin changelimit:=limit; +if limit>0 then for k:=0 to limit-1 do changebuffer[k]:=buffer[k]; +end{:131};10:end;{:128}{132:}procedure checkchange;label 10; +var n:integer;k:0..bufsize;begin if linesdontmatch then goto 10;n:=0; +while true do begin changing:=not changing;templine:=otherline; +otherline:=line;line:=templine;line:=line+1; +if not inputln(changefile)then begin begin writeln(output); +write(output,'! Change file ended before @y');error;end;changelimit:=0; +changing:=not changing;templine:=otherline;otherline:=line; +line:=templine;goto 10;end;{133:} +if limit>1 then if buffer[0]=64 then begin if(buffer[1]>=88)and(buffer[1 +]<=90)then buffer[1]:=buffer[1]+32; +if(buffer[1]=120)or(buffer[1]=122)then begin loc:=2; +begin writeln(output);write(output,'! Where is the matching @y?');error; +end;end else if buffer[1]=121 then begin if n>0 then begin loc:=2; +begin writeln(output); +write(output,'! Hmm... ',n:1,' of the preceding lines failed to match'); +error;end;end;goto 10;end;end{:133};{131:}begin changelimit:=limit; +if limit>0 then for k:=0 to limit-1 do changebuffer[k]:=buffer[k]; +end{:131};changing:=not changing;templine:=otherline;otherline:=line; +line:=templine;line:=line+1; +if not inputln(webfile)then begin begin writeln(output); +write(output,'! WEB file ended during a change');error;end; +inputhasended:=true;goto 10;end;if linesdontmatch then n:=n+1;end; +10:end;{:132}{135:}procedure getline;label 20; +begin 20:if changing then{137:}begin line:=line+1; +if not inputln(changefile)then begin begin writeln(output); +write(output,'! Change file ended without @z');error;end;buffer[0]:=64; +buffer[1]:=122;limit:=2;end; +if limit>1 then if buffer[0]=64 then begin if(buffer[1]>=88)and(buffer[1 +]<=90)then buffer[1]:=buffer[1]+32; +if(buffer[1]=120)or(buffer[1]=121)then begin loc:=2; +begin writeln(output);write(output,'! Where is the matching @z?');error; +end;end else if buffer[1]=122 then begin primethechangebuffer; +changing:=not changing;templine:=otherline;otherline:=line; +line:=templine;end;end;end{:137};if not changing then begin{136:} +begin line:=line+1; +if not inputln(webfile)then inputhasended:=true else if limit= +changelimit then if buffer[0]=changebuffer[0]then if changelimit>0 then +checkchange;end{:136};if changing then goto 20;end;loc:=0; +buffer[limit]:=32;end;{:135}{139:} +function controlcode(c:ASCIIcode):eightbits; +begin case c of 64:controlcode:=64;39:controlcode:=12; +34:controlcode:=13;36:controlcode:=125;32,9:controlcode:=136; +42:begin write(output,'*',modulecount+1:1);flush(output); +controlcode:=136;end;68,100:controlcode:=133;70,102:controlcode:=132; +123:controlcode:=9;125:controlcode:=10;80,112:controlcode:=134; +84,116,94,46,58:controlcode:=131;38:controlcode:=127; +60:controlcode:=135;61:controlcode:=2;92:controlcode:=3; +otherwise controlcode:=0 end;end;{:139}{140:} +function skipahead:eightbits;label 30;var c:eightbits; +begin while true do begin if loc>limit then begin getline; +if inputhasended then begin c:=136;goto 30;end;end;buffer[limit+1]:=64; +while buffer[loc]<>64 do loc:=loc+1;if loc<=limit then begin loc:=loc+2; +c:=controlcode(buffer[loc-1]);if(c<>0)or(buffer[loc-1]=62)then goto 30; +end;end;30:skipahead:=c;end;{:140}{141:}procedure skipcomment;label 10; +var bal:eightbits;c:ASCIIcode;begin bal:=0; +while true do begin if loc>limit then begin getline; +if inputhasended then begin begin writeln(output); +write(output,'! Input ended in mid-comment');error;end;goto 10;end;end; +c:=buffer[loc];loc:=loc+1;{142:}if c=64 then begin c:=buffer[loc]; +if(c<>32)and(c<>9)and(c<>42)and(c<>122)and(c<>90)then loc:=loc+1 else +begin begin writeln(output); +write(output,'! Section ended in mid-comment');error;end;loc:=loc-1; +goto 10; +end end else if(c=92)and(buffer[loc]<>64)then loc:=loc+1 else if c=123 +then bal:=bal+1 else if c=125 then begin if bal=0 then goto 10; +bal:=bal-1;end{:142};end;10:end;{:141}{145:}function getnext:eightbits; +label 20,30,31;var c:eightbits;d:eightbits;j,k:0..longestname; +begin 20:if loc>limit then begin getline; +if inputhasended then begin c:=136;goto 31;end;end;c:=buffer[loc]; +loc:=loc+1;if scanninghex then{146:} +if((c>=48)and(c<=57))or((c>=65)and(c<=70))then goto 31 else scanninghex +:=false{:146}; +case c of 65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85 +,86,87,88,89,90,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111 +,112,113,114,115,116,117,118,119,120,121,122:{148:} +begin if((c=101)or(c=69))and(loc>1)then if(buffer[loc-2]<=57)and(buffer[ +loc-2]>=48)then c:=0;if c<>0 then begin loc:=loc-1;idfirst:=loc; +repeat loc:=loc+1;d:=buffer[loc]; +until((d<48)or((d>57)and(d<65))or((d>90)and(d<97))or(d>122))and(d<>95); +if loc>idfirst+1 then begin c:=130;idloc:=loc;end;end else c:=69; +end{:148};34:{149:}begin doublechars:=0;idfirst:=loc-1; +repeat d:=buffer[loc];loc:=loc+1; +if(d=34)or(d=64)then if buffer[loc]=d then begin loc:=loc+1;d:=0; +doublechars:=doublechars+1; +end else begin if d=64 then begin writeln(output); +write(output,'! Double @ sign missing');error; +end end else if loc>limit then begin begin writeln(output); +write(output,'! String constant didn''t end');error;end;d:=34;end; +until d=34;idloc:=loc-1;c:=130;end{:149};64:{150:} +begin c:=controlcode(buffer[loc]);loc:=loc+1; +if c=0 then goto 20 else if c=13 then scanninghex:=true else if c=135 +then{151:}begin{153:}k:=0; +while true do begin if loc>limit then begin getline; +if inputhasended then begin begin writeln(output); +write(output,'! Input ended in section name');error;end;goto 30;end;end; +d:=buffer[loc];{154:}if d=64 then begin d:=buffer[loc+1]; +if d=62 then begin loc:=loc+2;goto 30;end; +if(d=32)or(d=9)or(d=42)then begin begin writeln(output); +write(output,'! Section name didn''t end');error;end;goto 30;end;k:=k+1; +modtext[k]:=64;loc:=loc+1;end{:154};loc:=loc+1; +if k<longestname-1 then k:=k+1;if(d=32)or(d=9)then begin d:=32; +if modtext[k-1]=32 then k:=k-1;end;modtext[k]:=d;end;30:{155:} +if k>=longestname-2 then begin begin writeln(output); +write(output,'! Section name too long: ');end; +for j:=1 to 25 do write(output,xchr[modtext[j]]);write(output,'...'); +if history=0 then history:=1;end{:155}; +if(modtext[k]=32)and(k>0)then k:=k-1;{:153}; +if k>3 then begin if(modtext[k]=46)and(modtext[k-1]=46)and(modtext[k-2]= +46)then curmodule:=prefixlookup(k-3)else curmodule:=modlookup(k); +end else curmodule:=modlookup(k);end{:151} +else if c=131 then begin repeat c:=skipahead;until c<>64; +if buffer[loc-1]<>62 then begin writeln(output); +write(output,'! Improper @ within control text');error;end;goto 20;end; +end{:150};{147:} +46:if buffer[loc]=46 then begin if loc<=limit then begin c:=32; +loc:=loc+1;end; +end else if buffer[loc]=41 then begin if loc<=limit then begin c:=93; +loc:=loc+1;end;end; +58:if buffer[loc]=61 then begin if loc<=limit then begin c:=24; +loc:=loc+1;end;end; +61:if buffer[loc]=61 then begin if loc<=limit then begin c:=30; +loc:=loc+1;end;end; +62:if buffer[loc]=61 then begin if loc<=limit then begin c:=29; +loc:=loc+1;end;end; +60:if buffer[loc]=61 then begin if loc<=limit then begin c:=28; +loc:=loc+1;end; +end else if buffer[loc]=62 then begin if loc<=limit then begin c:=26; +loc:=loc+1;end;end; +40:if buffer[loc]=42 then begin if loc<=limit then begin c:=9; +loc:=loc+1;end; +end else if buffer[loc]=46 then begin if loc<=limit then begin c:=91; +loc:=loc+1;end;end; +42:if buffer[loc]=41 then begin if loc<=limit then begin c:=10; +loc:=loc+1;end;end;{:147}32,9:goto 20;123:begin skipcomment;goto 20;end; +125:begin begin writeln(output);write(output,'! Extra }');error;end; +goto 20;end;otherwise if c>=128 then goto 20 else end; +31:{if troubleshooting then debughelp;}getnext:=c;end;{:145}{157:} +procedure scannumeric(p:namepointer);label 21,30; +var accumulator:integer;nextsign:-1..+1;q:namepointer;val:integer; +begin{158:}accumulator:=0;nextsign:=+1; +while true do begin nextcontrol:=getnext; +21:case nextcontrol of 48,49,50,51,52,53,54,55,56,57:begin{160:}val:=0; +repeat val:=10*val+nextcontrol-48;nextcontrol:=getnext; +until(nextcontrol>57)or(nextcontrol<48){:160}; +begin accumulator:=accumulator+nextsign*(val);nextsign:=+1;end;goto 21; +end;12:begin{161:}val:=0;nextcontrol:=48; +repeat val:=8*val+nextcontrol-48;nextcontrol:=getnext; +until(nextcontrol>55)or(nextcontrol<48){:161}; +begin accumulator:=accumulator+nextsign*(val);nextsign:=+1;end;goto 21; +end;13:begin{162:}val:=0;nextcontrol:=48; +repeat if nextcontrol>=65 then nextcontrol:=nextcontrol-7; +val:=16*val+nextcontrol-48;nextcontrol:=getnext; +until(nextcontrol>70)or(nextcontrol<48)or((nextcontrol>57)and( +nextcontrol<65)){:162};begin accumulator:=accumulator+nextsign*(val); +nextsign:=+1;end;goto 21;end;130:begin q:=idlookup(0); +if ilk[q]<>1 then begin nextcontrol:=42;goto 21;end; +begin accumulator:=accumulator+nextsign*(equiv[q]-32768);nextsign:=+1; +end;end;43:;45:nextsign:=-nextsign;132,133,135,134,136:goto 30; +59:begin writeln(output); +write(output,'! Omit semicolon in numeric definition');error;end; +otherwise{159:}begin begin writeln(output); +write(output,'! Improper numeric definition will be flushed');error;end; +repeat nextcontrol:=skipahead until(nextcontrol>=132); +if nextcontrol=135 then begin loc:=loc-2;nextcontrol:=getnext;end; +accumulator:=0;goto 30;end{:159}end;end;30:{:158}; +if abs(accumulator)>=32768 then begin begin writeln(output); +write(output,'! Value too big: ',accumulator:1);error;end; +accumulator:=0;end;equiv[p]:=accumulator+32768;end;{:157}{165:} +procedure scanrepl(t:eightbits);label 22,30,31,21;var a:sixteenbits; +b:ASCIIcode;bal:eightbits;begin bal:=0; +while true do begin 22:a:=getnext;case a of 40:bal:=bal+1; +41:if bal=0 then begin writeln(output);write(output,'! Extra )');error; +end else bal:=bal-1;39:{168:}begin b:=39; +while true do begin begin if tokptr[z]=maxtoks then begin writeln(output +);write(output,'! Sorry, ','token',' capacity exceeded');error; +history:=3;jumpout;end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1; +end; +if b=64 then if buffer[loc]=64 then loc:=loc+1 else begin writeln(output +);write(output,'! You should double @ signs in strings');error;end; +if loc=limit then begin begin writeln(output); +write(output,'! String didn''t end');error;end;buffer[loc]:=39; +buffer[loc+1]:=0;end;b:=buffer[loc];loc:=loc+1; +if b=39 then begin if buffer[loc]<>39 then goto 31 else begin loc:=loc+1 +;begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=39;tokptr[z]:=tokptr[z]+1;end;end;end; +end;31:end{:168};35:if t=3 then a:=0;{167:}130:begin a:=idlookup(0); +begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=(a div 256)+128;tokptr[z]:=tokptr[z]+1; +end;a:=a mod 256;end; +135:if t<>135 then goto 30 else begin begin if tokptr[z]=maxtoks then +begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=(curmodule div 256)+168; +tokptr[z]:=tokptr[z]+1;end;a:=curmodule mod 256;end;2:{169:} +begin begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=2;tokptr[z]:=tokptr[z]+1;end; +buffer[limit+1]:=64; +21:if buffer[loc]=64 then begin if loc<limit then if buffer[loc+1]=64 +then begin begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=64;tokptr[z]:=tokptr[z]+1;end; +loc:=loc+2;goto 21;end; +end else begin begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=buffer[loc];tokptr[z]:=tokptr[z]+1;end; +loc:=loc+1;goto 21;end;if loc>=limit then begin writeln(output); +write(output,'! Verbatim string didn''t end');error; +end else if buffer[loc+1]<>62 then begin writeln(output); +write(output,'! You should double @ signs in verbatim strings');error; +end;loc:=loc+2;end{:169}; +133,132,134:if t<>135 then goto 30 else begin begin writeln(output); +write(output,'! @',xchr[buffer[loc-1]],' is ignored in Pascal text'); +error;end;goto 22;end;136:goto 30;{:167}otherwise end; +begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=a;tokptr[z]:=tokptr[z]+1;end;end; +30:nextcontrol:=a;{166:} +if bal>0 then begin if bal=1 then begin writeln(output); +write(output,'! Missing )');error;end else begin writeln(output); +write(output,'! Missing ',bal:1,' )''s');error;end; +while bal>0 do begin begin if tokptr[z]=maxtoks then begin writeln( +output);write(output,'! Sorry, ','token',' capacity exceeded');error; +history:=3;jumpout;end;tokmem[z,tokptr[z]]:=41;tokptr[z]:=tokptr[z]+1; +end;bal:=bal-1;end;end{:166}; +if textptr>maxtexts-4 then begin writeln(output); +write(output,'! Sorry, ','text',' capacity exceeded');error;history:=3; +jumpout;end;currepltext:=textptr;tokstart[textptr+4]:=tokptr[z]; +textptr:=textptr+1;if z=3 then z:=0 else z:=z+1;end;{:165}{170:} +procedure definemacro(t:eightbits);var p:namepointer; +begin p:=idlookup(t);scanrepl(t);equiv[p]:=currepltext; +textlink[currepltext]:=0;end;{:170}{172:}procedure scanmodule; +label 22,30,10;var p:namepointer;begin modulecount:=modulecount+1;{173:} +nextcontrol:=0; +while true do begin 22:while nextcontrol<=132 do begin nextcontrol:= +skipahead;if nextcontrol=135 then begin loc:=loc-2;nextcontrol:=getnext; +end;end;if nextcontrol<>133 then goto 30;nextcontrol:=getnext; +if nextcontrol<>130 then begin begin writeln(output); +write(output,'! Definition flushed, must start with ', +'identifier of length > 1');error;end;goto 22;end;nextcontrol:=getnext; +if nextcontrol=61 then begin scannumeric(idlookup(1));goto 22; +end else if nextcontrol=30 then begin definemacro(2);goto 22; +end else{174:}if nextcontrol=40 then begin nextcontrol:=getnext; +if nextcontrol=35 then begin nextcontrol:=getnext; +if nextcontrol=41 then begin nextcontrol:=getnext; +if nextcontrol=61 then begin begin writeln(output); +write(output,'! Use == for macros');error;end;nextcontrol:=30;end; +if nextcontrol=30 then begin definemacro(3);goto 22;end;end;end;end; +{:174};begin writeln(output); +write(output,'! Definition flushed since it starts badly');error;end; +end;30:{:173};{175:}case nextcontrol of 134:p:=0;135:begin p:=curmodule; +{176:}repeat nextcontrol:=getnext;until nextcontrol<>43; +if(nextcontrol<>61)and(nextcontrol<>30)then begin begin writeln(output); +write(output,'! Pascal text flushed, = sign is missing');error;end; +repeat nextcontrol:=skipahead;until nextcontrol=136;goto 10;end{:176}; +end;otherwise goto 10 end;{177:}storetwobytes(53248+modulecount);{:177}; +scanrepl(135);{178:} +if p=0 then begin textlink[lastunnamed]:=currepltext; +lastunnamed:=currepltext; +end else if equiv[p]=0 then equiv[p]:=currepltext else begin p:=equiv[p] +;while textlink[p]<maxtexts do p:=textlink[p];textlink[p]:=currepltext; +end;textlink[currepltext]:=maxtexts;{:178};{:175};10:end;{:172}{181:} +{procedure debughelp;label 888,10;var k:integer; +begin debugskipped:=debugskipped+1; +if debugskipped<debugcycle then goto 10;debugskipped:=0; +while true do begin write(output,'#');flush(output);read(input,ddt); +if ddt<0 then goto 10 else if ddt=0 then begin goto 888; +888:ddt:=0; +end else begin read(input,dd);case ddt of 1:printid(dd);2:printrepl(dd); +3:for k:=1 to dd do write(output,xchr[buffer[k]]); +4:for k:=1 to dd do write(output,xchr[modtext[k]]); +5:for k:=1 to outptr do write(output,xchr[outbuf[k]]); +6:for k:=1 to dd do write(output,xchr[outcontrib[k]]); +otherwise write(output,'?')end;end;end;10:end;}{:181}{182:} +begin initialize;{134:}openinput;line:=0;otherline:=0;changing:=true; +primethechangebuffer;changing:=not changing;templine:=otherline; +otherline:=line;line:=templine;limit:=0;loc:=1;buffer[0]:=32; +inputhasended:=false;{:134}; +writeln(output,'This is TANGLE, Version 4.4 for SunOS');{183:} +phaseone:=true;modulecount:=0;repeat nextcontrol:=skipahead; +until nextcontrol=136;while not inputhasended do scanmodule;{138:} +if changelimit<>0 then begin for ii:=0 to changelimit do buffer[ii]:= +changebuffer[ii];limit:=changelimit;changing:=true;line:=otherline; +loc:=changelimit;begin writeln(output); +write(output,'! Change file entry did not match');error;end;end{:138}; +phaseone:=false;{:183};{for ii:=0 to 3 do maxtokptr[ii]:=tokptr[ii];} +{112:}if textlink[0]=0 then begin begin writeln(output); +write(output,'! No output was specified.');end; +if history=0 then history:=1;end else begin begin writeln(output); +write(output,'Writing the output file');end;flush(output);{83:} +stackptr:=1;bracelevel:=0;curstate.namefield:=0; +curstate.replfield:=textlink[0];zo:=curstate.replfield mod 4; +curstate.bytefield:=tokstart[curstate.replfield]; +curstate.endfield:=tokstart[curstate.replfield+4];curstate.modfield:=0; +{:83};{96:}outstate:=0;outptr:=0;breakptr:=0;semiptr:=0;outbuf[0]:=0; +line:=1;{:96};sendtheoutput;{98:}breakptr:=outptr;semiptr:=0; +flushbuffer;if bracelevel<>0 then begin writeln(output); +write(output,'! Program ended at brace level ',bracelevel:1);error;end; +{:98};begin writeln(output);write(output,'Done.');end;end{:112}; +9999:if stringptr>256 then{184:}begin begin writeln(output); +write(output,stringptr-256:1,' strings written to string pool file.'); +end;write(pool,'*'); +for ii:=1 to 9 do begin outbuf[ii]:=poolchecksum mod 10; +poolchecksum:=poolchecksum div 10;end; +for ii:=9 downto 1 do write(pool,xchr[48+outbuf[ii]]);writeln(pool); +end{:184};{[186:]begin writeln(output); +write(output,'Memory usage statistics:');end;begin writeln(output); +write(output,nameptr:1,' names, ',textptr:1,' replacement texts;');end; +begin writeln(output);write(output,byteptr[0]:1);end; +for wo:=1 to 2 do write(output,'+',byteptr[wo]:1); +if phaseone then for ii:=0 to 3 do maxtokptr[ii]:=tokptr[ii]; +write(output,' bytes, ',maxtokptr[0]:1); +for ii:=1 to 3 do write(output,'+',maxtokptr[ii]:1); +write(output,' tokens.');[:186];}{187:} +case history of 0:begin writeln(output); +write(output,'(No errors were found.)');end;1:begin writeln(output); +write(output,'(Did you see the warning message above?)');end; +2:begin writeln(output); +write(output,'(Pardon me, but I think I spotted something wrong.)');end; +3:begin writeln(output); +write(output,'(That was a fatal error, my friend.)');end;end{:187}; +writeln(output);if(history<>0)and(history<>1)then exit(1)else exit(0); +end.{:182} diff --git a/systems/knuth/local/web/tangle.p1 b/systems/knuth/local/web/tangle.p1 new file mode 100644 index 0000000000..0eeee9ce50 --- /dev/null +++ b/systems/knuth/local/web/tangle.p1 @@ -0,0 +1,814 @@ +{2:}{4:}{:4}program TANGLE(input,output);label 9999;const{8:} +bufsize=100;maxbytes=45000;maxtoks=50000;maxnames=4000;maxtexts=2000; +hashsize=353;longestname=400;linelength=72;outbufsize=144;stacksize=50; +maxidlength=50;unambiglength=7;{:8}type{11:}ASCIIcode=integer(8);{:11} +{37:}eightbits=0..255;sixteenbits=0..65535;{:37}{39:} +namepointer=0..maxnames;{:39}{43:}textpointer=0..maxtexts;{:43}{78:} +outputstate=record endfield:sixteenbits;bytefield:sixteenbits; +namefield:namepointer;replfield:textpointer;modfield:0..12287;end;{:78} +{190:}UNIXfilename=packed array[1..60]of char;{:190}var{9:}history:0..3; +{:9}{13:}xord:array[char]of ASCIIcode;xchr:array[ASCIIcode]of char;{:13} +{23:}webfile:text;changefile:text;{:23}{25:}Pascalfile:text;pool:text; +{:25}{27:}buffer:array[0..bufsize]of ASCIIcode;{:27}{29:} +phaseone:boolean;{:29}{38:} +bytemem:packed array[0..2,0..maxbytes]of ASCIIcode; +tokmem:packed array[0..3,0..maxtoks]of eightbits; +bytestart:array[0..maxnames]of sixteenbits; +tokstart:array[0..maxtexts]of sixteenbits; +link:array[0..maxnames]of sixteenbits; +ilk:array[0..maxnames]of sixteenbits; +equiv:array[0..maxnames]of sixteenbits; +textlink:array[0..maxtexts]of sixteenbits;{:38}{40:}nameptr:namepointer; +stringptr:namepointer;byteptr:array[0..2]of 0..maxbytes; +poolchecksum:integer;{:40}{44:}textptr:textpointer; +tokptr:array[0..3]of 0..maxtoks;z:0..3; +{maxtokptr:array[0..3]of 0..maxtoks;}{:44}{50:}idfirst:0..bufsize; +idloc:0..bufsize;doublechars:0..bufsize; +hash,chophash:array[0..hashsize]of sixteenbits; +choppedid:array[0..unambiglength]of ASCIIcode;{:50}{65:} +modtext:array[0..longestname]of ASCIIcode;{:65}{70:} +lastunnamed:textpointer;{:70}{79:}curstate:outputstate; +stack:array[1..stacksize]of outputstate;stackptr:0..stacksize;{:79}{80:} +zo:0..3;{:80}{82:}bracelevel:eightbits;{:82}{86:}curval:integer;{:86} +{94:}outbuf:array[0..outbufsize]of ASCIIcode;outptr:0..outbufsize; +breakptr:0..outbufsize;semiptr:0..outbufsize;{:94}{95:} +outstate:eightbits;outval,outapp:integer;outsign:ASCIIcode; +lastsign:-1..+1;{:95}{100:}outcontrib:array[1..linelength]of ASCIIcode; +{:100}{124:}ii:integer;line:integer;otherline:integer;templine:integer; +limit:0..bufsize;loc:0..bufsize;inputhasended:boolean;changing:boolean; +{:124}{126:}changebuffer:array[0..bufsize]of ASCIIcode; +changelimit:0..bufsize;{:126}{143:}curmodule:namepointer; +scanninghex:boolean;{:143}{156:}nextcontrol:eightbits;{:156}{164:} +currepltext:textpointer;{:164}{171:}modulecount:0..12287;{:171}{179:} +{troubleshooting:boolean;ddt:integer;dd:integer;debugcycle:integer; +debugskipped:integer;}{:179}{185:}{wo:0..2;}{:185}{189:} +webname,changename,Pascalname,poolname:UNIXfilename;{:189} +#include "tangext.h" +{30:}{procedure debughelp;forward;}{:30}{31:}procedure error; +var j:0..outbufsize;k,l:0..bufsize;begin if phaseone then{32:} +begin if changing then write(output,'. (change file ')else write(output, +'. (');writeln(output,'l.',line:1,')'); +if loc>=limit then l:=limit else l:=loc; +for k:=1 to l do if buffer[k-1]=9 then write(output,' ')else write( +output,xchr[buffer[k-1]]);writeln(output); +for k:=1 to l do write(output,' '); +for k:=l+1 to limit do write(output,xchr[buffer[k-1]]); +write(output,' ');end{:32}else{33:} +begin writeln(output,'. (l.',line:1,')'); +for j:=1 to outptr do write(output,xchr[outbuf[j-1]]); +write(output,'... ');end{:33};flush(output);history:=2; +{debugskipped:=debugcycle;debughelp;}end;{:31}{34:}procedure jumpout; +begin goto 9999;end;{:34}{191:}procedure scanargs; +var dotpos,i,a:integer;c:char;fname:UNIXfilename; +foundweb,foundchange:boolean;begin foundweb:=false;foundchange:=false; +for a:=1 to argc-1 do begin argv(a,fname); +if fname[1]<>'-'then begin if not foundweb then{192:}begin dotpos:=-1; +i:=1;while(fname[i]<>' ')and(i<=55)do begin webname[i]:=fname[i]; +if fname[i]='.'then dotpos:=i;i:=i+1;end; +if dotpos=-1 then begin dotpos:=i;webname[dotpos]:='.'; +webname[dotpos+1]:='w';webname[dotpos+2]:='e';webname[dotpos+3]:='b'; +webname[dotpos+4]:=' ';end else webname[i]:=' '; +for i:=1 to dotpos do begin c:=webname[i];Pascalname[i]:=c; +poolname[i]:=c;end;Pascalname[dotpos+1]:='p';Pascalname[dotpos+2]:=' '; +poolname[dotpos+1]:='p';poolname[dotpos+2]:='o';poolname[dotpos+3]:='o'; +poolname[dotpos+4]:='l';poolname[dotpos+5]:=' ';foundweb:=true;end{:192} +else if not foundchange then{193:}begin dotpos:=-1;i:=1; +while(fname[i]<>' ')and(i<=55)do begin changename[i]:=fname[i]; +if fname[i]='.'then dotpos:=i;i:=i+1;end; +if dotpos=-1 then begin dotpos:=i;changename[dotpos]:='.'; +changename[dotpos+1]:='c';changename[dotpos+2]:='h'; +changename[dotpos+3]:=' ';end else changename[i]:=' ';foundchange:=true; +end{:193}else{196:}begin begin writeln(output); +write(output,'! Usage: webfile[.web] [changefile[.ch]]');end;error; +jumpout;end{:196};end else{195:}begin{196:}begin begin writeln(output); +write(output,'! Usage: webfile[.web] [changefile[.ch]]');end;error; +jumpout;end{:196};end{:195};end;if not foundweb then{196:} +begin begin writeln(output); +write(output,'! Usage: webfile[.web] [changefile[.ch]]');end;error; +jumpout;end{:196};if not foundchange then{194:}begin changename[1]:='/'; +changename[2]:='d';changename[3]:='e';changename[4]:='v'; +changename[5]:='/';changename[6]:='n';changename[7]:='u'; +changename[8]:='l';changename[9]:='l';changename[10]:=' ';end{:194};end; +{:191}procedure initialize;var{16:}i:0..255;{:16}{41:}wi:0..2;{:41}{45:} +zi:0..3;{:45}{51:}h:0..hashsize;{:51}begin{10:}history:=0;{:10}{14:} +xchr[32]:=' ';xchr[33]:='!';xchr[34]:='"';xchr[35]:='#';xchr[36]:='$'; +xchr[37]:='%';xchr[38]:='&';xchr[39]:='''';xchr[40]:='(';xchr[41]:=')'; +xchr[42]:='*';xchr[43]:='+';xchr[44]:=',';xchr[45]:='-';xchr[46]:='.'; +xchr[47]:='/';xchr[48]:='0';xchr[49]:='1';xchr[50]:='2';xchr[51]:='3'; +xchr[52]:='4';xchr[53]:='5';xchr[54]:='6';xchr[55]:='7';xchr[56]:='8'; +xchr[57]:='9';xchr[58]:=':';xchr[59]:=';';xchr[60]:='<';xchr[61]:='='; +xchr[62]:='>';xchr[63]:='?';xchr[64]:='@';xchr[65]:='A';xchr[66]:='B'; +xchr[67]:='C';xchr[68]:='D';xchr[69]:='E';xchr[70]:='F';xchr[71]:='G'; +xchr[72]:='H';xchr[73]:='I';xchr[74]:='J';xchr[75]:='K';xchr[76]:='L'; +xchr[77]:='M';xchr[78]:='N';xchr[79]:='O';xchr[80]:='P';xchr[81]:='Q'; +xchr[82]:='R';xchr[83]:='S';xchr[84]:='T';xchr[85]:='U';xchr[86]:='V'; +xchr[87]:='W';xchr[88]:='X';xchr[89]:='Y';xchr[90]:='Z';xchr[91]:='['; +xchr[92]:='\';xchr[93]:=']';xchr[94]:='^';xchr[95]:='_';xchr[96]:='`'; +xchr[97]:='a';xchr[98]:='b';xchr[99]:='c';xchr[100]:='d';xchr[101]:='e'; +xchr[102]:='f';xchr[103]:='g';xchr[104]:='h';xchr[105]:='i'; +xchr[106]:='j';xchr[107]:='k';xchr[108]:='l';xchr[109]:='m'; +xchr[110]:='n';xchr[111]:='o';xchr[112]:='p';xchr[113]:='q'; +xchr[114]:='r';xchr[115]:='s';xchr[116]:='t';xchr[117]:='u'; +xchr[118]:='v';xchr[119]:='w';xchr[120]:='x';xchr[121]:='y'; +xchr[122]:='z';xchr[123]:='{';xchr[124]:='|';xchr[125]:='}'; +xchr[126]:='~';xchr[0]:=' ';xchr[127]:=' ';{:14}{17:} +for i:=1 to 31 do xchr[i]:=chr(i);for i:=128 to 255 do xchr[i]:=chr(i); +{:17}{18:}for i:=0 to 255 do xord[chr(i)]:=32; +for i:=1 to 255 do xord[xchr[i]]:=i;xord[' ']:=32;{:18}{21:}{:21}{26:} +scanargs;rewrite(Pascalfile,Pascalname);rewrite(pool,poolname);{:26} +{42:}for wi:=0 to 2 do begin bytestart[wi]:=0;byteptr[wi]:=0;end; +bytestart[3]:=0;nameptr:=1;stringptr:=256;poolchecksum:=271828;{:42} +{46:}for zi:=0 to 3 do begin tokstart[zi]:=0;tokptr[zi]:=0;end; +tokstart[4]:=0;textptr:=1;z:=1 mod 4;{:46}{48:}ilk[0]:=0;equiv[0]:=0; +{:48}{52:}for h:=0 to hashsize-1 do begin hash[h]:=0;chophash[h]:=0;end; +{:52}{71:}lastunnamed:=0;textlink[0]:=0;{:71}{144:}scanninghex:=false; +{:144}{152:}modtext[0]:=32;{:152}{180:}{troubleshooting:=true; +debugcycle:=1;debugskipped:=0;troubleshooting:=false;debugcycle:=99999;} +{:180}end;{:2}{24:}procedure openinput;begin reset(webfile,webname); +reset(changefile,changename);end;{:24}{28:} +function inputln(var f:text):boolean;begin limit:=0; +if testeof(f)then inputln:=false else begin lineread(f); +if limit=bufsize then begin limit:=limit-1;begin writeln(output); +write(output,'! Input line too long');end;loc:=0;error;end; +inputln:=true;end;end;{:28}{49:}procedure printid(p:namepointer); +var k:0..maxbytes;w:0..2; +begin if p>=nameptr then write(output,'IMPOSSIBLE')else begin w:=p mod 3 +; +for k:=bytestart[p]to bytestart[p+3]-1 do write(output,xchr[bytemem[w,k] +]);end;end;{:49}{53:}function idlookup(t:eightbits):namepointer; +label 31,32;var c:eightbits;i:0..bufsize;h:0..hashsize;k:0..maxbytes; +w:0..2;l:0..bufsize;p,q:namepointer;s:0..unambiglength; +begin l:=idloc-idfirst;{54:}h:=buffer[idfirst];i:=idfirst+1; +while i<idloc do begin h:=(h+h+buffer[i])mod hashsize;i:=i+1;end{:54}; +{55:}p:=hash[h]; +while p<>0 do begin if bytestart[p+3]-bytestart[p]=l then{56:} +begin i:=idfirst;k:=bytestart[p];w:=p mod 3; +while(i<idloc)and(buffer[i]=bytemem[w,k])do begin i:=i+1;k:=k+1;end; +if i=idloc then goto 31;end{:56};p:=link[p];end;p:=nameptr; +link[p]:=hash[h];hash[h]:=p;31:{:55};if(p=nameptr)or(t<>0)then{57:} +begin if((p<>nameptr)and(t<>0)and(ilk[p]=0))or((p=nameptr)and(t=0)and( +buffer[idfirst]<>34))then{58:}begin i:=idfirst;s:=0;h:=0; +while(i<idloc)and(s<unambiglength)do begin if buffer[i]<>95 then begin +if buffer[i]>=97 then choppedid[s]:=buffer[i]-32 else choppedid[s]:= +buffer[i];h:=(h+h+choppedid[s])mod hashsize;s:=s+1;end;i:=i+1;end; +choppedid[s]:=0;end{:58};if p<>nameptr then{59:} +begin if ilk[p]=0 then begin if t=1 then begin writeln(output); +write(output,'! This identifier has already appeared');error;end;{60:} +q:=chophash[h]; +if q=p then chophash[h]:=equiv[p]else begin while equiv[q]<>p do q:= +equiv[q];equiv[q]:=equiv[p];end{:60};end else begin writeln(output); +write(output,'! This identifier was defined before');error;end; +ilk[p]:=t;end{:59}else{61:} +begin if(t=0)and(buffer[idfirst]<>34)then{62:}begin q:=chophash[h]; +while q<>0 do begin{63:}begin k:=bytestart[q];s:=0;w:=q mod 3; +while(k<bytestart[q+3])and(s<unambiglength)do begin c:=bytemem[w,k]; +if c<>95 then begin if c>=97 then c:=c-32; +if choppedid[s]<>c then goto 32;s:=s+1;end;k:=k+1;end; +if(k=bytestart[q+3])and(choppedid[s]<>0)then goto 32; +begin writeln(output);write(output,'! Identifier conflict with ');end; +for k:=bytestart[q]to bytestart[q+3]-1 do write(output,xchr[bytemem[w,k] +]);error;q:=0;32:end{:63};q:=equiv[q];end;equiv[p]:=chophash[h]; +chophash[h]:=p;end{:62};w:=nameptr mod 3;k:=byteptr[w]; +if k+l>maxbytes then begin writeln(output); +write(output,'! Sorry, ','byte memory',' capacity exceeded');error; +history:=3;jumpout;end;if nameptr>maxnames-3 then begin writeln(output); +write(output,'! Sorry, ','name',' capacity exceeded');error;history:=3; +jumpout;end;i:=idfirst;while i<idloc do begin bytemem[w,k]:=buffer[i]; +k:=k+1;i:=i+1;end;byteptr[w]:=k;bytestart[nameptr+3]:=k; +nameptr:=nameptr+1;if buffer[idfirst]<>34 then ilk[p]:=t else{64:} +begin ilk[p]:=1; +if l-doublechars=2 then equiv[p]:=buffer[idfirst+1]+32768 else begin +equiv[p]:=stringptr+32768;l:=l-doublechars-1; +if l>99 then begin writeln(output); +write(output,'! Preprocessed string is too long');error;end; +stringptr:=stringptr+1;write(pool,xchr[48+l div 10],xchr[48+l mod 10]); +poolchecksum:=poolchecksum+poolchecksum+l; +while poolchecksum>536870839 do poolchecksum:=poolchecksum-536870839; +i:=idfirst+1;while i<idloc do begin write(pool,xchr[buffer[i]]); +poolchecksum:=poolchecksum+poolchecksum+buffer[i]; +while poolchecksum>536870839 do poolchecksum:=poolchecksum-536870839; +if(buffer[i]=34)or(buffer[i]=64)then i:=i+2 else i:=i+1;end; +writeln(pool);end;end{:64};end{:61};end{:57};idlookup:=p;end;{:53}{66:} +function modlookup(l:sixteenbits):namepointer;label 31;var c:0..4; +j:0..longestname;k:0..maxbytes;w:0..2;p:namepointer;q:namepointer; +begin c:=2;q:=0;p:=ilk[0];while p<>0 do begin{68:}begin k:=bytestart[p]; +w:=p mod 3;c:=1;j:=1; +while(k<bytestart[p+3])and(j<=l)and(modtext[j]=bytemem[w,k])do begin k:= +k+1;j:=j+1;end; +if k=bytestart[p+3]then if j>l then c:=1 else c:=4 else if j>l then c:=3 +else if modtext[j]<bytemem[w,k]then c:=0 else c:=2;end{:68};q:=p; +if c=0 then p:=link[q]else if c=2 then p:=ilk[q]else goto 31;end;{67:} +w:=nameptr mod 3;k:=byteptr[w]; +if k+l>maxbytes then begin writeln(output); +write(output,'! Sorry, ','byte memory',' capacity exceeded');error; +history:=3;jumpout;end;if nameptr>maxnames-3 then begin writeln(output); +write(output,'! Sorry, ','name',' capacity exceeded');error;history:=3; +jumpout;end;p:=nameptr;if c=0 then link[q]:=p else ilk[q]:=p;link[p]:=0; +ilk[p]:=0;c:=1;equiv[p]:=0; +for j:=1 to l do bytemem[w,k+j-1]:=modtext[j];byteptr[w]:=k+l; +bytestart[nameptr+3]:=k+l;nameptr:=nameptr+1;{:67}; +31:if c<>1 then begin begin writeln(output); +write(output,'! Incompatible section names');error;end;p:=0;end; +modlookup:=p;end;{:66}{69:} +function prefixlookup(l:sixteenbits):namepointer;var c:0..4; +count:0..maxnames;j:0..longestname;k:0..maxbytes;w:0..2;p:namepointer; +q:namepointer;r:namepointer;begin q:=0;p:=ilk[0];count:=0;r:=0; +while p<>0 do begin{68:}begin k:=bytestart[p];w:=p mod 3;c:=1;j:=1; +while(k<bytestart[p+3])and(j<=l)and(modtext[j]=bytemem[w,k])do begin k:= +k+1;j:=j+1;end; +if k=bytestart[p+3]then if j>l then c:=1 else c:=4 else if j>l then c:=3 +else if modtext[j]<bytemem[w,k]then c:=0 else c:=2;end{:68}; +if c=0 then p:=link[p]else if c=2 then p:=ilk[p]else begin r:=p; +count:=count+1;q:=ilk[p];p:=link[p];end;if p=0 then begin p:=q;q:=0;end; +end;if count<>1 then if count=0 then begin writeln(output); +write(output,'! Name does not match');error; +end else begin writeln(output);write(output,'! Ambiguous prefix');error; +end;prefixlookup:=r;end;{:69}{73:} +procedure storetwobytes(x:sixteenbits); +begin if tokptr[z]+2>maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=x div 256; +tokmem[z,tokptr[z]+1]:=x mod 256;tokptr[z]:=tokptr[z]+2;end;{:73}{74:} +{procedure printrepl(p:textpointer);var k:0..maxtoks;a:sixteenbits; +zp:0..3; +begin if p>=textptr then write(output,'BAD')else begin k:=tokstart[p]; +zp:=p mod 4;while k<tokstart[p+4]do begin a:=tokmem[zp,k]; +if a>=128 then[75:]begin k:=k+1; +if a<168 then begin a:=(a-128)*256+tokmem[zp,k];printid(a); +if bytemem[a mod 3,bytestart[a]]=34 then write(output,'"')else write( +output,' ');end else if a<208 then begin write(output,'@<'); +printid((a-168)*256+tokmem[zp,k]);write(output,'@>'); +end else begin a:=(a-208)*256+tokmem[zp,k]; +write(output,'@',xchr[123],a:1,'@',xchr[125]);end; +end[:75]else[76:]case a of 9:write(output,'@',xchr[123]); +10:write(output,'@',xchr[125]);12:write(output,'@'''); +13:write(output,'@"');125:write(output,'@$');0:write(output,'#'); +64:write(output,'@@');2:write(output,'@=');3:write(output,'@\'); +otherwise write(output,xchr[a])end[:76];k:=k+1;end;end;end;}{:74}{84:} +procedure pushlevel(p:namepointer); +begin if stackptr=stacksize then begin writeln(output); +write(output,'! Sorry, ','stack',' capacity exceeded');error;history:=3; +jumpout;end else begin stack[stackptr]:=curstate;stackptr:=stackptr+1; +curstate.namefield:=p;curstate.replfield:=equiv[p]; +zo:=curstate.replfield mod 4; +curstate.bytefield:=tokstart[curstate.replfield]; +curstate.endfield:=tokstart[curstate.replfield+4];curstate.modfield:=0; +end;end;{:84}{85:}procedure poplevel;label 10; +begin if textlink[curstate.replfield]=0 then begin if ilk[curstate. +namefield]=3 then{91:}begin nameptr:=nameptr-1;textptr:=textptr-1; +z:=textptr mod 4;{if tokptr[z]>maxtokptr[z]then maxtokptr[z]:=tokptr[z]; +}tokptr[z]:=tokstart[textptr]; +{byteptr[nameptr mod 3]:=byteptr[nameptr mod 3]-1;}end{:91}; +end else if textlink[curstate.replfield]<maxtexts then begin curstate. +replfield:=textlink[curstate.replfield];zo:=curstate.replfield mod 4; +curstate.bytefield:=tokstart[curstate.replfield]; +curstate.endfield:=tokstart[curstate.replfield+4];goto 10;end; +stackptr:=stackptr-1;if stackptr>0 then begin curstate:=stack[stackptr]; +zo:=curstate.replfield mod 4;end;10:end;{:85}{87:} +function getoutput:sixteenbits;label 20,30,31;var a:sixteenbits; +b:eightbits;bal:sixteenbits;k:0..maxbytes;w:0..2; +begin 20:if stackptr=0 then begin a:=0;goto 31;end; +if curstate.bytefield=curstate.endfield then begin curval:=-curstate. +modfield;poplevel;if curval=0 then goto 20;a:=129;goto 31;end; +a:=tokmem[zo,curstate.bytefield]; +curstate.bytefield:=curstate.bytefield+1;if a<128 then if a=0 then{92:} +begin pushlevel(nameptr-1);goto 20;end{:92}else goto 31; +a:=(a-128)*256+tokmem[zo,curstate.bytefield]; +curstate.bytefield:=curstate.bytefield+1;if a<10240 then{89:} +begin case ilk[a]of 0:begin curval:=a;a:=130;end; +1:begin curval:=equiv[a]-32768;a:=128;end;2:begin pushlevel(a);goto 20; +end;3:begin{90:} +while(curstate.bytefield=curstate.endfield)and(stackptr>0)do poplevel; +if(stackptr=0)or(tokmem[zo,curstate.bytefield]<>40)then begin begin +writeln(output);write(output,'! No parameter given for ');end; +printid(a);error;goto 20;end;{93:}bal:=1; +curstate.bytefield:=curstate.bytefield+1; +while true do begin b:=tokmem[zo,curstate.bytefield]; +curstate.bytefield:=curstate.bytefield+1; +if b=0 then storetwobytes(nameptr+32767)else begin if b>=128 then begin +begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1;end; +b:=tokmem[zo,curstate.bytefield]; +curstate.bytefield:=curstate.bytefield+1; +end else case b of 40:bal:=bal+1;41:begin bal:=bal-1; +if bal=0 then goto 30;end; +39:repeat begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1;end; +b:=tokmem[zo,curstate.bytefield]; +curstate.bytefield:=curstate.bytefield+1;until b=39;otherwise end; +begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1;end;end;end; +30:{:93};equiv[nameptr]:=textptr;ilk[nameptr]:=2;w:=nameptr mod 3; +k:=byteptr[w]; +if nameptr>maxnames-3 then begin writeln(output); +write(output,'! Sorry, ','name',' capacity exceeded');error;history:=3; +jumpout;end;bytestart[nameptr+3]:=k;nameptr:=nameptr+1; +if textptr>maxtexts-4 then begin writeln(output); +write(output,'! Sorry, ','text',' capacity exceeded');error;history:=3; +jumpout;end;textlink[textptr]:=0;tokstart[textptr+4]:=tokptr[z]; +textptr:=textptr+1;z:=textptr mod 4{:90}; +pushlevel(a);goto 20;end; +otherwise begin writeln(output); +write(output,'! This can''t happen (','output',')');error;history:=3; +jumpout;end end;goto 31;end{:89};if a<20480 then{88:}begin a:=a-10240; +if equiv[a]<>0 then pushlevel(a)else if a<>0 then begin begin writeln( +output);write(output,'! Not present: <');end;printid(a); +write(output,'>');error;end;goto 20;end{:88};curval:=a-20480;a:=129; +curstate.modfield:=curval;31:{if troubleshooting then debughelp;} +getoutput:=a;end;{:87}{97:}procedure flushbuffer;var k:0..outbufsize; +b:0..outbufsize;begin b:=breakptr; +if(semiptr<>0)and(outptr-semiptr<=linelength)then breakptr:=semiptr; +for k:=1 to breakptr do write(Pascalfile,xchr[outbuf[k-1]]); +writeln(Pascalfile);line:=line+1; +if line mod 100=0 then begin write(output,'.'); +if line mod 500=0 then write(output,line:1);flush(output);end; +if breakptr<outptr then begin if outbuf[breakptr]=32 then begin breakptr +:=breakptr+1;if breakptr>b then b:=breakptr;end; +for k:=breakptr to outptr-1 do outbuf[k-breakptr]:=outbuf[k];end; +outptr:=outptr-breakptr;breakptr:=b-breakptr;semiptr:=0; +if outptr>linelength then begin begin writeln(output); +write(output,'! Long line must be truncated');error;end; +outptr:=linelength;end;end;{:97}{99:}procedure appval(v:integer); +var k:0..outbufsize;begin k:=outbufsize;repeat outbuf[k]:=v mod 10; +v:=v div 10;k:=k-1;until v=0;repeat k:=k+1; +begin outbuf[outptr]:=outbuf[k]+48;outptr:=outptr+1;end; +until k=outbufsize;end;{:99}{101:}procedure sendout(t:eightbits; +v:sixteenbits);label 20;var k:0..linelength;begin{102:} +20:case outstate of 1:if t<>3 then begin breakptr:=outptr; +if t=2 then begin outbuf[outptr]:=32;outptr:=outptr+1;end;end; +2:begin begin outbuf[outptr]:=44-outapp;outptr:=outptr+1;end; +if outptr>linelength then flushbuffer;breakptr:=outptr;end; +3,4:begin{103:} +if(outval<0)or((outval=0)and(lastsign<0))then begin outbuf[outptr]:=45; +outptr:=outptr+1; +end else if outsign>0 then begin outbuf[outptr]:=outsign; +outptr:=outptr+1;end;appval(abs(outval)); +if outptr>linelength then flushbuffer;{:103};outstate:=outstate-2; +goto 20;end;5:{104:}begin if(t=3)or({105:} +((t=2)and(v=3)and(((outcontrib[1]=68)and(outcontrib[2]=73)and(outcontrib +[3]=86))or((outcontrib[1]=100)and(outcontrib[2]=105)and(outcontrib[3]= +118))or((outcontrib[1]=77)and(outcontrib[2]=79)and(outcontrib[3]=68))or( +(outcontrib[1]=109)and(outcontrib[2]=111)and(outcontrib[3]=100))))or((t= +0)and((v=42)or(v=47))){:105})then begin{103:} +if(outval<0)or((outval=0)and(lastsign<0))then begin outbuf[outptr]:=45; +outptr:=outptr+1; +end else if outsign>0 then begin outbuf[outptr]:=outsign; +outptr:=outptr+1;end;appval(abs(outval)); +if outptr>linelength then flushbuffer;{:103};outsign:=43;outval:=outapp; +end else outval:=outval+outapp;outstate:=3;goto 20;end{:104}; +0:if t<>3 then breakptr:=outptr;otherwise end{:102}; +if t<>0 then for k:=1 to v do begin outbuf[outptr]:=outcontrib[k]; +outptr:=outptr+1;end else begin outbuf[outptr]:=v;outptr:=outptr+1;end; +if outptr>linelength then flushbuffer; +if(t=0)and((v=59)or(v=125))then begin semiptr:=outptr;breakptr:=outptr; +end;if t>=2 then outstate:=1 else outstate:=0 end;{:101}{106:} +procedure sendsign(v:integer); +begin case outstate of 2,4:outapp:=outapp*v;3:begin outapp:=v; +outstate:=4;end;5:begin outval:=outval+outapp;outapp:=v;outstate:=4;end; +otherwise begin breakptr:=outptr;outapp:=v;outstate:=2;end end; +lastsign:=outapp;end;{:106}{107:}procedure sendval(v:integer); +label 666,10;begin case outstate of 1:begin{110:} +if(outptr=breakptr+3)or((outptr=breakptr+4)and(outbuf[breakptr]=32))then +if((outbuf[outptr-3]=68)and(outbuf[outptr-2]=73)and(outbuf[outptr-1]=86) +)or((outbuf[outptr-3]=100)and(outbuf[outptr-2]=105)and(outbuf[outptr-1]= +118))or((outbuf[outptr-3]=77)and(outbuf[outptr-2]=79)and(outbuf[outptr-1 +]=68))or((outbuf[outptr-3]=109)and(outbuf[outptr-2]=111)and(outbuf[ +outptr-1]=100))then goto 666{:110};outsign:=32;outstate:=3;outval:=v; +breakptr:=outptr;lastsign:=+1;end;0:begin{109:} +if(outptr=breakptr+1)and((outbuf[breakptr]=42)or(outbuf[breakptr]=47)) +then goto 666{:109};outsign:=0;outstate:=3;outval:=v;breakptr:=outptr; +lastsign:=+1;end;{108:}2:begin outsign:=43;outstate:=3;outval:=outapp*v; +end;3:begin outstate:=5;outapp:=v;begin writeln(output); +write(output,'! Two numbers occurred without a sign between them'); +error;end;end;4:begin outstate:=5;outapp:=outapp*v;end; +5:begin outval:=outval+outapp;outapp:=v;begin writeln(output); +write(output,'! Two numbers occurred without a sign between them'); +error;end;end;{:108}otherwise goto 666 end;goto 10;666:{111:} +if v>=0 then begin if outstate=1 then begin breakptr:=outptr; +begin outbuf[outptr]:=32;outptr:=outptr+1;end;end;appval(v); +if outptr>linelength then flushbuffer;outstate:=1; +end else begin begin outbuf[outptr]:=40;outptr:=outptr+1;end; +begin outbuf[outptr]:=45;outptr:=outptr+1;end;appval(-v); +begin outbuf[outptr]:=41;outptr:=outptr+1;end; +if outptr>linelength then flushbuffer;outstate:=0;end{:111};10:end; +{:107}{113:}procedure sendtheoutput;label 2,21,22;var curchar:eightbits; +k:0..linelength;j:0..maxbytes;w:0..2;n:integer; +begin while stackptr>0 do begin curchar:=getoutput; +21:case curchar of 0:;{116:} +65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88, +89,90,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111,112,113, +114,115,116,117,118,119,120,121,122:begin outcontrib[1]:=curchar; +sendout(2,1);end;130:begin k:=0;j:=bytestart[curval];w:=curval mod 3; +while(k<maxidlength)and(j<bytestart[curval+3])do begin k:=k+1; +outcontrib[k]:=bytemem[w,j];j:=j+1;if outcontrib[k]=95 then k:=k-1;end; +sendout(2,k);end;{:116}{119:}48,49,50,51,52,53,54,55,56,57:begin n:=0; +repeat curchar:=curchar-48;if n>=214748364 then begin writeln(output); +write(output,'! Constant too big');error;end else n:=10*n+curchar; +curchar:=getoutput;until(curchar>57)or(curchar<48);sendval(n);k:=0; +if curchar=101 then curchar:=69;if curchar=69 then goto 2 else goto 21; +end;125:sendval(poolchecksum);12:begin n:=0;curchar:=48; +repeat curchar:=curchar-48;if n>=268435456 then begin writeln(output); +write(output,'! Constant too big');error;end else n:=8*n+curchar; +curchar:=getoutput;until(curchar>55)or(curchar<48);sendval(n);goto 21; +end;13:begin n:=0;curchar:=48; +repeat if curchar>=65 then curchar:=curchar-55 else curchar:=curchar-48; +if n>=134217728 then begin writeln(output); +write(output,'! Constant too big');error;end else n:=16*n+curchar; +curchar:=getoutput; +until(curchar>70)or(curchar<48)or((curchar>57)and(curchar<65)); +sendval(n);goto 21;end;128:sendval(curval);46:begin k:=1; +outcontrib[1]:=46;curchar:=getoutput; +if curchar=46 then begin outcontrib[2]:=46;sendout(1,2); +end else if(curchar>=48)and(curchar<=57)then goto 2 else begin sendout(0 +,46);goto 21;end;end;{:119}43,45:sendsign(44-curchar);{114:} +4:begin outcontrib[1]:=97;outcontrib[2]:=110;outcontrib[3]:=100; +sendout(2,3);end;5:begin outcontrib[1]:=110;outcontrib[2]:=111; +outcontrib[3]:=116;sendout(2,3);end;6:begin outcontrib[1]:=105; +outcontrib[2]:=110;sendout(2,2);end;31:begin outcontrib[1]:=111; +outcontrib[2]:=114;sendout(2,2);end;24:begin outcontrib[1]:=58; +outcontrib[2]:=61;sendout(1,2);end;26:begin outcontrib[1]:=60; +outcontrib[2]:=62;sendout(1,2);end;28:begin outcontrib[1]:=60; +outcontrib[2]:=61;sendout(1,2);end;29:begin outcontrib[1]:=62; +outcontrib[2]:=61;sendout(1,2);end;30:begin outcontrib[1]:=61; +outcontrib[2]:=61;sendout(1,2);end;32:begin outcontrib[1]:=46; +outcontrib[2]:=46;sendout(1,2);end;{:114}39:{117:}begin k:=1; +outcontrib[1]:=39;repeat if k<linelength then k:=k+1; +outcontrib[k]:=getoutput;until(outcontrib[k]=39)or(stackptr=0); +if k=linelength then begin writeln(output); +write(output,'! String too long');error;end;sendout(1,k); +curchar:=getoutput;if curchar=39 then outstate:=6;goto 21;end{:117}; +{115:} +33,34,35,36,37,38,40,41,42,44,47,58,59,60,61,62,63,64,91,92,93,94,95,96, +123,124{:115}:sendout(0,curchar);{121:} +9:begin if bracelevel=0 then sendout(0,123)else sendout(0,91); +bracelevel:=bracelevel+1;end; +10:if bracelevel>0 then begin bracelevel:=bracelevel-1; +if bracelevel=0 then sendout(0,125)else sendout(0,93); +end else begin writeln(output);write(output,'! Extra @}');error;end; +129:begin if bracelevel=0 then sendout(0,123)else sendout(0,91); +if curval<0 then begin sendout(0,58);sendval(-curval); +end else begin sendval(curval);sendout(0,58);end; +if bracelevel=0 then sendout(0,125)else sendout(0,93);end;{:121} +127:begin sendout(3,0);outstate:=6;end;2:{118:}begin k:=0; +repeat if k<linelength then k:=k+1;outcontrib[k]:=getoutput; +until(outcontrib[k]=2)or(stackptr=0); +if k=linelength then begin writeln(output); +write(output,'! Verbatim string too long');error;end;sendout(1,k-1); +end{:118};3:{122:}begin sendout(1,0); +while outptr>0 do begin if outptr<=linelength then breakptr:=outptr; +flushbuffer;end;outstate:=0;end{:122};otherwise begin writeln(output); +write(output,'! Can''t output ASCII code ',curchar:1);error;end end; +goto 22;2:{120:}repeat if k<linelength then k:=k+1; +outcontrib[k]:=curchar;curchar:=getoutput; +if(outcontrib[k]=69)and((curchar=43)or(curchar=45))then begin if k< +linelength then k:=k+1;outcontrib[k]:=curchar;curchar:=getoutput; +end else if curchar=101 then curchar:=69; +until(curchar<>69)and((curchar<48)or(curchar>57)); +if k=linelength then begin writeln(output); +write(output,'! Fraction too long');error;end;sendout(3,k);goto 21{:120} +;22:end;end;{:113}{127:}function linesdontmatch:boolean;label 10; +var k:0..bufsize;begin linesdontmatch:=true; +if changelimit<>limit then goto 10; +if limit>0 then for k:=0 to limit-1 do if changebuffer[k]<>buffer[k]then +goto 10;linesdontmatch:=false;10:end;{:127}{128:} +procedure primethechangebuffer;label 22,30,10;var k:0..bufsize; +begin changelimit:=0;{129:}while true do begin line:=line+1; +if not inputln(changefile)then goto 10;if limit<2 then goto 22; +if buffer[0]<>64 then goto 22; +if(buffer[1]>=88)and(buffer[1]<=90)then buffer[1]:=buffer[1]+32; +if buffer[1]=120 then goto 30; +if(buffer[1]=121)or(buffer[1]=122)then begin loc:=2; +begin writeln(output);write(output,'! Where is the matching @x?');error; +end;end;22:end;30:{:129};{130:}repeat line:=line+1; +if not inputln(changefile)then begin begin writeln(output); +write(output,'! Change file ended after @x');error;end;goto 10;end; +until limit>0;{:130};{131:}begin changelimit:=limit; +if limit>0 then for k:=0 to limit-1 do changebuffer[k]:=buffer[k]; +end{:131};10:end;{:128}{132:}procedure checkchange;label 10; +var n:integer;k:0..bufsize;begin if linesdontmatch then goto 10;n:=0; +while true do begin changing:=not changing;templine:=otherline; +otherline:=line;line:=templine;line:=line+1; +if not inputln(changefile)then begin begin writeln(output); +write(output,'! Change file ended before @y');error;end;changelimit:=0; +changing:=not changing;templine:=otherline;otherline:=line; +line:=templine;goto 10;end;{133:} +if limit>1 then if buffer[0]=64 then begin if(buffer[1]>=88)and(buffer[1 +]<=90)then buffer[1]:=buffer[1]+32; +if(buffer[1]=120)or(buffer[1]=122)then begin loc:=2; +begin writeln(output);write(output,'! Where is the matching @y?');error; +end;end else if buffer[1]=121 then begin if n>0 then begin loc:=2; +begin writeln(output); +write(output,'! Hmm... ',n:1,' of the preceding lines failed to match'); +error;end;end;goto 10;end;end{:133};{131:}begin changelimit:=limit; +if limit>0 then for k:=0 to limit-1 do changebuffer[k]:=buffer[k]; +end{:131};changing:=not changing;templine:=otherline;otherline:=line; +line:=templine;line:=line+1; +if not inputln(webfile)then begin begin writeln(output); +write(output,'! WEB file ended during a change');error;end; +inputhasended:=true;goto 10;end;if linesdontmatch then n:=n+1;end; +10:end;{:132}{135:}procedure getline;label 20; +begin 20:if changing then{137:}begin line:=line+1; +if not inputln(changefile)then begin begin writeln(output); +write(output,'! Change file ended without @z');error;end;buffer[0]:=64; +buffer[1]:=122;limit:=2;end; +if limit>1 then if buffer[0]=64 then begin if(buffer[1]>=88)and(buffer[1 +]<=90)then buffer[1]:=buffer[1]+32; +if(buffer[1]=120)or(buffer[1]=121)then begin loc:=2; +begin writeln(output);write(output,'! Where is the matching @z?');error; +end;end else if buffer[1]=122 then begin primethechangebuffer; +changing:=not changing;templine:=otherline;otherline:=line; +line:=templine;end;end;end{:137};if not changing then begin{136:} +begin line:=line+1; +if not inputln(webfile)then inputhasended:=true else if limit= +changelimit then if buffer[0]=changebuffer[0]then if changelimit>0 then +checkchange;end{:136};if changing then goto 20;end;loc:=0; +buffer[limit]:=32;end;{:135}{139:} +function controlcode(c:ASCIIcode):eightbits; +begin case c of 64:controlcode:=64;39:controlcode:=12; +34:controlcode:=13;36:controlcode:=125;32,9:controlcode:=136; +42:begin write(output,'*',modulecount+1:1);flush(output); +controlcode:=136;end;68,100:controlcode:=133;70,102:controlcode:=132; +123:controlcode:=9;125:controlcode:=10;80,112:controlcode:=134; +84,116,94,46,58:controlcode:=131;38:controlcode:=127; +60:controlcode:=135;61:controlcode:=2;92:controlcode:=3; +otherwise controlcode:=0 end;end;{:139}{140:} +function skipahead:eightbits;label 30;var c:eightbits; +begin while true do begin if loc>limit then begin getline; +if inputhasended then begin c:=136;goto 30;end;end;buffer[limit+1]:=64; +while buffer[loc]<>64 do loc:=loc+1;if loc<=limit then begin loc:=loc+2; +c:=controlcode(buffer[loc-1]);if(c<>0)or(buffer[loc-1]=62)then goto 30; +end;end;30:skipahead:=c;end;{:140}{141:}procedure skipcomment;label 10; +var bal:eightbits;c:ASCIIcode;begin bal:=0; +while true do begin if loc>limit then begin getline; +if inputhasended then begin begin writeln(output); +write(output,'! Input ended in mid-comment');error;end;goto 10;end;end; +c:=buffer[loc];loc:=loc+1;{142:}if c=64 then begin c:=buffer[loc]; +if(c<>32)and(c<>9)and(c<>42)and(c<>122)and(c<>90)then loc:=loc+1 else +begin begin writeln(output); +write(output,'! Section ended in mid-comment');error;end;loc:=loc-1; +goto 10; +end end else if(c=92)and(buffer[loc]<>64)then loc:=loc+1 else if c=123 +then bal:=bal+1 else if c=125 then begin if bal=0 then goto 10; +bal:=bal-1;end{:142};end;10:end;{:141}{145:}function getnext:eightbits; +label 20,30,31;var c:eightbits;d:eightbits;j,k:0..longestname; +begin 20:if loc>limit then begin getline; +if inputhasended then begin c:=136;goto 31;end;end;c:=buffer[loc]; +loc:=loc+1;if scanninghex then{146:} +if((c>=48)and(c<=57))or((c>=65)and(c<=70))then goto 31 else scanninghex +:=false{:146}; +case c of 65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85 +,86,87,88,89,90,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111 +,112,113,114,115,116,117,118,119,120,121,122:{148:} +begin if((c=101)or(c=69))and(loc>1)then if(buffer[loc-2]<=57)and(buffer[ +loc-2]>=48)then c:=0;if c<>0 then begin loc:=loc-1;idfirst:=loc; +repeat loc:=loc+1;d:=buffer[loc]; +until((d<48)or((d>57)and(d<65))or((d>90)and(d<97))or(d>122))and(d<>95); +if loc>idfirst+1 then begin c:=130;idloc:=loc;end;end else c:=69; +end{:148};34:{149:}begin doublechars:=0;idfirst:=loc-1; +repeat d:=buffer[loc];loc:=loc+1; +if(d=34)or(d=64)then if buffer[loc]=d then begin loc:=loc+1;d:=0; +doublechars:=doublechars+1; +end else begin if d=64 then begin writeln(output); +write(output,'! Double @ sign missing');error; +end end else if loc>limit then begin begin writeln(output); +write(output,'! String constant didn''t end');error;end;d:=34;end; +until d=34;idloc:=loc-1;c:=130;end{:149};64:{150:} +begin c:=controlcode(buffer[loc]);loc:=loc+1; +if c=0 then goto 20 else if c=13 then scanninghex:=true else if c=135 +then{151:}begin{153:}k:=0; +while true do begin if loc>limit then begin getline; +if inputhasended then begin begin writeln(output); +write(output,'! Input ended in section name');error;end;goto 30;end;end; +d:=buffer[loc];{154:}if d=64 then begin d:=buffer[loc+1]; +if d=62 then begin loc:=loc+2;goto 30;end; +if(d=32)or(d=9)or(d=42)then begin begin writeln(output); +write(output,'! Section name didn''t end');error;end;goto 30;end;k:=k+1; +modtext[k]:=64;loc:=loc+1;end{:154};loc:=loc+1; +if k<longestname-1 then k:=k+1;if(d=32)or(d=9)then begin d:=32; +if modtext[k-1]=32 then k:=k-1;end;modtext[k]:=d;end;30:{155:} +if k>=longestname-2 then begin begin writeln(output); +write(output,'! Section name too long: ');end; +for j:=1 to 25 do write(output,xchr[modtext[j]]);write(output,'...'); +if history=0 then history:=1;end{:155}; +if(modtext[k]=32)and(k>0)then k:=k-1;{:153}; +if k>3 then begin if(modtext[k]=46)and(modtext[k-1]=46)and(modtext[k-2]= +46)then curmodule:=prefixlookup(k-3)else curmodule:=modlookup(k); +end else curmodule:=modlookup(k);end{:151} +else if c=131 then begin repeat c:=skipahead;until c<>64; +if buffer[loc-1]<>62 then begin writeln(output); +write(output,'! Improper @ within control text');error;end;goto 20;end; +end{:150};{147:} +46:if buffer[loc]=46 then begin if loc<=limit then begin c:=32; +loc:=loc+1;end; +end else if buffer[loc]=41 then begin if loc<=limit then begin c:=93; +loc:=loc+1;end;end; +58:if buffer[loc]=61 then begin if loc<=limit then begin c:=24; +loc:=loc+1;end;end; +61:if buffer[loc]=61 then begin if loc<=limit then begin c:=30; +loc:=loc+1;end;end; +62:if buffer[loc]=61 then begin if loc<=limit then begin c:=29; +loc:=loc+1;end;end; +60:if buffer[loc]=61 then begin if loc<=limit then begin c:=28; +loc:=loc+1;end; +end else if buffer[loc]=62 then begin if loc<=limit then begin c:=26; +loc:=loc+1;end;end; +40:if buffer[loc]=42 then begin if loc<=limit then begin c:=9; +loc:=loc+1;end; +end else if buffer[loc]=46 then begin if loc<=limit then begin c:=91; +loc:=loc+1;end;end; +42:if buffer[loc]=41 then begin if loc<=limit then begin c:=10; +loc:=loc+1;end;end;{:147}32,9:goto 20;123:begin skipcomment;goto 20;end; +125:begin begin writeln(output);write(output,'! Extra }');error;end; +goto 20;end;otherwise if c>=128 then goto 20 else end; +31:{if troubleshooting then debughelp;}getnext:=c;end;{:145}{157:} +procedure scannumeric(p:namepointer);label 21,30; +var accumulator:integer;nextsign:-1..+1;q:namepointer;val:integer; +begin{158:}accumulator:=0;nextsign:=+1; +while true do begin nextcontrol:=getnext; +21:case nextcontrol of 48,49,50,51,52,53,54,55,56,57:begin{160:}val:=0; +repeat val:=10*val+nextcontrol-48;nextcontrol:=getnext; +until(nextcontrol>57)or(nextcontrol<48){:160}; +begin accumulator:=accumulator+nextsign*(val);nextsign:=+1;end;goto 21; +end;12:begin{161:}val:=0;nextcontrol:=48; +repeat val:=8*val+nextcontrol-48;nextcontrol:=getnext; +until(nextcontrol>55)or(nextcontrol<48){:161}; +begin accumulator:=accumulator+nextsign*(val);nextsign:=+1;end;goto 21; +end;13:begin{162:}val:=0;nextcontrol:=48; +repeat if nextcontrol>=65 then nextcontrol:=nextcontrol-7; +val:=16*val+nextcontrol-48;nextcontrol:=getnext; +until(nextcontrol>70)or(nextcontrol<48)or((nextcontrol>57)and( +nextcontrol<65)){:162};begin accumulator:=accumulator+nextsign*(val); +nextsign:=+1;end;goto 21;end;130:begin q:=idlookup(0); +if ilk[q]<>1 then begin nextcontrol:=42;goto 21;end; +begin accumulator:=accumulator+nextsign*(equiv[q]-32768);nextsign:=+1; +end;end;43:;45:nextsign:=-nextsign;132,133,135,134,136:goto 30; +59:begin writeln(output); +write(output,'! Omit semicolon in numeric definition');error;end; +otherwise{159:}begin begin writeln(output); +write(output,'! Improper numeric definition will be flushed');error;end; +repeat nextcontrol:=skipahead until(nextcontrol>=132); +if nextcontrol=135 then begin loc:=loc-2;nextcontrol:=getnext;end; +accumulator:=0;goto 30;end{:159}end;end;30:{:158}; +if abs(accumulator)>=32768 then begin begin writeln(output); +write(output,'! Value too big: ',accumulator:1);error;end; +accumulator:=0;end;equiv[p]:=accumulator+32768;end;{:157}{165:} +procedure scanrepl(t:eightbits);label 22,30,31,21;var a:sixteenbits; +b:ASCIIcode;bal:eightbits;begin bal:=0; +while true do begin 22:a:=getnext;case a of 40:bal:=bal+1; +41:if bal=0 then begin writeln(output);write(output,'! Extra )');error; +end else bal:=bal-1;39:{168:}begin b:=39; +while true do begin begin if tokptr[z]=maxtoks then begin writeln(output +);write(output,'! Sorry, ','token',' capacity exceeded');error; +history:=3;jumpout;end;tokmem[z,tokptr[z]]:=b;tokptr[z]:=tokptr[z]+1; +end; +if b=64 then if buffer[loc]=64 then loc:=loc+1 else begin writeln(output +);write(output,'! You should double @ signs in strings');error;end; +if loc=limit then begin begin writeln(output); +write(output,'! String didn''t end');error;end;buffer[loc]:=39; +buffer[loc+1]:=0;end;b:=buffer[loc];loc:=loc+1; +if b=39 then begin if buffer[loc]<>39 then goto 31 else begin loc:=loc+1 +;begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=39;tokptr[z]:=tokptr[z]+1;end;end;end; +end;31:end{:168};35:if t=3 then a:=0;{167:}130:begin a:=idlookup(0); +begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=(a div 256)+128;tokptr[z]:=tokptr[z]+1; +end;a:=a mod 256;end; +135:if t<>135 then goto 30 else begin begin if tokptr[z]=maxtoks then +begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=(curmodule div 256)+168; +tokptr[z]:=tokptr[z]+1;end;a:=curmodule mod 256;end;2:{169:} +begin begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=2;tokptr[z]:=tokptr[z]+1;end; +buffer[limit+1]:=64; +21:if buffer[loc]=64 then begin if loc<limit then if buffer[loc+1]=64 +then begin begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=64;tokptr[z]:=tokptr[z]+1;end; +loc:=loc+2;goto 21;end; +end else begin begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=buffer[loc];tokptr[z]:=tokptr[z]+1;end; +loc:=loc+1;goto 21;end;if loc>=limit then begin writeln(output); +write(output,'! Verbatim string didn''t end');error; +end else if buffer[loc+1]<>62 then begin writeln(output); +write(output,'! You should double @ signs in verbatim strings');error; +end;loc:=loc+2;end{:169}; +133,132,134:if t<>135 then goto 30 else begin begin writeln(output); +write(output,'! @',xchr[buffer[loc-1]],' is ignored in Pascal text'); +error;end;goto 22;end;136:goto 30;{:167}otherwise end; +begin if tokptr[z]=maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[z,tokptr[z]]:=a;tokptr[z]:=tokptr[z]+1;end;end; +30:nextcontrol:=a;{166:} +if bal>0 then begin if bal=1 then begin writeln(output); +write(output,'! Missing )');error;end else begin writeln(output); +write(output,'! Missing ',bal:1,' )''s');error;end; +while bal>0 do begin begin if tokptr[z]=maxtoks then begin writeln( +output);write(output,'! Sorry, ','token',' capacity exceeded');error; +history:=3;jumpout;end;tokmem[z,tokptr[z]]:=41;tokptr[z]:=tokptr[z]+1; +end;bal:=bal-1;end;end{:166}; +if textptr>maxtexts-4 then begin writeln(output); +write(output,'! Sorry, ','text',' capacity exceeded');error;history:=3; +jumpout;end;currepltext:=textptr;tokstart[textptr+4]:=tokptr[z]; +textptr:=textptr+1;if z=3 then z:=0 else z:=z+1;end;{:165}{170:} +procedure definemacro(t:eightbits);var p:namepointer; +begin p:=idlookup(t);scanrepl(t);equiv[p]:=currepltext; +textlink[currepltext]:=0;end;{:170}{172:}procedure scanmodule; +label 22,30,10;var p:namepointer;begin modulecount:=modulecount+1;{173:} +nextcontrol:=0; +while true do begin 22:while nextcontrol<=132 do begin nextcontrol:= +skipahead;if nextcontrol=135 then begin loc:=loc-2;nextcontrol:=getnext; +end;end;if nextcontrol<>133 then goto 30;nextcontrol:=getnext; +if nextcontrol<>130 then begin begin writeln(output); +write(output,'! Definition flushed, must start with ', +'identifier of length > 1');error;end;goto 22;end;nextcontrol:=getnext; +if nextcontrol=61 then begin scannumeric(idlookup(1));goto 22; +end else if nextcontrol=30 then begin definemacro(2);goto 22; +end else{174:}if nextcontrol=40 then begin nextcontrol:=getnext; +if nextcontrol=35 then begin nextcontrol:=getnext; +if nextcontrol=41 then begin nextcontrol:=getnext; +if nextcontrol=61 then begin begin writeln(output); +write(output,'! Use == for macros');error;end;nextcontrol:=30;end; +if nextcontrol=30 then begin definemacro(3);goto 22;end;end;end;end; +{:174};begin writeln(output); +write(output,'! Definition flushed since it starts badly');error;end; +end;30:{:173};{175:}case nextcontrol of 134:p:=0;135:begin p:=curmodule; +{176:}repeat nextcontrol:=getnext;until nextcontrol<>43; +if(nextcontrol<>61)and(nextcontrol<>30)then begin begin writeln(output); +write(output,'! Pascal text flushed, = sign is missing');error;end; +repeat nextcontrol:=skipahead;until nextcontrol=136;goto 10;end{:176}; +end;otherwise goto 10 end;{177:}storetwobytes(53248+modulecount);{:177}; +scanrepl(135);{178:} +if p=0 then begin textlink[lastunnamed]:=currepltext; +lastunnamed:=currepltext; +end else if equiv[p]=0 then equiv[p]:=currepltext else begin p:=equiv[p] +;while textlink[p]<maxtexts do p:=textlink[p];textlink[p]:=currepltext; +end;textlink[currepltext]:=maxtexts;{:178};{:175};10:end;{:172}{181:} +{procedure debughelp;label 888,10;var k:integer; +begin debugskipped:=debugskipped+1; +if debugskipped<debugcycle then goto 10;debugskipped:=0; +while true do begin write(output,'#');flush(output);read(input,ddt); +if ddt<0 then goto 10 else if ddt=0 then begin goto 888; +888:ddt:=0; +end else begin read(input,dd);case ddt of 1:printid(dd);2:printrepl(dd); +3:for k:=1 to dd do write(output,xchr[buffer[k]]); +4:for k:=1 to dd do write(output,xchr[modtext[k]]); +5:for k:=1 to outptr do write(output,xchr[outbuf[k]]); +6:for k:=1 to dd do write(output,xchr[outcontrib[k]]); +otherwise write(output,'?')end;end;end;10:end;}{:181}{182:} +begin initialize;{134:}openinput;line:=0;otherline:=0;changing:=true; +primethechangebuffer;changing:=not changing;templine:=otherline; +otherline:=line;line:=templine;limit:=0;loc:=1;buffer[0]:=32; +inputhasended:=false;{:134}; +writeln(output,'This is TANGLE, Version 4.4 for Linux');{183:} +phaseone:=true;modulecount:=0;repeat nextcontrol:=skipahead; +until nextcontrol=136;while not inputhasended do scanmodule;{138:} +if changelimit<>0 then begin for ii:=0 to changelimit do buffer[ii]:= +changebuffer[ii];limit:=changelimit;changing:=true;line:=otherline; +loc:=changelimit;begin writeln(output); +write(output,'! Change file entry did not match');error;end;end{:138}; +phaseone:=false;{:183};{for ii:=0 to 3 do maxtokptr[ii]:=tokptr[ii];} +{112:}if textlink[0]=0 then begin begin writeln(output); +write(output,'! No output was specified.');end; +if history=0 then history:=1;end else begin begin writeln(output); +write(output,'Writing the output file');end;flush(output);{83:} +stackptr:=1;bracelevel:=0;curstate.namefield:=0; +curstate.replfield:=textlink[0];zo:=curstate.replfield mod 4; +curstate.bytefield:=tokstart[curstate.replfield]; +curstate.endfield:=tokstart[curstate.replfield+4];curstate.modfield:=0; +{:83};{96:}outstate:=0;outptr:=0;breakptr:=0;semiptr:=0;outbuf[0]:=0; +line:=1;{:96};sendtheoutput;{98:}breakptr:=outptr;semiptr:=0; +flushbuffer;if bracelevel<>0 then begin writeln(output); +write(output,'! Program ended at brace level ',bracelevel:1);error;end; +{:98};begin writeln(output);write(output,'Done.');end;end{:112}; +9999:if stringptr>256 then{184:}begin begin writeln(output); +write(output,stringptr-256:1,' strings written to string pool file.'); +end;write(pool,'*'); +for ii:=1 to 9 do begin outbuf[ii]:=poolchecksum mod 10; +poolchecksum:=poolchecksum div 10;end; +for ii:=9 downto 1 do write(pool,xchr[48+outbuf[ii]]);writeln(pool); +end{:184};{[186:]begin writeln(output); +write(output,'Memory usage statistics:');end;begin writeln(output); +write(output,nameptr:1,' names, ',textptr:1,' replacement texts;');end; +begin writeln(output);write(output,byteptr[0]:1);end; +for wo:=1 to 2 do write(output,'+',byteptr[wo]:1); +if phaseone then for ii:=0 to 3 do maxtokptr[ii]:=tokptr[ii]; +write(output,' bytes, ',maxtokptr[0]:1); +for ii:=1 to 3 do write(output,'+',maxtokptr[ii]:1); +write(output,' tokens.');[:186];}{187:} +case history of 0:begin writeln(output); +write(output,'(No errors were found.)');end;1:begin writeln(output); +write(output,'(Did you see the warning message above?)');end; +2:begin writeln(output); +write(output,'(Pardon me, but I think I spotted something wrong.)');end; +3:begin writeln(output); +write(output,'(That was a fatal error, my friend.)');end;end{:187}; +writeln(output);if(history<>0)and(history<>1)then exit(1)else exit(0); +end.{:182} diff --git a/systems/knuth/local/web/weave.ch b/systems/knuth/local/web/weave.ch new file mode 100644 index 0000000000..9f36a11f90 --- /dev/null +++ b/systems/knuth/local/web/weave.ch @@ -0,0 +1,598 @@ +% Change file for the WEAVE processor, for use with GNU Pascal. +% This file was created by Don Knuth, based on the original +% UNIX port by Howard Trickey, Pavel Curtis, et al. +% (See ../web-sparc for details of that work.) + +% History: +% 2000.04.29 Original version + +% NOTE: The module numbers refer to the standard WEB manual (CS 980). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [0] WEAVE: print changes only +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +\pageno=\contentspagenumber \advance\pageno by 1 +@y +\pageno=\contentspagenumber \advance\pageno by 1 +\let\maybe=\iffalse +\def\title{WEAVE changes for{\mc GNU} Pascal} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [1] Change banner message +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d banner=='This is WEAVE, Version 4.4' +@y +@d banner=='This is WEAVE, Version 4.4 for Linux' +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [2] add input and output, remove other files, add ref to scan_args, +% [2] and #include external definition for exit(), etc. +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +program WEAVE(@!web_file,@!change_file,@!tex_file); +label end_of_WEAVE; {go here to finish} +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +@<Error handling procedures@>@/ +@y +program WEAVE(@!input,@!output); +label end_of_WEAVE; {go here to finish} +const @<Constants in the outer block@>@/ +type @<Types in the outer block@>@/ +var @<Globals in the outer block@>@/ +@\ +@=#include "tangext.h"@> +@\@/ +@<Error handling procedures@>@/ +@<Declaration of |scan_args|@>@/ +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [3] Show statistics +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d stat==@{ {change this to `$\\{stat}\equiv\null$' + when gathering usage statistics} +@d tats==@t@>@} {change this to `$\\{tats}\equiv\null$' + when gathering usage statistics} +@y +@d stat== {I'm gathering usage statistics} +@d tats== {because I have to know how close \TeX\ comes to the limits} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [4] compiler options +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@{@&$C-,A+,D-@} {no range check, catch arithmetic overflow, no debug overhead} +@!debug @{@&$C+,D+@}@+ gubed {but turn everything on when debugging} +@y +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [7] Fix others: +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d othercases == others: {default for cases not listed explicitly} +@y +@d othercases == otherwise {ISO extended Pascal default cases} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [8] Constants: Make stack_size=400 instead of 200 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!stack_size=200; {number of simultaneous output levels} +@y +@!stack_size=400; {number of simultaneous output levels} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [11] make ASCII codes take 1 byte (not 4 or more!) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!ASCII_code=0..255; {eight-bit numbers, a subrange of the integers} +@y +@!ASCII_code=ByteCard; {eight-bit numbers, a subrange of the integers} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [12] make the compiler recognize a text file as text +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d text_char == char {the data type of characters in text files} +@d first_text_char=0 {ordinal number of the smallest element of |text_char|} +@d last_text_char=255 {ordinal number of the largest element of |text_char|} + +@<Types...@>= +@!text_file=packed file of text_char; +@y +@d text_char == char {the data type of characters in text files} +@d first_text_char=0 {ordinal number of the smallest element of |text_char|} +@d last_text_char=255 {ordinal number of the largest element of |text_char|} +@d text_file==text +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [13] xchr and xord now external +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@!xord: array [text_char] of ASCII_code; + {specifies conversion of input characters} +@!xchr: array [ASCII_code] of text_char; + {specifies conversion of output characters} +@y +@!xord: external array [text_char] of ASCII_code; + {specifies conversion of input characters} +@!xchr: external array [ASCII_code] of text_char; + {specifies conversion of output characters} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [17] enable maximum character set +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +for i:=1 to @'37 do xchr[i]:=' '; +for i:=@'200 to @'377 do xchr[i]:=' '; +@y +for i:=1 to @'37 do xchr[i]:=chr(i); +for i:=@'200 to @'377 do xchr[i]:=chr(i); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [20] terminal output: use standard i/o +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d print(#)==write(term_out,#) {`|print|' means write on the terminal} +@y +@d term_out==output +@d print(#)==write(term_out,#) {`|print|' means write on the terminal} +@z + +@x +@<Globals...@>= +@!term_out:text_file; {the terminal as an output file} +@y + +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [21] init terminal +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ Different systems have different ways of specifying that the output on a +certain file will appear on the user's terminal. Here is one way to do this +on the \PASCAL\ system that was used in \.{TANGLE}'s initial development: +@^system dependencies@> + +@<Set init...@>= +rewrite(term_out,'TTY:'); {send |term_out| output to the terminal} +@y +@ Different systems have different ways of specifying that the output on a +certain file will appear on the user's terminal. +@^system dependencies@> + +@<Set init...@>= + {Nothing need be done on Linux} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [22] flush terminal buffer +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d update_terminal == break(term_out) {empty the terminal output buffer} +@y +@d update_terminal == flush_stdout {empty the terminal output buffer} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [24] open input files +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The following code opens the input files. Since these files were listed +in the program header, we assume that the \PASCAL\ runtime system has +already checked that suitable file names have been given; therefore no +additional error checking needs to be done. We will see below that +\.{WEAVE} reads through the entire input twice. +@^system dependencies@> + +@p procedure open_input; {prepare to read |web_file| and |change_file|} +begin reset(web_file); reset(change_file); +end; +@y +@ The following code opens the input files. +This is called after |scan_args| has filled the file name variables +appropriately. +@^system dependencies@> + +@p procedure open_input; {prepare to read |web_file| and |change_file|} +begin +reset(web_file,web_name); reset(change_file,change_name); +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [26] opening tex file +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@ The following code opens |tex_file|. +Since this file was listed in the program header, we assume that the +\PASCAL\ runtime system has checked that a suitable external file name has +been given. +@^system dependencies@> + +@<Set init...@>= +rewrite(tex_file); +@y +@ The following code opens |tex_file|. +The |scan_args| procedure is used to set up |tex_name| as required. +@^system dependencies@> + +@<Set init...@>= +scan_args; +rewrite(tex_file,tex_name); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [27] buffer now external +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@<Globals...@>=@!buffer: array[0..long_buf_size] of ASCII_code; +@y +@<Globals...@>=@!buffer: external array[0..long_buf_size] of ASCII_code; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [28] faster input_ln +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p function input_ln(var f:text_file):boolean; + {inputs a line or returns |false|} +var final_limit:0..buf_size; {|limit| without trailing blanks} +begin limit:=0; final_limit:=0; +if eof(f) then input_ln:=false +else begin while not eoln(f) do + begin buffer[limit]:=xord[f^]; get(f); + incr(limit); + if buffer[limit-1]<>" " then final_limit:=limit; + if limit=buf_size then + begin while not eoln(f) do get(f); + decr(limit); {keep |buffer[buf_size]| empty} + if final_limit>limit then final_limit:=limit; + print_nl('! Input line too long'); loc:=0; error; +@.Input line too long@> + end; + end; + read_ln(f); limit:=final_limit; input_ln:=true; + end; +end; +@y +With Linux we call an external C procedure, |line_read|. +That routine fills |buffer| from 0 onwards with the |xord|'ed values +of the next line, setting |limit| appropriately (ignoring trailing +blanks). +It will stop if |limit=buf_size|, and the following will cause an error +message. + +@p function input_ln(var f:text_file):boolean; + {inputs a line or returns |false|} +begin limit:=0; +if test_eof(f) then input_ln:=false +else begin line_read(f); + if limit=buf_size then + begin + decr(limit); {keep |buffer[buf_size]| empty} + print_nl('! Input line too long'); loc:=0; error; +@.Input line too long@> + end; + input_ln:=true; + end; +end; +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [50] don't enter xrefs if no_xref set +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@d append_xref(#)==if xref_ptr=max_refs then overflow('cross reference') + else begin incr(xref_ptr); num(xref_ptr):=#; + end + +@p procedure new_xref(@!p:name_pointer); +label exit; +var q:xref_number; {pointer to previous cross reference} +@!m,@!n: sixteen_bits; {new and previous cross-reference value} +begin if (reserved(p)or(byte_start[p]+1=byte_start[p+ww]))and +@y +If the user has sent the |no_xref| flag (the -x option of the command line), +then it is unnecessary to keep track of cross references for identifers. +If one were careful, one could probably make more changes around module +100 to avoid a lot of identifier looking up. + +@d append_xref(#)==if xref_ptr=max_refs then overflow('cross reference') + else begin incr(xref_ptr); num(xref_ptr):=#; + end + +@p procedure new_xref(@!p:name_pointer); +label exit; +var q:xref_number; {pointer to previous cross-reference} +@!m,@!n: sixteen_bits; {new and previous cross-reference value} +begin if no_xref then return; +if (reserved(p)or(byte_start[p]+1=byte_start[p+ww]))and +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [53] Work around a bug in GPC version 2.8.1 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@t\hskip1em@>@!tok_mem: packed array [0..max_toks] of sixteen_bits; {tokens} +@y +@t\hskip1em@>@!tok_mem: array [0..max_toks] of sixteen_bits; {tokens} +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [185] Work around a bug in GPC version 2.8.1 +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +reswitch: case next_control of +string,verbatim: @<Append a \(string scrap@>; +identifier: @<Append an identifier scrap@>; +TeX_string: @<Append a \TeX\ string scrap@>; +othercases easy_cases +endcases +@y +reswitch: if (next_control=string)or(next_control=verbatim) + then @<Append a \(string scrap@> +else if (next_control=identifier) then @<Append an identifier scrap@> +else if (next_control=TeX_string) then @<Append a \TeX\ string scrap@> +else easy_cases +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [239] omit index and module names if no_xref set +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@<Phase III: Output the cross-reference index@>= +@y +If the user has set the |no_xref| flag (the -x option on the command line), +just finish off the page, omitting the index, module name list, and table of +contents. + +@<Phase III: Output the cross-reference index@>= +if no_xref then begin + finish_line; + out("\"); out5("v")("f")("i")("l")("l"); + out4("\")("e")("n")("d"); + finish_line; + end +else begin +@z + +@x +print('Done.'); +@y +end; +print('Done.'); +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [258] term_in == input, when debugging +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +any error stop will set |debug_cycle| to zero. +@y +any error stop will set |debug_cycle| to zero. + +@d term_in==input +@z + +@x +@!term_in:text_file; {the user's terminal as an input file} +@y + +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [259] Take out reset(term_in) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +reset(term_in,'TTY:','/I'); {open |term_in| as the terminal, don't do a |get|} +@y + +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [261] print newline at end of run and exit based upon value of history +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@p procedure Phase_I; +@y +@d UNIXexit==e@&x@&i@&t + +@p procedure Phase_I; +@z + +@x +end. +@y +new_line; +if (history <> spotless) and (history <> harmless_message) then + UNIXexit(1) +else + UNIXexit(0); +end. +@z + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% [264] system dependent changes--the scan_args procedure +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +@x +@* System-dependent changes. +This module should be replaced, if necessary, by changes to the program +that are necessary to make \.{WEAVE} work at a particular installation. +It is usually best to design your change file so that all changes to +previous modules preserve the module numbering; then everybody's version +will be consistent with the printed program. More extensive changes, +which introduce new modules, can be inserted here; then only the index +itself will get a new module number. +@^system dependencies@> +@y +@* System-dependent changes. +@^system dependencies@> + +@ The user calls \.{WEAVE} with arguments on the command line. +These are either file names or flags (beginning with '-'). +The following globals are for communicating the user's desires to the rest +of the program. The various |file_name| variables contain strings with +the full names of those files, as UNIX knows them. + +The only flag that affects weave is |'-x'| whose status is kept in |no_xref|. + +@d max_file_name_length==60 + +@<Globals...@>= +@!web_name,@!change_name,@!tex_name: + array[1..max_file_name_length] of char; +@!no_xref:boolean; + +@ @<Types...@>= +UNIX_filename=packed array[1..max_file_name_length] of char; + +@ The |scan_args| procedure looks at the command line arguments and sets +the |file_name| variables accordingly. +At least one file name must be present: the \.{WEB} file. It may have +an extension, or it may omit it to get |'.web'| added. +The \TeX\ output file name is formed by replacing the \.{WEB} file +name extension by |'.tex'|. + +If there is another file name present among the arguments, it is the +change file, again either with an extension or without one to get |'.ch'| +An omitted change file argument means that |'/dev/null'| should be used, +when no changes are desired. + +An argument beginning with a minus sign is a flag. +Any letters following the minus sign may cause global flag variables to be +set. +Currently, an |x| means that the cross referencing information---the index, +the module name list, and the table of contents---is to be suppressed. + +@<Declaration of |scan_args|@>= +procedure scan_args; +var dot_pos,i,a: integer; {indices} +@!fname: UNIX_filename; {temporary argument holder} +@!found_web,@!found_change: boolean; {|true| when those file names have + been seen} +begin +found_web:=false; +found_change:=false; +no_xref:=false; +for a:=1 to argc-1 do begin + argv(a,fname); {put argument number |a| into |fname|} + if fname[1]<>'-' then begin + if not found_web then + @<Get |web_name| and |tex_name| from |fname|@> + else if not found_change then + @<Get |change_name| from |fname|@> + else @<Print usage error message and quit@>; + end + else @<Handle flag argument in |fname|@>; + end; +if not found_web then @<Print usage error message and quit@>; +if not found_change then @<Set up null change file@>; +end; + +@ Use all of |fname| for the |web_name| if there is a |'.'| in it, +otherwise add |'.web'|. +The other file names come from adding things after the dot. +The |argv| procedure will not put more than |max_file_name_length-5| +characters into |fname|, and this leaves enough room in the |file_name| +variables to add the extensions. + +The end of a file name is marked with a |chr(0)|, the convention assumed by +the |argv| and |reset| and |rewrite| procedures. + +@<Get |web_name|...@>= +begin +dot_pos:=-1; +i:=1; +while (fname[i]<>chr(0)) and (i<=max_file_name_length-5) do begin + web_name[i]:=fname[i]; + if fname[i]='.' then dot_pos:=i; + incr(i); + end; +if dot_pos=-1 then begin + dot_pos:=i; + web_name[dot_pos]:='.'; + web_name[dot_pos+1]:='w'; + web_name[dot_pos+2]:='e'; + web_name[dot_pos+3]:='b'; + web_name[dot_pos+4]:=chr(0); + end +else web_name[i]:=chr(0); +for i:=1 to dot_pos do begin + tex_name[i]:=web_name[i]; + end; +tex_name[dot_pos+1]:='t'; +tex_name[dot_pos+2]:='e'; +tex_name[dot_pos+3]:='x'; +tex_name[dot_pos+4]:=chr(0); +found_web:=true; +end + +@ @<Get |change_name|...@>= +begin +dot_pos:=-1; +i:=1; +while (fname[i]<>chr(0)) and (i<=max_file_name_length-5) +do begin + change_name[i]:=fname[i]; + if fname[i]='.' then dot_pos:=i; + incr(i); + end; +if dot_pos=-1 then begin + dot_pos:=i; + change_name[dot_pos]:='.'; + change_name[dot_pos+1]:='c'; + change_name[dot_pos+2]:='h'; + change_name[dot_pos+3]:=chr(0); + end +else change_name[i]:=chr(0); +found_change:=true; +end + +@ @<Set up null...@>= +begin + change_name[1]:='/'; + change_name[2]:='d'; + change_name[3]:='e'; + change_name[4]:='v'; + change_name[5]:='/'; + change_name[6]:='n'; + change_name[7]:='u'; + change_name[8]:='l'; + change_name[9]:='l'; + change_name[10]:=chr(0); +end + +@ @<Handle flag...@>= +begin +i:=2; +while (fname[i]<>chr(0)) and (i<=max_file_name_length-5) do begin + if fname[i]='x' then no_xref:=true; + incr(i); + end; +end + +@ @<Print usage error message and quit@>= +begin +print_nl('! Usage: weave [-x] webfile[.web] [changefile[.ch]]'); +error; +jump_out; +end + +@z diff --git a/systems/knuth/local/web/weave.p b/systems/knuth/local/web/weave.p new file mode 100644 index 0000000000..27ee89cd87 --- /dev/null +++ b/systems/knuth/local/web/weave.p @@ -0,0 +1,1603 @@ +{2:}{4:}{:4}program WEAVE(input,output);label 9999;const{8:} +maxbytes=45000;maxnames=5000;maxmodules=2000;hashsize=353;bufsize=100; +longestname=400;longbufsize=500;linelength=80;maxrefs=30000; +maxtoks=30000;maxtexts=2000;maxscraps=1000;stacksize=400;{:8}type{11:} +ASCIIcode=ByteCard;{:11}{36:}eightbits=0..255;sixteenbits=0..65535;{:36} +{38:}namepointer=0..maxnames;{:38}{47:}xrefnumber=0..maxrefs;{:47}{52:} +textpointer=0..maxtexts;{:52}{201:}mode=0..1; +outputstate=record endfield:sixteenbits;tokfield:sixteenbits; +modefield:mode;end;{:201}{266:}UNIXfilename=packed array[1..60]of char; +{:266}var{9:}history:0..3;{:9}{13:} +xord:external array[char]of ASCIIcode; +xchr:external array[ASCIIcode]of char;{:13}{23:}webfile:text; +changefile:text;{:23}{25:}texfile:text;{:25}{27:} +buffer:external array[0..longbufsize]of ASCIIcode;{:27}{29:} +phaseone:boolean;phasethree:boolean;{:29}{37:} +bytemem:packed array[0..1,0..maxbytes]of ASCIIcode; +bytestart:array[0..maxnames]of sixteenbits; +link:array[0..maxnames]of sixteenbits; +ilk:array[0..maxnames]of sixteenbits; +xref:array[0..maxnames]of sixteenbits;{:37}{39:}nameptr:namepointer; +byteptr:array[0..1]of 0..maxbytes;{:39}{45:}modulecount:0..maxmodules; +changedmodule:packed array[0..maxmodules]of boolean; +changeexists:boolean;{:45}{48:} +xmem:array[xrefnumber]of packed record numfield:sixteenbits; +xlinkfield:sixteenbits;end;xrefptr:xrefnumber; +xrefswitch,modxrefswitch:0..10240;{:48}{53:} +tokmem:array[0..maxtoks]of sixteenbits; +tokstart:array[textpointer]of sixteenbits;textptr:textpointer; +tokptr:0..maxtoks;maxtokptr,maxtxtptr:0..maxtoks;{:53}{55:} +idfirst:0..longbufsize;idloc:0..longbufsize; +hash:array[0..hashsize]of sixteenbits;{:55}{63:}curname:namepointer; +{:63}{65:}modtext:array[0..longestname]of ASCIIcode;{:65}{71:} +ii:integer;line:integer;otherline:integer;templine:integer; +limit:0..longbufsize;loc:0..longbufsize;inputhasended:boolean; +changing:boolean;changepending:boolean;{:71}{73:} +changebuffer:array[0..bufsize]of ASCIIcode;changelimit:0..bufsize;{:73} +{93:}curmodule:namepointer;scanninghex:boolean;{:93}{108:} +nextcontrol:eightbits;{:108}{114:}lhs,rhs:namepointer;{:114}{118:} +curxref:xrefnumber;{:118}{121:}outbuf:array[0..linelength]of ASCIIcode; +outptr:0..linelength;outline:integer;{:121}{129:}dig:array[0..4]of 0..9; +{:129}{144:}cat:array[0..maxscraps]of eightbits; +trans:array[0..maxscraps]of 0..10239;pp:0..maxscraps; +scrapbase:0..maxscraps;scrapptr:0..maxscraps;loptr:0..maxscraps; +hiptr:0..maxscraps;maxscrptr:0..maxscraps;{:144}{177:}{tracing:0..2;} +{:177}{202:}curstate:outputstate; +stack:array[1..stacksize]of outputstate;stackptr:0..stacksize; +maxstackptr:0..stacksize;{:202}{219:}saveline:integer; +saveplace:sixteenbits;{:219}{229:}thismodule:namepointer;{:229}{234:} +nextxref,thisxref,firstxref,midxref:xrefnumber;{:234}{240:} +kmodule:0..maxmodules;{:240}{242:}bucket:array[ASCIIcode]of namepointer; +nextname:namepointer;c:ASCIIcode;h:0..hashsize; +blink:array[0..maxnames]of sixteenbits;{:242}{244:}curdepth:eightbits; +curbyte:0..maxbytes;curbank:0..1;curval:sixteenbits; +maxsortptr:0..maxscraps;{:244}{246:}collate:array[0..229]of ASCIIcode; +{:246}{258:}{troubleshooting:boolean;ddt:integer;dd:integer; +debugcycle:integer;debugskipped:integer;}{:258}{265:} +webname,changename,texname:array[1..60]of char;noxref:boolean;{:265} +#include "tangext.h" +{30:}{procedure debughelp;forward;}{:30}{31:}procedure error; +var k,l:0..longbufsize;begin{32:} +begin if changing then write(output,'. (change file ')else write(output, +'. (');writeln(output,'l.',line:1,')'); +if loc>=limit then l:=limit else l:=loc; +for k:=1 to l do if buffer[k-1]=9 then write(output,' ')else write( +output,xchr[buffer[k-1]]);writeln(output); +for k:=1 to l do write(output,' '); +for k:=l+1 to limit do write(output,xchr[buffer[k-1]]); +if buffer[limit]=124 then write(output,xchr[124]);write(output,' '); +end{:32};flushstdout;history:=2;{debugskipped:=debugcycle;debughelp;} +end;{:31}{33:}procedure jumpout;begin goto 9999;end;{:33}{267:} +procedure scanargs;var dotpos,i,a:integer;fname:UNIXfilename; +foundweb,foundchange:boolean;begin foundweb:=false;foundchange:=false; +noxref:=false;for a:=1 to argc-1 do begin argv(a,fname); +if fname[1]<>'-'then begin if not foundweb then{268:}begin dotpos:=-1; +i:=1;while(fname[i]<>chr(0))and(i<=55)do begin webname[i]:=fname[i]; +if fname[i]='.'then dotpos:=i;i:=i+1;end; +if dotpos=-1 then begin dotpos:=i;webname[dotpos]:='.'; +webname[dotpos+1]:='w';webname[dotpos+2]:='e';webname[dotpos+3]:='b'; +webname[dotpos+4]:=chr(0);end else webname[i]:=chr(0); +for i:=1 to dotpos do begin texname[i]:=webname[i];end; +texname[dotpos+1]:='t';texname[dotpos+2]:='e';texname[dotpos+3]:='x'; +texname[dotpos+4]:=chr(0);foundweb:=true;end{:268} +else if not foundchange then{269:}begin dotpos:=-1;i:=1; +while(fname[i]<>chr(0))and(i<=55)do begin changename[i]:=fname[i]; +if fname[i]='.'then dotpos:=i;i:=i+1;end; +if dotpos=-1 then begin dotpos:=i;changename[dotpos]:='.'; +changename[dotpos+1]:='c';changename[dotpos+2]:='h'; +changename[dotpos+3]:=chr(0);end else changename[i]:=chr(0); +foundchange:=true;end{:269}else{272:}begin begin writeln(output); +write(output,'! Usage: weave [-x] webfile[.web] [changefile[.ch]]');end; +error;jumpout;end{:272};end else{271:}begin i:=2; +while(fname[i]<>chr(0))and(i<=55)do begin if fname[i]='x'then noxref:= +true;i:=i+1;end;end{:271};end;if not foundweb then{272:} +begin begin writeln(output); +write(output,'! Usage: weave [-x] webfile[.web] [changefile[.ch]]');end; +error;jumpout;end{:272};if not foundchange then{270:} +begin changename[1]:='/';changename[2]:='d';changename[3]:='e'; +changename[4]:='v';changename[5]:='/';changename[6]:='n'; +changename[7]:='u';changename[8]:='l';changename[9]:='l'; +changename[10]:=chr(0);end{:270};end;{:267}procedure initialize;var{16:} +i:0..255;{:16}{40:}wi:0..1;{:40}{56:}h:0..hashsize;{:56}{247:} +c:ASCIIcode;{:247}begin{10:}history:=0;{:10}{14:}xchr[32]:=' '; +xchr[33]:='!';xchr[34]:='"';xchr[35]:='#';xchr[36]:='$';xchr[37]:='%'; +xchr[38]:='&';xchr[39]:='''';xchr[40]:='(';xchr[41]:=')';xchr[42]:='*'; +xchr[43]:='+';xchr[44]:=',';xchr[45]:='-';xchr[46]:='.';xchr[47]:='/'; +xchr[48]:='0';xchr[49]:='1';xchr[50]:='2';xchr[51]:='3';xchr[52]:='4'; +xchr[53]:='5';xchr[54]:='6';xchr[55]:='7';xchr[56]:='8';xchr[57]:='9'; +xchr[58]:=':';xchr[59]:=';';xchr[60]:='<';xchr[61]:='=';xchr[62]:='>'; +xchr[63]:='?';xchr[64]:='@';xchr[65]:='A';xchr[66]:='B';xchr[67]:='C'; +xchr[68]:='D';xchr[69]:='E';xchr[70]:='F';xchr[71]:='G';xchr[72]:='H'; +xchr[73]:='I';xchr[74]:='J';xchr[75]:='K';xchr[76]:='L';xchr[77]:='M'; +xchr[78]:='N';xchr[79]:='O';xchr[80]:='P';xchr[81]:='Q';xchr[82]:='R'; +xchr[83]:='S';xchr[84]:='T';xchr[85]:='U';xchr[86]:='V';xchr[87]:='W'; +xchr[88]:='X';xchr[89]:='Y';xchr[90]:='Z';xchr[91]:='[';xchr[92]:='\'; +xchr[93]:=']';xchr[94]:='^';xchr[95]:='_';xchr[96]:='`';xchr[97]:='a'; +xchr[98]:='b';xchr[99]:='c';xchr[100]:='d';xchr[101]:='e'; +xchr[102]:='f';xchr[103]:='g';xchr[104]:='h';xchr[105]:='i'; +xchr[106]:='j';xchr[107]:='k';xchr[108]:='l';xchr[109]:='m'; +xchr[110]:='n';xchr[111]:='o';xchr[112]:='p';xchr[113]:='q'; +xchr[114]:='r';xchr[115]:='s';xchr[116]:='t';xchr[117]:='u'; +xchr[118]:='v';xchr[119]:='w';xchr[120]:='x';xchr[121]:='y'; +xchr[122]:='z';xchr[123]:='{';xchr[124]:='|';xchr[125]:='}'; +xchr[126]:='~';xchr[0]:=' ';xchr[127]:=' ';{:14}{17:} +for i:=1 to 31 do xchr[i]:=chr(i);for i:=128 to 255 do xchr[i]:=chr(i); +{:17}{18:}for i:=0 to 255 do xord[chr(i)]:=32; +for i:=1 to 255 do xord[xchr[i]]:=i;xord[' ']:=32;{:18}{21:}{:21}{26:} +scanargs;rewrite(texfile,texname);{:26}{41:} +for wi:=0 to 1 do begin bytestart[wi]:=0;byteptr[wi]:=0;end; +bytestart[2]:=0;nameptr:=1;{:41}{43:}ilk[0]:=0;{:43}{49:}xrefptr:=0; +xrefswitch:=0;modxrefswitch:=0;xmem[0].numfield:=0;xref[0]:=0;{:49}{54:} +tokptr:=1;textptr:=1;tokstart[0]:=1;tokstart[1]:=1;maxtokptr:=1; +maxtxtptr:=1;{:54}{57:}for h:=0 to hashsize-1 do hash[h]:=0;{:57}{94:} +scanninghex:=false;{:94}{102:}modtext[0]:=32;{:102}{124:}outptr:=1; +outline:=1;outbuf[1]:=99;write(texfile,'\input webma');{:124}{126:} +outbuf[0]:=92;{:126}{145:}scrapbase:=1;scrapptr:=0;maxscrptr:=0;{:145} +{203:}maxstackptr:=0;{:203}{245:}maxsortptr:=0;{:245}{248:} +collate[0]:=0;collate[1]:=32;for c:=1 to 31 do collate[c+1]:=c; +for c:=33 to 47 do collate[c]:=c;for c:=58 to 64 do collate[c-10]:=c; +for c:=91 to 94 do collate[c-36]:=c;collate[59]:=96; +for c:=123 to 255 do collate[c-63]:=c;collate[193]:=95; +for c:=97 to 122 do collate[c+97]:=c; +for c:=48 to 57 do collate[c+172]:=c;{:248}{259:}{troubleshooting:=true; +debugcycle:=1;debugskipped:=0;tracing:=0;troubleshooting:=false; +debugcycle:=99999;}{:259}end;{:2}{24:}procedure openinput; +begin reset(webfile,webname);reset(changefile,changename);end;{:24}{28:} +function inputln(var f:text):boolean;begin limit:=0; +if testeof(f)then inputln:=false else begin lineread(f); +if limit=bufsize then begin limit:=limit-1;begin writeln(output); +write(output,'! Input line too long');end;loc:=0;error;end; +inputln:=true;end;end;{:28}{44:}procedure printid(p:namepointer); +var k:0..maxbytes;w:0..1; +begin if p>=nameptr then write(output,'IMPOSSIBLE')else begin w:=p mod 2 +; +for k:=bytestart[p]to bytestart[p+2]-1 do write(output,xchr[bytemem[w,k] +]);end;end;{:44}{50:}procedure newxref(p:namepointer);label 10; +var q:xrefnumber;m,n:sixteenbits;begin if noxref then goto 10; +if((ilk[p]>3)or(bytestart[p]+1=bytestart[p+2]))and(xrefswitch=0)then +goto 10;m:=modulecount+xrefswitch;xrefswitch:=0;q:=xref[p]; +if q>0 then begin n:=xmem[q].numfield; +if(n=m)or(n=m+10240)then goto 10 else if m=n+10240 then begin xmem[q]. +numfield:=m;goto 10;end;end; +if xrefptr=maxrefs then begin writeln(output); +write(output,'! Sorry, ','cross reference',' capacity exceeded');error; +history:=3;jumpout;end else begin xrefptr:=xrefptr+1; +xmem[xrefptr].numfield:=m;end;xmem[xrefptr].xlinkfield:=q; +xref[p]:=xrefptr;10:end;{:50}{51:}procedure newmodxref(p:namepointer); +var q,r:xrefnumber;begin q:=xref[p];r:=0; +if q>0 then begin if modxrefswitch=0 then while xmem[q].numfield>=10240 +do begin r:=q;q:=xmem[q].xlinkfield; +end else if xmem[q].numfield>=10240 then begin r:=q; +q:=xmem[q].xlinkfield;end;end; +if xrefptr=maxrefs then begin writeln(output); +write(output,'! Sorry, ','cross reference',' capacity exceeded');error; +history:=3;jumpout;end else begin xrefptr:=xrefptr+1; +xmem[xrefptr].numfield:=modulecount+modxrefswitch;end; +xmem[xrefptr].xlinkfield:=q;modxrefswitch:=0; +if r=0 then xref[p]:=xrefptr else xmem[r].xlinkfield:=xrefptr;end;{:51} +{58:}function idlookup(t:eightbits):namepointer;label 31; +var i:0..longbufsize;h:0..hashsize;k:0..maxbytes;w:0..1; +l:0..longbufsize;p:namepointer;begin l:=idloc-idfirst;{59:} +h:=buffer[idfirst];i:=idfirst+1; +while i<idloc do begin h:=(h+h+buffer[i])mod hashsize;i:=i+1;end{:59}; +{60:}p:=hash[h]; +while p<>0 do begin if(bytestart[p+2]-bytestart[p]=l)and((ilk[p]=t)or((t +=0)and(ilk[p]>3)))then{61:}begin i:=idfirst;k:=bytestart[p];w:=p mod 2; +while(i<idloc)and(buffer[i]=bytemem[w,k])do begin i:=i+1;k:=k+1;end; +if i=idloc then goto 31;end{:61};p:=link[p];end;p:=nameptr; +link[p]:=hash[h];hash[h]:=p;31:{:60};if p=nameptr then{62:} +begin w:=nameptr mod 2; +if byteptr[w]+l>maxbytes then begin writeln(output); +write(output,'! Sorry, ','byte memory',' capacity exceeded');error; +history:=3;jumpout;end;if nameptr+2>maxnames then begin writeln(output); +write(output,'! Sorry, ','name',' capacity exceeded');error;history:=3; +jumpout;end;i:=idfirst;k:=byteptr[w]; +while i<idloc do begin bytemem[w,k]:=buffer[i];k:=k+1;i:=i+1;end; +byteptr[w]:=k;bytestart[nameptr+2]:=k;nameptr:=nameptr+1;ilk[p]:=t; +xref[p]:=0;end{:62};idlookup:=p;end;{:58}{66:} +function modlookup(l:sixteenbits):namepointer;label 31;var c:0..4; +j:0..longestname;k:0..maxbytes;w:0..1;p:namepointer;q:namepointer; +begin c:=2;q:=0;p:=ilk[0];while p<>0 do begin{68:}begin k:=bytestart[p]; +w:=p mod 2;c:=1;j:=1; +while(k<bytestart[p+2])and(j<=l)and(modtext[j]=bytemem[w,k])do begin k:= +k+1;j:=j+1;end; +if k=bytestart[p+2]then if j>l then c:=1 else c:=4 else if j>l then c:=3 +else if modtext[j]<bytemem[w,k]then c:=0 else c:=2;end{:68};q:=p; +if c=0 then p:=link[q]else if c=2 then p:=ilk[q]else goto 31;end;{67:} +w:=nameptr mod 2;k:=byteptr[w]; +if k+l>maxbytes then begin writeln(output); +write(output,'! Sorry, ','byte memory',' capacity exceeded');error; +history:=3;jumpout;end;if nameptr>maxnames-2 then begin writeln(output); +write(output,'! Sorry, ','name',' capacity exceeded');error;history:=3; +jumpout;end;p:=nameptr;if c=0 then link[q]:=p else ilk[q]:=p;link[p]:=0; +ilk[p]:=0;xref[p]:=0;c:=1;for j:=1 to l do bytemem[w,k+j-1]:=modtext[j]; +byteptr[w]:=k+l;bytestart[nameptr+2]:=k+l;nameptr:=nameptr+1;{:67}; +31:if c<>1 then begin begin if not phaseone then begin writeln(output); +write(output,'! Incompatible section names');error;end;end;p:=0;end; +modlookup:=p;end;{:66}{69:} +function prefixlookup(l:sixteenbits):namepointer;var c:0..4; +count:0..maxnames;j:0..longestname;k:0..maxbytes;w:0..1;p:namepointer; +q:namepointer;r:namepointer;begin q:=0;p:=ilk[0];count:=0;r:=0; +while p<>0 do begin{68:}begin k:=bytestart[p];w:=p mod 2;c:=1;j:=1; +while(k<bytestart[p+2])and(j<=l)and(modtext[j]=bytemem[w,k])do begin k:= +k+1;j:=j+1;end; +if k=bytestart[p+2]then if j>l then c:=1 else c:=4 else if j>l then c:=3 +else if modtext[j]<bytemem[w,k]then c:=0 else c:=2;end{:68}; +if c=0 then p:=link[p]else if c=2 then p:=ilk[p]else begin r:=p; +count:=count+1;q:=ilk[p];p:=link[p];end;if p=0 then begin p:=q;q:=0;end; +end;if count<>1 then if count=0 then begin if not phaseone then begin +writeln(output);write(output,'! Name does not match');error;end; +end else begin if not phaseone then begin writeln(output); +write(output,'! Ambiguous prefix');error;end;end;prefixlookup:=r;end; +{:69}{74:}function linesdontmatch:boolean;label 10;var k:0..bufsize; +begin linesdontmatch:=true;if changelimit<>limit then goto 10; +if limit>0 then for k:=0 to limit-1 do if changebuffer[k]<>buffer[k]then +goto 10;linesdontmatch:=false;10:end;{:74}{75:} +procedure primethechangebuffer;label 22,30,10;var k:0..bufsize; +begin changelimit:=0;{76:}while true do begin line:=line+1; +if not inputln(changefile)then goto 10;if limit<2 then goto 22; +if buffer[0]<>64 then goto 22; +if(buffer[1]>=88)and(buffer[1]<=90)then buffer[1]:=buffer[1]+32; +if buffer[1]=120 then goto 30; +if(buffer[1]=121)or(buffer[1]=122)then begin loc:=2; +begin if not phaseone then begin writeln(output); +write(output,'! Where is the matching @x?');error;end;end;end;22:end; +30:{:76};{77:}repeat line:=line+1; +if not inputln(changefile)then begin begin if not phaseone then begin +writeln(output);write(output,'! Change file ended after @x');error;end; +end;goto 10;end;until limit>0;{:77};{78:}begin changelimit:=limit; +if limit>0 then for k:=0 to limit-1 do changebuffer[k]:=buffer[k]; +end{:78};10:end;{:75}{79:}procedure checkchange;label 10;var n:integer; +k:0..bufsize;begin if linesdontmatch then goto 10;changepending:=false; +if not changedmodule[modulecount]then begin loc:=0;buffer[limit]:=33; +while(buffer[loc]=32)or(buffer[loc]=9)do loc:=loc+1;buffer[limit]:=32; +if buffer[loc]=64 then if(buffer[loc+1]=42)or(buffer[loc+1]=32)or(buffer +[loc+1]=9)then changepending:=true; +if not changepending then changedmodule[modulecount]:=true;end;n:=0; +while true do begin changing:=not changing;templine:=otherline; +otherline:=line;line:=templine;line:=line+1; +if not inputln(changefile)then begin begin if not phaseone then begin +writeln(output);write(output,'! Change file ended before @y');error;end; +end;changelimit:=0;changing:=not changing;templine:=otherline; +otherline:=line;line:=templine;goto 10;end;{80:} +if limit>1 then if buffer[0]=64 then begin if(buffer[1]>=88)and(buffer[1 +]<=90)then buffer[1]:=buffer[1]+32; +if(buffer[1]=120)or(buffer[1]=122)then begin loc:=2; +begin if not phaseone then begin writeln(output); +write(output,'! Where is the matching @y?');error;end;end; +end else if buffer[1]=121 then begin if n>0 then begin loc:=2; +begin if not phaseone then begin writeln(output); +write(output,'! Hmm... ',n:1,' of the preceding lines failed to match'); +error;end;end;end;goto 10;end;end{:80};{78:}begin changelimit:=limit; +if limit>0 then for k:=0 to limit-1 do changebuffer[k]:=buffer[k]; +end{:78};changing:=not changing;templine:=otherline;otherline:=line; +line:=templine;line:=line+1; +if not inputln(webfile)then begin begin if not phaseone then begin +writeln(output);write(output,'! WEB file ended during a change');error; +end;end;inputhasended:=true;goto 10;end;if linesdontmatch then n:=n+1; +end;10:end;{:79}{81:}procedure resetinput;begin openinput;line:=0; +otherline:=0;changing:=true;primethechangebuffer;changing:=not changing; +templine:=otherline;otherline:=line;line:=templine;limit:=0;loc:=1; +buffer[0]:=32;inputhasended:=false;end;{:81}{82:}procedure getline; +label 20;begin 20:if changing then{84:}begin line:=line+1; +if not inputln(changefile)then begin begin if not phaseone then begin +writeln(output);write(output,'! Change file ended without @z');error; +end;end;buffer[0]:=64;buffer[1]:=122;limit:=2;end; +if limit>0 then begin if changepending then begin loc:=0; +buffer[limit]:=33;while(buffer[loc]=32)or(buffer[loc]=9)do loc:=loc+1; +buffer[limit]:=32; +if buffer[loc]=64 then if(buffer[loc+1]=42)or(buffer[loc+1]=32)or(buffer +[loc+1]=9)then changepending:=false; +if changepending then begin changedmodule[modulecount]:=true; +changepending:=false;end;end;buffer[limit]:=32; +if buffer[0]=64 then begin if(buffer[1]>=88)and(buffer[1]<=90)then +buffer[1]:=buffer[1]+32; +if(buffer[1]=120)or(buffer[1]=121)then begin loc:=2; +begin if not phaseone then begin writeln(output); +write(output,'! Where is the matching @z?');error;end;end; +end else if buffer[1]=122 then begin primethechangebuffer; +changing:=not changing;templine:=otherline;otherline:=line; +line:=templine;end;end;end;end{:84};if not changing then begin{83:} +begin line:=line+1; +if not inputln(webfile)then inputhasended:=true else if limit= +changelimit then if buffer[0]=changebuffer[0]then if changelimit>0 then +checkchange;end{:83};if changing then goto 20;end;loc:=0; +buffer[limit]:=32;end;{:82}{87:} +function controlcode(c:ASCIIcode):eightbits; +begin case c of 64:controlcode:=64;39:controlcode:=12; +34:controlcode:=13;36:controlcode:=135;32,9,42:controlcode:=147; +61:controlcode:=2;92:controlcode:=3;68,100:controlcode:=144; +70,102:controlcode:=143;123:controlcode:=9;125:controlcode:=10; +80,112:controlcode:=145;38:controlcode:=136;60:controlcode:=146; +62:begin begin if not phaseone then begin writeln(output); +write(output,'! Extra @>');error;end;end;controlcode:=0;end; +84,116:controlcode:=134;33:controlcode:=126;63:controlcode:=125; +94:controlcode:=131;58:controlcode:=132;46:controlcode:=133; +44:controlcode:=137;124:controlcode:=138;47:controlcode:=139; +35:controlcode:=140;43:controlcode:=141;59:controlcode:=142;{88:} +{48,49,50:begin tracing:=c-48;controlcode:=0;end;}{:88} +otherwise begin begin if not phaseone then begin writeln(output); +write(output,'! Unknown control code');error;end;end;controlcode:=0; +end end;end;{:87}{89:}procedure skiplimbo;label 10;var c:ASCIIcode; +begin while true do if loc>limit then begin getline; +if inputhasended then goto 10;end else begin buffer[limit+1]:=64; +while buffer[loc]<>64 do loc:=loc+1;if loc<=limit then begin loc:=loc+2; +c:=buffer[loc-1];if(c=32)or(c=9)or(c=42)then goto 10;end;end;10:end; +{:89}{90:}function skipTeX:eightbits;label 30;var c:eightbits; +begin while true do begin if loc>limit then begin getline; +if inputhasended then begin c:=147;goto 30;end;end;buffer[limit+1]:=64; +repeat c:=buffer[loc];loc:=loc+1;if c=124 then goto 30;until c=64; +if loc<=limit then begin c:=controlcode(buffer[loc]);loc:=loc+1;goto 30; +end;end;30:skipTeX:=c;end;{:90}{91:} +function skipcomment(bal:eightbits):eightbits;label 30;var c:ASCIIcode; +begin while true do begin if loc>limit then begin getline; +if inputhasended then begin bal:=0;goto 30;end;end;c:=buffer[loc]; +loc:=loc+1;if c=124 then goto 30;{92:}if c=64 then begin c:=buffer[loc]; +if(c<>32)and(c<>9)and(c<>42)then loc:=loc+1 else begin loc:=loc-1; +bal:=0;goto 30; +end end else if(c=92)and(buffer[loc]<>64)then loc:=loc+1 else if c=123 +then bal:=bal+1 else if c=125 then begin bal:=bal-1; +if bal=0 then goto 30;end{:92};end;30:skipcomment:=bal;end;{:91}{95:} +function getnext:eightbits;label 20,30,31;var c:eightbits;d:eightbits; +j,k:0..longestname;begin 20:if loc>limit then begin getline; +if inputhasended then begin c:=147;goto 31;end;end;c:=buffer[loc]; +loc:=loc+1;if scanninghex then{96:} +if((c>=48)and(c<=57))or((c>=65)and(c<=70))then goto 31 else scanninghex +:=false{:96}; +case c of 65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85 +,86,87,88,89,90,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111 +,112,113,114,115,116,117,118,119,120,121,122:{98:} +begin if((c=69)or(c=101))and(loc>1)then if(buffer[loc-2]<=57)and(buffer[ +loc-2]>=48)then c:=128;if c<>128 then begin loc:=loc-1;idfirst:=loc; +repeat loc:=loc+1;d:=buffer[loc]; +until((d<48)or((d>57)and(d<65))or((d>90)and(d<97))or(d>122))and(d<>95); +c:=130;idloc:=loc;end;end{:98};39,34:{99:}begin idfirst:=loc-1; +repeat d:=buffer[loc];loc:=loc+1; +if loc>limit then begin begin if not phaseone then begin writeln(output) +;write(output,'! String constant didn''t end');error;end;end;loc:=limit; +d:=c;end;until d=c;idloc:=loc;c:=129;end{:99};64:{100:} +begin c:=controlcode(buffer[loc]);loc:=loc+1; +if c=126 then begin xrefswitch:=10240;goto 20; +end else if c=125 then begin xrefswitch:=0;goto 20; +end else if(c<=134)and(c>=131)then{106:}begin idfirst:=loc; +buffer[limit+1]:=64;while buffer[loc]<>64 do loc:=loc+1;idloc:=loc; +if loc>limit then begin begin if not phaseone then begin writeln(output) +;write(output,'! Control text didn''t end');error;end;end;loc:=limit; +end else begin loc:=loc+2; +if buffer[loc-1]<>62 then begin if not phaseone then begin writeln( +output);write(output,'! Control codes are forbidden in control text'); +error;end;end;end;end{:106} +else if c=13 then scanninghex:=true else if c=146 then{101:}begin{103:} +k:=0;while true do begin if loc>limit then begin getline; +if inputhasended then begin begin if not phaseone then begin writeln( +output);write(output,'! Input ended in section name');error;end;end; +loc:=1;goto 30;end;end;d:=buffer[loc];{104:} +if d=64 then begin d:=buffer[loc+1];if d=62 then begin loc:=loc+2; +goto 30;end; +if(d=32)or(d=9)or(d=42)then begin begin if not phaseone then begin +writeln(output);write(output,'! Section name didn''t end');error;end; +end;goto 30;end;k:=k+1;modtext[k]:=64;loc:=loc+1;end{:104};loc:=loc+1; +if k<longestname-1 then k:=k+1;if(d=32)or(d=9)then begin d:=32; +if modtext[k-1]=32 then k:=k-1;end;modtext[k]:=d;end;30:{105:} +if k>=longestname-2 then begin begin writeln(output); +write(output,'! Section name too long: ');end; +for j:=1 to 25 do write(output,xchr[modtext[j]]);write(output,'...'); +if history=0 then history:=1;end{:105}; +if(modtext[k]=32)and(k>0)then k:=k-1{:103}; +if k>3 then begin if(modtext[k]=46)and(modtext[k-1]=46)and(modtext[k-2]= +46)then curmodule:=prefixlookup(k-3)else curmodule:=modlookup(k); +end else curmodule:=modlookup(k);xrefswitch:=0;end{:101} +else if c=2 then{107:}begin idfirst:=loc;loc:=loc+1;buffer[limit+1]:=64; +buffer[limit+2]:=62; +while(buffer[loc]<>64)or(buffer[loc+1]<>62)do loc:=loc+1; +if loc>=limit then begin if not phaseone then begin writeln(output); +write(output,'! Verbatim string didn''t end');error;end;end;idloc:=loc; +loc:=loc+2;end{:107};end{:100};{97:} +46:if buffer[loc]=46 then begin if loc<=limit then begin c:=32; +loc:=loc+1;end; +end else if buffer[loc]=41 then begin if loc<=limit then begin c:=93; +loc:=loc+1;end;end; +58:if buffer[loc]=61 then begin if loc<=limit then begin c:=24; +loc:=loc+1;end;end; +61:if buffer[loc]=61 then begin if loc<=limit then begin c:=30; +loc:=loc+1;end;end; +62:if buffer[loc]=61 then begin if loc<=limit then begin c:=29; +loc:=loc+1;end;end; +60:if buffer[loc]=61 then begin if loc<=limit then begin c:=28; +loc:=loc+1;end; +end else if buffer[loc]=62 then begin if loc<=limit then begin c:=26; +loc:=loc+1;end;end; +40:if buffer[loc]=42 then begin if loc<=limit then begin c:=9; +loc:=loc+1;end; +end else if buffer[loc]=46 then begin if loc<=limit then begin c:=91; +loc:=loc+1;end;end; +42:if buffer[loc]=41 then begin if loc<=limit then begin c:=10; +loc:=loc+1;end;end;{:97}32,9:goto 20; +125:begin begin if not phaseone then begin writeln(output); +write(output,'! Extra }');error;end;end;goto 20;end; +otherwise if c>=128 then goto 20 else end; +31:{if troubleshooting then debughelp;}getnext:=c;end;{:95}{111:} +procedure Pascalxref;label 10;var p:namepointer; +begin while nextcontrol<143 do begin if(nextcontrol>=130)and(nextcontrol +<=133)then begin p:=idlookup(nextcontrol-130);newxref(p); +if(ilk[p]=17)or(ilk[p]=22)then xrefswitch:=10240;end; +nextcontrol:=getnext;if(nextcontrol=124)or(nextcontrol=123)then goto 10; +end;10:end;{:111}{112:}procedure outerxref;var bal:eightbits; +begin while nextcontrol<143 do if nextcontrol<>123 then Pascalxref else +begin bal:=skipcomment(1);nextcontrol:=124; +while bal>0 do begin Pascalxref; +if nextcontrol=124 then bal:=skipcomment(bal)else bal:=0;end;end;end; +{:112}{119:}procedure modcheck(p:namepointer); +begin if p>0 then begin modcheck(link[p]);curxref:=xref[p]; +if xmem[curxref].numfield<10240 then begin begin writeln(output); +write(output,'! Never defined: <');end;printid(p);write(output,'>'); +if history=0 then history:=1;end; +while xmem[curxref].numfield>=10240 do curxref:=xmem[curxref].xlinkfield +;if curxref=0 then begin begin writeln(output); +write(output,'! Never used: <');end;printid(p);write(output,'>'); +if history=0 then history:=1;end;modcheck(ilk[p]);end;end;{:119}{122:} +procedure flushbuffer(b:eightbits;percent,carryover:boolean); +label 30,31;var j,k:0..linelength;begin j:=b; +if not percent then while true do begin if j=0 then goto 30; +if outbuf[j]<>32 then goto 30;j:=j-1;end; +30:for k:=1 to j do write(texfile,xchr[outbuf[k]]); +if percent then write(texfile,xchr[37]);writeln(texfile); +outline:=outline+1; +if carryover then for k:=1 to j do if outbuf[k]=37 then if(k=1)or(outbuf +[k-1]<>92)then begin outbuf[b]:=37;b:=b-1;goto 31;end; +31:if(b<outptr)then for k:=b+1 to outptr do outbuf[k-b]:=outbuf[k]; +outptr:=outptr-b;end;{:122}{123:}procedure finishline;label 10; +var k:0..bufsize; +begin if outptr>0 then flushbuffer(outptr,false,false)else begin for k:= +0 to limit do if(buffer[k]<>32)and(buffer[k]<>9)then goto 10; +flushbuffer(0,false,false);end;10:end;{:123}{127:}procedure breakout; +label 10;var k:0..linelength;d:ASCIIcode;begin k:=outptr; +while true do begin if k=0 then{128:}begin begin writeln(output); +write(output,'! Line had to be broken (output l.',outline:1);end; +writeln(output,'):'); +for k:=1 to outptr-1 do write(output,xchr[outbuf[k]]);writeln(output); +if history=0 then history:=1;flushbuffer(outptr-1,true,true);goto 10; +end{:128};d:=outbuf[k];if d=32 then begin flushbuffer(k,false,true); +goto 10;end; +if(d=92)and(outbuf[k-1]<>92)then begin flushbuffer(k-1,true,true); +goto 10;end;k:=k-1;end;10:end;{:127}{130:}procedure outmod(m:integer); +var k:0..5;a:integer;begin k:=0;a:=m;repeat dig[k]:=a mod 10; +a:=a div 10;k:=k+1;until a=0;repeat k:=k-1; +begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=dig[k]+48;end;until k=0; +if changedmodule[m]then begin if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=92;if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=42;end;end;{:130}{131:} +procedure outname(p:namepointer);var k:0..maxbytes;w:0..1; +begin begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=123;end;w:=p mod 2; +for k:=bytestart[p]to bytestart[p+2]-1 do begin if bytemem[w,k]=95 then +begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=92;end;begin if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=bytemem[w,k];end;end; +begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=125;end;end;{:131}{132:}procedure copylimbo;label 10; +var c:ASCIIcode;begin while true do if loc>limit then begin finishline; +getline;if inputhasended then goto 10; +end else begin buffer[limit+1]:=64;{133:} +while buffer[loc]<>64 do begin begin if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=buffer[loc];end;loc:=loc+1;end; +if loc<=limit then begin loc:=loc+2;c:=buffer[loc-1]; +if(c=32)or(c=9)or(c=42)then goto 10; +if(c<>122)and(c<>90)then begin begin if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=64;end; +if c<>64 then begin if not phaseone then begin writeln(output); +write(output,'! Double @ required outside of sections');error;end;end; +end;end{:133};end;10:end;{:132}{134:}function copyTeX:eightbits; +label 30;var c:eightbits; +begin while true do begin if loc>limit then begin finishline;getline; +if inputhasended then begin c:=147;goto 30;end;end;buffer[limit+1]:=64; +{135:}repeat c:=buffer[loc];loc:=loc+1;if c=124 then goto 30; +if c<>64 then begin begin if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=c;end; +if(outptr=1)and((c=32)or(c=9))then outptr:=outptr-1;end;until c=64; +if loc<=limit then begin c:=controlcode(buffer[loc]);loc:=loc+1;goto 30; +end{:135};end;30:copyTeX:=c;end;{:134}{136:} +function copycomment(bal:eightbits):eightbits;label 30;var c:ASCIIcode; +begin while true do begin if loc>limit then begin getline; +if inputhasended then begin begin if not phaseone then begin writeln( +output);write(output,'! Input ended in mid-comment');error;end;end; +loc:=1;{138:}begin if tokptr+2>maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[tokptr]:=32;tokptr:=tokptr+1;end; +repeat begin if tokptr+2>maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[tokptr]:=125;tokptr:=tokptr+1;end;bal:=bal-1; +until bal=0;goto 30;{:138};end;end;c:=buffer[loc];loc:=loc+1; +if c=124 then goto 30; +begin if tokptr+2>maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[tokptr]:=c;tokptr:=tokptr+1;end;{137:} +if c=64 then begin loc:=loc+1; +if buffer[loc-1]<>64 then begin begin if not phaseone then begin writeln +(output);write(output,'! Illegal use of @ in comment');error;end;end; +loc:=loc-2;tokptr:=tokptr-1;{138:} +begin if tokptr+2>maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[tokptr]:=32;tokptr:=tokptr+1;end; +repeat begin if tokptr+2>maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[tokptr]:=125;tokptr:=tokptr+1;end;bal:=bal-1; +until bal=0;goto 30;{:138};end; +end else if(c=92)and(buffer[loc]<>64)then begin begin if tokptr+2> +maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[tokptr]:=buffer[loc];tokptr:=tokptr+1;end;loc:=loc+1; +end else if c=123 then bal:=bal+1 else if c=125 then begin bal:=bal-1; +if bal=0 then goto 30;end{:137};end;30:copycomment:=bal;end;{:136}{140:} +{procedure printcat(c:eightbits);begin case c of 1:write(output,'simp'); +2:write(output,'math');3:write(output,'intro');4:write(output,'open'); +5:write(output,'beginning');6:write(output,'close'); +7:write(output,'alpha');8:write(output,'omega');9:write(output,'semi'); +10:write(output,'terminator');11:write(output,'stmt'); +12:write(output,'cond');13:write(output,'clause'); +14:write(output,'colon');15:write(output,'exp');16:write(output,'proc'); +17:write(output,'casehead');18:write(output,'recordhead'); +19:write(output,'varhead');20:write(output,'elsie'); +21:write(output,'casey');22:write(output,'module'); +otherwise write(output,'UNKNOWN')end;end;}{:140}{146:} +{procedure printtext(p:textpointer);var j:0..maxtoks;r:0..10239; +begin if p>=textptr then write(output,'BAD')else for j:=tokstart[p]to +tokstart[p+1]-1 do begin r:=tokmem[j]mod 10240; +case tokmem[j]div 10240 of 1:begin write(output,'\\',xchr[123]); +printid(r);write(output,xchr[125]);end; +2:begin write(output,'\&',xchr[123]);printid(r);write(output,xchr[125]); +end;3:begin write(output,'<');printid(r);write(output,'>');end; +4:write(output,'[[',r:1,']]');5:write(output,'|[[',r:1,']]|'); +otherwise[147:]case r of 131:write(output,'\mathbin',xchr[123]); +132:write(output,'\mathrel',xchr[123]); +133:write(output,'\mathop',xchr[123]);134:write(output,'[ccancel]'); +135:write(output,'[cancel]');136:write(output,'[indent]'); +137:write(output,'[outdent]');139:write(output,'[backup]'); +138:write(output,'[opt]');140:write(output,'[break]'); +141:write(output,'[force]');142:write(output,'[fforce]'); +143:write(output,'[quit]');otherwise write(output,xchr[r])end[:147]end; +end;end;}{:146}{172:}procedure red(j:sixteenbits;k:eightbits; +c:eightbits;d:integer);var i:0..maxscraps;begin cat[j]:=c; +trans[j]:=textptr;textptr:=textptr+1;tokstart[textptr]:=tokptr; +if k>1 then begin for i:=j+k to loptr do begin cat[i-k+1]:=cat[i]; +trans[i-k+1]:=trans[i];end;loptr:=loptr-k+1;end;{173:} +if pp+d>=scrapbase then pp:=pp+d else pp:=scrapbase{:173};end;{:172} +{174:}procedure sq(j:sixteenbits;k:eightbits;c:eightbits;d:integer); +var i:0..maxscraps;begin if k=1 then begin cat[j]:=c;{173:} +if pp+d>=scrapbase then pp:=pp+d else pp:=scrapbase{:173}; +end else begin for i:=j to j+k-1 do begin tokmem[tokptr]:=40960+trans[i] +;tokptr:=tokptr+1;end;red(j,k,c,d);end;end;{:174}{178:} +{procedure prod(n:eightbits);var k:1..maxscraps; +begin if tracing=2 then begin begin writeln(output); +write(output,n:1,':');end; +for k:=scrapbase to loptr do begin if k=pp then write(output,'*')else +write(output,' ');printcat(cat[k]);end; +if hiptr<=scrapptr then write(output,'...');end;end;}{:178}{179:}{150:} +procedure fivecases;label 31;begin case cat[pp]of 5:{152:} +if cat[pp+1]=6 then begin if(cat[pp+2]=10)or(cat[pp+2]=11)then begin sq( +pp,3,11,-2);{prod(5)};goto 31;end; +end else if cat[pp+1]=11 then begin tokmem[tokptr]:=40960+trans[pp]; +tokptr:=tokptr+1;tokmem[tokptr]:=140;tokptr:=tokptr+1; +tokmem[tokptr]:=40960+trans[pp+1];tokptr:=tokptr+1;red(pp,2,5,-1); +{prod(6)};goto 31;end{:152};3:{159:} +if cat[pp+1]=11 then begin tokmem[tokptr]:=40960+trans[pp]; +tokptr:=tokptr+1;tokmem[tokptr]:=32;tokptr:=tokptr+1; +tokmem[tokptr]:=138;tokptr:=tokptr+1;tokmem[tokptr]:=55; +tokptr:=tokptr+1;tokmem[tokptr]:=135;tokptr:=tokptr+1; +tokmem[tokptr]:=40960+trans[pp+1];tokptr:=tokptr+1;red(pp,2,11,-2); +{prod(17)};goto 31;end{:159};2:{160:} +if cat[pp+1]=6 then begin tokmem[tokptr]:=36;tokptr:=tokptr+1; +tokmem[tokptr]:=40960+trans[pp];tokptr:=tokptr+1;tokmem[tokptr]:=36; +tokptr:=tokptr+1;red(pp,1,11,-2);{prod(18)};goto 31; +end else if cat[pp+1]=14 then begin tokmem[tokptr]:=141; +tokptr:=tokptr+1;tokmem[tokptr]:=139;tokptr:=tokptr+1; +tokmem[tokptr]:=36;tokptr:=tokptr+1;tokmem[tokptr]:=40960+trans[pp]; +tokptr:=tokptr+1;tokmem[tokptr]:=36;tokptr:=tokptr+1; +tokmem[tokptr]:=40960+trans[pp+1];tokptr:=tokptr+1;red(pp,2,3,-3); +{prod(19)};goto 31;end else if cat[pp+1]=2 then begin sq(pp,2,2,-1); +{prod(20)};goto 31;end else if cat[pp+1]=1 then begin sq(pp,2,2,-1); +{prod(21)};goto 31; +end else if cat[pp+1]=11 then begin tokmem[tokptr]:=36;tokptr:=tokptr+1; +tokmem[tokptr]:=40960+trans[pp];tokptr:=tokptr+1;tokmem[tokptr]:=36; +tokptr:=tokptr+1;tokmem[tokptr]:=136;tokptr:=tokptr+1; +tokmem[tokptr]:=140;tokptr:=tokptr+1;tokmem[tokptr]:=40960+trans[pp+1]; +tokptr:=tokptr+1;tokmem[tokptr]:=135;tokptr:=tokptr+1; +tokmem[tokptr]:=137;tokptr:=tokptr+1;tokmem[tokptr]:=141; +tokptr:=tokptr+1;red(pp,2,11,-2);{prod(22)};goto 31; +end else if cat[pp+1]=10 then begin tokmem[tokptr]:=36;tokptr:=tokptr+1; +tokmem[tokptr]:=40960+trans[pp];tokptr:=tokptr+1;tokmem[tokptr]:=36; +tokptr:=tokptr+1;tokmem[tokptr]:=40960+trans[pp+1];tokptr:=tokptr+1; +red(pp,2,11,-2);{prod(23)};goto 31;end{:160};4:{162:} +if(cat[pp+1]=17)and(cat[pp+2]=6)then begin tokmem[tokptr]:=40960+trans[ +pp];tokptr:=tokptr+1;tokmem[tokptr]:=36;tokptr:=tokptr+1; +tokmem[tokptr]:=135;tokptr:=tokptr+1;tokmem[tokptr]:=40960+trans[pp+1]; +tokptr:=tokptr+1;tokmem[tokptr]:=135;tokptr:=tokptr+1; +tokmem[tokptr]:=137;tokptr:=tokptr+1;tokmem[tokptr]:=36; +tokptr:=tokptr+1;tokmem[tokptr]:=40960+trans[pp+2];tokptr:=tokptr+1; +red(pp,3,2,-1);{prod(26)};goto 31; +end else if cat[pp+1]=6 then begin tokmem[tokptr]:=40960+trans[pp]; +tokptr:=tokptr+1;tokmem[tokptr]:=92;tokptr:=tokptr+1;tokmem[tokptr]:=44; +tokptr:=tokptr+1;tokmem[tokptr]:=40960+trans[pp+1];tokptr:=tokptr+1; +red(pp,2,2,-1);{prod(27)};goto 31;end else if cat[pp+1]=2 then{163:} +begin if(cat[pp+2]=17)and(cat[pp+3]=6)then begin tokmem[tokptr]:=40960+ +trans[pp];tokptr:=tokptr+1;tokmem[tokptr]:=40960+trans[pp+1]; +tokptr:=tokptr+1;tokmem[tokptr]:=36;tokptr:=tokptr+1; +tokmem[tokptr]:=135;tokptr:=tokptr+1;tokmem[tokptr]:=40960+trans[pp+2]; +tokptr:=tokptr+1;tokmem[tokptr]:=135;tokptr:=tokptr+1; +tokmem[tokptr]:=137;tokptr:=tokptr+1;tokmem[tokptr]:=36; +tokptr:=tokptr+1;tokmem[tokptr]:=40960+trans[pp+3];tokptr:=tokptr+1; +red(pp,4,2,-1);{prod(28)};goto 31; +end else if cat[pp+2]=6 then begin sq(pp,3,2,-1);{prod(29)};goto 31; +end else if cat[pp+2]=14 then begin sq(pp+1,2,2,0);{prod(30)};goto 31; +end else if cat[pp+2]=16 then begin if cat[pp+3]=3 then begin tokmem[ +tokptr]:=40960+trans[pp+1];tokptr:=tokptr+1;tokmem[tokptr]:=133; +tokptr:=tokptr+1;tokmem[tokptr]:=135;tokptr:=tokptr+1; +tokmem[tokptr]:=40960+trans[pp+2];tokptr:=tokptr+1;tokmem[tokptr]:=125; +tokptr:=tokptr+1;red(pp+1,3,2,0);{prod(31)};goto 31;end; +end else if cat[pp+2]=9 then begin tokmem[tokptr]:=40960+trans[pp+1]; +tokptr:=tokptr+1;tokmem[tokptr]:=40960+trans[pp+2];tokptr:=tokptr+1; +tokmem[tokptr]:=92;tokptr:=tokptr+1;tokmem[tokptr]:=44;tokptr:=tokptr+1; +tokmem[tokptr]:=138;tokptr:=tokptr+1;tokmem[tokptr]:=53; +tokptr:=tokptr+1;red(pp+1,2,2,0);{prod(32)};goto 31; +end else if cat[pp+2]=19 then begin if cat[pp+3]=3 then begin tokmem[ +tokptr]:=40960+trans[pp+1];tokptr:=tokptr+1;tokmem[tokptr]:=133; +tokptr:=tokptr+1;tokmem[tokptr]:=135;tokptr:=tokptr+1; +tokmem[tokptr]:=40960+trans[pp+2];tokptr:=tokptr+1;tokmem[tokptr]:=125; +tokptr:=tokptr+1;red(pp+1,3,2,0);{prod(31)};goto 31;end;end;end{:163} +else if cat[pp+1]=16 then begin if cat[pp+2]=3 then begin tokmem[tokptr] +:=133;tokptr:=tokptr+1;tokmem[tokptr]:=135;tokptr:=tokptr+1; +tokmem[tokptr]:=40960+trans[pp+1];tokptr:=tokptr+1;tokmem[tokptr]:=125; +tokptr:=tokptr+1;red(pp+1,2,2,0);{prod(34)};goto 31;end; +end else if cat[pp+1]=1 then begin sq(pp+1,1,2,0);{prod(35)};goto 31; +end else if(cat[pp+1]=11)and(cat[pp+2]=6)then begin tokmem[tokptr]:= +40960+trans[pp];tokptr:=tokptr+1;tokmem[tokptr]:=36;tokptr:=tokptr+1; +tokmem[tokptr]:=135;tokptr:=tokptr+1;tokmem[tokptr]:=40960+trans[pp+1]; +tokptr:=tokptr+1;tokmem[tokptr]:=135;tokptr:=tokptr+1; +tokmem[tokptr]:=36;tokptr:=tokptr+1;tokmem[tokptr]:=40960+trans[pp+2]; +tokptr:=tokptr+1;red(pp,3,2,-1);{prod(36)};goto 31; +end else if cat[pp+1]=19 then begin if cat[pp+2]=3 then begin tokmem[ +tokptr]:=133;tokptr:=tokptr+1;tokmem[tokptr]:=135;tokptr:=tokptr+1; +tokmem[tokptr]:=40960+trans[pp+1];tokptr:=tokptr+1;tokmem[tokptr]:=125; +tokptr:=tokptr+1;red(pp+1,2,2,0);{prod(37)};goto 31;end;end{:162}; +1:{167:}if cat[pp+1]=6 then begin sq(pp,1,11,-2);{prod(43)};goto 31; +end else if cat[pp+1]=14 then begin tokmem[tokptr]:=141; +tokptr:=tokptr+1;tokmem[tokptr]:=139;tokptr:=tokptr+1; +tokmem[tokptr]:=40960+trans[pp];tokptr:=tokptr+1; +tokmem[tokptr]:=40960+trans[pp+1];tokptr:=tokptr+1;red(pp,2,3,-3); +{prod(44)};goto 31;end else if cat[pp+1]=2 then begin sq(pp,2,2,-1); +{prod(45)};goto 31;end else if cat[pp+1]=22 then begin sq(pp,2,22,0); +{prod(46)};goto 31;end else if cat[pp+1]=1 then begin sq(pp,2,1,-2); +{prod(47)};goto 31;end else if cat[pp+1]=10 then begin sq(pp,2,11,-2); +{prod(48)};goto 31;end{:167};otherwise end;pp:=pp+1;31:end; +procedure alphacases;label 31;begin{151:} +if cat[pp+1]=2 then begin if cat[pp+2]=14 then begin sq(pp+1,2,2,0); +{prod(1)};goto 31; +end else if cat[pp+2]=8 then begin tokmem[tokptr]:=40960+trans[pp]; +tokptr:=tokptr+1;tokmem[tokptr]:=32;tokptr:=tokptr+1;tokmem[tokptr]:=36; +tokptr:=tokptr+1;tokmem[tokptr]:=40960+trans[pp+1];tokptr:=tokptr+1; +tokmem[tokptr]:=36;tokptr:=tokptr+1;tokmem[tokptr]:=32;tokptr:=tokptr+1; +tokmem[tokptr]:=136;tokptr:=tokptr+1;tokmem[tokptr]:=40960+trans[pp+2]; +tokptr:=tokptr+1;red(pp,3,13,-2);{prod(2)};goto 31;end; +end else if cat[pp+1]=8 then begin tokmem[tokptr]:=40960+trans[pp]; +tokptr:=tokptr+1;tokmem[tokptr]:=32;tokptr:=tokptr+1; +tokmem[tokptr]:=136;tokptr:=tokptr+1;tokmem[tokptr]:=40960+trans[pp+1]; +tokptr:=tokptr+1;red(pp,2,13,-2);{prod(3)};goto 31; +end else if cat[pp+1]=1 then begin sq(pp+1,1,2,0);{prod(4)};goto 31; +end{:151};pp:=pp+1;31:end;{:150}function translate:textpointer; +label 30,31;var i:1..maxscraps;j:0..maxscraps;k:0..longbufsize; +begin pp:=scrapbase;loptr:=pp-1;hiptr:=pp;{182:} +{if tracing=2 then begin begin writeln(output); +write(output,'Tracing after l.',line:1,':');end; +if history=0 then history:=1;if loc>50 then begin write(output,'...'); +for k:=loc-50 to loc do write(output,xchr[buffer[k-1]]); +end else for k:=1 to loc do write(output,xchr[buffer[k-1]]);end}{:182}; +{175:}while true do begin{176:} +if loptr<pp+3 then begin repeat if hiptr<=scrapptr then begin loptr:= +loptr+1;cat[loptr]:=cat[hiptr];trans[loptr]:=trans[hiptr]; +hiptr:=hiptr+1;end;until(hiptr>scrapptr)or(loptr=pp+3); +for i:=loptr+1 to pp+3 do cat[i]:=0;end{:176}; +if(tokptr+8>maxtoks)or(textptr+4>maxtexts)then begin if tokptr>maxtokptr +then maxtokptr:=tokptr;if textptr>maxtxtptr then maxtxtptr:=textptr; +begin writeln(output); +write(output,'! Sorry, ','token/text',' capacity exceeded');error; +history:=3;jumpout;end;end;if pp>loptr then goto 30;{149:} +if cat[pp]<=7 then if cat[pp]<7 then fivecases else alphacases else +begin case cat[pp]of 17:{153:} +if cat[pp+1]=21 then begin if cat[pp+2]=13 then begin tokmem[tokptr]:= +40960+trans[pp];tokptr:=tokptr+1;tokmem[tokptr]:=137;tokptr:=tokptr+1; +tokmem[tokptr]:=40960+trans[pp+1];tokptr:=tokptr+1; +tokmem[tokptr]:=40960+trans[pp+2];tokptr:=tokptr+1;red(pp,3,17,0); +{prod(7)};goto 31;end; +end else if cat[pp+1]=6 then begin if cat[pp+2]=10 then begin tokmem[ +tokptr]:=40960+trans[pp];tokptr:=tokptr+1;tokmem[tokptr]:=135; +tokptr:=tokptr+1;tokmem[tokptr]:=137;tokptr:=tokptr+1; +tokmem[tokptr]:=40960+trans[pp+1];tokptr:=tokptr+1; +tokmem[tokptr]:=40960+trans[pp+2];tokptr:=tokptr+1;red(pp,3,11,-2); +{prod(8)};goto 31;end; +end else if cat[pp+1]=11 then begin tokmem[tokptr]:=40960+trans[pp]; +tokptr:=tokptr+1;tokmem[tokptr]:=141;tokptr:=tokptr+1; +tokmem[tokptr]:=40960+trans[pp+1];tokptr:=tokptr+1;red(pp,2,17,0); +{prod(9)};goto 31;end{:153};21:{154:} +if cat[pp+1]=13 then begin sq(pp,2,17,0);{prod(10)};goto 31;end{:154}; +13:{155:}if cat[pp+1]=11 then begin tokmem[tokptr]:=40960+trans[pp]; +tokptr:=tokptr+1;tokmem[tokptr]:=140;tokptr:=tokptr+1; +tokmem[tokptr]:=40960+trans[pp+1];tokptr:=tokptr+1;tokmem[tokptr]:=135; +tokptr:=tokptr+1;tokmem[tokptr]:=137;tokptr:=tokptr+1; +tokmem[tokptr]:=141;tokptr:=tokptr+1;red(pp,2,11,-2);{prod(11)};goto 31; +end{:155};12:{156:} +if(cat[pp+1]=13)and(cat[pp+2]=11)then if cat[pp+3]=20 then begin tokmem[ +tokptr]:=40960+trans[pp];tokptr:=tokptr+1; +tokmem[tokptr]:=40960+trans[pp+1];tokptr:=tokptr+1;tokmem[tokptr]:=140; +tokptr:=tokptr+1;tokmem[tokptr]:=40960+trans[pp+2];tokptr:=tokptr+1; +tokmem[tokptr]:=40960+trans[pp+3];tokptr:=tokptr+1;tokmem[tokptr]:=32; +tokptr:=tokptr+1;tokmem[tokptr]:=135;tokptr:=tokptr+1;red(pp,4,13,-2); +{prod(12)};goto 31;end else begin tokmem[tokptr]:=40960+trans[pp]; +tokptr:=tokptr+1;tokmem[tokptr]:=40960+trans[pp+1];tokptr:=tokptr+1; +tokmem[tokptr]:=140;tokptr:=tokptr+1;tokmem[tokptr]:=40960+trans[pp+2]; +tokptr:=tokptr+1;tokmem[tokptr]:=135;tokptr:=tokptr+1; +tokmem[tokptr]:=137;tokptr:=tokptr+1;tokmem[tokptr]:=141; +tokptr:=tokptr+1;red(pp,3,11,-2);{prod(13)};goto 31;end{:156};20:{157:} +begin sq(pp,1,3,-3);{prod(14)};goto 31;end{:157};15:{158:} +if cat[pp+1]=2 then begin if cat[pp+2]=1 then if cat[pp+3]<>1 then begin +tokmem[tokptr]:=40960+trans[pp];tokptr:=tokptr+1; +tokmem[tokptr]:=40960+trans[pp+1];tokptr:=tokptr+1; +tokmem[tokptr]:=40960+trans[pp+2];tokptr:=tokptr+1;tokmem[tokptr]:=125; +tokptr:=tokptr+1;red(pp,3,2,-1);{prod(15)};goto 31;end; +end else if cat[pp+1]=1 then if cat[pp+2]<>1 then begin tokmem[tokptr]:= +40960+trans[pp];tokptr:=tokptr+1;tokmem[tokptr]:=40960+trans[pp+1]; +tokptr:=tokptr+1;tokmem[tokptr]:=125;tokptr:=tokptr+1;red(pp,2,2,-1); +{prod(16)};goto 31;end{:158};22:{161:} +if(cat[pp+1]=10)or(cat[pp+1]=9)then begin tokmem[tokptr]:=40960+trans[pp +];tokptr:=tokptr+1;tokmem[tokptr]:=40960+trans[pp+1];tokptr:=tokptr+1; +tokmem[tokptr]:=141;tokptr:=tokptr+1;red(pp,2,11,-2);{prod(24)};goto 31; +end else begin sq(pp,1,1,-2);{prod(25)};goto 31;end{:161};16:{164:} +if cat[pp+1]=5 then begin if(cat[pp+2]=6)and(cat[pp+3]=10)then begin +tokmem[tokptr]:=40960+trans[pp];tokptr:=tokptr+1;tokmem[tokptr]:=135; +tokptr:=tokptr+1;tokmem[tokptr]:=137;tokptr:=tokptr+1; +tokmem[tokptr]:=40960+trans[pp+1];tokptr:=tokptr+1; +tokmem[tokptr]:=40960+trans[pp+2];tokptr:=tokptr+1; +tokmem[tokptr]:=40960+trans[pp+3];tokptr:=tokptr+1;red(pp,4,11,-2); +{prod(38)};goto 31;end; +end else if cat[pp+1]=11 then begin tokmem[tokptr]:=40960+trans[pp]; +tokptr:=tokptr+1;tokmem[tokptr]:=140;tokptr:=tokptr+1; +tokmem[tokptr]:=40960+trans[pp+1];tokptr:=tokptr+1;red(pp,2,16,-2); +{prod(39)};goto 31;end{:164};18:{165:} +if(cat[pp+1]=3)and(cat[pp+2]=21)then begin tokmem[tokptr]:=40960+trans[ +pp];tokptr:=tokptr+1;tokmem[tokptr]:=40960+trans[pp+1];tokptr:=tokptr+1; +tokmem[tokptr]:=32;tokptr:=tokptr+1;tokmem[tokptr]:=135; +tokptr:=tokptr+1;tokmem[tokptr]:=40960+trans[pp+2];tokptr:=tokptr+1; +red(pp,3,21,-2);{prod(40)};goto 31;end else begin tokmem[tokptr]:=136; +tokptr:=tokptr+1;tokmem[tokptr]:=40960+trans[pp];tokptr:=tokptr+1; +tokmem[tokptr]:=135;tokptr:=tokptr+1;red(pp,1,17,0);{prod(41)};goto 31; +end{:165};9:{166:}begin sq(pp,1,10,-3);{prod(42)};goto 31;end{:166}; +11:{168:}if cat[pp+1]=11 then begin tokmem[tokptr]:=40960+trans[pp]; +tokptr:=tokptr+1;tokmem[tokptr]:=140;tokptr:=tokptr+1; +tokmem[tokptr]:=40960+trans[pp+1];tokptr:=tokptr+1;red(pp,2,11,-2); +{prod(49)};goto 31;end{:168};10:{169:}begin sq(pp,1,11,-2);{prod(50)}; +goto 31;end{:169};19:{170:}if cat[pp+1]=5 then begin sq(pp,1,11,-2); +{prod(51)};goto 31; +end else if cat[pp+1]=2 then begin if cat[pp+2]=14 then begin tokmem[ +tokptr]:=36;tokptr:=tokptr+1;tokmem[tokptr]:=40960+trans[pp+1]; +tokptr:=tokptr+1;tokmem[tokptr]:=36;tokptr:=tokptr+1; +tokmem[tokptr]:=40960+trans[pp+2];tokptr:=tokptr+1;red(pp+1,2,3,+1); +{prod(52)};goto 31;end; +end else if cat[pp+1]=1 then begin if cat[pp+2]=14 then begin sq(pp+1,2, +3,+1);{prod(53)};goto 31;end; +end else if cat[pp+1]=11 then begin tokmem[tokptr]:=40960+trans[pp]; +tokptr:=tokptr+1;tokmem[tokptr]:=140;tokptr:=tokptr+1; +tokmem[tokptr]:=40960+trans[pp+1];tokptr:=tokptr+1;red(pp,2,19,-2); +{prod(54)};goto 31;end{:170};otherwise end;pp:=pp+1;31:end{:149};end; +30:{:175}; +if(loptr=scrapbase)and(cat[loptr]<>2)then translate:=trans[loptr]else{ +180:}begin{181:} +{if(loptr>scrapbase)and(tracing=1)then begin begin writeln(output); +write(output,'Irreducible scrap sequence in section ',modulecount:1); +end;writeln(output,':');if history=0 then history:=1; +for j:=scrapbase to loptr do begin write(output,' ');printcat(cat[j]); +end;end;}{:181}; +for j:=scrapbase to loptr do begin if j<>scrapbase then begin tokmem[ +tokptr]:=32;tokptr:=tokptr+1;end; +if cat[j]=2 then begin tokmem[tokptr]:=36;tokptr:=tokptr+1;end; +tokmem[tokptr]:=40960+trans[j];tokptr:=tokptr+1; +if cat[j]=2 then begin tokmem[tokptr]:=36;tokptr:=tokptr+1;end; +if tokptr+6>maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;end;textptr:=textptr+1;tokstart[textptr]:=tokptr; +translate:=textptr-1;end{:180};end;{:179}{183:}{195:} +procedure appcomment;begin textptr:=textptr+1;tokstart[textptr]:=tokptr; +if(scrapptr<scrapbase)or(cat[scrapptr]<8)or(cat[scrapptr]>10)then begin +scrapptr:=scrapptr+1;cat[scrapptr]:=10;trans[scrapptr]:=0; +end else begin tokmem[tokptr]:=40960+trans[scrapptr];tokptr:=tokptr+1; +end;tokmem[tokptr]:=textptr+40959;tokptr:=tokptr+1; +trans[scrapptr]:=textptr;textptr:=textptr+1;tokstart[textptr]:=tokptr; +end;{:195}{196:}procedure appoctal;begin tokmem[tokptr]:=92; +tokptr:=tokptr+1;tokmem[tokptr]:=79;tokptr:=tokptr+1; +tokmem[tokptr]:=123;tokptr:=tokptr+1; +while(buffer[loc]>=48)and(buffer[loc]<=55)do begin begin if tokptr+2> +maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[tokptr]:=buffer[loc];tokptr:=tokptr+1;end;loc:=loc+1; +end;begin tokmem[tokptr]:=125;tokptr:=tokptr+1;scrapptr:=scrapptr+1; +cat[scrapptr]:=1;trans[scrapptr]:=textptr;textptr:=textptr+1; +tokstart[textptr]:=tokptr;end;end;procedure apphex; +begin tokmem[tokptr]:=92;tokptr:=tokptr+1;tokmem[tokptr]:=72; +tokptr:=tokptr+1;tokmem[tokptr]:=123;tokptr:=tokptr+1; +while((buffer[loc]>=48)and(buffer[loc]<=57))or((buffer[loc]>=65)and( +buffer[loc]<=70))do begin begin if tokptr+2>maxtoks then begin writeln( +output);write(output,'! Sorry, ','token',' capacity exceeded');error; +history:=3;jumpout;end;tokmem[tokptr]:=buffer[loc];tokptr:=tokptr+1;end; +loc:=loc+1;end;begin tokmem[tokptr]:=125;tokptr:=tokptr+1; +scrapptr:=scrapptr+1;cat[scrapptr]:=1;trans[scrapptr]:=textptr; +textptr:=textptr+1;tokstart[textptr]:=tokptr;end;end;{:196}{186:} +procedure easycases; +begin case nextcontrol of 6:begin tokmem[tokptr]:=92;tokptr:=tokptr+1; +tokmem[tokptr]:=105;tokptr:=tokptr+1;tokmem[tokptr]:=110; +tokptr:=tokptr+1;scrapptr:=scrapptr+1;cat[scrapptr]:=2; +trans[scrapptr]:=textptr;textptr:=textptr+1;tokstart[textptr]:=tokptr; +end;32:begin tokmem[tokptr]:=92;tokptr:=tokptr+1;tokmem[tokptr]:=116; +tokptr:=tokptr+1;tokmem[tokptr]:=111;tokptr:=tokptr+1; +scrapptr:=scrapptr+1;cat[scrapptr]:=2;trans[scrapptr]:=textptr; +textptr:=textptr+1;tokstart[textptr]:=tokptr;end; +35,36,37,94,95:begin tokmem[tokptr]:=92;tokptr:=tokptr+1; +tokmem[tokptr]:=nextcontrol;tokptr:=tokptr+1;scrapptr:=scrapptr+1; +cat[scrapptr]:=2;trans[scrapptr]:=textptr;textptr:=textptr+1; +tokstart[textptr]:=tokptr;end;0,124,131,132,133:; +40,91:begin tokmem[tokptr]:=nextcontrol;tokptr:=tokptr+1; +scrapptr:=scrapptr+1;cat[scrapptr]:=4;trans[scrapptr]:=textptr; +textptr:=textptr+1;tokstart[textptr]:=tokptr;end; +41,93:begin tokmem[tokptr]:=nextcontrol;tokptr:=tokptr+1; +scrapptr:=scrapptr+1;cat[scrapptr]:=6;trans[scrapptr]:=textptr; +textptr:=textptr+1;tokstart[textptr]:=tokptr;end; +42:begin tokmem[tokptr]:=92;tokptr:=tokptr+1;tokmem[tokptr]:=97; +tokptr:=tokptr+1;tokmem[tokptr]:=115;tokptr:=tokptr+1; +tokmem[tokptr]:=116;tokptr:=tokptr+1;scrapptr:=scrapptr+1; +cat[scrapptr]:=2;trans[scrapptr]:=textptr;textptr:=textptr+1; +tokstart[textptr]:=tokptr;end;44:begin tokmem[tokptr]:=44; +tokptr:=tokptr+1;tokmem[tokptr]:=138;tokptr:=tokptr+1; +tokmem[tokptr]:=57;tokptr:=tokptr+1;scrapptr:=scrapptr+1; +cat[scrapptr]:=2;trans[scrapptr]:=textptr;textptr:=textptr+1; +tokstart[textptr]:=tokptr;end; +46,48,49,50,51,52,53,54,55,56,57:begin tokmem[tokptr]:=nextcontrol; +tokptr:=tokptr+1;scrapptr:=scrapptr+1;cat[scrapptr]:=1; +trans[scrapptr]:=textptr;textptr:=textptr+1;tokstart[textptr]:=tokptr; +end;59:begin tokmem[tokptr]:=59;tokptr:=tokptr+1;scrapptr:=scrapptr+1; +cat[scrapptr]:=9;trans[scrapptr]:=textptr;textptr:=textptr+1; +tokstart[textptr]:=tokptr;end;58:begin tokmem[tokptr]:=58; +tokptr:=tokptr+1;scrapptr:=scrapptr+1;cat[scrapptr]:=14; +trans[scrapptr]:=textptr;textptr:=textptr+1;tokstart[textptr]:=tokptr; +end;{188:}26:begin tokmem[tokptr]:=92;tokptr:=tokptr+1; +tokmem[tokptr]:=73;tokptr:=tokptr+1;scrapptr:=scrapptr+1; +cat[scrapptr]:=2;trans[scrapptr]:=textptr;textptr:=textptr+1; +tokstart[textptr]:=tokptr;end;28:begin tokmem[tokptr]:=92; +tokptr:=tokptr+1;tokmem[tokptr]:=76;tokptr:=tokptr+1; +scrapptr:=scrapptr+1;cat[scrapptr]:=2;trans[scrapptr]:=textptr; +textptr:=textptr+1;tokstart[textptr]:=tokptr;end; +29:begin tokmem[tokptr]:=92;tokptr:=tokptr+1;tokmem[tokptr]:=71; +tokptr:=tokptr+1;scrapptr:=scrapptr+1;cat[scrapptr]:=2; +trans[scrapptr]:=textptr;textptr:=textptr+1;tokstart[textptr]:=tokptr; +end;30:begin tokmem[tokptr]:=92;tokptr:=tokptr+1;tokmem[tokptr]:=83; +tokptr:=tokptr+1;scrapptr:=scrapptr+1;cat[scrapptr]:=2; +trans[scrapptr]:=textptr;textptr:=textptr+1;tokstart[textptr]:=tokptr; +end;4:begin tokmem[tokptr]:=92;tokptr:=tokptr+1;tokmem[tokptr]:=87; +tokptr:=tokptr+1;scrapptr:=scrapptr+1;cat[scrapptr]:=2; +trans[scrapptr]:=textptr;textptr:=textptr+1;tokstart[textptr]:=tokptr; +end;31:begin tokmem[tokptr]:=92;tokptr:=tokptr+1;tokmem[tokptr]:=86; +tokptr:=tokptr+1;scrapptr:=scrapptr+1;cat[scrapptr]:=2; +trans[scrapptr]:=textptr;textptr:=textptr+1;tokstart[textptr]:=tokptr; +end;5:begin tokmem[tokptr]:=92;tokptr:=tokptr+1;tokmem[tokptr]:=82; +tokptr:=tokptr+1;scrapptr:=scrapptr+1;cat[scrapptr]:=2; +trans[scrapptr]:=textptr;textptr:=textptr+1;tokstart[textptr]:=tokptr; +end;24:begin tokmem[tokptr]:=92;tokptr:=tokptr+1;tokmem[tokptr]:=75; +tokptr:=tokptr+1;scrapptr:=scrapptr+1;cat[scrapptr]:=2; +trans[scrapptr]:=textptr;textptr:=textptr+1;tokstart[textptr]:=tokptr; +end;{:188}128:begin tokmem[tokptr]:=92;tokptr:=tokptr+1; +tokmem[tokptr]:=69;tokptr:=tokptr+1;tokmem[tokptr]:=123; +tokptr:=tokptr+1;scrapptr:=scrapptr+1;cat[scrapptr]:=15; +trans[scrapptr]:=textptr;textptr:=textptr+1;tokstart[textptr]:=tokptr; +end;9:begin tokmem[tokptr]:=92;tokptr:=tokptr+1;tokmem[tokptr]:=66; +tokptr:=tokptr+1;scrapptr:=scrapptr+1;cat[scrapptr]:=2; +trans[scrapptr]:=textptr;textptr:=textptr+1;tokstart[textptr]:=tokptr; +end;10:begin tokmem[tokptr]:=92;tokptr:=tokptr+1;tokmem[tokptr]:=84; +tokptr:=tokptr+1;scrapptr:=scrapptr+1;cat[scrapptr]:=2; +trans[scrapptr]:=textptr;textptr:=textptr+1;tokstart[textptr]:=tokptr; +end;12:appoctal;13:apphex;135:begin tokmem[tokptr]:=92;tokptr:=tokptr+1; +tokmem[tokptr]:=41;tokptr:=tokptr+1;scrapptr:=scrapptr+1; +cat[scrapptr]:=1;trans[scrapptr]:=textptr;textptr:=textptr+1; +tokstart[textptr]:=tokptr;end;3:begin tokmem[tokptr]:=92; +tokptr:=tokptr+1;tokmem[tokptr]:=93;tokptr:=tokptr+1; +scrapptr:=scrapptr+1;cat[scrapptr]:=1;trans[scrapptr]:=textptr; +textptr:=textptr+1;tokstart[textptr]:=tokptr;end; +137:begin tokmem[tokptr]:=92;tokptr:=tokptr+1;tokmem[tokptr]:=44; +tokptr:=tokptr+1;scrapptr:=scrapptr+1;cat[scrapptr]:=2; +trans[scrapptr]:=textptr;textptr:=textptr+1;tokstart[textptr]:=tokptr; +end;138:begin tokmem[tokptr]:=138;tokptr:=tokptr+1;tokmem[tokptr]:=48; +tokptr:=tokptr+1;scrapptr:=scrapptr+1;cat[scrapptr]:=1; +trans[scrapptr]:=textptr;textptr:=textptr+1;tokstart[textptr]:=tokptr; +end;139:begin tokmem[tokptr]:=141;tokptr:=tokptr+1;appcomment;end; +140:begin tokmem[tokptr]:=142;tokptr:=tokptr+1;appcomment;end; +141:begin tokmem[tokptr]:=134;tokptr:=tokptr+1;tokmem[tokptr]:=92; +tokptr:=tokptr+1;tokmem[tokptr]:=32;tokptr:=tokptr+1; +begin tokmem[tokptr]:=134;tokptr:=tokptr+1;appcomment;end;end; +142:begin scrapptr:=scrapptr+1;cat[scrapptr]:=9;trans[scrapptr]:=0;end; +136:begin tokmem[tokptr]:=92;tokptr:=tokptr+1;tokmem[tokptr]:=74; +tokptr:=tokptr+1;scrapptr:=scrapptr+1;cat[scrapptr]:=2; +trans[scrapptr]:=textptr;textptr:=textptr+1;tokstart[textptr]:=tokptr; +end;otherwise begin tokmem[tokptr]:=nextcontrol;tokptr:=tokptr+1; +scrapptr:=scrapptr+1;cat[scrapptr]:=2;trans[scrapptr]:=textptr; +textptr:=textptr+1;tokstart[textptr]:=tokptr;end end;end;{:186}{192:} +procedure subcases(p:namepointer); +begin case ilk[p]of 0:begin tokmem[tokptr]:=10240+p;tokptr:=tokptr+1; +scrapptr:=scrapptr+1;cat[scrapptr]:=1;trans[scrapptr]:=textptr; +textptr:=textptr+1;tokstart[textptr]:=tokptr;end; +4:begin tokmem[tokptr]:=20480+p;tokptr:=tokptr+1;scrapptr:=scrapptr+1; +cat[scrapptr]:=7;trans[scrapptr]:=textptr;textptr:=textptr+1; +tokstart[textptr]:=tokptr;end;7:begin tokmem[tokptr]:=141; +tokptr:=tokptr+1;tokmem[tokptr]:=139;tokptr:=tokptr+1; +tokmem[tokptr]:=20480+p;tokptr:=tokptr+1;scrapptr:=scrapptr+1; +cat[scrapptr]:=3;trans[scrapptr]:=textptr;textptr:=textptr+1; +tokstart[textptr]:=tokptr;end;8:begin tokmem[tokptr]:=131; +tokptr:=tokptr+1;tokmem[tokptr]:=20480+p;tokptr:=tokptr+1; +tokmem[tokptr]:=125;tokptr:=tokptr+1;scrapptr:=scrapptr+1; +cat[scrapptr]:=2;trans[scrapptr]:=textptr;textptr:=textptr+1; +tokstart[textptr]:=tokptr;end;9:begin tokmem[tokptr]:=20480+p; +tokptr:=tokptr+1;scrapptr:=scrapptr+1;cat[scrapptr]:=8; +trans[scrapptr]:=textptr;textptr:=textptr+1;tokstart[textptr]:=tokptr; +end;12:begin tokmem[tokptr]:=141;tokptr:=tokptr+1; +tokmem[tokptr]:=20480+p;tokptr:=tokptr+1;scrapptr:=scrapptr+1; +cat[scrapptr]:=7;trans[scrapptr]:=textptr;textptr:=textptr+1; +tokstart[textptr]:=tokptr;end;13:begin tokmem[tokptr]:=20480+p; +tokptr:=tokptr+1;scrapptr:=scrapptr+1;cat[scrapptr]:=3; +trans[scrapptr]:=textptr;textptr:=textptr+1;tokstart[textptr]:=tokptr; +end;16:begin tokmem[tokptr]:=20480+p;tokptr:=tokptr+1; +scrapptr:=scrapptr+1;cat[scrapptr]:=1;trans[scrapptr]:=textptr; +textptr:=textptr+1;tokstart[textptr]:=tokptr;end; +20:begin tokmem[tokptr]:=132;tokptr:=tokptr+1;tokmem[tokptr]:=20480+p; +tokptr:=tokptr+1;tokmem[tokptr]:=125;tokptr:=tokptr+1; +scrapptr:=scrapptr+1;cat[scrapptr]:=2;trans[scrapptr]:=textptr; +textptr:=textptr+1;tokstart[textptr]:=tokptr;end;end;end;{:192} +procedure Pascalparse;label 21,10;var j:0..longbufsize;p:namepointer; +begin while nextcontrol<143 do begin{185:}{187:} +if(scrapptr+4>maxscraps)or(tokptr+6>maxtoks)or(textptr+4>maxtexts)then +begin if scrapptr>maxscrptr then maxscrptr:=scrapptr; +if tokptr>maxtokptr then maxtokptr:=tokptr; +if textptr>maxtxtptr then maxtxtptr:=textptr;begin writeln(output); +write(output,'! Sorry, ','scrap/token/text',' capacity exceeded');error; +history:=3;jumpout;end;end{:187}; +21:if(nextcontrol=129)or(nextcontrol=2)then{189:} +begin tokmem[tokptr]:=92;tokptr:=tokptr+1; +if nextcontrol=2 then begin tokmem[tokptr]:=61;tokptr:=tokptr+1; +end else begin tokmem[tokptr]:=46;tokptr:=tokptr+1;end; +tokmem[tokptr]:=123;tokptr:=tokptr+1;j:=idfirst; +while j<idloc do begin case buffer[j]of 32,92,35,37,36,94,39,96,123,125, +126,38,95:begin tokmem[tokptr]:=92;tokptr:=tokptr+1;end; +64:if buffer[j+1]=64 then j:=j+1 else begin if not phaseone then begin +writeln(output);write(output,'! Double @ should be used in strings'); +error;end;end;otherwise end; +begin if tokptr+2>maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[tokptr]:=buffer[j];tokptr:=tokptr+1;end;j:=j+1;end; +begin tokmem[tokptr]:=125;tokptr:=tokptr+1;scrapptr:=scrapptr+1; +cat[scrapptr]:=1;trans[scrapptr]:=textptr;textptr:=textptr+1; +tokstart[textptr]:=tokptr;end;end{:189} +else if(nextcontrol=130)then{191:}begin p:=idlookup(0); +case ilk[p]of 0,4,7,8,9,12,13,16,20:subcases(p);{193:} +5:begin begin tokmem[tokptr]:=141;tokptr:=tokptr+1; +tokmem[tokptr]:=20480+p;tokptr:=tokptr+1;tokmem[tokptr]:=135; +tokptr:=tokptr+1;scrapptr:=scrapptr+1;cat[scrapptr]:=5; +trans[scrapptr]:=textptr;textptr:=textptr+1;tokstart[textptr]:=tokptr; +end;begin scrapptr:=scrapptr+1;cat[scrapptr]:=3;trans[scrapptr]:=0;end; +end;6:begin begin scrapptr:=scrapptr+1;cat[scrapptr]:=21; +trans[scrapptr]:=0;end;begin tokmem[tokptr]:=141;tokptr:=tokptr+1; +tokmem[tokptr]:=20480+p;tokptr:=tokptr+1;scrapptr:=scrapptr+1; +cat[scrapptr]:=7;trans[scrapptr]:=textptr;textptr:=textptr+1; +tokstart[textptr]:=tokptr;end;end;10:begin{194:} +if(scrapptr<scrapbase)or((cat[scrapptr]<>10)and(cat[scrapptr]<>9))then +begin scrapptr:=scrapptr+1;cat[scrapptr]:=10;trans[scrapptr]:=0; +end{:194};begin tokmem[tokptr]:=141;tokptr:=tokptr+1; +tokmem[tokptr]:=139;tokptr:=tokptr+1;tokmem[tokptr]:=20480+p; +tokptr:=tokptr+1;scrapptr:=scrapptr+1;cat[scrapptr]:=20; +trans[scrapptr]:=textptr;textptr:=textptr+1;tokstart[textptr]:=tokptr; +end;end;11:begin{194:} +if(scrapptr<scrapbase)or((cat[scrapptr]<>10)and(cat[scrapptr]<>9))then +begin scrapptr:=scrapptr+1;cat[scrapptr]:=10;trans[scrapptr]:=0; +end{:194};begin tokmem[tokptr]:=141;tokptr:=tokptr+1; +tokmem[tokptr]:=20480+p;tokptr:=tokptr+1;scrapptr:=scrapptr+1; +cat[scrapptr]:=6;trans[scrapptr]:=textptr;textptr:=textptr+1; +tokstart[textptr]:=tokptr;end;end;14:begin begin scrapptr:=scrapptr+1; +cat[scrapptr]:=12;trans[scrapptr]:=0;end;begin tokmem[tokptr]:=141; +tokptr:=tokptr+1;tokmem[tokptr]:=20480+p;tokptr:=tokptr+1; +scrapptr:=scrapptr+1;cat[scrapptr]:=7;trans[scrapptr]:=textptr; +textptr:=textptr+1;tokstart[textptr]:=tokptr;end;end; +23:begin begin tokmem[tokptr]:=141;tokptr:=tokptr+1;tokmem[tokptr]:=92; +tokptr:=tokptr+1;tokmem[tokptr]:=126;tokptr:=tokptr+1; +scrapptr:=scrapptr+1;cat[scrapptr]:=7;trans[scrapptr]:=textptr; +textptr:=textptr+1;tokstart[textptr]:=tokptr;end; +begin tokmem[tokptr]:=20480+p;tokptr:=tokptr+1;scrapptr:=scrapptr+1; +cat[scrapptr]:=8;trans[scrapptr]:=textptr;textptr:=textptr+1; +tokstart[textptr]:=tokptr;end;end;17:begin begin tokmem[tokptr]:=141; +tokptr:=tokptr+1;tokmem[tokptr]:=139;tokptr:=tokptr+1; +tokmem[tokptr]:=20480+p;tokptr:=tokptr+1;tokmem[tokptr]:=135; +tokptr:=tokptr+1;scrapptr:=scrapptr+1;cat[scrapptr]:=16; +trans[scrapptr]:=textptr;textptr:=textptr+1;tokstart[textptr]:=tokptr; +end;begin tokmem[tokptr]:=136;tokptr:=tokptr+1;tokmem[tokptr]:=92; +tokptr:=tokptr+1;tokmem[tokptr]:=32;tokptr:=tokptr+1; +scrapptr:=scrapptr+1;cat[scrapptr]:=3;trans[scrapptr]:=textptr; +textptr:=textptr+1;tokstart[textptr]:=tokptr;end;end; +18:begin begin tokmem[tokptr]:=20480+p;tokptr:=tokptr+1; +scrapptr:=scrapptr+1;cat[scrapptr]:=18;trans[scrapptr]:=textptr; +textptr:=textptr+1;tokstart[textptr]:=tokptr;end; +begin scrapptr:=scrapptr+1;cat[scrapptr]:=3;trans[scrapptr]:=0;end;end; +19:begin begin tokmem[tokptr]:=141;tokptr:=tokptr+1;tokmem[tokptr]:=136; +tokptr:=tokptr+1;tokmem[tokptr]:=20480+p;tokptr:=tokptr+1; +tokmem[tokptr]:=135;tokptr:=tokptr+1;scrapptr:=scrapptr+1; +cat[scrapptr]:=5;trans[scrapptr]:=textptr;textptr:=textptr+1; +tokstart[textptr]:=tokptr;end;begin scrapptr:=scrapptr+1; +cat[scrapptr]:=3;trans[scrapptr]:=0;end;end;21:begin{194:} +if(scrapptr<scrapbase)or((cat[scrapptr]<>10)and(cat[scrapptr]<>9))then +begin scrapptr:=scrapptr+1;cat[scrapptr]:=10;trans[scrapptr]:=0; +end{:194};begin tokmem[tokptr]:=141;tokptr:=tokptr+1; +tokmem[tokptr]:=139;tokptr:=tokptr+1;tokmem[tokptr]:=20480+p; +tokptr:=tokptr+1;scrapptr:=scrapptr+1;cat[scrapptr]:=6; +trans[scrapptr]:=textptr;textptr:=textptr+1;tokstart[textptr]:=tokptr; +end;begin scrapptr:=scrapptr+1;cat[scrapptr]:=13;trans[scrapptr]:=0;end; +end;22:begin begin tokmem[tokptr]:=141;tokptr:=tokptr+1; +tokmem[tokptr]:=139;tokptr:=tokptr+1;tokmem[tokptr]:=20480+p; +tokptr:=tokptr+1;tokmem[tokptr]:=135;tokptr:=tokptr+1; +scrapptr:=scrapptr+1;cat[scrapptr]:=19;trans[scrapptr]:=textptr; +textptr:=textptr+1;tokstart[textptr]:=tokptr;end; +begin scrapptr:=scrapptr+1;cat[scrapptr]:=3;trans[scrapptr]:=0;end;end; +{:193}otherwise begin nextcontrol:=ilk[p]-24;goto 21;end end;end{:191} +else if(nextcontrol=134)then{190:}begin tokmem[tokptr]:=92; +tokptr:=tokptr+1;tokmem[tokptr]:=104;tokptr:=tokptr+1; +tokmem[tokptr]:=98;tokptr:=tokptr+1;tokmem[tokptr]:=111; +tokptr:=tokptr+1;tokmem[tokptr]:=120;tokptr:=tokptr+1; +tokmem[tokptr]:=123;tokptr:=tokptr+1; +for j:=idfirst to idloc-1 do begin if tokptr+2>maxtoks then begin +writeln(output);write(output,'! Sorry, ','token',' capacity exceeded'); +error;history:=3;jumpout;end;tokmem[tokptr]:=buffer[j];tokptr:=tokptr+1; +end;begin tokmem[tokptr]:=125;tokptr:=tokptr+1;scrapptr:=scrapptr+1; +cat[scrapptr]:=1;trans[scrapptr]:=textptr;textptr:=textptr+1; +tokstart[textptr]:=tokptr;end;end{:190}else easycases{:185}; +nextcontrol:=getnext;if(nextcontrol=124)or(nextcontrol=123)then goto 10; +end;10:end;{:183}{197:}function Pascaltranslate:textpointer; +var p:textpointer;savebase:0..maxscraps;begin savebase:=scrapbase; +scrapbase:=scrapptr+1;Pascalparse; +if nextcontrol<>124 then begin if not phaseone then begin writeln(output +);write(output,'! Missing "|" after Pascal text');error;end;end; +begin if tokptr+2>maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[tokptr]:=135;tokptr:=tokptr+1;end;appcomment; +p:=translate;if scrapptr>maxscrptr then maxscrptr:=scrapptr; +scrapptr:=scrapbase-1;scrapbase:=savebase;Pascaltranslate:=p;end;{:197} +{198:}procedure outerparse;var bal:eightbits;p,q:textpointer; +begin while nextcontrol<143 do if nextcontrol<>123 then Pascalparse else +begin{199:} +if(tokptr+7>maxtoks)or(textptr+3>maxtexts)or(scrapptr>=maxscraps)then +begin if scrapptr>maxscrptr then maxscrptr:=scrapptr; +if tokptr>maxtokptr then maxtokptr:=tokptr; +if textptr>maxtxtptr then maxtxtptr:=textptr;begin writeln(output); +write(output,'! Sorry, ','token/text/scrap',' capacity exceeded');error; +history:=3;jumpout;end;end{:199};tokmem[tokptr]:=92;tokptr:=tokptr+1; +tokmem[tokptr]:=67;tokptr:=tokptr+1;tokmem[tokptr]:=123; +tokptr:=tokptr+1;bal:=copycomment(1);nextcontrol:=124; +while bal>0 do begin p:=textptr;textptr:=textptr+1; +tokstart[textptr]:=tokptr;q:=Pascaltranslate;tokmem[tokptr]:=40960+p; +tokptr:=tokptr+1;tokmem[tokptr]:=51200+q;tokptr:=tokptr+1; +if nextcontrol=124 then bal:=copycomment(bal)else bal:=0;end; +tokmem[tokptr]:=141;tokptr:=tokptr+1;appcomment;end;end;{:198}{204:} +procedure pushlevel(p:textpointer); +begin if stackptr=stacksize then begin writeln(output); +write(output,'! Sorry, ','stack',' capacity exceeded');error;history:=3; +jumpout;end else begin if stackptr>0 then stack[stackptr]:=curstate; +stackptr:=stackptr+1;if stackptr>maxstackptr then maxstackptr:=stackptr; +curstate.tokfield:=tokstart[p];curstate.endfield:=tokstart[p+1];end;end; +{:204}{206:}function getoutput:eightbits;label 20;var a:sixteenbits; +begin 20:while curstate.tokfield=curstate.endfield do begin stackptr:= +stackptr-1;curstate:=stack[stackptr];end;a:=tokmem[curstate.tokfield]; +curstate.tokfield:=curstate.tokfield+1; +if a>=256 then begin curname:=a mod 10240;case a div 10240 of 2:a:=129; +3:a:=128;4:begin pushlevel(curname);goto 20;end; +5:begin pushlevel(curname);curstate.modefield:=0;goto 20;end; +otherwise a:=130 end;end;{if troubleshooting then debughelp;} +getoutput:=a;end;{:206}{207:}procedure makeoutput;forward; +procedure outputPascal; +var savetokptr,savetextptr,savenextcontrol:sixteenbits;p:textpointer; +begin savetokptr:=tokptr;savetextptr:=textptr; +savenextcontrol:=nextcontrol;nextcontrol:=124;p:=Pascaltranslate; +tokmem[tokptr]:=p+51200;tokptr:=tokptr+1;makeoutput; +if textptr>maxtxtptr then maxtxtptr:=textptr; +if tokptr>maxtokptr then maxtokptr:=tokptr;textptr:=savetextptr; +tokptr:=savetokptr;nextcontrol:=savenextcontrol;end;{:207}{208:} +procedure makeoutput;label 21,10,31;var a:eightbits;b:eightbits; +k,klimit:0..maxbytes;w:0..1;j:0..longbufsize;stringdelimiter:ASCIIcode; +saveloc,savelimit:0..longbufsize;curmodname:namepointer;savemode:mode; +begin tokmem[tokptr]:=143;tokptr:=tokptr+1;textptr:=textptr+1; +tokstart[textptr]:=tokptr;pushlevel(textptr-1); +while true do begin a:=getoutput;21:case a of 143:goto 10;130,129:{209:} +begin begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=92;end; +if a=130 then if bytestart[curname+2]-bytestart[curname]=1 then begin if +outptr=linelength then breakout;outptr:=outptr+1;outbuf[outptr]:=124; +end else begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=92;end else begin if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=38;end; +if bytestart[curname+2]-bytestart[curname]=1 then begin if outptr= +linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=bytemem[curname mod 2,bytestart[curname]]; +end else outname(curname);end{:209};128:{213:} +begin begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=92;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=88;end;curxref:=xref[curname]; +if xmem[curxref].numfield>=10240 then begin outmod(xmem[curxref]. +numfield-10240); +if phasethree then begin curxref:=xmem[curxref].xlinkfield; +while xmem[curxref].numfield>=10240 do begin begin if outptr=linelength +then breakout;outptr:=outptr+1;outbuf[outptr]:=44; +if outptr=linelength then breakout;outptr:=outptr+1;outbuf[outptr]:=32; +end;outmod(xmem[curxref].numfield-10240); +curxref:=xmem[curxref].xlinkfield;end;end; +end else begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=48;end;begin if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=58;end;{214:}k:=bytestart[curname]; +w:=curname mod 2;klimit:=bytestart[curname+2];curmodname:=curname; +while k<klimit do begin b:=bytemem[w,k];k:=k+1;if b=64 then{215:} +begin if bytemem[w,k]<>64 then begin begin writeln(output); +write(output,'! Illegal control code in section name:');end; +begin writeln(output);write(output,'<');end;printid(curmodname); +write(output,'> ');history:=2;end;k:=k+1;end{:215}; +if b<>124 then begin if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=b;end else begin{216:}j:=limit+1; +buffer[j]:=124;stringdelimiter:=0; +while true do begin if k>=klimit then begin begin writeln(output); +write(output,'! Pascal text in section name didn''t end:');end; +begin writeln(output);write(output,'<');end;printid(curmodname); +write(output,'> ');history:=2;goto 31;end;b:=bytemem[w,k];k:=k+1; +if b=64 then{217:}begin if j>longbufsize-4 then begin writeln(output); +write(output,'! Sorry, ','buffer',' capacity exceeded');error; +history:=3;jumpout;end;buffer[j+1]:=64;buffer[j+2]:=bytemem[w,k];j:=j+2; +k:=k+1;end{:217} +else begin if(b=34)or(b=39)then if stringdelimiter=0 then +stringdelimiter:=b else if stringdelimiter=b then stringdelimiter:=0; +if(b<>124)or(stringdelimiter<>0)then begin if j>longbufsize-3 then begin +writeln(output);write(output,'! Sorry, ','buffer',' capacity exceeded'); +error;history:=3;jumpout;end;j:=j+1;buffer[j]:=b;end else goto 31;end; +end;31:{:216};saveloc:=loc;savelimit:=limit;loc:=limit+2;limit:=j+1; +buffer[limit]:=124;outputPascal;loc:=saveloc;limit:=savelimit;end; +end{:214};begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=92;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=88;end;end{:213};131,133,132:{210:} +begin begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=92;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=109;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=97;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=116;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=104;end; +if a=131 then begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=98;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=105;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=110; +end else if a=132 then begin if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=114;if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=101;if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=108; +end else begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=111;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=112;end;begin if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=123;end;end{:210}; +135:begin repeat a:=getoutput;until(a<139)or(a>142);goto 21;end; +134:begin repeat a:=getoutput;until((a<139)and(a<>32))or(a>142);goto 21; +end;136,137,138,139,140,141,142:{211:} +if a<140 then begin if curstate.modefield=1 then begin begin if outptr= +linelength then breakout;outptr:=outptr+1;outbuf[outptr]:=92; +if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=a-87;end; +if a=138 then begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=getoutput; +end end else if a=138 then b:=getoutput end else{212:}begin b:=a; +savemode:=curstate.modefield;while true do begin a:=getoutput; +if(a=135)or(a=134)then goto 21; +if((a<>32)and(a<140))or(a>142)then begin if savemode=1 then begin if +outptr>3 then if(outbuf[outptr]=80)and(outbuf[outptr-1]=92)and(outbuf[ +outptr-2]=89)and(outbuf[outptr-3]=92)then goto 21; +begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=92;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=b-87;end;if a<>143 then finishline; +end else if(a<>143)and(curstate.modefield=0)then begin if outptr= +linelength then breakout;outptr:=outptr+1;outbuf[outptr]:=32;end; +goto 21;end;if a>b then b:=a;end;end{:212}{:211}; +otherwise begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=a;end end;end;10:end;{:208}{226:}procedure finishPascal; +var p:textpointer;begin begin if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=92;if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=80;end; +begin if tokptr+2>maxtoks then begin writeln(output); +write(output,'! Sorry, ','token',' capacity exceeded');error;history:=3; +jumpout;end;tokmem[tokptr]:=141;tokptr:=tokptr+1;end;appcomment; +p:=translate;tokmem[tokptr]:=p+40960;tokptr:=tokptr+1;makeoutput; +if outptr>1 then if outbuf[outptr-1]=92 then if outbuf[outptr]=54 then +outptr:=outptr-2 else if outbuf[outptr]=55 then outbuf[outptr]:=89; +begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=92;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=112;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=97;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=114;end;finishline; +if textptr>maxtxtptr then maxtxtptr:=textptr; +if tokptr>maxtokptr then maxtokptr:=tokptr; +if scrapptr>maxscrptr then maxscrptr:=scrapptr;tokptr:=1;textptr:=1; +scrapptr:=0;end;{:226}{236:}procedure footnote(flag:sixteenbits); +label 30,10;var q:xrefnumber; +begin if xmem[curxref].numfield<=flag then goto 10;finishline; +begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=92;end; +if flag=0 then begin if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=85; +end else begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=65;end;{237:}q:=curxref; +if xmem[xmem[q].xlinkfield].numfield>flag then begin if outptr= +linelength then breakout;outptr:=outptr+1;outbuf[outptr]:=115;end; +while true do begin outmod(xmem[curxref].numfield-flag); +curxref:=xmem[curxref].xlinkfield; +if xmem[curxref].numfield<=flag then goto 30; +if xmem[xmem[curxref].xlinkfield].numfield>flag then begin if outptr= +linelength then breakout;outptr:=outptr+1;outbuf[outptr]:=44; +if outptr=linelength then breakout;outptr:=outptr+1;outbuf[outptr]:=32; +end else begin begin if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=92;if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=69;if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=84;end; +if curxref<>xmem[q].xlinkfield then begin if outptr=linelength then +breakout;outptr:=outptr+1;outbuf[outptr]:=115;end;end;end;30:{:237}; +begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=46;end;10:end;{:236}{249:} +procedure unbucket(d:eightbits);var c:ASCIIcode; +begin for c:=229 downto 0 do if bucket[collate[c]]>0 then begin if +scrapptr>maxscraps then begin writeln(output); +write(output,'! Sorry, ','sorting',' capacity exceeded');error; +history:=3;jumpout;end;scrapptr:=scrapptr+1; +if scrapptr>maxsortptr then maxsortptr:=scrapptr; +if c=0 then cat[scrapptr]:=255 else cat[scrapptr]:=d; +trans[scrapptr]:=bucket[collate[c]];bucket[collate[c]]:=0;end;end;{:249} +{256:}procedure modprint(p:namepointer); +begin if p>0 then begin modprint(link[p]); +begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=92;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=58;end;tokptr:=1;textptr:=1;scrapptr:=0;stackptr:=0; +curstate.modefield:=1;tokmem[tokptr]:=p+30720;tokptr:=tokptr+1; +makeoutput;footnote(0);finishline;modprint(ilk[p]);end;end;{:256}{260:} +{procedure debughelp;label 888,10;var k:integer; +begin debugskipped:=debugskipped+1; +if debugskipped<debugcycle then goto 10;debugskipped:=0; +while true do begin write(output,'#');flushstdout;read(input,ddt); +if ddt<0 then goto 10 else if ddt=0 then begin goto 888; +888:ddt:=0; +end else begin read(input,dd);case ddt of 1:printid(dd);2:printtext(dd); +3:for k:=1 to dd do write(output,xchr[buffer[k]]); +4:for k:=1 to dd do write(output,xchr[modtext[k]]); +5:for k:=1 to outptr do write(output,xchr[outbuf[k]]); +6:for k:=1 to dd do begin printcat(cat[k]);write(output,' ');end; +otherwise write(output,'?')end;end;end;10:end;}{:260}{261:} +procedure PhaseI;begin{109:}phaseone:=true;phasethree:=false;resetinput; +modulecount:=0;skiplimbo;changeexists:=false; +while not inputhasended do{110:}begin modulecount:=modulecount+1; +if modulecount=maxmodules then begin writeln(output); +write(output,'! Sorry, ','section number',' capacity exceeded');error; +history:=3;jumpout;end;changedmodule[modulecount]:=changing; +if buffer[loc-1]=42 then begin write(output,'*',modulecount:1); +flushstdout;end;{113:}repeat nextcontrol:=skipTeX; +case nextcontrol of 126:xrefswitch:=10240;125:xrefswitch:=0; +124:Pascalxref;131,132,133,146:begin loc:=loc-2;nextcontrol:=getnext; +if nextcontrol<>146 then newxref(idlookup(nextcontrol-130));end; +otherwise end;until nextcontrol>=143{:113};{115:} +while nextcontrol<=144 do begin xrefswitch:=10240; +if nextcontrol=144 then nextcontrol:=getnext else{116:} +begin nextcontrol:=getnext; +if nextcontrol=130 then begin lhs:=idlookup(0);ilk[lhs]:=0;newxref(lhs); +nextcontrol:=getnext;if nextcontrol=30 then begin nextcontrol:=getnext; +if nextcontrol=130 then begin rhs:=idlookup(0);ilk[lhs]:=ilk[rhs]; +ilk[rhs]:=0;newxref(rhs);ilk[rhs]:=ilk[lhs];nextcontrol:=getnext;end; +end;end;end{:116};outerxref;end{:115};{117:} +if nextcontrol<=146 then begin if nextcontrol=145 then modxrefswitch:=0 +else modxrefswitch:=10240; +repeat if nextcontrol=146 then newmodxref(curmodule); +nextcontrol:=getnext;outerxref;until nextcontrol>146;end{:117}; +if changedmodule[modulecount]then changeexists:=true;end{:110}; +changedmodule[modulecount]:=changeexists;phaseone:=false;{120:} +modcheck(ilk[0]){:120};{:109};end;procedure PhaseII;begin{218:} +resetinput;begin writeln(output); +write(output,'Writing the output file...');end;modulecount:=0;copylimbo; +finishline;flushbuffer(0,false,false);while not inputhasended do{220:} +begin modulecount:=modulecount+1;{221:} +begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=92;end; +if buffer[loc-1]<>42 then begin if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=77; +end else begin begin if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=78;end;write(output,'*',modulecount:1); +flushstdout;end;outmod(modulecount); +begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=46;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=32;end{:221};saveline:=outline;saveplace:=outptr;{222:} +repeat nextcontrol:=copyTeX;case nextcontrol of 124:begin stackptr:=0; +curstate.modefield:=1;outputPascal;end; +64:begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=64;end;12:{223:} +begin begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=92;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=79;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=123;end; +while(buffer[loc]>=48)and(buffer[loc]<=55)do begin begin if outptr= +linelength then breakout;outptr:=outptr+1;outbuf[outptr]:=buffer[loc]; +end;loc:=loc+1;end;begin if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=125;end;end{:223};13:{224:} +begin begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=92;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=72;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=123;end; +while((buffer[loc]>=48)and(buffer[loc]<=57))or((buffer[loc]>=65)and( +buffer[loc]<=70))do begin begin if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=buffer[loc];end;loc:=loc+1;end; +begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=125;end;end{:224};134,131,132,133,146:begin loc:=loc-2; +nextcontrol:=getnext; +if nextcontrol=134 then begin if not phaseone then begin writeln(output) +;write(output,'! TeX string should be in Pascal text only');error;end; +end;end; +9,10,135,137,138,139,140,141,136,142:begin if not phaseone then begin +writeln(output);write(output,'! You can''t do that in TeX text');error; +end;end;otherwise end;until nextcontrol>=143{:222};{225:} +if nextcontrol<=144 then begin if(saveline<>outline)or(saveplace<>outptr +)then begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=92;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=89;end;saveline:=outline;saveplace:=outptr;end; +while nextcontrol<=144 do begin stackptr:=0;curstate.modefield:=1; +if nextcontrol=144 then{227:}begin begin tokmem[tokptr]:=92; +tokptr:=tokptr+1;tokmem[tokptr]:=68;tokptr:=tokptr+1; +scrapptr:=scrapptr+1;cat[scrapptr]:=3;trans[scrapptr]:=textptr; +textptr:=textptr+1;tokstart[textptr]:=tokptr;end;nextcontrol:=getnext; +if nextcontrol<>130 then begin if not phaseone then begin writeln(output +);write(output,'! Improper macro definition');error;end; +end else begin tokmem[tokptr]:=10240+idlookup(0);tokptr:=tokptr+1; +scrapptr:=scrapptr+1;cat[scrapptr]:=2;trans[scrapptr]:=textptr; +textptr:=textptr+1;tokstart[textptr]:=tokptr;end;nextcontrol:=getnext; +end{:227}else{228:}begin begin tokmem[tokptr]:=92;tokptr:=tokptr+1; +tokmem[tokptr]:=70;tokptr:=tokptr+1;scrapptr:=scrapptr+1; +cat[scrapptr]:=3;trans[scrapptr]:=textptr;textptr:=textptr+1; +tokstart[textptr]:=tokptr;end;nextcontrol:=getnext; +if nextcontrol=130 then begin begin tokmem[tokptr]:=10240+idlookup(0); +tokptr:=tokptr+1;scrapptr:=scrapptr+1;cat[scrapptr]:=2; +trans[scrapptr]:=textptr;textptr:=textptr+1;tokstart[textptr]:=tokptr; +end;nextcontrol:=getnext; +if nextcontrol=30 then begin begin tokmem[tokptr]:=92;tokptr:=tokptr+1; +tokmem[tokptr]:=83;tokptr:=tokptr+1;scrapptr:=scrapptr+1; +cat[scrapptr]:=2;trans[scrapptr]:=textptr;textptr:=textptr+1; +tokstart[textptr]:=tokptr;end;nextcontrol:=getnext; +if nextcontrol=130 then begin begin tokmem[tokptr]:=10240+idlookup(0); +tokptr:=tokptr+1;scrapptr:=scrapptr+1;cat[scrapptr]:=2; +trans[scrapptr]:=textptr;textptr:=textptr+1;tokstart[textptr]:=tokptr; +end;begin scrapptr:=scrapptr+1;cat[scrapptr]:=9;trans[scrapptr]:=0;end; +nextcontrol:=getnext;end;end;end; +if scrapptr<>5 then begin if not phaseone then begin writeln(output); +write(output,'! Improper format definition');error;end;end;end{:228}; +outerparse;finishPascal;end{:225};{230:}thismodule:=0; +if nextcontrol<=146 then begin if(saveline<>outline)or(saveplace<>outptr +)then begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=92;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=89;end;stackptr:=0;curstate.modefield:=1; +if nextcontrol=145 then nextcontrol:=getnext else begin thismodule:= +curmodule;{231:}repeat nextcontrol:=getnext;until nextcontrol<>43; +if(nextcontrol<>61)and(nextcontrol<>30)then begin if not phaseone then +begin writeln(output); +write(output,'! You need an = sign after the section name');error;end; +end else nextcontrol:=getnext; +if outptr>1 then if(outbuf[outptr]=89)and(outbuf[outptr-1]=92)then begin +tokmem[tokptr]:=139;tokptr:=tokptr+1;end; +begin tokmem[tokptr]:=30720+thismodule;tokptr:=tokptr+1; +scrapptr:=scrapptr+1;cat[scrapptr]:=22;trans[scrapptr]:=textptr; +textptr:=textptr+1;tokstart[textptr]:=tokptr;end; +curxref:=xref[thismodule]; +if xmem[curxref].numfield<>modulecount+10240 then begin begin tokmem[ +tokptr]:=132;tokptr:=tokptr+1;tokmem[tokptr]:=43;tokptr:=tokptr+1; +tokmem[tokptr]:=125;tokptr:=tokptr+1;scrapptr:=scrapptr+1; +cat[scrapptr]:=2;trans[scrapptr]:=textptr;textptr:=textptr+1; +tokstart[textptr]:=tokptr;end;thismodule:=0;end; +begin tokmem[tokptr]:=92;tokptr:=tokptr+1;tokmem[tokptr]:=83; +tokptr:=tokptr+1;scrapptr:=scrapptr+1;cat[scrapptr]:=2; +trans[scrapptr]:=textptr;textptr:=textptr+1;tokstart[textptr]:=tokptr; +end;begin tokmem[tokptr]:=141;tokptr:=tokptr+1;scrapptr:=scrapptr+1; +cat[scrapptr]:=9;trans[scrapptr]:=textptr;textptr:=textptr+1; +tokstart[textptr]:=tokptr;end;{:231};end; +while nextcontrol<=146 do begin outerparse;{232:} +if nextcontrol<146 then begin begin if not phaseone then begin writeln( +output);write(output,'! You can''t do that in Pascal text');error;end; +end;nextcontrol:=getnext; +end else if nextcontrol=146 then begin begin tokmem[tokptr]:=30720+ +curmodule;tokptr:=tokptr+1;scrapptr:=scrapptr+1;cat[scrapptr]:=22; +trans[scrapptr]:=textptr;textptr:=textptr+1;tokstart[textptr]:=tokptr; +end;nextcontrol:=getnext;end{:232};end;finishPascal;end{:230};{233:} +if thismodule>0 then begin{235:}firstxref:=xref[thismodule]; +thisxref:=xmem[firstxref].xlinkfield; +if xmem[thisxref].numfield>10240 then begin midxref:=thisxref; +curxref:=0;repeat nextxref:=xmem[thisxref].xlinkfield; +xmem[thisxref].xlinkfield:=curxref;curxref:=thisxref;thisxref:=nextxref; +until xmem[thisxref].numfield<=10240; +xmem[firstxref].xlinkfield:=curxref;end else midxref:=0;curxref:=0; +while thisxref<>0 do begin nextxref:=xmem[thisxref].xlinkfield; +xmem[thisxref].xlinkfield:=curxref;curxref:=thisxref;thisxref:=nextxref; +end; +if midxref>0 then xmem[midxref].xlinkfield:=curxref else xmem[firstxref] +.xlinkfield:=curxref;curxref:=xmem[firstxref].xlinkfield{:235}; +footnote(10240);footnote(0);end{:233};{238:} +begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=92;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=102;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=105;end;finishline;flushbuffer(0,false,false);{:238}; +end{:220}{:218};end;begin initialize; +writeln(output,'This is WEAVE, Version 4.4 for Linux');{64:}idloc:=10; +idfirst:=7;buffer[7]:=97;buffer[8]:=110;buffer[9]:=100; +curname:=idlookup(28);idfirst:=5;buffer[5]:=97;buffer[6]:=114; +buffer[7]:=114;buffer[8]:=97;buffer[9]:=121;curname:=idlookup(4); +idfirst:=5;buffer[5]:=98;buffer[6]:=101;buffer[7]:=103;buffer[8]:=105; +buffer[9]:=110;curname:=idlookup(5);idfirst:=6;buffer[6]:=99; +buffer[7]:=97;buffer[8]:=115;buffer[9]:=101;curname:=idlookup(6); +idfirst:=5;buffer[5]:=99;buffer[6]:=111;buffer[7]:=110;buffer[8]:=115; +buffer[9]:=116;curname:=idlookup(7);idfirst:=7;buffer[7]:=100; +buffer[8]:=105;buffer[9]:=118;curname:=idlookup(8);idfirst:=8; +buffer[8]:=100;buffer[9]:=111;curname:=idlookup(9);idfirst:=4; +buffer[4]:=100;buffer[5]:=111;buffer[6]:=119;buffer[7]:=110; +buffer[8]:=116;buffer[9]:=111;curname:=idlookup(20);idfirst:=6; +buffer[6]:=101;buffer[7]:=108;buffer[8]:=115;buffer[9]:=101; +curname:=idlookup(10);idfirst:=7;buffer[7]:=101;buffer[8]:=110; +buffer[9]:=100;curname:=idlookup(11);idfirst:=6;buffer[6]:=102; +buffer[7]:=105;buffer[8]:=108;buffer[9]:=101;curname:=idlookup(4); +idfirst:=7;buffer[7]:=102;buffer[8]:=111;buffer[9]:=114; +curname:=idlookup(12);idfirst:=2;buffer[2]:=102;buffer[3]:=117; +buffer[4]:=110;buffer[5]:=99;buffer[6]:=116;buffer[7]:=105; +buffer[8]:=111;buffer[9]:=110;curname:=idlookup(17);idfirst:=6; +buffer[6]:=103;buffer[7]:=111;buffer[8]:=116;buffer[9]:=111; +curname:=idlookup(13);idfirst:=8;buffer[8]:=105;buffer[9]:=102; +curname:=idlookup(14);idfirst:=8;buffer[8]:=105;buffer[9]:=110; +curname:=idlookup(30);idfirst:=5;buffer[5]:=108;buffer[6]:=97; +buffer[7]:=98;buffer[8]:=101;buffer[9]:=108;curname:=idlookup(7); +idfirst:=7;buffer[7]:=109;buffer[8]:=111;buffer[9]:=100; +curname:=idlookup(8);idfirst:=7;buffer[7]:=110;buffer[8]:=105; +buffer[9]:=108;curname:=idlookup(16);idfirst:=7;buffer[7]:=110; +buffer[8]:=111;buffer[9]:=116;curname:=idlookup(29);idfirst:=8; +buffer[8]:=111;buffer[9]:=102;curname:=idlookup(9);idfirst:=8; +buffer[8]:=111;buffer[9]:=114;curname:=idlookup(55);idfirst:=4; +buffer[4]:=112;buffer[5]:=97;buffer[6]:=99;buffer[7]:=107; +buffer[8]:=101;buffer[9]:=100;curname:=idlookup(13);idfirst:=1; +buffer[1]:=112;buffer[2]:=114;buffer[3]:=111;buffer[4]:=99; +buffer[5]:=101;buffer[6]:=100;buffer[7]:=117;buffer[8]:=114; +buffer[9]:=101;curname:=idlookup(17);idfirst:=3;buffer[3]:=112; +buffer[4]:=114;buffer[5]:=111;buffer[6]:=103;buffer[7]:=114; +buffer[8]:=97;buffer[9]:=109;curname:=idlookup(17);idfirst:=4; +buffer[4]:=114;buffer[5]:=101;buffer[6]:=99;buffer[7]:=111; +buffer[8]:=114;buffer[9]:=100;curname:=idlookup(18);idfirst:=4; +buffer[4]:=114;buffer[5]:=101;buffer[6]:=112;buffer[7]:=101; +buffer[8]:=97;buffer[9]:=116;curname:=idlookup(19);idfirst:=7; +buffer[7]:=115;buffer[8]:=101;buffer[9]:=116;curname:=idlookup(4); +idfirst:=6;buffer[6]:=116;buffer[7]:=104;buffer[8]:=101;buffer[9]:=110; +curname:=idlookup(9);idfirst:=8;buffer[8]:=116;buffer[9]:=111; +curname:=idlookup(20);idfirst:=6;buffer[6]:=116;buffer[7]:=121; +buffer[8]:=112;buffer[9]:=101;curname:=idlookup(7);idfirst:=5; +buffer[5]:=117;buffer[6]:=110;buffer[7]:=116;buffer[8]:=105; +buffer[9]:=108;curname:=idlookup(21);idfirst:=7;buffer[7]:=118; +buffer[8]:=97;buffer[9]:=114;curname:=idlookup(22);idfirst:=5; +buffer[5]:=119;buffer[6]:=104;buffer[7]:=105;buffer[8]:=108; +buffer[9]:=101;curname:=idlookup(12);idfirst:=6;buffer[6]:=119; +buffer[7]:=105;buffer[8]:=116;buffer[9]:=104;curname:=idlookup(12); +idfirst:=3;buffer[3]:=120;buffer[4]:=99;buffer[5]:=108;buffer[6]:=97; +buffer[7]:=117;buffer[8]:=115;buffer[9]:=101;curname:=idlookup(23);{:64} +;PhaseI;PhaseII;{239:}if noxref then begin finishline; +begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=92;end;begin if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=118;if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=102;if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=105;if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=108;if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=108;end; +begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=92;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=101;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=110;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=100;end;finishline;end else begin phasethree:=true; +begin writeln(output);write(output,'Writing the index...');end; +if changeexists then begin finishline;{241:}begin kmodule:=1; +begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=92;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=99;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=104;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=32;end; +while kmodule<modulecount do begin if changedmodule[kmodule]then begin +outmod(kmodule);begin if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=44;if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=32;end;end;kmodule:=kmodule+1;end; +outmod(kmodule);begin if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=46;end;end{:241};end;finishline; +begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=92;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=105;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=110;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=120;end;finishline;{243:} +for c:=0 to 255 do bucket[c]:=0; +for h:=0 to hashsize-1 do begin nextname:=hash[h]; +while nextname<>0 do begin curname:=nextname;nextname:=link[curname]; +if xref[curname]<>0 then begin c:=bytemem[curname mod 2,bytestart[ +curname]];if(c<=90)and(c>=65)then c:=c+32;blink[curname]:=bucket[c]; +bucket[c]:=curname;end;end;end{:243};{250:}scrapptr:=0;unbucket(1); +while scrapptr>0 do begin curdepth:=cat[scrapptr]; +if(blink[trans[scrapptr]]=0)or(curdepth=255)then{252:} +begin curname:=trans[scrapptr];{if troubleshooting then debughelp;} +repeat begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=92;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=58;end;{253:} +case ilk[curname]of 0:if bytestart[curname+2]-bytestart[curname]=1 then +begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=92;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=124;end else begin if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=92;if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=92;end;1:; +2:begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=92;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=57;end;3:begin if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=92;if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=46;end; +otherwise begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=92;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=38;end end;outname(curname){:253};{254:}{255:} +thisxref:=xref[curname];curxref:=0; +repeat nextxref:=xmem[thisxref].xlinkfield; +xmem[thisxref].xlinkfield:=curxref;curxref:=thisxref;thisxref:=nextxref; +until thisxref=0{:255};repeat begin if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=44;if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=32;end;curval:=xmem[curxref].numfield; +if curval<10240 then outmod(curval)else begin begin if outptr=linelength +then breakout;outptr:=outptr+1;outbuf[outptr]:=92; +if outptr=linelength then breakout;outptr:=outptr+1;outbuf[outptr]:=91; +end;outmod(curval-10240);begin if outptr=linelength then breakout; +outptr:=outptr+1;outbuf[outptr]:=93;end;end; +curxref:=xmem[curxref].xlinkfield;until curxref=0; +begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=46;end;finishline{:254};curname:=blink[curname]; +until curname=0;scrapptr:=scrapptr-1;end{:252}else{251:} +begin nextname:=trans[scrapptr];repeat curname:=nextname; +nextname:=blink[curname];curbyte:=bytestart[curname]+curdepth; +curbank:=curname mod 2; +if curbyte=bytestart[curname+2]then c:=0 else begin c:=bytemem[curbank, +curbyte];if(c<=90)and(c>=65)then c:=c+32;end;blink[curname]:=bucket[c]; +bucket[c]:=curname;until nextname=0;scrapptr:=scrapptr-1; +unbucket(curdepth+1);end{:251};end{:250}; +begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=92;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=102;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=105;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=110;end;finishline;{257:}modprint(ilk[0]){:257}; +begin if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=92;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=99;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=111;if outptr=linelength then breakout;outptr:=outptr+1; +outbuf[outptr]:=110;end;finishline;end;write(output,'Done.');{:239}; +{85:} +if changelimit<>0 then begin for ii:=0 to changelimit do buffer[ii]:= +changebuffer[ii];limit:=changelimit;changing:=true;line:=otherline; +loc:=changelimit;begin if not phaseone then begin writeln(output); +write(output,'! Change file entry did not match');error;end;end;end{:85} +;9999:{262:}begin writeln(output); +write(output,'Memory usage statistics: ',nameptr:1,' names, ',xrefptr:1, +' cross references, ',byteptr[0]:1);end; +for curbank:=1 to 1 do write(output,'+',byteptr[curbank]:1); +write(output,' bytes;');begin writeln(output); +write(output,'parsing required ',maxscrptr:1,' scraps, ',maxtxtptr:1, +' texts, ',maxtokptr:1,' tokens, ',maxstackptr:1,' levels;');end; +begin writeln(output); +write(output,'sorting required ',maxsortptr:1,' levels.');end{:262}; +{263:}case history of 0:begin writeln(output); +write(output,'(No errors were found.)');end;1:begin writeln(output); +write(output,'(Did you see the warning message above?)');end; +2:begin writeln(output); +write(output,'(Pardon me, but I think I spotted something wrong.)');end; +3:begin writeln(output); +write(output,'(That was a fatal error, my friend.)');end;end{:263}; +writeln(output);if(history<>0)and(history<>1)then exit(1)else exit(0); +end.{:261} diff --git a/systems/knuth/local/web/weavext.c b/systems/knuth/local/web/weavext.c new file mode 100644 index 0000000000..87f1c99b22 --- /dev/null +++ b/systems/knuth/local/web/weavext.c @@ -0,0 +1,107 @@ +/* External procedures for weave */ +/* Written by: H. Trickey, 11/17/83 */ + +/* Modified for 8-bit input --- don 8/31/89 */ + +/* Note: these procedures aren't necessary; the default input_ln and + * flush_buffer routines in tangle/weave work fine on UNIX. + * However a very big time improvement is achieved by using these. + * + * These procedures are the same as for tangle, except for a slight offset + * in which characters are output from outbuf in linewrite. + */ + +#define BUF_SIZE 100 /* should agree with tangle.web */ + +#include "h00vars.h" /* defines Pascal I/O structure */ + +extern short buffer[]; /* 0..BUF_SIZE. Input goes here */ +extern short outbuf[]; /* 0..OUT_BUF_SIZE. Output from here */ +extern short xord[]; +extern char xchr[]; /* character translation arrays */ +extern short limit; /* index into buffer. Note that limit + is 0..long_buf_size in weave.web; this + differs from the definition in tangle.web */ + +/* + * lineread reads from the Pascal text file with iorec pointer filep + * into buffer[0], buffer[1],..., buffer[limit-1] (and + * setting "limit"). + * Characters are read until a newline is found (which isn't put in the + * buffer) or until the next character would go into buffer[BUF_SIZE]. + * And trailing blanks are to be ignored, so limit is really set to + * one past the last non-blank. + * The characters need to be translated, so really xord[c] is put into + * the buffer when c is read. + * If end-of-file is encountered, the funit field of *filep is set + * appropriately. + */ +lineread(filep) +struct iorec *filep; +{ + register c; + register short *cs; /* pointer into buffer where next char goes */ + register short *cnb; /* last non-blank character input */ + register FILE *iop; /* stdio-style FILE pointer */ + register int l; /* how many chars allowed before buffer overflow */ + + iop = filep->fbuf; + cnb = cs = &(buffer[0]); + l = BUF_SIZE; + /* overflow when next char would go into buffer[BUF_SIZE] */ + while (--l>=0 && (c = getc(iop)) != EOF && c!='\n') + if((*cs++ = xord[c])!=' ') cnb = cs; + if (c == EOF) + filep->funit |= EOFF; /* we hit end-of-file */ + limit = cnb-&(buffer[0]); +} + +/* + * linewrite writes to the Pascal text file with iorec pointer filep + * from outbuf[1], outbuf[1],..., outbuf[cnt]. + * (Note the offset of indices vis a vis the tangext version of this.) + * Translation is done, so that xchr[c] is output instead of c. + */ + linewrite(filep,cnt) + struct iorec *filep; + int cnt; + { + register FILE *iop; /* stdio-style FILE pointer */ + register short *cs; /* pointer to next character to output */ + register int l; /* how many characters left to output */ + + iop = filep->fbuf; + cs = &(outbuf[1]); + l = cnt; + while (--l>=0) putc(xchr[*cs++],iop); +} + +/* +** testeof(filep) +** +** Test whether or not the Pascal text file with iorec pointer filep +** has reached end-of-file (when the only I/O on it is done with +** lineread, above). +** We may have to read the next character and unget it to see if perhaps +** the end-of-file is next. +*/ + +bool +testeof(filep) +register struct iorec *filep; +{ + register char c; + register FILE *iop; /* stdio-style FILE pointer */ + if (filep->funit & EOFF) + return(TRUE); + else { /* check to see if next is EOF */ + iop = filep->fbuf; + c = getc(iop); + if (c == EOF) + return(TRUE); + else { + ungetc(c,iop); + return(FALSE); + } + } +} |