@d banner=='This is TeX, Version 1.3' {printed when \TeX\ starts}

@d banner=='This is TeX 1.3 for Cedar 6.0' {printed when \TeX\ starts}

@f type==true {but `|type|' will not be treated as a reserved word}

@f type==true {but `|type|' will not be treated as a reserved word}

@d write←ln==writeln {since our Tangle doesn't strip out "←"}

@d read←ln==readln {since our Tangle doesn't strip out "←"}

procedure initialize; {this procedure gets things started properly}

@<External procedure declarations for things implemented directly in Cedar@>@/

procedure initialize; {this procedure gets things started properly}

@d debug==@{ {change this to `$\\{debug}\equiv\null$' when debugging}

@d gubed==@t@>@} {change this to `$\\{gubed}\equiv\null$' when debugging}

@d debug==

@d gubed==

@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}

@d stat==

@d tats==

@!init @<Initialize table entries (done by \.{INITEX} only)@>@;@+tini

if start←like←initex then

begin

@<Initialize table entries (done by \.{INITEX} only)@>

end;

@!mem←max=30000; {greatest index in \TeX's internal |mem| array,

@!mem←max=3000; {greatest index in \TeX's internal |mem| array,

@!mem←max=30000; {greatest index in \TeX's internal |mem| array;

@!mem←max=65000; {greatest index in \TeX's internal |mem| array;

@!buf←size=500; {maximum number of characters simultaneously present in

@!buf←size=7500; {maximum number of characters simultaneously present in

@!error←line=72; {width of context lines on terminal error messages}

@!half𡤎rror←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}

@!error←line=64; {width of context lines on terminal error messages}

@!half𡤎rror←line=32; {width of first lines of contexts in terminal

error messages, should be between 30 and |error←line-15|}

@!max←print←line=72; {width of longest text lines output, should be at least 60}

@!error←line=72; {width of context lines on terminal error messages}

@!half𡤎rror←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}

@!error←line=64; {width of context lines on terminal error messages}

@!half𡤎rror←line=32; {width of first lines of contexts in terminal

error messages; should be between 30 and |error←line-15|}

@!max←print←line=30000; {width of longest text lines output; should be at least 60}

@!font←max=75; {maximum internal font number; must not exceed |max←quarterword|
and must be at most |font�se+256|}
@!font←mem←size=20000; {number of words of |font←info| for all fonts}

@!font←max=100; {maximum internal font number; must not exceed |max←quarterword|
and must be at most |font�se+256|}
@!font←mem←size=25000; {number of words of |font←info| for all fonts}

@!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}

@!max←strings=4400; {maximum number of strings; must not exceed |max←halfword|}
@!string←vacancies=15000; {the minimum number of characters that should be
available for the user's control sequences and font names,
after \TeX's own error messages are stored}
@!pool←size=48000; {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}

@!file←name←size=40; {file names shouldn't be longer than this}

@!file←name←size=127; {file names shouldn't be longer than this}

@!pool←name='TeXformats:TEX.POOL ';

@d mem𡤋ot=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𡤋ot|

and not greater than |mem←max|}

@d mem𡤋ot=0 {smallest index in the |mem| array dumped by \.{INITEX};

must not be less than |mem←min|}

@d mem←top==65000 {largest index in the |mem| array dumped by \.{INITEX};

must be substantially larger than |mem𡤋ot|

and not greater than |mem←max|}

@d hash←size=2100 {maximum number of control sequences; it should be at most
about |(mem←max-mem←min)/10|, but 2100 is already quite generous}
@d hash←prime=1777 {a prime number equal to about 85\% of |hash←size|}

@d hash←size=2500 {maximum number of control sequences; it should be at most
about |(mem←max-mem←min)/10|, but 2100 is already quite generous}
@d hash←prime=2129 {a prime number equal to about 85\% of |hash←size|}

@d last←text𡤌har=127 {ordinal number of the largest element of |text𡤌har|}

@d last←text𡤌har=255 {ordinal number of the largest element of |text𡤌har|}

for i:=1 to @'37 do xchr[i]:=' ';

for i:=1 to @'37 do xchr[i]:=chr(i);

@d reset←OK(#)==erstat(#)=0

@d rewrite←OK(#)==erstat(#)=0

@p function a←open←in(var f:alpha𡤏ile):boolean;

{open a text file for input}

begin reset(f,name←of𡤏ile,'/O'); a←open←in:=reset←OK(f);

end;

@#

function a←open←out(var f:alpha𡤏ile):boolean;

{open a text file for output}

begin rewrite(f,name←of𡤏ile,'/O'); a←open←out:=rewrite←OK(f);

end;

@#

function b←open←in(var f:byte𡤏ile):boolean;

{open a binary file for input}

begin reset(f,name←of𡤏ile,'/O'); b←open←in:=reset←OK(f);

end;

@#

function b←open←out(var f:byte𡤏ile):boolean;

{open a binary file for output}

begin rewrite(f,name←of𡤏ile,'/O'); b←open←out:=rewrite←OK(f);

end;

@#

function w←open←in(var f:word𡤏ile):boolean;

{open a word file for input}

begin reset(f,name←of𡤏ile,'/O'); w←open←in:=reset←OK(f);

end;

@#

function w←open←out(var f:word𡤏ile):boolean;

{open a word file for output}

begin rewrite(f,name←of𡤏ile,'/O'); w←open←out:=rewrite←OK(f);

end;

@p function a←open←in(var f:alpha𡤏ile):boolean; external;

{open a text file for input}

@#

function a←open←out(var f:alpha𡤏ile):boolean; external;

{open a text file for output}

@#

function b←open←in(var f:byte𡤏ile):boolean; external;

{open a binary file for input}

@#

function b←open←out(var f:byte𡤏ile):boolean; external;

{open a binary file for output}

@#

function w←open←in(var f:word𡤏ile):boolean; external;

{open a word file for input}

@#

function w←open←out(var f:word𡤏ile):boolean; external;

{open a word file for output}

@p procedure a𡤌lose(var f:alpha𡤏ile); {close a text file}

begin close(f);

end;

@#

procedure b𡤌lose(var f:byte𡤏ile); {close a binary file}

begin close(f);

end;

@#

procedure w𡤌lose(var f:word𡤏ile); {close a word file}

begin close(f);

end;

@p procedure a𡤌lose(var f:alpha𡤏ile); external; {close a text file}

@#

procedure b𡤌lose(var f:byte𡤏ile); external; {close a binary file}

@#

procedure w𡤌lose(var f:word𡤏ile); external; {close a word file}

@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}

@d t←open←in==reset←term←in(term←in) {open the terminal for text input}

@d t←open←out==rewrite←term←out(term←out) {open the terminal for text output}

@d clear←terminal == break←in(term←in,true) {clear the terminal input buffer}

@d clear←terminal == {clear the terminal input buffer}

begin t←open←in;

const cmd𡤋lank = 0;

var cmd←status:integer;

begin t←open←in;

cmd←status:=stuff←on𡤌md←line;

if cmd←status=cmd←overflow then overflow("buffer size",buf←size);

if cmd←status=cmd←ok then begin init←terminal:=true; return end;

name←of𡤏ile:=pool←name; {we needn't set |name←length|}

set←pool←name;

if interaction=error←stop←mode then @<Get user's advice and |return|@>;

if interaction=error←stop←mode then
begin set←normal←priority; @<Get user's advice and |return|@>; end;

exit:end;

exit: set�kground←priority; end;

print(" at line "); print←int(line);

print(" near character "); print←int(line);

@!nonnegative←integer=0..@'17777777777; {$0\L x<2^{31}$}

@!nonnegative←integer=integer; {$0\L x<2^{31}$}

@d max←halfword==65535 {largest allowable value in a |halfword|}

@d max←halfword==65515 {largest allowable value in a |halfword|}

@d qi(#)==#+min←quarterword
{to put an |eight𡤋its| item into a quarterword}
@d qo(#)==#-min←quarterword
{to take an |eight𡤋its| item out of a quarterword}
@d hi(#)==#+min←halfword
{to put a sixteen-bit item into a halfword}
@d ho(#)==#-min←halfword
{to take a sixteen-bit item from a halfword}

@d qi(#)==#
{to put an |eight𡤋its| item into a quarterword}
@d qo(#)==#
{to take an |eight𡤋its| item out of a quarterword}
@d hi(#)==#
{to put a sixteen-bit item into a halfword}
@d ho(#)==#
{to take a sixteen-bit item from a halfword}

@!two𡤌hoices = 1..2; {used when there are two variants in a record}

@!four𡤌hoices = 1..4; {used when there are four variants in a record}

@!two←halves = packed record@;@/

@!rh:halfword;

case two𡤌hoices of

1: (@!lh:halfword);

2: (@!b0:quarterword; @!b1:quarterword);

end;

@!four←quarters = packed record@;@/

@!b0:quarterword;

@!b1:quarterword;

@!b2:quarterword;

@!b3:quarterword;

end;

@!memory←word = record@;@/

case four𡤌hoices of

1: (@!int:integer);

2: (@!gr:glue←ratio);

3: (@!hh:two←halves);

4: (@!qqqq:four←quarters);

end;

@!two𡤌hoices = (c1of2, c2of2);

{used when there are two variants in a record}

@!four𡤌hoices = (c1of4, c2of4, c3of4, c4of4);

{used when there are four variants in a record}

@!two←halves = packed record@;@/

@!rh:halfword;

case two𡤌hoices of

c1of2: (@!lh:halfword);

c2of2: (@!b0:quarterword; @!b1:quarterword);

end;

@!four←quarters = packed record@;@/

@!b0:quarterword;

@!b1:quarterword;

@!b2:quarterword;

@!b3:quarterword;

end;

@!memory←word = record@;@/

case four𡤌hoices of

c1of4: (@!int:integer);

c2of4: (@!gr:glue←ratio);

c3of4: (@!hh:two←halves);

c4of4: (@!qqqq:four←quarters);

end;

print(" entered at line "); print←int(abs(nest[p].ml𡤏ield));

print(" entered in line at c. "); print←int(abs(nest[p].ml𡤏ield));

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;

begin read←the𡤌lock(time,day,month,year);

end;

@!mag←set:integer; {if nonzero, this magnification should be used henceforth}

@!mag←set:integer; {if nonzero, this magnification should be used henceforth}

@!use←press𡤏ormat:boolean; {the user has requested that Press format be used}

@p procedure prepare←mag;

begin if (mag←set>0)and(mag<>mag←set) then

@p procedure prepare←mag;

var @!user←wants←press:boolean;

begin user←wants←press:=profile𡤊sks𡤏or←press;

if (mag←set>0)and(mag<>mag←set) then

if (mag<=0)or(mag>32768) then

if (mag←set>0)and(use←press𡤏ormat<>user←wants←press) then

begin print𡤎rr("Tardy attempt to select Press print file format is being ignored");

error;

user←wants←press:=use←press𡤏ormat;

end;

if (mag<=0)or(mag>32768) then

mag←set:=mag;

mag←set:=mag;

use←press𡤏ormat:=user←wants←press;

else begin print←nl("l."); print←int(line);

else begin print←nl("c."); print←int(line+(loc-start));

print("; all text was ignored after line "); print←int(skip←line);

print("; all text was ignored after line at c. "); print←int(skip←line);

begin incr(line); first:=start;

begin line:=file←get←pos(cur𡤏ile); first:=start;

@!num,@!denom:1..65536; {conversion ratio for the scanned units}

@!num,@!denom:integer; {conversion ratio for the scanned units}

@d TEX𡤊rea=="TeXinputs:"

@.TeXinputs@>

@d TEX𡤏ont𡤊rea=="TeXfonts:"

@.TeXfonts@>

@<Glob...@>=

@!TEX𡤊rea:str←number;

@.TeXinputs@>

@!TEX𡤏ont𡤊rea:str←number;

@.TeXfonts@>

else begin if (c=">")or(c=":") then
begin area�limiter:=pool←ptr; ext�limiter:=0;
end
else if (c=".")and(ext�limiter=0) then ext�limiter:=pool←ptr;

else begin if (c=">")or(c="/")or(c="]") then
area�limiter:=pool←ptr
else if (c=".") then ext�limiter:=pool←ptr;

@ A messier routine is also needed, since format file names must be scanned
before \TeX's string mechanism has been initialized. We shall use the
global variable |TEX𡤏ormat�ult| to supply the text for default system areas
and extensions related to format files.
@^system dependencies@>

@d format�ult←length=20 {length of the |TEX𡤏ormat�ult| string}
@d format𡤊rea←length=11 {length of its area part}
@d format𡤎xt←length=4 {length of its `\.{.fmt}' part}

@<Glob...@>=
@!TEX𡤏ormat�ult:packed array[1..format�ult←length] of char;

@ @<Set init...@>=
TEX𡤏ormat�ult:='TeXformats:PLAIN.fmt';
@.TeXformats@>
@.PLAIN@>
@^system dependencies@>

@ @<Check the ``constant'' values for consistency@>=
if format�ult←length>file←name←size then bad:=31;

@ This module is a dummy. The default name of the format file is dealt with
directly in Cedar.

@ So is this one.

@ This one too.

@p procedure pack𡤋uffered←name(@!n:small←number;@!a,@!b:integer);
var k:integer; {number of positions filled in |name←of𡤏ile|}
@!c: ASCII𡤌ode; {character being packed}
@!j:integer; {index into |buffer| or |TEX𡤏ormat�ult|}
begin if n+b-a+1+format𡤎xt←length>file←name←size then
b:=a+file←name←size-n-1-format𡤎xt←length;
k:=0;
for j:=1 to n do append←to←name(xord[TEX𡤏ormat�ult[j]]);
for j:=a to b do append←to←name(buffer[j]);
for j:=format�ult←length-format𡤎xt←length+1 to format�ult←length do
append←to←name(xord[TEX𡤏ormat�ult[j]]);
if k<=file←name←size then name←length:=k@+else name←length:=file←name←size;
for k:=name←length+1 to file←name←size do name←of𡤏ile[k]:=' ';
end;

@p procedure pack𡤋uffered←name(@!a,@!b:integer); external;

procedure pack�ult𡤊rea(@!a,@!b:integer); external;

procedure pack𡤊ll�ult; external;

pack𡤋uffered←name(0,loc,j-1); {try first without the system file area}

pack𡤋uffered←name(loc,j-1); {try first without the system file area}

pack𡤋uffered←name(format𡤊rea←length,loc,j-1);

pack�ult𡤊rea(loc,j-1);

wterm←ln('Sorry, I can''t find that format;',' will try PLAIN.');

wterm←ln('Sorry, I can''t find that format;',' will try your default.');

pack𡤋uffered←name(format�ult←length-format𡤎xt←length,1,0);

pack𡤊ll�ult;

wterm←ln('I can''t find the PLAIN format file!');

wterm←ln('I can''t find your default format file!');

function a←make←name←string(var f:alpha𡤏ile):str←number;
begin a←make←name←string:=make←name←string;
end;
function b←make←name←string(var f:byte𡤏ile):str←number;
begin b←make←name←string:=make←name←string;
end;
function w←make←name←string(var f:word𡤏ile):str←number;
begin w←make←name←string:=make←name←string;
end;

function a←make←name←string(var f:alpha𡤏ile):str←number; external;

function b←make←name←string(var f:byte𡤏ile):str←number; external;

function w←make←name←string(var f:word𡤏ile):str←number; external;

function press←make←name←string:str←number; external;

@d ensure𡤍vi←open==if output𡤏ile←name=0 then

@d ensure←press←open==if output𡤏ile←name=0 then

begin if job←name=0 then open←log𡤏ile;

pack←job←name(".press");

while not press←open←out do

prompt𡤏ile←name("file name for output",".press");

output𡤏ile←name:=press←make←name←string;

end;

@d ensure𡤍vi←open==if output𡤏ile←name=0 then

first:=limit+1; loc:=start; line:=1;

first:=limit+1; loc:=start; line:=1;

@!skew𡤌har:array[internal𡤏ont←number] of integer;

{current \.{\\skewchar} values}

@!skew𡤌har:array[internal𡤏ont←number] of integer;

{current \.{\\skewchar} values}

@!font�mily:array[internal𡤏ont←number] of str←number;

{the Press family name}

@!font�:array[internal𡤏ont←number] of eight𡤋its;

{the Press face code}

@!font←pype𡤌ode:array[internal𡤏ont←number] of cedar←nat;

{once font←used is true, holds the SirPress pyping font code}

@!f:internal𡤏ont←number; {the new font's number}

@!i,@!fam←len:halfword; {new temporaries}

@!f:internal𡤏ont←number; {the new font's number}

begin g:=null𡤏ont;@/

procedure read←the←tfm←header;

begin g:=null𡤏ont;@/

@<Read the {\.{TFM}} header@>;

read←the←tfm←header;

@ Only the first two words of the header are needed by \TeX82.

@<Read the {\.{TFM}} header@>=
begin if lh<2 then abort;
store𡤏our←quarters(font𡤌heck[f]);
fget; read←sixteen(z); {this rejects a negative design size}
fget; z:=z*@'400+fbyte; fget; z:=(z*@'20)+(fbyte div@'20);
if z<unity then abort;
while lh>2 do
begin fget;fget;fget;fget;decr(lh); {ignore the rest of the header}
end;
font𡤍size[f]:=z;
if s<>-1000 then
if s>=0 then z:=s
else z:=xn←over𡤍(z,-s,1000);
font←size[f]:=z;
end

@ Normally, \TeX82 only needs to read the first two words of the
header. But we must read more, in order to handle Press output.

@<Read the {\.{TFM}} header@>=
begin if lh<18 then abort;
store𡤏our←quarters(font𡤌heck[f]);
fget; read←sixteen(z); {this rejects a negative design size}
fget; z:=z*@'400+fbyte; fget; z:=(z*@'20)+(fbyte div@'20);
if z<unity then abort;
for i:=1 to 10 do begin fget;fget;fget;fget end; {ignore character coding scheme}
fget; {read the length of the font family name}
fam←len:=fbyte;
str←room(fam←len);
for i:=1 to fam←len do begin fget; append𡤌har(fbyte) end;
for i:=fam←len+1 to 19 do fget;
font�mily[f]:=make←string;
fget; fget; fget; fget; font�[f]:=fbyte;
while lh>18 do
begin fget;fget;fget;fget;decr(lh); {ignore the rest of the header}
end;
font𡤍size[f]:=z;
if s<>-1000 then
if s>=0 then z:=s
else z:=xn←over𡤍(z,-s,1000);
font←size[f]:=z;
end

@p procedure write𡤍vi(@!a,@!b:dvi←index);

var k:dvi←index;

begin for k:=a to b do write(dvi𡤏ile,dvi𡤋uf[k]);

end;

@p procedure write𡤍vi(@!a,@!b:dvi←index); external;

@!cur←s:integer; {current depth of output box nesting}

@!cur←s:integer; {current depth of output box nesting}

@!press←h←ok:boolean; {while pyping, tells if SirPress has the correct x-coordinate}

cur←s:=-1; ensure𡤍vi←open;

cur←s:=-1;

prepare←mag; {now the Press/DVI die is cast}

if use←press𡤏ormat then

begin

ensure←press←open;

if total←pages=0 then

do←nothing; {nothing special needs to be done before the first page}

end

else

begin

ensure𡤍vi←open;

pool←ptr:=str←start[str←ptr]; {flush the current string}

end

pool←ptr:=str←start[str←ptr]; {flush the current string}

end;

end

@p procedure@?vlist←out; forward; {|hlist←out| and |vlist←out| are mutually

recursive}

@p procedure@?vlist←out; forward; {|hlist←out| and |vlist←out| are mutually

recursive}

procedure@?hlist←press←out; forward;

procedure@?vlist←press←out; forward;

@ The recursive procedures |hlist←out| and |vlist←out| each have local variables
|save←h| and |save←v| to hold the values of |dvi←h| and |dvi←v| just before
entering a new level of recursion. In effect, the values of |save←h| and
|save←v| on \TeX's run-time stack correspond to the values of |h| and |v|
that a \.{DVI}-reading program will push onto its coordinate stack.

@d move←past=13 {go to this label when advancing past glue or a rule}
@d fin←rule=14 {go to this label to finish processing a rule}
@d next←p=15 {go to this label when finished with node |p|}

@p @t\4@>@<Declare procedures needed in |hlist←out|, |vlist←out|@>@t@>@/
procedure hlist←out; {output an |hlist←node| box}
label reswitch, move←past, fin←rule, next←p;
var base←line: scaled; {the baseline coordinate for this box}
@!left�ge: scaled; {the left coordinate for this box}
@!save←h,@!save←v: scaled; {what |dvi←h| and |dvi←v| should pop to}
@!this𡤋ox: pointer; {pointer to containing box}
@!g←order: glue←ord; {applicable order of infinity for glue}
@!g←sign: normal..shrinking; {selects type of glue}
@!p:pointer; {current position in the hlist}
@!save←loc:integer; {\.{DVI} byte location upon entry}
@!leader𡤋ox:pointer; {the leader box being replicated}
@!leader←wd:scaled; {width of leader box being replicated}
@!lx:scaled; {extra space between leader boxes}
@!outer𡤍oing←leaders:boolean; {were we doing leaders?}
@!edge:scaled; {left edge of sub-box, or right edge of leader space}
begin this𡤋ox:=temp←ptr; g←order:=glue←order(this𡤋ox);
g←sign:=glue←sign(this𡤋ox); p:=list←ptr(this𡤋ox);
incr(cur←s);
if cur←s>0 then dvi←out(push);
if cur←s>max←push then max←push:=cur←s;
save←loc:=dvi←offset+dvi←ptr; base←line:=cur←v; left�ge:=cur←h;
while p<>null do @<Output node |p| for |hlist←out| and move to the next node,
maintaining the condition |cur←v=base←line|@>;
prune←movements(save←loc);
if cur←s>0 then dvi←pop(save←loc);
decr(cur←s);
end;

@ We ought to give special care to the efficiency of one part of |hlist←out|,
since it belongs to \TeX's inner loop. When a |char←node| is encountered,
we save a little time by processing several nodes in succession until
reaching a non-|char←node|. The program uses the fact that |set𡤌har𡤀=0|.
@^inner loop@>

@<Output node |p| for |hlist←out|...@>=
reswitch: if is𡤌har←node(p) then
begin synch←h; synch←v;
repeat f:=font(p); c:=character(p);
if f<>dvi𡤏 then @<Change font |dvi𡤏| to |f|@>;
if c<qi(128) then dvi←out(qo(c))
else begin dvi←out(set1); dvi←out(qo(c));
end;
cur←h:=cur←h+char←width(f)(char←info(f)(c));
p:=link(p);
until not is𡤌har←node(p);
dvi←h:=cur←h;
end
else @<Output the non-|char←node| |p| for |hlist←out|
and move to the next node@>

@ @<Change font |dvi𡤏| to |f|@>=
begin if not font←used[f] then
begin dvi𡤏ont�(f); font←used[f]:=true;
end;
if f<=64+font�se then dvi←out(f-font�se-1+fnt←num𡤀)
else begin dvi←out(fnt1); dvi←out(f-font�se-1);
end;
dvi𡤏:=f;
end

@ @<Output the non-|char←node| |p| for |hlist←out|...@>=
begin case type(p) of
hlist←node,vlist←node:@<Output a box in an hlist@>;
rule←node: begin rule←ht:=height(p); rule𡤍p:=depth(p); rule←wd:=width(p);
goto fin←rule;
end;
whatsit←node: @<Output the whatsit node |p| in an hlist@>;
glue←node: @<Move right or output leaders@>;
kern←node,math←node:cur←h:=cur←h+width(p);
ligature←node: @<Make node |p| look like a |char←node| and |goto reswitch|@>;
othercases do←nothing
endcases;@/
goto next←p;
fin←rule: @<Output a rule in an hlist@>;
move←past: cur←h:=cur←h+rule←wd;
next←p:p:=link(p);
end

@ @<Output a box in an hlist@>=
if list←ptr(p)=null then cur←h:=cur←h+width(p)
else begin save←h:=dvi←h; save←v:=dvi←v;
cur←v:=base←line+shift𡤊mount(p); {shift the box down}
temp←ptr:=p; edge:=cur←h;
if type(p)=vlist←node then vlist←out@+else hlist←out;
dvi←h:=save←h; dvi←v:=save←v;
cur←h:=edge+width(p); cur←v:=base←line;
end

@ @<Output a rule in an hlist@>=
if is←running(rule←ht) then rule←ht:=height(this𡤋ox);
if is←running(rule𡤍p) then rule𡤍p:=depth(this𡤋ox);
rule←ht:=rule←ht+rule𡤍p; {this is the rule thickness}
if (rule←ht>0)and(rule←wd>0) then {we don't output empty rules}
begin synch←h; cur←v:=base←line+rule𡤍p; synch←v;
dvi←out(set←rule); dvi𡤏our(rule←ht); dvi𡤏our(rule←wd);
cur←v:=base←line; dvi←h:=dvi←h+rule←wd;
end

@ @<Move right or output leaders@>=
begin g:=glue←ptr(p); rule←wd:=width(g);
if g←sign<>normal then
begin if g←sign=stretching then
begin if stretch←order(g)=g←order then
rule←wd:=rule←wd+round(float(glue←set(this𡤋ox))*stretch(g));
@^real multiplication@>
end
else begin if shrink←order(g)=g←order then
rule←wd:=rule←wd-round(float(glue←set(this𡤋ox))*shrink(g));
end;
end;
if subtype(p)>=a←leaders then
@<Output leaders in an hlist, |goto fin←rule| if a rule
or to |next←p| if done@>;
goto move←past;
end

@ @<Output leaders in an hlist...@>=
begin leader𡤋ox:=leader←ptr(p);
if type(leader𡤋ox)=rule←node then
begin rule←ht:=height(leader𡤋ox); rule𡤍p:=depth(leader𡤋ox);
goto fin←rule;
end;
leader←wd:=width(leader𡤋ox);
if (leader←wd>0)and(rule←wd>0) then
begin edge:=cur←h+rule←wd; lx:=0;
@<Let |cur←h| be the position of the first box, and set |leader←wd+lx|
to the spacing between corresponding parts of boxes@>;
while cur←h+leader←wd<=edge do
@<Output a leader box at |cur←h|,
then advance |cur←h| by |leader←wd+lx|@>;
cur←h:=edge; goto next←p;
end;
end

@ The calculations related to leaders require a bit of care. First, in the
case of |a←leaders| (aligned leaders), we want to move |cur←h| to
|left�ge| plus the smallest multiple of |leader←wd| for which the result
is not less than the current value of |cur←h|; i.e., |cur←h| should become
$|left�ge|+|leader←wd|\times\lceil
(|cur←h|-|left�ge|)/|leader←wd|\rceil$. The program here should work in
all cases even though some implementations of \PASCAL\ give nonstandard
results for the |div| operation precisely, and even when |cur←h| is less
than |left�ge|.

In the case of |c←leaders| (centered leaders), we want to increase |cur←h|
by half of the excess space not occupied by the leaders; and in the case of
case of |x←leaders| (expanded leaders) we increase |cur←h|
by $1/(q+1)$ of this excess space, where $q$ is the number of times the
leader box will be replicated. Slight inaccuracies in the division might
accumulate; half of this rounding error is placed at each end of the leaders.

@<Let |cur←h| be the position of the first box, ...@>=
if subtype(p)=a←leaders then
begin save←h:=cur←h;
cur←h:=left�ge+leader←wd*((cur←h-left�ge)@!div leader←wd);
if cur←h<save←h then cur←h:=cur←h+leader←wd;
end
else begin lq:=rule←wd div leader←wd; {the number of box copies}
lr:=rule←wd mod leader←wd; {the remaining space}
if subtype(p)=c←leaders then cur←h:=cur←h+(lr div 2)
else begin lx:=(2*lr+lq+1) div (2*lq+2); {round|(lr/(lq+1))|}
cur←h:=cur←h+((lr-(lq-1)*lx) div 2);
end;
end

@ The `\\{synch}' operations here are intended to decrease the number
of bytes needed to specify horizontal and vertical motion in the \.{DVI} output.

@<Output a leader box at |cur←h|, ...@>=
begin cur←v:=base←line+shift𡤊mount(leader𡤋ox); synch←v; save←v:=dvi←v;@/
synch←h; save←h:=dvi←h; temp←ptr:=leader𡤋ox;
outer𡤍oing←leaders:=doing←leaders; doing←leaders:=true;
if type(leader𡤋ox)=vlist←node then vlist←out@+else hlist←out;
doing←leaders:=outer𡤍oing←leaders;
dvi←v:=save←v; dvi←h:=save←h; cur←v:=save←v;
cur←h:=save←h+leader←wd+lx;
end

@ The |vlist←out| routine is similar to |hlist←out|, but a bit simpler.

@p procedure vlist←out; {output a |vlist←node| box}
label move←past, fin←rule, next←p;
var left�ge: scaled; {the left coordinate for this box}
@!top�ge: scaled; {the top coordinate for this box}
@!save←h,@!save←v: scaled; {what |dvi←h| and |dvi←v| should pop to}
@!this𡤋ox: pointer; {pointer to containing box}
@!g←order: glue←ord; {applicable order of infinity for glue}
@!g←sign: normal..shrinking; {selects type of glue}
@!p:pointer; {current position in the vlist}
@!save←loc:integer; {\.{DVI} byte location upon entry}
@!leader𡤋ox:pointer; {the leader box being replicated}
@!leader←ht:scaled; {height of leader box being replicated}
@!lx:scaled; {extra space between leader boxes}
@!outer𡤍oing←leaders:boolean; {were we doing leaders?}
@!edge:scaled; {bottom boundary of leader space}
begin this𡤋ox:=temp←ptr; g←order:=glue←order(this𡤋ox);
g←sign:=glue←sign(this𡤋ox); p:=list←ptr(this𡤋ox);
incr(cur←s);
if cur←s>0 then dvi←out(push);
if cur←s>max←push then max←push:=cur←s;
save←loc:=dvi←offset+dvi←ptr; left�ge:=cur←h; cur←v:=cur←v-height(this𡤋ox);
top�ge:=cur←v;
while p<>null do @<Output node |p| for |vlist←out| and move to the next node,
maintaining the condition |cur←h=left�ge|@>;
prune←movements(save←loc);
if cur←s>0 then dvi←pop(save←loc);
decr(cur←s);
end;

@ @<Output node |p| for |vlist←out|...@>=
begin if is𡤌har←node(p) then confusion("vlistout")
@:this can't happen vlistout}{\quad vlistout@>
else @<Output the non-|char←node| |p| for |vlist←out|@>;
next←p:p:=link(p);
end

@ @<Output the non-|char←node| |p| for |vlist←out|@>=
begin case type(p) of
hlist←node,vlist←node:@<Output a box in a vlist@>;
rule←node: begin rule←ht:=height(p); rule𡤍p:=depth(p); rule←wd:=width(p);
goto fin←rule;
end;
whatsit←node: @<Output the whatsit node |p| in a vlist@>;
glue←node: @<Move down or output leaders@>;
kern←node:cur←v:=cur←v+width(p);
othercases do←nothing
endcases;@/
goto next←p;
fin←rule: @<Output a rule in a vlist, |goto next←p|@>;
move←past: cur←v:=cur←v+rule←ht;
end

@ The |synch←v| here allows the \.{DVI} output to use one-byte commands
for adjusting |v| in most cases, since the baselineskip distance will
usually be constant.

@<Output a box in a vlist@>=
if list←ptr(p)=null then cur←v:=cur←v+height(p)+depth(p)
else begin cur←v:=cur←v+height(p); synch←v;
save←h:=dvi←h; save←v:=dvi←v;
cur←h:=left�ge+shift𡤊mount(p); {shift the box right}
temp←ptr:=p;
if type(p)=vlist←node then vlist←out@+else hlist←out;
dvi←h:=save←h; dvi←v:=save←v;
cur←v:=save←v+depth(p); cur←h:=left�ge;
end

@ @<Output a rule in a vlist...@>=
if is←running(rule←wd) then rule←wd:=width(this𡤋ox);
rule←ht:=rule←ht+rule𡤍p; {this is the rule thickness}
cur←v:=cur←v+rule←ht;
if (rule←ht>0)and(rule←wd>0) then {we don't output empty rules}
begin synch←h; synch←v;
dvi←out(put←rule); dvi𡤏our(rule←ht); dvi𡤏our(rule←wd);
end;
goto next←p

@ @<Move down or output leaders@>=
begin g:=glue←ptr(p); rule←ht:=width(g);
if g←sign<>normal then
begin if g←sign=stretching then
begin if stretch←order(g)=g←order then
rule←ht:=rule←ht+round(float(glue←set(this𡤋ox))*stretch(g));
@^real multiplication@>
end
else begin if shrink←order(g)=g←order then
rule←ht:=rule←ht-round(float(glue←set(this𡤋ox))*shrink(g));
end;
end;
if subtype(p)>=a←leaders then
@<Output leaders in a vlist, |goto fin←rule| if a rule
or to |next←p| if done@>;
goto move←past;
end

@ @<Output leaders in a vlist...@>=
begin leader𡤋ox:=leader←ptr(p);
if type(leader𡤋ox)=rule←node then
begin rule←wd:=width(leader𡤋ox); rule𡤍p:=0;
goto fin←rule;
end;
leader←ht:=height(leader𡤋ox)+depth(leader𡤋ox);
if (leader←ht>0)and(rule←ht>0) then
begin edge:=cur←v+rule←ht; lx:=0;
@<Let |cur←v| be the position of the first box, and set |leader←ht+lx|
to the spacing between corresponding parts of boxes@>;
while cur←v+leader←ht<=edge do
@<Output a leader box at |cur←v|,
then advance |cur←v| by |leader←ht+lx|@>;
cur←v:=edge; goto next←p;
end;
end

@ @<Let |cur←v| be the position of the first box, ...@>=
if subtype(p)=a←leaders then
begin save←v:=cur←v;
cur←v:=top�ge+leader←ht*((cur←v-top�ge)@!div leader←ht);
if cur←v<save←v then cur←v:=cur←v+leader←ht;
end
else begin lq:=rule←ht div leader←ht; {the number of box copies}
lr:=rule←ht mod leader←ht; {the remaining space}
if subtype(p)=c←leaders then cur←v:=cur←v+(lr div 2)
else begin lx:=(2*lr+lq+1) div (2*lq+2); {round|(lr/(lq+1))|}
cur←v:=cur←v+((lr-(lq-1)*lx) div 2);
end;
end

@ When we reach this part of the program, |cur←v| indicates the top of a
leader box, not its baseline.

@<Output a leader box at |cur←v|, ...@>=
begin cur←h:=left�ge+shift𡤊mount(leader𡤋ox); synch←h; save←h:=dvi←h;@/
cur←v:=cur←v+height(leader𡤋ox); synch←v; save←v:=dvi←v;
temp←ptr:=leader𡤋ox;
outer𡤍oing←leaders:=doing←leaders; doing←leaders:=true;
if type(leader𡤋ox)=vlist←node then vlist←out@+else hlist←out;
doing←leaders:=outer𡤍oing←leaders;
dvi←v:=save←v; dvi←h:=save←h; cur←h:=save←h;
cur←v:=save←v-height(leader𡤋ox)+leader←ht+lx;
end

@ The recursive procedures |hlist←out| and |vlist←out| each have local variables
|save←h| and |save←v| to hold the values of |dvi←h| and |dvi←v| just before
entering a new level of recursion. In effect, the values of |save←h| and
|save←v| on \TeX's run-time stack correspond to the values of |h| and |v|
that a \.{DVI}-reading program will push onto its coordinate stack.

@d move←past=13 {go to this label when advancing past glue or a rule}
@d fin←rule=14 {go to this label to finish processing a rule}
@d next←p=15 {go to this label when finished with node |p|}

@p @t\4@>@<Declare procedures needed in |hlist←out|, |vlist←out|@>@t@>@/
procedure hlist←out; {output an |hlist←node| box}
label reswitch, move←past, fin←rule, next←p;
var base←line: scaled; {the baseline coordinate for this box}
@!left�ge: scaled; {the left coordinate for this box}
@!save←h,@!save←v: scaled; {what |dvi←h| and |dvi←v| should pop to}
@!this𡤋ox: pointer; {pointer to containing box}
@!g←order: glue←ord; {applicable order of infinity for glue}
@!g←sign: normal..shrinking; {selects type of glue}
@!p:pointer; {current position in the hlist}
@!save←loc:integer; {\.{DVI} byte location upon entry}
@!leader𡤋ox:pointer; {the leader box being replicated}
@!leader←wd:scaled; {width of leader box being replicated}
@!lx:scaled; {extra space between leader boxes}
@!outer𡤍oing←leaders:boolean; {were we doing leaders?}
@!edge:scaled; {left edge of sub-box, or right edge of leader space}
begin this𡤋ox:=temp←ptr; g←order:=glue←order(this𡤋ox);
g←sign:=glue←sign(this𡤋ox); p:=list←ptr(this𡤋ox);
incr(cur←s);
if cur←s>0 then dvi←out(push);
if cur←s>max←push then max←push:=cur←s;
save←loc:=dvi←offset+dvi←ptr; base←line:=cur←v; left�ge:=cur←h;
while p<>null do @<Output node |p| for |hlist←out| and move to the next node,
maintaining the condition |cur←v=base←line|@>;
prune←movements(save←loc);
if cur←s>0 then dvi←pop(save←loc);
decr(cur←s);
end;

@ We ought to give special care to the efficiency of one part of |hlist←out|,
since it belongs to \TeX's inner loop. When a |char←node| is encountered,
we save a little time by processing several nodes in succession until
reaching a non-|char←node|. The program uses the fact that |set𡤌har𡤀=0|.
@^inner loop@>

@<Output node |p| for |hlist←out|...@>=
reswitch: if is𡤌har←node(p) then
begin synch←h; synch←v;
repeat f:=font(p); c:=character(p);
if f<>dvi𡤏 then @<Change font |dvi𡤏| to |f|@>;
if c<qi(128) then dvi←out(qo(c))
else begin dvi←out(set1); dvi←out(qo(c));
end;
cur←h:=cur←h+char←width(f)(char←info(f)(c));
p:=link(p);
until not is𡤌har←node(p);
dvi←h:=cur←h;
end
else @<Output the non-|char←node| |p| for |hlist←out|
and move to the next node@>

@ @<Change font |dvi𡤏| to |f|@>=
begin if not font←used[f] then
begin dvi𡤏ont�(f); font←used[f]:=true;
end;
if f<=64+font�se then dvi←out(f-font�se-1+fnt←num𡤀)
else begin dvi←out(fnt1); dvi←out(f-font�se-1);
end;
dvi𡤏:=f;
end

@ @<Output the non-|char←node| |p| for |hlist←out|...@>=
begin case type(p) of
hlist←node,vlist←node:@<Output a box in an hlist@>;
rule←node: begin rule←ht:=height(p); rule𡤍p:=depth(p); rule←wd:=width(p);
goto fin←rule;
end;
whatsit←node: @<Output the whatsit node |p| in an hlist@>;
glue←node: @<Move right or output leaders@>;
kern←node,math←node:cur←h:=cur←h+width(p);
ligature←node: @<Make node |p| look like a |char←node| and |goto reswitch|@>;
othercases do←nothing
endcases;@/
goto next←p;
fin←rule: @<Output a rule in an hlist@>;
move←past: cur←h:=cur←h+rule←wd;
next←p:p:=link(p);
end

@ @<Output a box in an hlist@>=
if list←ptr(p)=null then cur←h:=cur←h+width(p)
else begin save←h:=dvi←h; save←v:=dvi←v;
cur←v:=base←line+shift𡤊mount(p); {shift the box down}
temp←ptr:=p; edge:=cur←h;
if type(p)=vlist←node then vlist←out@+else hlist←out;
dvi←h:=save←h; dvi←v:=save←v;
cur←h:=edge+width(p); cur←v:=base←line;
end

@ @<Output a rule in an hlist@>=
if is←running(rule←ht) then rule←ht:=height(this𡤋ox);
if is←running(rule𡤍p) then rule𡤍p:=depth(this𡤋ox);
rule←ht:=rule←ht+rule𡤍p; {this is the rule thickness}
if (rule←ht>0)and(rule←wd>0) then {we don't output empty rules}
begin synch←h; cur←v:=base←line+rule𡤍p; synch←v;
dvi←out(set←rule); dvi𡤏our(rule←ht); dvi𡤏our(rule←wd);
cur←v:=base←line; dvi←h:=dvi←h+rule←wd;
end

@ @<Move right or output leaders@>=
begin g:=glue←ptr(p); rule←wd:=width(g);
if g←sign<>normal then
begin if g←sign=stretching then
begin if stretch←order(g)=g←order then
rule←wd:=rule←wd+round(float(glue←set(this𡤋ox))*stretch(g));
@^real multiplication@>
end
else begin if shrink←order(g)=g←order then
rule←wd:=rule←wd-round(float(glue←set(this𡤋ox))*shrink(g));
end;
end;
if subtype(p)>=a←leaders then
@<Output leaders in an hlist, |goto fin←rule| if a rule
or to |next←p| if done@>;
goto move←past;
end

@ @<Output leaders in an hlist...@>=
begin leader𡤋ox:=leader←ptr(p);
if type(leader𡤋ox)=rule←node then
begin rule←ht:=height(leader𡤋ox); rule𡤍p:=depth(leader𡤋ox);
goto fin←rule;
end;
leader←wd:=width(leader𡤋ox);
if (leader←wd>0)and(rule←wd>0) then
begin edge:=cur←h+rule←wd; lx:=0;
@<Let |cur←h| be the position of the first box, and set |leader←wd+lx|
to the spacing between corresponding parts of boxes@>;
while cur←h+leader←wd<=edge do
@<Output a leader box at |cur←h|,
then advance |cur←h| by |leader←wd+lx|@>;
cur←h:=edge; goto next←p;
end;
end

@ The calculations related to leaders require a bit of care. First, in the
case of |a←leaders| (aligned leaders), we want to move |cur←h| to
|left�ge| plus the smallest multiple of |leader←wd| for which the result
is not less than the current value of |cur←h|; i.e., |cur←h| should become
$|left�ge|+|leader←wd|\times\lceil
(|cur←h|-|left�ge|)/|leader←wd|\rceil$. The program here should work in
all cases even though some implementations of \PASCAL\ give nonstandard
results for the |div| operation precisely, and even when |cur←h| is less
than |left�ge|.

In the case of |c←leaders| (centered leaders), we want to increase |cur←h|
by half of the excess space not occupied by the leaders; and in the case of
case of |x←leaders| (expanded leaders) we increase |cur←h|
by $1/(q+1)$ of this excess space, where $q$ is the number of times the
leader box will be replicated. Slight inaccuracies in the division might
accumulate; half of this rounding error is placed at each end of the leaders.

@<Let |cur←h| be the position of the first box, ...@>=
if subtype(p)=a←leaders then
begin save←h:=cur←h;
cur←h:=left�ge+leader←wd*((cur←h-left�ge)@!div leader←wd);
if cur←h<save←h then cur←h:=cur←h+leader←wd;
end
else begin lq:=rule←wd div leader←wd; {the number of box copies}
lr:=rule←wd mod leader←wd; {the remaining space}
if subtype(p)=c←leaders then cur←h:=cur←h+(lr div 2)
else begin lx:=(2*lr+lq+1) div (2*lq+2); {round|(lr/(lq+1))|}
cur←h:=cur←h+((lr-(lq-1)*lx) div 2);
end;
end

@ The `\\{synch}' operations here are intended to decrease the number
of bytes needed to specify horizontal and vertical motion in the \.{DVI} output.

@<Output a leader box at |cur←h|, ...@>=
begin cur←v:=base←line+shift𡤊mount(leader𡤋ox); synch←v; save←v:=dvi←v;@/
synch←h; save←h:=dvi←h; temp←ptr:=leader𡤋ox;
outer𡤍oing←leaders:=doing←leaders; doing←leaders:=true;
if type(leader𡤋ox)=vlist←node then vlist←out@+else hlist←out;
doing←leaders:=outer𡤍oing←leaders;
dvi←v:=save←v; dvi←h:=save←h; cur←v:=save←v;
cur←h:=save←h+leader←wd+lx;
end

@ The |vlist←out| routine is similar to |hlist←out|, but a bit simpler.

@p procedure vlist←out; {output a |vlist←node| box}
label move←past, fin←rule, next←p;
var left�ge: scaled; {the left coordinate for this box}
@!top�ge: scaled; {the top coordinate for this box}
@!save←h,@!save←v: scaled; {what |dvi←h| and |dvi←v| should pop to}
@!this𡤋ox: pointer; {pointer to containing box}
@!g←order: glue←ord; {applicable order of infinity for glue}
@!g←sign: normal..shrinking; {selects type of glue}
@!p:pointer; {current position in the vlist}
@!save←loc:integer; {\.{DVI} byte location upon entry}
@!leader𡤋ox:pointer; {the leader box being replicated}
@!leader←ht:scaled; {height of leader box being replicated}
@!lx:scaled; {extra space between leader boxes}
@!outer𡤍oing←leaders:boolean; {were we doing leaders?}
@!edge:scaled; {bottom boundary of leader space}
begin this𡤋ox:=temp←ptr; g←order:=glue←order(this𡤋ox);
g←sign:=glue←sign(this𡤋ox); p:=list←ptr(this𡤋ox);
incr(cur←s);
if cur←s>0 then dvi←out(push);
if cur←s>max←push then max←push:=cur←s;
save←loc:=dvi←offset+dvi←ptr; left�ge:=cur←h; cur←v:=cur←v-height(this𡤋ox);
top�ge:=cur←v;
while p<>null do @<Output node |p| for |vlist←out| and move to the next node,
maintaining the condition |cur←h=left�ge|@>;
prune←movements(save←loc);
if cur←s>0 then dvi←pop(save←loc);
decr(cur←s);
end;

@ @<Output node |p| for |vlist←out|...@>=
begin if is𡤌har←node(p) then confusion("vlistout")
@:this can't happen vlistout}{\quad vlistout@>
else @<Output the non-|char←node| |p| for |vlist←out|@>;
next←p:p:=link(p);
end

@ @<Output the non-|char←node| |p| for |vlist←out|@>=
begin case type(p) of
hlist←node,vlist←node:@<Output a box in a vlist@>;
rule←node: begin rule←ht:=height(p); rule𡤍p:=depth(p); rule←wd:=width(p);
goto fin←rule;
end;
whatsit←node: @<Output the whatsit node |p| in a vlist@>;
glue←node: @<Move down or output leaders@>;
kern←node:cur←v:=cur←v+width(p);
othercases do←nothing
endcases;@/
goto next←p;
fin←rule: @<Output a rule in a vlist, |goto next←p|@>;
move←past: cur←v:=cur←v+rule←ht;
end

@ The |synch←v| here allows the \.{DVI} output to use one-byte commands
for adjusting |v| in most cases, since the baselineskip distance will
usually be constant.

@<Output a box in a vlist@>=
if list←ptr(p)=null then cur←v:=cur←v+height(p)+depth(p)
else begin cur←v:=cur←v+height(p); synch←v;
save←h:=dvi←h; save←v:=dvi←v;
cur←h:=left�ge+shift𡤊mount(p); {shift the box right}
temp←ptr:=p;
if type(p)=vlist←node then vlist←out@+else hlist←out;
dvi←h:=save←h; dvi←v:=save←v;
cur←v:=save←v+depth(p); cur←h:=left�ge;
end

@ @<Output a rule in a vlist...@>=
if is←running(rule←wd) then rule←wd:=width(this𡤋ox);
rule←ht:=rule←ht+rule𡤍p; {this is the rule thickness}
cur←v:=cur←v+rule←ht;
if (rule←ht>0)and(rule←wd>0) then {we don't output empty rules}
begin synch←h; synch←v;
dvi←out(put←rule); dvi𡤏our(rule←ht); dvi𡤏our(rule←wd);
end;
goto next←p

@ @<Move down or output leaders@>=
begin g:=glue←ptr(p); rule←ht:=width(g);
if g←sign<>normal then
begin if g←sign=stretching then
begin if stretch←order(g)=g←order then
rule←ht:=rule←ht+round(float(glue←set(this𡤋ox))*stretch(g));
@^real multiplication@>
end
else begin if shrink←order(g)=g←order then
rule←ht:=rule←ht-round(float(glue←set(this𡤋ox))*shrink(g));
end;
end;
if subtype(p)>=a←leaders then
@<Output leaders in a vlist, |goto fin←rule| if a rule
or to |next←p| if done@>;
goto move←past;
end

@ @<Output leaders in a vlist...@>=
begin leader𡤋ox:=leader←ptr(p);
if type(leader𡤋ox)=rule←node then
begin rule←wd:=width(leader𡤋ox); rule𡤍p:=0;
goto fin←rule;
end;
leader←ht:=height(leader𡤋ox)+depth(leader𡤋ox);
if (leader←ht>0)and(rule←ht>0) then
begin edge:=cur←v+rule←ht; lx:=0;
@<Let |cur←v| be the position of the first box, and set |leader←ht+lx|
to the spacing between corresponding parts of boxes@>;
while cur←v+leader←ht<=edge do
@<Output a leader box at |cur←v|,
then advance |cur←v| by |leader←ht+lx|@>;
cur←v:=edge; goto next←p;
end;
end

@ @<Let |cur←v| be the position of the first box, ...@>=
if subtype(p)=a←leaders then
begin save←v:=cur←v;
cur←v:=top�ge+leader←ht*((cur←v-top�ge)@!div leader←ht);
if cur←v<save←v then cur←v:=cur←v+leader←ht;
end
else begin lq:=rule←ht div leader←ht; {the number of box copies}
lr:=rule←ht mod leader←ht; {the remaining space}
if subtype(p)=c←leaders then cur←v:=cur←v+(lr div 2)
else begin lx:=(2*lr+lq+1) div (2*lq+2); {round|(lr/(lq+1))|}
cur←v:=cur←v+((lr-(lq-1)*lx) div 2);
end;
end

@ When we reach this part of the program, |cur←v| indicates the top of a
leader box, not its baseline.

@<Output a leader box at |cur←v|, ...@>=
begin cur←h:=left�ge+shift𡤊mount(leader𡤋ox); synch←h; save←h:=dvi←h;@/
cur←v:=cur←v+height(leader𡤋ox); synch←v; save←v:=dvi←v;
temp←ptr:=leader𡤋ox;
outer𡤍oing←leaders:=doing←leaders; doing←leaders:=true;
if type(leader𡤋ox)=vlist←node then vlist←out@+else hlist←out;
doing←leaders:=outer𡤍oing←leaders;
dvi←v:=save←v; dvi←h:=save←h; cur←h:=save←h;
cur←v:=save←v-height(leader𡤋ox)+leader←ht+lx;
end

@p procedure ship←out(@!p:pointer); {output the box |p|}

@p @t\4@>@<Declare procedures for Press output@>@t@>@/

procedure ship←out(@!p:pointer); {output the box |p|}

page←loc:=dvi←offset+dvi←ptr;
dvi←out(bop);
for k:=0 to 9 do dvi𡤏our(count(k));
dvi𡤏our(last𡤋op); last𡤋op:=page←loc;
cur←v:=height(p)+v←offset; temp←ptr:=p;
if type(p)=vlist←node then vlist←out@+else hlist←out;
dvi←out(eop); incr(total←pages);
done:

if use←press𡤏ormat then
begin
cur←v:=height(p)+v←offset; temp←ptr:=p;
if type(p)=vlist←node then vlist←press←out@+else hlist←press←out;
press←write←page;
incr(total←pages);
end
else begin
page←loc:=dvi←offset+dvi←ptr;
dvi←out(bop);
for k:=0 to 9 do dvi𡤏our(count(k));
dvi𡤏our(last𡤋op); last𡤋op:=page←loc;
cur←v:=height(p)+v←offset; temp←ptr:=p;
if type(p)=vlist←node then vlist←out@+else hlist←out;
dvi←out(eop); incr(total←pages);
end;
done:

else begin dvi←out(post); {beginning of the postamble}

else if use←press𡤏ormat then
begin
print←nl("Output written on "); print(output𡤏ile←name);
@.Output written on x@>
print(" ("); print←int(total←pages); print(" page");
if total←pages<>1 then print𡤌har("s");
print(").");
press𡤌lose𡤏ile;
end
else begin dvi←out(post); {beginning of the postamble}

begin if pack�gin←line>0 then print(") in paragraph at lines ")

else print(") in alignment at lines ");

begin if pack�gin←line>0 then print(") in paragraph at cc. ")

else print(") in alignment at cc. ");

else print(") detected at line ");

else print(") detected at c. ");

begin print(") in alignment at lines ");

begin print(") in alignment at cc. ");

else print(") detected at line ");

else print(") detected at c. ");

@!rule←save:scaled; {temporary storage for |overfull←rule|}

@!rule←save:scaled; {temporary storage for |overfull←rule|}

procedure fin𡤊lign←inner;

@<Set the glue in all the unset boxes of the current list@>;

fin𡤊lign←inner;

var @<Local variables for line breaking@>@;

begin pack�gin←line:=mode←line; {this is for over/underfull box messages}

@<Get ready to start line breaking@>;

var @<Local variables for line breaking@>@;

procedure line𡤋reak←inner;

begin pack�gin←line:=mode←line; {this is for over/underfull box messages}

line𡤋reak←inner;

label exit,done,done1,continue,deactivate;

label exit,done1,continue,deactivate;

@<Other local variables for |try𡤋reak|@>@;

@<Other local variables for |try𡤋reak|@>@;

procedure try𡤋reak←inner;

((old←l<>easy←line)or(r=last�tive)) then

@<Create new active nodes for the best feasible breaks

just found@>;

((old←l<>easy←line)or(r=last�tive)) then

try𡤋reak←inner;

dump←int(skew𡤌har[k]);@/

dump←int(skew𡤌har[k]);@/

dump←int(font�mily[k]);

dump←int(font�[k]);@/

undump←int(skew𡤌har[k]);@/

undump←int(skew𡤌har[k]);@/

undump(0)(str←ptr)(font�mily[k]);

undump(0)(255)(font�[k]);@/

@!ready𡤊lready:integer; {a sacrifice of purity for economy}

@!start←like←initex:boolean; {otherwise, we start up like TeX}

@p begin @!{|start←here|}

@p procedure the←real←tex;

begin @!{|start←here|}

if ready𡤊lready=314159 then goto start←of←TEX;

set�kground←priority;

@!init if not get←strings←started then goto final𡤎nd;
init←prim; {call |primitive| for each primitive}
tini@/

if start←like←initex then

begin
if not get←strings←started then goto final𡤎nd;

init←prim; {call |primitive| for each primitive}

end;

ready𡤊lready:=314159;

final𡤎nd: ready𡤊lready:=0;

final𡤎nd: set←normal←priority;

end.

end;

begin

end.

begin @<Finish the extensions@>;

begin @<Finish the extensions@>;

for k := 1 to in←open do

print(log←name); print𡤌har(".");

print(log←name); print𡤌har("."); print𡤌har(carriage←return);

begin print(" on line "); print←int(if←line);

begin print(" on line at c. "); print←int(if←line);

if (loc<limit)and(cat𡤌ode(buffer[loc])<>escape) then start←input;

read←profile𡤏or𡤍irectories;

if (loc<limit)and(cat𡤌ode(buffer[loc])<>escape) then start←input;

itself will get a new section number.

@^system dependencies@>

itself will get a new section number.
@^system dependencies@>

@ @<Declare procedures for Press output@>=

@<Declare external procedures for Press output@>
@<Declare extension-related procedures for Press output@>
@<Declare hlist←press←out@>
@<Declare vlist←press←out@>

@ The actual work of writing the Press file is done by the SirPress
package in Cedar. The following procedures provide access to
this package from Pascal. The final function is a little different:
its job it to provide access to our procedures from Cedar.

@<Declare external procedures for Press output@>=
function get←pype𡤌ode(f: internal𡤏ont←number; at←size←in←hnm:integer): cedar←nat;
external;
procedure press←set𡤏ont(c: cedar←nat); external;
procedure press←show𡤌har(c: quarterword); external;
procedure press←set←x(x: scaled); external;
procedure press←set←y(y: scaled); external;
procedure press←show←rule(xstart, ystart, xlen, ylen: scaled); external;
procedure flush←pype; external;
procedure press←write←page; external;
procedure press𡤌lose𡤏ile; external;

@ The procedure hlist←press←out is very similar to hlist←out. Note that
hlist←press←out makes no use of dvi←h, dvi←v, or cur←s. Instead, we make
use of the global booleans press←h←ok; if we are pyping, this
boolean tells us that there is no need to do a PipePosition before the
next PipeChar.

We shall first add a macro definition for the number of micas in
11 inches, since Press has it's vertical axis running up instead of down.
Also, a macro for the number of hectonanometers (meters*e^-7) in 11
inches, since sometimes we will be computing in them. They correspond
to SirPress.unit=100.

In addition, the origin of the DVI page is actually shifted by one inch in
both h and v. We also add macros for these distances.

@d page←height←in←mica==27940 {micas in 11 inches}
@d page←height←in←hnm==2794000 {hnm in 11 inches}

@d h←marg←in←mica==2540
@d h←marg←in←hnm==254000
@d v←marg←in←mica==2540
@d v←marg←in←hnm==254000


@<Declare hlist←press←out@>=

procedure hlist←press←out; {output an |hlist←node| box}
label reswitch, move←past, fin←rule, next←p;
var base←line: scaled; {the baseline coordinate for this box}
@!base←in←mica: scaled; {baseline in micas}
@!left�ge: scaled; {the left coordinate for this box}
@!save←h,@!save←v: scaled; {still used in leaders calculations}
@!this𡤋ox: pointer; {pointer to containing box}
@!g←order: glue←ord; {applicable order of infinity for glue}
@!g←sign: normal..shrinking; {selects type of glue}
@!p:pointer; {current position in the hlist}
@!leader𡤋ox:pointer; {the leader box being replicated}
@!leader←wd:scaled; {width of leader box being replicated}
@!lx:scaled; {extra space between leader boxes}
@!outer𡤍oing←leaders:boolean; {were we doing leaders?}
@!edge:scaled; {left edge of sub-box, or right edge of leader space}
begin this𡤋ox:=temp←ptr; g←order:=glue←order(this𡤋ox);
g←sign:=glue←sign(this𡤋ox); p:=list←ptr(this𡤋ox);
base←line:=cur←v; left�ge:=cur←h;
base←in←mica:=page←height←in←mica - v←marg←in←mica
- x←over←n(xn←over𡤍(base←line, mag, 18647),100);
while p<>null do @<Press: Output node |p| for |hlist←press←out| and move to the
next node, maintaining the condition |cur←v=base←line|@>;
end;


@ @<Press: Output node |p| for |hlist←press←out| ...@>=
reswitch: if is𡤌har←node(p) then
begin press←set←y(base←in←mica);
f:=font(p);
if f<>dvi𡤏 then @<Press: Change font |dvi𡤏| to |f|@>;
press←set←x(h←marg←in←mica + x←over←n(xn←over𡤍(cur←h, mag, 18647),100));
repeat
c:=character(p);
press←show𡤌har(c);
cur←h:=cur←h+char←width(f)(char←info(f)(c));
p:=link(p);
until (not is𡤌har←node(p))or(font(p)<>dvi𡤏);
end
else @<Press: Output the non-|char←node| |p| for |hlist←press←out|
and move to the next node@>

@ @<Press: Change font |dvi𡤏| to |f|@>=
begin if not font←used[f] then
begin
font←pype𡤌ode[f]:=get←pype𡤌ode(f, xn←over𡤍(font←size[f],mag,18647));
font←used[f]:=true;
end;
press←set𡤏ont(font←pype𡤌ode[f]);
dvi𡤏:=f;
end

@ @<Press: Output the non-|char←node| |p| for |hlist←press←out| ...@>=
begin case type(p) of
hlist←node,vlist←node:@<Press: Output a box in an hlist@>;
rule←node: begin rule←ht:=height(p); rule𡤍p:=depth(p); rule←wd:=width(p);
goto fin←rule;
end;
whatsit←node: @<Press: Output the whatsit node |p| in an hlist@>;
glue←node: @<Press: Move right or output leaders@>;
kern←node,math←node:cur←h:=cur←h+width(p);
ligature←node: @<Make node |p| look like a |char←node| and |goto reswitch|@>;
othercases do←nothing
endcases;@/
goto next←p;
fin←rule: @<Press: Output a rule in an hlist@>;
move←past: cur←h:=cur←h+rule←wd;
next←p:p:=link(p);
end

@ @<Press: Output a box in an hlist@>=
if list←ptr(p)=null then cur←h:=cur←h+width(p)
else begin cur←v:=base←line+shift𡤊mount(p); {shift the box down}
temp←ptr:=p; edge:=cur←h;
if type(p)=vlist←node then vlist←press←out@+else hlist←press←out;
cur←h:=edge+width(p); cur←v:=base←line;
end

@ @<Press: Output a rule in an hlist@>=
if is←running(rule←ht) then rule←ht:=height(this𡤋ox);
if is←running(rule𡤍p) then rule𡤍p:=depth(this𡤋ox);
rule←ht:=rule←ht+rule𡤍p; {this is the rule thickness}
if (rule←ht>0)and(rule←wd>0) then {we don't output empty rules}
begin press←show←rule(h←marg←in←hnm + xn←over𡤍(cur←h,mag,18647),
page←height←in←hnm - v←marg←in←hnm
- xn←over𡤍(base←line+rule𡤍p,mag,18647),
xn←over𡤍(rule←wd,mag,18647),
xn←over𡤍(rule←ht,mag,18647));
cur←v:=base←line;
end

@ @<Press: Move right or output leaders@>=
begin g:=glue←ptr(p); rule←wd:=width(g);
if g←sign<>normal then
begin if g←sign=stretching then
begin if stretch←order(g)=g←order then
rule←wd:=rule←wd+round(float(glue←set(this𡤋ox))*stretch(g));
@^real multiplication@>
end
else begin if shrink←order(g)=g←order then
rule←wd:=rule←wd-round(float(glue←set(this𡤋ox))*shrink(g));
end;
end;
if subtype(p)>=a←leaders then
@<Press: Output leaders in an hlist, |goto fin←rule| if a rule
or to |next←p| if done@>;
goto move←past;
end

@ @<Press: Output leaders in an hlist...@>=
begin leader𡤋ox:=leader←ptr(p);
if type(leader𡤋ox)=rule←node then
begin rule←ht:=height(leader𡤋ox); rule𡤍p:=depth(leader𡤋ox);
goto fin←rule;
end;
leader←wd:=width(leader𡤋ox);
if (leader←wd>0)and(rule←wd>0) then
begin edge:=cur←h+rule←wd; lx:=0;
@<Let |cur←h| be the position of the first box, and set |leader←wd+lx|
to the spacing between corresponding parts of boxes@>;
while cur←h+leader←wd<=edge do
@<Press: Output a leader box at |cur←h|,
then advance |cur←h| by |leader←wd+lx|@>;
cur←h:=edge; goto next←p;
end;
end

@ @<Press: Output a leader box at |cur←h|, ...@>=
begin cur←v:=base←line+shift𡤊mount(leader𡤋ox); save←v:=cur←v;@/
save←h:=cur←h; temp←ptr:=leader𡤋ox;
outer𡤍oing←leaders:=doing←leaders; doing←leaders:=true;
if type(leader𡤋ox)=vlist←node then vlist←press←out@+else hlist←press←out;
doing←leaders:=outer𡤍oing←leaders;
cur←v:=save←v;
cur←h:=save←h+leader←wd+lx;
end

@ @<Declare vlist←press←out@>=

procedure vlist←press←out; {output a |vlist←node| box}
label move←past, fin←rule, next←p;
var left�ge: scaled; {the left coordinate for this box}
@!top�ge: scaled; {the top coordinate for this box}
@!save←h,@!save←v: scaled; {what |dvi←h| and |dvi←v| should pop to}
@!this𡤋ox: pointer; {pointer to containing box}
@!g←order: glue←ord; {applicable order of infinity for glue}
@!g←sign: normal..shrinking; {selects type of glue}
@!p:pointer; {current position in the vlist}
@!leader𡤋ox:pointer; {the leader box being replicated}
@!leader←ht:scaled; {height of leader box being replicated}
@!lx:scaled; {extra space between leader boxes}
@!outer𡤍oing←leaders:boolean; {were we doing leaders?}
@!edge:scaled; {bottom boundary of leader space}
begin this𡤋ox:=temp←ptr; g←order:=glue←order(this𡤋ox);
g←sign:=glue←sign(this𡤋ox); p:=list←ptr(this𡤋ox);
left�ge:=cur←h; cur←v:=cur←v-height(this𡤋ox);
top�ge:=cur←v;
while p<>null do @<Press: Output node |p| for |vlist←press←out| and move
to the next node, maintaining the condition |cur←h=left�ge|@>;
end;

@ @<Press: Output node |p| for |vlist←press←out|...@>=
begin if is𡤌har←node(p) then confusion("vlistout")
@:this can't happen vlistout}{\quad vlistout@>
else @<Press: Output the non-|char←node| |p| for |vlist←press←out|@>;
next←p:p:=link(p);
end

@ @<Press: Output the non-|char←node| |p| for |vlist←press←out|@>=
begin case type(p) of
hlist←node,vlist←node:@<Press: Output a box in a vlist@>;
rule←node: begin rule←ht:=height(p); rule𡤍p:=depth(p); rule←wd:=width(p);
goto fin←rule;
end;
whatsit←node: @<Press: Output the whatsit node |p| in a vlist@>;
glue←node: @<Press: Move down or output leaders@>;
kern←node:cur←v:=cur←v+width(p);
othercases do←nothing
endcases;@/
goto next←p;
fin←rule: @<Press: Output a rule in a vlist, |goto next←p|@>;
move←past: cur←v:=cur←v+rule←ht;
end

@ @<Press: Output a box in a vlist@>=
if list←ptr(p)=null then cur←v:=cur←v+height(p)+depth(p)
else begin cur←v:=cur←v+height(p);
save←v:=cur←v;
cur←h:=left�ge+shift𡤊mount(p); {shift the box right}
temp←ptr:=p;
if type(p)=vlist←node then vlist←press←out@+else hlist←press←out;
cur←v:=save←v+depth(p); cur←h:=left�ge;
end

@ @<Press: Output a rule in a vlist...@>=
if is←running(rule←wd) then rule←wd:=width(this𡤋ox);
rule←ht:=rule←ht+rule𡤍p; {this is the rule thickness}
cur←v:=cur←v+rule←ht;
if (rule←ht>0)and(rule←wd>0) then {we don't output empty rules}
begin press←show←rule(h←marg←in←hnm + xn←over𡤍(cur←h,mag,18647),
page←height←in←hnm - v←marg←in←hnm
- xn←over𡤍(cur←v,mag,18647),
xn←over𡤍(rule←wd,mag,18647),
xn←over𡤍(rule←ht,mag,18647));
end;
goto next←p

@ @<Press: Move down or output leaders@>=
begin g:=glue←ptr(p); rule←ht:=width(g);
if g←sign<>normal then
begin if g←sign=stretching then
begin if stretch←order(g)=g←order then
rule←ht:=rule←ht+round(float(glue←set(this𡤋ox))*stretch(g));
@^real multiplication@>
end
else begin if shrink←order(g)=g←order then
rule←ht:=rule←ht-round(float(glue←set(this𡤋ox))*shrink(g));
end;
end;
if subtype(p)>=a←leaders then
@<Press: Output leaders in a vlist, |goto fin←rule| if a rule
or to |next←p| if done@>;
goto move←past;
end

@ @<Press: Output leaders in a vlist...@>=
begin leader𡤋ox:=leader←ptr(p);
if type(leader𡤋ox)=rule←node then
begin rule←wd:=width(leader𡤋ox); rule𡤍p:=0;
goto fin←rule;
end;
leader←ht:=height(leader𡤋ox)+depth(leader𡤋ox);
if (leader←ht>0)and(rule←ht>0) then
begin edge:=cur←v+rule←ht; lx:=0;
@<Let |cur←v| be the position of the first box, and set |leader←ht+lx|
to the spacing between corresponding parts of boxes@>;
while cur←v+leader←ht<=edge do
@<Press: Output a leader box at |cur←v|,
then advance |cur←v| by |leader←ht+lx|@>;
cur←v:=edge; goto next←p;
end;
end

@ @<Press: Output a leader box at |cur←v|, ...@>=
begin cur←h:=left�ge+shift𡤊mount(leader𡤋ox); save←h:=cur←h;@/
cur←v:=cur←v+height(leader𡤋ox); save←v:=cur←v;
temp←ptr:=leader𡤋ox;
outer𡤍oing←leaders:=doing←leaders; doing←leaders:=true;
if type(leader𡤋ox)=vlist←node then vlist←press←out@+else hlist←press←out;
doing←leaders:=outer𡤍oing←leaders;
cur←h:=save←h;
cur←v:=save←v-height(leader𡤋ox)+leader←ht+lx;
end

@ @<Declare extension-related procedures for Press output@>=
procedure press←out←what(@!p:pointer);
begin case subtype(p) of
open←node,write←node,close←node:out←what(p);
special←node:do←nothing; {specials not implemented for Press output}
othercases confusion("ext4")
@:this can't happen ext4}{\quad ext4@>
endcases;
end;

@ @<Press: Output the whatsit node |p| in an hlist@>=
press←out←what(p)

@ @<Press: Output the whatsit node |p| in a vlist@>=
press←out←what(p)


@ We want to refer to the type of SirPress font codes from with Pascal, so we
do the following.

@<Types...@>=

@!cedar←nat=0..32767;

@ Here, finally, are the external procedure declarations.

@<External procedure declarations for things implemented directly in Cedar@>=

procedure reset←term←in(var f: alpha𡤏ile); external;

 {set up for input from terminal}

procedure rewrite←term←out(var f: alpha𡤏ile); external;

 {set up for output to terminal}

function profile𡤊sks𡤏or←press: boolean; external;

function press←open←out: boolean; external;

procedure read←the𡤌lock(var ttime,dday,mmonth,yyear:integer); external;

function file←get←pos(var f: alpha𡤏ile):integer; external; {return character count}

procedure set←pool←name; external;

procedure read←profile𡤏or𡤍irectories; external;

procedure set←normal←priority; external;

procedure set�kground←priority; external;

function stuff←on𡤌md←line:integer; external;