Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
metafont/sources/mfbase.sai
There are no other files named mfbase.sai in the archive.
comment A list of the type codes;
comment The following definitions attach numeric codes to the various
"types" output by getnext for interpretation by the METAFONT routines.
The symbolic names of these codes are used everywhere in the program,
so you don't need to read this page except when debugging. An attempt
has been made to choose code numbers so that the range of types in
case statements is reasonably small;
internaldef innput=0 # "input";
internaldef rel=1 # "<", ">", "=", "", " ", or " ";
internaldef ddot=2 # "..";
internaldef rpren=3 # ")";
internaldef lbrace=4 # "{";
internaldef rbrace=5 # "}";
internaldef hashmark=6 # "#";
internaldef comma=7 # ",";
internaldef colon=8 # ":";
internaldef varparam=9 # "var";
internaldef indexparam=10 # "index";
internaldef semi=11 # semicolon;
internaldef quote=12 # """";
internaldef stop=13 # "end";
internaldef fullstop=14 # period ending a routine or subroutine;
internaldef iff=15 # "if";
internaldef elsse=16 # "else";
internaldef ffi=17 # "fi";
internaldef ident=18 # identifier;
internaldef wxy=19 # "w", "x", or "y";
internaldef rbrack=20 # "]";
internaldef lbrack=21 # "[";
internaldef digit=22 # "0", "1", ..., "9";
internaldef pnt=23 # ".";
internaldef apost=24 # "'";
internaldef letter=25 # "A", "B", ..., "Z", "a", "b", ..., "z";
internaldef equals=26 # "=";
internaldef openq=27 # "`";
internaldef space=28 # " " or character ignored by scanner;
internaldef carret=29 # carriage return or form feed or "%";
internaldef abbs=30 # "|";
internaldef index=31 # index argument;
internaldef lpren=32 # "(";
internaldef char=33 # single character in constant or subroutine call;
internaldef constant=34 # (real) constant;
internaldef plusorminus=35 # "+" or "-";
internaldef timesordiv=36 # "." or "*" or "" or "/";
internaldef randm=37 # "nrand";
internaldef known=38 # variable whose value is known;
internaldef direction=39 # "lft" or "rt" or "top" or "bot";
internaldef dependent=40 # variable whose value is a dependency list;
internaldef newid=41 # identifier whose type has not yet been assigned;
internaldef independent=42 # variable whose value is independent;
internaldef unary=43 # "sqrt" or "round" or "good";
internaldef subroutine=44 # identifier corresponding to a stored subroutine;
internaldef penname=45 # "cpen" or "hpen" or ... or "spen" or "epen";
internaldef cawl=46 # "call";
internaldef new=47 # "new";
internaldef mfparam=48 # "charcode", "maxvr", etc.;
internaldef contrl=49 # "proofmode", "pause", "eqtrace", etc.;
internaldef no=50 # "no";
internaldef draw=51 # "draw";
internaldef ddraw=52 # "ddraw";
internaldef subrtn=53 # "subroutine";
internaldef param=54 # identifier that is a parameter;
internaldef varchar=55 # "varchar";
internaldef charlist=56 # "charlist";
internaldef texinfo=57 # "texinfo";
internaldef lig=58 # "lig";
internaldef invisible=59 # "invisible";
internaldef break=60 # "crsbreak";
internaldef kern=61 # "kern";
internaldef binput=62 # "binput";
internaldef areahead=(2^types-1) # area header node;
comment The following codes are used for second-order differences;
internaldef lft=0 # "lft";
internaldef rt=1 # "rt";
internaldef top=2 # "top";
internaldef bot=3 # "bot";
internaldef root=0 # "sqrt";
internaldef sine=1 # "sind";
internaldef cosine=2 # "cosd";
internaldef round=3 # "round";
internaldef good=4 # "good";
internaldef cpen=0 # "cpen";
internaldef hpen=1 # "hpen";
internaldef vpen=2 # "vpen";
internaldef lpen=3 # "lpen";
internaldef rpen=4 # "rpen";
internaldef spen=5 # "spen";
internaldef epen=6 # "epen";
internaldef badpen=7 # illegal pen type (the initial value);
comment The following table assigns type codes to all ascii characters;
preloadwith space,space,space,space,space,space,space,space,
space,space,space,space,carret,carret,space,space,
space,space,space,space,space,space,timesordiv,space,
letter,space,carret,rel,rel,rel,letter,space,
space,space,quote,hashmark,space,carret,space,apost,
lpren,rpren,timesordiv,plusorminus,comma,plusorminus,pnt,timesordiv,
digit,digit,digit,digit,digit,digit,digit,digit,
digit,digit,colon,semi,rel,equals,rel,space,
space,letter,letter,letter,letter,letter,letter,letter,
letter,letter,letter,letter,letter,letter,letter,letter,
letter,letter,letter,letter,letter,letter,letter,wxy,
wxy,wxy,letter,lbrack,space,rbrack,space,space,
openq,letter,letter,letter,letter,letter,letter,letter,
letter,letter,letter,letter,letter,letter,letter,letter,
letter,letter,letter,letter,letter,letter,letter,wxy,
wxy,wxy,letter,lbrace,abbs,rbrace,rbrace,space;
saf integer array chartype[0:127] # type codes for METAFONT scanning;
comment The following data is used for METAFONT's basic parameters;
internaldef realpars=23,intpars=10, stringpars=2 # number of real, integer, and string parameters;
internaldef penparam=realpars+4 # distinguish the first four integer parameters;
internaldef intpar=realpars # offset used for integer parameters;
internaldef stringpar=realpars+intpars # offset used for string parameters;
internal saf real array realparam[1:realpars] # real parameters to METAFONT;
internal saf integer array intparam[intpar+1:intpar+intpars] # integer parameters;
internal saf string array stringparam[stringpar+1:stringpar+stringpars] # integer parameters;
internaldef xxtr=realparam[1], xytr=realparam[2], xtr=realparam[3],
yxtr=realparam[4], yytr=realparam[5], ytr=realparam[6];
internaldef charwd=realparam[7] # width of character to be output;
internaldef charht=realparam[8] # height of character to be output;
internaldef chardp=realparam[9] # depth of character to be output;
internaldef charic=realparam[10] # italic correction of character to be output;
internaldef safetyfactor=realparam[11] # extra factor for overlap in ddraw;
internaldef maxvr=realparam[12], minvr=realparam[13],
maxvs=realparam[14], minvs=realparam[15] # velocity thresholds;
internaldef epenxfactor=realparam[16], epenyfactor=realparam[17],
excorr=realparam[18], eycorr=realparam[19] # parameters for \&{epen}s;
internaldef designsize=realparam[20] # nominal height of font to be output,
expressed in points;
internaldef xresolution=realparam[21], yresolution=realparam[22] # of
output, expressed in pixels per point;
internaldef magnification=realparam[23] # factor by which logical font has
been expanded or contracted, a pure number;
internaldef hpenht=intparam[intpar+1] # hpen height;
internaldef vpenwd=intparam[intpar+2] # vpen width;
internaldef lpenht=intparam[intpar+3] # lpen height;
internaldef rpenht=intparam[intpar+4] # rpen height;
preloadwith "hpen height","vpen width","lpen height","rpen height";
saf string array sympar[intpar+1:intpar+4];
internaldef dumplength=intparam[intpar+5] # length of strings for dumping;
internaldef charcode=intparam[intpar+6] # ascii code of character to be output;
internaldef chardw=intparam[intpar+7] # device width of character to be output;
internaldef seed=intparam[intpar+8] # controls random number generator;
internaldef dumpwindow=intparam[intpar+9] # number of characters in error m'ges;
internaldef maxht=intparam[intpar+10] # maximum height above baseline;
internaldef fontidentifier=stringparam[stringpar+1] # a string that names
all sizes, logical and physical, of the current font. This
string incorporates the PARC notions of family and face: for
example, "CMR", "CMSS", "CMTT", ...;
internal integer control # bits that control various METAFONT functions;
comment The individual control bits have the following significance:
'1 tracing definitions of variables
'2 tracing titles of routines
'4 tracing calls of subroutines
'10 pausing before each input line from a file
'20 warning messages if page ended unexpectedly
'40 pen type and size are undefined on entry to subroutine
Bits '100 thru '400 are defined in MFRAST (if anywhere)
Bits '1000 thru '400000 are defined in MFOUT for particular output modes
Bits '1000000 thru '4000000 govern on-line raster display;
define trdefs=(control land 1), trtitles=(control land 2),
trcalls=(control land 4), pausing=(control land '10),
warning=(control land '20), penreset=(control land '40);
comment The hash table: hashh, hname, idlookup, idremove, idhide;
comment Identifiers, some of which are predeclared as "reserved words,"
are recorded in a hash table, with an associated table of their equivalent meanings.
This table is accessed via "chaining with separate lists" (cf. Section 6.4 of
ACP)--in other words, there are three parts to the table: An array hashh contains
list heads for each possible hash code--these list heads are pointers into mem,
starting a linked list representing all identifiers having a given hash code.
Identifiers that represent parameters in more than one subroutine appear several
times in the linked list, once for each subroutine.
Another array hname contains the first few characters of each identifier.
(As many 5-bit characters are kept as will fit in a machine word.)
The third part of the hash table consists of the linked lists in mem, with two-word
nodes containing type, name, and link fields in one word and a value field in the
other. The type and value fields are reported by getnext after it finds the
identifier. The name field points to the hname array, and the link field points
to the next node in the list.
The hash code for an identifier is the remainder of (first few characters)+(length)
divided by the size of the hashh table. Thus, identifiers with the same first few
characters but different lengths (modulo the size of hashh) will never be confused
with each other;
internaldef hashsize = 89 # hashtable size, should be prime;
internaldef namesize = 300 # maximum number of different identifiers, is << 2^names;
comment The difference between 2^names and namesize is the maximum allowable
subscript on a w-, x-, or y-variable;
internal saf integer array hashh[0:hashsize-1] # list heads for hashing;
internal saf integer array hname[0:namesize-1] # first characters of identifiers;
internal integer hptr # number of different identifiers currently in memory;
internaldef types=6, typed=bitsperwd-types # type field in nodes;
internaldef names=typed-links, named=links # name field in nodes;
internaldef type(p)=field(type,mem[p]) # type field in node p;
internaldef name(p)=field(name,mem[p]) # name field in node p;
internaldef bitsrem=bitsperwd mod 5 # extra bits at left of hname entries;
define letsperwd=(bitsperwd-bitsrem)div 5 # number of letters per word;
internal boolean forcednew # identifier when looked up will not match any other;
internal integer procedure idlookup(integer firstfew,length) # look for identifier;
begin comment This procedure finds the given identifier using the hash table
mechanisms, inserting it (with type code "newid" and value pointing to
itself) if it is not present already. If global variable "forcednew" is true, the
given identifier is added to the table even if it is already present;
integer h,q;
h_(firstfew+length)mod hashsize; q_hashh[h];
if not forcednew then while q do
begin if hname[name(q)]=firstfew then return(q);
q_link(q);
end;
comment Identifier not found, must insert it;
if hptr namesize then overflow(namesize);
hname[hptr]_firstfew # new name into the table;
getvavail(q); mem[q]_(newid lsh typed)+(hptr lsh named)+hashh[h];
vmemint(q)_q; hashh[h]_q;
hptr_hptr+1;
return(q);
end;
procedure idhide(integer iloc) # covers up an identifier;
begin comment This procedure makes an identifier invisible, given the location
of that identifier's entry in the mem array. (It is used for subroutine
arguments after the subroutine has been stored away.);
integer t # temporary storage for letters while computing the length;
integer l # length;
integer h # hash location;
integer p # pointer that follows q;
integer q # pointer that runs through hash lists;
boolean oncethru # we have run to the end of the hash table;
if name(iloc) hptr then confusion # the identifier is assumed present;
h_t_hname[name(iloc)];
if t land '37 then l_letsperwd
else begin l_1; t_t rot(bitsrem+10);
while t land '37 do
begin l_l+1; t_t rot 5;
end;
end;
h_(h+l)mod hashsize; oncethru_false;
loop begin p_0; q_hashh[h];
while q do if q=iloc then
begin if p=0 then hashh[h]_link(q) else setlink(p,link(q));
return;
end
else begin p_q; q_link(q);
end;
h_h+1; if h hashsize then
begin if oncethru then confusion;
h_0; oncethru_true;
end;
end;
end;
comment wxy-variables and area headers: wxylookup, indexname, idname;
comment The METAFONT language gives special meaning to identifiers that begin
with w, x, or y, namely they must be of the form w<index> or x<index> or
y<index>. Inside the METAFONT system an index variable is represented as a pair
(info,link) where info is a small integer subscript and link points to an
"area header". Within a subroutine, x1 refers to a variable local to that
subroutine, and all x-variables of that subroutine are addressed via its area
header. The area header of the main program (i.e., outside subroutines) is pointed
to by "main".
Linked lists are maintained for the x-variables and y-variables of each area.
(All w-variables come from a single area, whose list starts in mem[wvar].)
The name field in this list is the subscript plus namesize, while the type and
value fields are the same as for ordinary identifiers. The lists are kept in
order by subscript, and the last node of the list points back to the area
header.
An area header p is a two-word node containing
areahead, in the type field of mem[p]
a character code, in the name field of mem[p] (e.g., "call`c" on a
subroutine puts "c" in this field)
pointer to enclosing area header, in the link field of mem[p]
pointer to first x-variable, in the info field of vmemint(p)
pointer to first y-variable, in the link field of vmemint(p).
The area headers in existence at any given time constitute a stack corresponding
to subroutines that have been called and not yet terminated. The global variable
curarea points to the top of this stack, while main points to the bottom;
integer curarea # pointer to the current area header;
comment The following procedures are used to access wxy-variables, analogous to
the routines for other identifiers;
integer procedure wxylookup(integer chr,indx) # find a wxy-identifier;
begin comment This procedure finds a given wxy-variable, when chr is
"w", "x", or "y", mod 32, and indx is an index value;
integer n,p,q,m,prevp;
n_field(info,indx)+namesize;
case chr of begin
["w" land '37] p_link(wvar);
["x" land '37] begin m_field(link,indx); p_field(info,vmemint(m)) end;
["y" land '37] begin m_field(link,indx); p_field(link,vmemint(m)) end;
else confusion
end;
prevp_0 # indicates that p was found in the area header node;
while type(p)areahead do
begin integer nn;
if(nn_name(p))>n then done
else if nn=n then return(p);
prevp_p; p_link(p);
end;
comment The variable is not in the list, it needs to be inserted
between prevp and p;
if n (1 lsh names) then overflow(names) # not enough bits to represent such a
large subscript;
getvavail(q);
mem[q]_(newid lsh typed)+(n lsh named)+p; vmemint(q)_q;
if prevp then setlink(prevp,q)
else case chr of begin
["w" land '37] setlink(wvar,q);
["x" land '37] setfield(info,vmemint(m),q);
["y" land '37] setfield(link,vmemint(m),q);
else confusion
end;
return(q);
end;
internal string procedure indexname(integer i) # symbolic name of an index value;
begin comment If the main procedure says call"a" sub1 and sub1 says call"b" sub2
and the argument i is an index for variables x3 and y3 in sub2, this
procedure returns the string "ab3";
string s; integer p; s_"";
p_field(link,i);
while pmain do
begin if name(p) then s_name(p)&s;
p_link(p);
end;
return(s&cvs(field(info,i)));
end;
integer idarea # communication between entersym and idname;
internal string procedure idname(integer p) # produces name for printouts;
begin comment This procedure is sort of an inverse to idlookup and wxylookup:
Given the output of one of those procedures, it figures out the corresponding
identifier. Since the procedure is used only for error messages, it need not be
too efficient. If the identifier begins with "x" or "y", global variable
idarea is set to the corresponding areahead;
integer n; string s;
if(n_name(p))<namesize then
begin comment normal identifier;
integer t,x,l,i;
t_hname[n] lsh bitsrem; s_""; l_0;
while(x_(t rot 5)land '37) do
begin s_s&(x+'140); l_l+1; t_t lsh 5;
end;
if l<letsperwd then return(s);
for i_1 thru 10 do
begin comment try to find the identifier;
integer q;
q_hashh[(hname[n]+l)mod hashsize];
while q do if q=p then return(s) else q_link(q);
s_s&"x"; l_l+1;
end;
comment Not found. (If METAFONT is working, this means the identifier is
extremely long, or it's a parameter name that has been hidden.);
return(s[1 to letsperwd]&"X");
end
else begin comment wxy-identifier;
integer r;
s_cvs(n-namesize) # string representing the index;
idarea_link(p);
loop begin comment search for area;
if idarea=0 then return("wxy??") # unknown indentifier;
if type(idarea)areahead then idarea_link(idarea) else done;
end;
if idarea=wvar then return("w"&s);
r_idarea;
while link(r) do
begin integer x;
if(x_name(r)) then s_x&s # put call characters into the name;
r_link(r);
end;
r_field(info,vmemint(idarea));
loop begin comment look thru the x-list;
if r=p then return("x"&s) # x-variable found;
if r=0 then confusion;
if type(r)areahead then r_link(r) else done;
end;
r_field(link,vmemint(idarea));
loop begin comment look thru the y-list;
if r=p then return("y"&s) # y-variable found;
if r=0 then confusion;
if type(r)areahead then r_link(r) else done;
end;
return("wxy??") # doesn't check out: not w, x, or y;
end;
end;
comment The input stacks: inbuf,curbuf,state,loc,recovery,filename;
comment The state of the scanning routine appears in several stacks.
Global variables inbuf, curbuf, loc, recovery, and filename contain
the current status, while arrays inbufstack, curbfstack, ..., filenmstack contain
the status of activities that have temporarily been suspended. The stack
pointer is called inptr, and it is set so that, for example, inbufstack[0] thru
inbufstack[inptr-1] are the suspended inbufs;
internaldef stacksize=40 # maximum number of simultaneous input sources;
internal saf string array inbufstack[0:stacksize]; internal string inbuf
# current lines being input from a character file;
internal saf string array curbfstack[0:stacksize]; internal string curbuf
# the parts of inbuf that haven't yet been input;
internal saf string array filenmstack[0:stacksize]; internal string filename
# the names of the current character files;
internal saf integer array locstack[0:stacksize]; internal integer loc
# current scanner locations;
internal saf integer array recvrystack[0:stacksize]; internal integer recovery
# information about what to do when done on each level;
comment The upper limit in these declarations is stacksize rather than stacksize-1
so that the dumpcontext routine doesn't cause embarrassing stack overflow;
internal integer inptr # first unused location in input stacks;
comment When the current input is from an external character file (this is indicated
by recovery 0), inbuf contains the current line, and curbuf contains
the remains of the current line as its characters are being lopped off.
String filename is the name of the file -- this is used only for printing error
messages and returning to the editor (cf. the error procedure in MFSYS).
The loc contains page number and line number of the current line, in its
respective info and link fields. The channel number appears in recovery.
A null filename denotes input from the user terminal. (In this case loc and
recovery are zero.)
When the state specifies reading from an internal linked list of tokens,
inbuf and curbuf and filename are not used. The loc points to the next low-level
token to be scanned, and recovery contains the negative of the address of the
beginning of this token list;
internal string pagewarning # most recent quoted string scanned;
comment When \\{pagewarning} is non-null, the user's source file
probably shouldn't contain any form-feeds (end-of-page marks);
comment The global variable "cond" is true when scanning a condition
(between "if" and the following ":");
boolean cond # "=" signs should be treated as relations like "<";
comment Tokens, token lists, and the diagnostic routines dumplist,dumptokens;
comment A low-level token is either an identifier that isn't a wxy-variable,
or the letter "w", "x", or "y", or a digit, or a punctuation mark.
Subroutines are represented as linked lists of low-level tokens. For example, the
subroutine body (using ":" for semicolons because of SAIL's comment convention)
hpen: lft0 x1 = lft8 xi - 3.05ssd: call`a sb(i): w0 draw 1..i.
consists of the tokens
<hpen>,semi,<lft>,0,x,1,equals,<lft>,8,x,<i>,op-,
3,pnt,0,5,<ssd>,semi,<call>,char a,<sb>,lpren,
<i>,rpren,semi,w,0,<draw>,1,ddot,<i>,fullstop.
Here <...> means an identifier pointer, op- means the operator minus, and so
on. Tokens are represented in mem by type and name fields,
so that, for example, <hpen> has type ident and its name field is a pointer to
the mem entry for that identifier. Note that different uses of certain characters
like "." and "-" are disambiguated in their type fields.
The name field in a token is equal to the
corresponding character whenever possible, so that a token list can be
printed out in a readable form.
A high-level token is like a low-level token except that constants like "3.05"
are combined into one item, and so are wxy-variables. The type of a high-level
token is never "ident", it is the type of the identifier. High-level tokens
that aren't low-level tokens never appear in token lists (since the information
on how to print them is not available).
The token list for a subroutine begins with the identifier representing its name,
followed by tokens indicating parameters (if any), followed by a colon, and it
ends with the "fullstop" token following that subroutine.
The procedure dumplist illustrates the above conventions. It is used
for diagnostic purposes;
internal saf string array tokstring[0:1] # output of dumplist;
internal procedure dumplist(integer p,q) # makes strings out of a token list;
begin comment This procedure is used for diagnostic messages. It creates two
strings from the token list pointed to by p, namely tokstring[0] for all
tokens up to but not including the one pointed to by q, and tokstring[1]
for the remaining tokens if any. For example, if p points to the node <hpen>
in the above example and if q points to the second "0", the result will be
tokstring[0]="hpen: lft0 x1 = lft8 xi - 3."
tokstring[1]="05 ssd: call`a sb(i): w0 draw 1..i."
(But with semicolons instead of colons.)
This routine is intended to be robust in the sense that one can try it while
debugging just to see whether a particular memory location makes sense
if regarded as a token list;
integer j # 0 until q is reached, then 1;
string optspace # " " if next id should be preceded by space, otherwise "";
integer chr,t,n; string s;
if (n_dumplength) 0 then n_1000 # maximum length of strings produced;
tokstring[0]_tokstring[1]_null; j_0; optspace_"";
while p do
begin if p=q then j_1;
if p<0 or p memsize then
begin tokstring[j]_tokstring[j]&"CLOBBERED"; done;
end;
t_type(p); chr_name(p);
case t of begin
[ident] if chr<vmemsize then
begin integer typ;
s_optspace&idname(chr); typ_type(chr);
if typ=iff or typ=draw or typ=ddraw or
(typ=unary and vmemint(chr)good) then
begin s_s&" "; optspace_"";
end
else optspace_" ";
end
else begin s_optspace&"IMPOSSIBLE"; optspace_" ";
end;
[wxy] begin s_optspace&chr; optspace_"" end;
[lbrace][hashmark][lbrack][pnt][abbs][lpren] begin s_chr; optspace_"" end;
[char] begin s_"`"&chr; optspace_" " end;
[rpren][rbrace][rbrack][digit][apost] begin s_chr; optspace_" " end;
[comma][colon][semi][fullstop] begin s_chr&" "; optspace_"" end;
[ddot] begin s_".."; optspace_"" end;
[varparam] begin s_"(var "&idname(chr)&")"; optspace_"" end;
[indexparam] begin s_"(index "&idname(chr)&")"; optspace_"" end;
[timesordiv] begin s_chr; optspace_"" end;
[rel][equals][plusorminus] begin s_" "&chr&" "; optspace_"" end;
else begin s_optspace&"BAD"; optspace_" " end
end;
tokstring[j]_tokstring[j]&s;
if length(tokstring[j])>n then
begin tokstring[j]_tokstring[j]&optspace&"ETC"; done;
end;
p_link(p);
end;
end;
internal string procedure dumptokens(integer p) # simple special case of dumplist;
begin dumplist(p,0); return(tokstring[0]);
end;