|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 121344 (0x1da00)
Types: TextFile
Names: »typesettxt«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦this⟧ »typesettxt«
\f
;seh time.300
(
o t28
mode list.yes
clear typesetx
typesetx=set 185
permanent typesetx.12
typesetx=algol list.no xref.no
)
begin comment TYPOL typesetting program.
Updated version, S.E.Harnung, February 1981.
Current version: 01 12 81.
VARIABLES IN ALPHABETIC ORDER:
a constant, see comment in program.
accuw accumulated width of current line.
b constant, see comment in program.
back true from call of proc backspace until a character
different from underline is read.
Used to allow xxxx_xxxx to be interpreted as one word.
blind true if current line is empty (no visible characters).
bool1,bool2 working variables.
bs constant, special value (5) for backspace.
bss constant, backspace-value for the typesetting machine.
c zone, connected to the console in case of a online run.
class integer array used by the hyphenation routine hyph.
c1,c2 pointers in codebuf used when code is to be saved
to the next line.
censp no. of units to be generated before the first character
in current line when centering or quadding right mode.
chapstd standard value for <chapstart>.
chapstart distance in points from upper page limit to start
of a new page when pageshift is generated by the user.
codebuf buffer for control characters(code) for the typesetting
machine in current line.
codemode true if last action=putting characters in codebuf.
codemask codemask shift i<0 indicates that control characters
are generated after word no. i in the current line.
comno processing a command, comno is assigned the command no.
according to the case construction in procedure typol
and the table comtab.
comtab table with all the commands on ISO-form, each element
contains the NUL-character and the two letters.
d constant, see comment in program.
dropjust true if current line dont have to be right-justified,
only used in justifying mode.
ff constant, ISO-value for formfeed.
figroom size in points of figures to be saved to the next page.
figsize size in points of figure to be saved until current
line is terminated.
finis true when command EF is met.
first used in justification part of program, false if
additional words are read trying to make the word
spacing lesser.
fn pointer to first free place in footnote buffer.
fnfont array, element no. i contains the font no. for footnote
no. i on current page.
fnote buffer for footnotes.
fnoteno counts the footnotes on current page.
fontcode font-character values.
folip equal to <arg.1> in command PL.
font actual font=the parameter to the last FT-command met.
h1,h2 pointers in linebuf used when a word or part of a word
is saved to the next line.
h3 in case of hyphenation h3 saves the character in linebuf
to be replaced by a hyphen.
headlim max no. of characters in running head.
headmode true when setting a running head.
headp equal to <arg.4> in command PL.
hyp true if hyphenation has taken place (but not if a
natural breakpoint has been found).
hypdigit true if procedure hyph is called, used by procedure
digit to change the input table for + and -.
hyphinf zone connected to a backing store area containing
hyphenation information (hypmode 1 and 3).
hypmode hyphenation mode.
hypno value of the hyphenation procedure hyph.
i working variable.
intab contains the input table, see program description for
details.
j working variable.
k working varaible.
klass input class according to the input table of last
character read.
convert table for conversion from ISO to the actual typesetting
machine code.
language language for source text used by the hyph. routine
1 danish
2 english.
lc constant, lover case value for the typesetting machine.
leading actual leading in points.
leftspa used in the justification part, true if wordspace
in previous line is bigger in the left part than in the
right part of the line.
lin pointer to first free place in linebuf.
line1 used under setting of running head, false if working on
a possible second line in the head.
linelim max no. of characters in linebuf.
linebuf the line buffer containing all the words in a line on
ISO-form, special arrays (pib and pis) points to start
and end of a word.
linecount distance in points from upper page limit to actual
place on the page.
lineno counts lines with visible characters on a page.
linewidth actual line width in units.
machine no. of actual typesetting machine.
1. RC 610 Line Printer
2. Diablo 1620
margin left margin in units.
margtext array containing margin text generated by the
MT-command.
maxnotelim max no. of footnotes on a page.
maxfactor constant, maxfactor*maxspace is the upper limit for
the average word space in a line, in which case it
is not tried to read more words in order to
decrease the wordspace.
maxspace constant, maximum allowed word space in units.
minfactor minfactor*minspace is the lower limit for the average
word space in a line which is allowed (if possible)
in the case where the word space in the previous
line have been bigger than maxfactor*maxspace.
minlead constant, minimum leading on the actual typesetting
machine, used in connection with footnotes.
(seh: to be reset by typol-order FL).
minspace minimum allowed word space in units.
mode current working mode.
1. justifying, 2. non-justifying, 3. tabulating,
4. centering, 5. quadding right.
more false indicates that reading from the source file to
the current line is terminated.
mtext true if margin text is to be placed in following line.
mtextlim max no. of characters in margin text.
mtfont font no. for margin text.
newpage true if the PS-command is met.
newpar indentation in units of the following line when the
NP-command is met.
newpstd standard indentation in units in case of new paragraph.
nl constant, ISO-value for new line.
nlpar number of new line characters to be generated after
current line.
nls constant, new line value for the typesetting machine.
normsp normal width of a space in units.
normw average width of a character in units.
notefont font no. for the current note when setting footnotes.
notelim max no. of characters in all footnotes on a page.
notenumw the width in units of <d) > where d is a digit.
notemode true when setting footnotes.
nstext true if a new section command is met.
nummode equal to the first parameter in the last PN-command.
nump1 equal to <arg. 5> in command PL.
oldfont working variable for saving of font value when setting
running heads and footnotes.
outcon true if zone out = console.
p0mask
p1mask p1mask shift comno<0 indicates that command no. comno
allways contain one parameter.
p2mask constant,
p2mask shift comno<0 indicates that command no.
comno contain one optional or more than one parameter.
p3mask
pair integer array used by the hyphenation routine hyph.
pagnum actual page number.
pagelength distance in points from upper page limit to last real
text line.
pc points to first free place in codebuf.
pco pco(i) is equal to the number of characters placed in
codebuf to be written after word no. i.
pib pib(i) points into linebuf to start of word no. i.
pis pis(i) points into linebuf to end of word no. i.
pnfont font no. of page number.
point constant, equal to the size in mm of the typographical
unit point (25.4/72 = 0.3532).
pr zone connected to the proofreading file.
printbuf printbuf(i) contains information about characters to
be printed on the proofreading file after word no. i
in current line packed in this way:
bit 0-11 number of spaces
bit 12-17 indicates a font command
bit 18-23 indicates a leading command
printmask printmask shift i<0 indicates that printbuf(i)
contains something to be printed after word no. i.
printmode true if output is wanted on the list file.
prognl true if nl has been generated by the program.
progpage true in the time from the generation of a page shift
to the output of the first real text line on the
following page.
q1,q2 working variables.
ra working array.
rh points to the first free place in rhead.
rhead buffer for running head.
rhfont font no. for running head.
runfont last font no. written on the object file.
runhead true if a running head
is to be set on the following page.
s1,s2 working variables.
savecode true if control characters are saved from previous line.
savelead assigned to leading when entering notemode.
savell assigned to linewidth when entering notemode.
savemode assigned to mode when entering notemode.
saveword true if a word or part of word
is saved from previous line.
sc1,sc2 saves the pointers c1 and c2 in connection with a page
shift, since the footnote setting may destroy them.
sep ISO-value for the actual separator.
set zone connected to the object file.
setmode true if output is wanted on the object file.
sh1,sh2,sh3 saves the pointers h1,h2,h3
in connection with page shift.
shiftlead true if more than one footnote on current page or the
only footnote contains more than one line.
shyp save value of hyp in connection with page shift.
smargin the coming left margin in units, used when the
LM-command dont occur in connection with line shift.
smtext true, if margin text is to be placed in the coming line,
used whenthe MT-command don't occur in connection with
line shift.
snitspace working variable for average word space.
sp constant, ISO-value for space.
sp1,sp2,sp3 constants, code-values to the typesetting machine for
1 unit, 2 unit and 3 units space.
spamax true if the average in the previous line is bigger than
maxfactor*maxspace.
sps constant, space-value for the typeset.mach.
ssavecode true if control characters
is to be saved under page shift.
ssaveword true if a word or part of word is to be saved under
page shift.
sstab special symbol table,
sstab(i) contains class shift 12+value
for the character assigned to the special symbol no.
i by the SB command.
startofline true from end of the output of the previous line until
first character in next line is met.
startofword true from end of reading of previous word until reading
of first character in the next word is read.
stop constant, stopcode value for the typesetting machine.
swidth the coming line width in units, used when the
LW-command does not occur in connection with lineshift.
swordbuf buffer for word to be saved under page shift.
tabcount counts number of tabulator marks
passed in current line.
tabno number of tabulator marks.
tabpar table with the distance in units between the tabulator
marks.
test constant.
text zone connected to the source file.
textp equal to <arg. 3> in command PL.
time constant, assign it to true if you want segment trans-
fer time, cpu and real time printed on current output.
toppage true from top of a page after a program generated
page shift to first significant character is met,
used to avoid double page shift.
toptext true from top of a page to the first real text line
is to be outputted. Used to skip NL-commands in start
of a page.
typlim number of typol-commands
in the actual edition of program.
u1 constant, ISO-value=1 which by the table convert is
converted to the value for 1 unit space.
uc constant, the upper case value for the typeset.mach.
ulinemask ulinemask shift i<0 indicates that the space following
word no. i is to be underlined.
unit constant, equal to the size in mm of the least space
unit on the actual typesetting machine
alse used when measuring the width of characters.
upperp equal to <arg. 2> in command PL.
v ISO-value for the last character read.
w count the words in current line.
wid width in units of first part of a hyphenated word.
word false when something signalizing end of a word is met
under reading from the source file
wordlim max no. of char. in the word possible to be saved
from one page to the next;
integer linelim,wordlim,mtextlim,headlim,maxnotelim,
typlim,fontlim,hypmode,machine,hyphzl,proofzl,
objzl,czl,tstp1,tstp2,rtxtlim;
boolean setmode,printmode,test,time,check,compchar,continue,
err,printer,diablo,notearea;
real array prooffile,objfile,hyphfile,sourcefile,
notefile,cons(1:2),ra(1:3);
begin <* scan call parameters *>
integer sep,no,next,q; real r;
real array param(1:2);
machine:=1; <*printer*>
setmode:=printmode:=notearea:=false; hypmode:=4;
objzl:=hyphzl:=proofzl:=czl:=1;
sourcefile(1):=real<::>; no:=1;
test:=time:=diablo:=check:=false;
printer:=true;
tstp1:=1; tstp2:=10000;
sep:=system(4,1,param);
if sep=6 shift 12 + 10 then
begin <* = , text *>
system(4,0,objfile); setmode:=true;
no:=2; objzl:=128
end;
for sep:=system(4,no,param) while sep shift (-12) > 3 do
begin <* scan one parameter *>
if sep extract 12 <> 10 then goto paramerror;
if param(1)=real<:machi:> add 110 then
begin
sep:=system(4,no+1,param);
if sep=8 shift 12 add 10 then
begin <* dot, text *>
r:=param(1);
if r=real<:print:> add 101 then machine:=1
else
if r=real<:diabl:> add 111 then machine:=2
else goto paramerror;
if machine=2 then
begin printer:=false; diablo:=true
end;
next:=no+2
end
else if sep shift (-12)<6 then goto sourcename
else goto paramerror
end else
if param(1)=real<:proof:> then
begin
sep:=system(4,no+1,param);
if sep=8 shift 12 + 10 then
begin
printmode:=true; proofzl:=128;
prooffile(1):=param(1); prooffile(2):=param(2);
next:=no+2
end
else if sep shift (-12) < 6 then goto sourcename
else goto paramerror
end else
if param(1)=real<:note:> then
begin
sep:=system(4,no+1,param);
if sep=8 shift 12 + 10 then
begin
notearea:=true; next:=no+2;
notefile(1):=param(1); notefile(2):=param(2)
end
else if sep shift (-12)<6 then goto sourcename
else goto paramerror
end else
if param(1)=real<:test:> then
begin
test:=true;
next:=no+1;
sep:=system(4,next,param);
if sep=8 shift 12 add 4 then
begin
tstp1:=tstp2:=param(1);
next:=next+1;
sep:=system(4,next,param);
if sep=8 shift 12 add 4 then
begin
tstp2:=param(1);
next:=next+1
end
end
else if sep shift (-12)<6 then goto sourcename
else goto paramerror
end else
if param(1)=real<:check:> then
begin
sep:=system(4,no+1,param);
if sep=8 shift 12+10 then
begin
check:=param(1)=real<:yes:>;
next:=no+2
end
else if sep shift (-12) < 6 then goto sourcename
else goto paramerror
end else
if param(1)=real<:time:> then
begin
sep:=system(4,no+1,param);
if sep=8 shift 12 + 10 then
begin
time:=param(1)=real<:yes:>;
next:=no+2
end
else if sep shift (-12) < 6 then goto sourcename
else goto paramerror
end else
if param(1)=real<:hyphe:> add 110 then
begin
next:=no+1; q:=0;
sep:=system(4,no+1,param);
if sep=8 shift 12 + 10 then
begin
if param(1)=real<:c:> then
begin
if rc8000 then
begin
end else
begin
system(8)dummy:(czl)parent:(cons);
if cons(1)=real<:s:> or cons(1)=real<:av:> then
begin q:=1;
write(out,<:***typeset: attempted message to :>,
string cons(increase(q)),<:<10>:>);
goto paramerror
end
end;
czl:=26; q:=q+1; next:=next+1;
sep:=system(4,no+2,param)
end;
if sep=8 shift 12 + 10 then
begin
q:=q+2; next:=next+1;
hyphzl:=128;
hyphfile(1):=param(1); hyphfile(2):=param(2);
end;
hypmode:=case q of(2,3,1);
end else
if sep shift (-12) < 6 then goto sourcename
else goto paramerror
end else
begin
sourcename:
if sourcefile(1)<>real<::> then goto paramerror else
begin
sourcefile(1):=param(1); sourcefile(2):=param(2);
next:=no+1;
end;
end;
if system(4,next,param) shift (-12) >=6 then
goto paramerror
else no:=next
end while;
if false then
paramerror:
begin
write(out,<:***typeset param :>);
for sep:=system(4,no,param),
system(4,no,param) while sep shift (-12) > 5 do
begin
write(out,if sep shift (-12) = 8 then <:.:> else <: :>);
q:=1;
if sep extract 12 = 10 then
write(out,string param(increase(q))) else
write(out,<<d>,entier(param(1)+0.5));
no:=no+1
end;
outchar(out,10);
fpproc(7,0,0,3)
end;
if check then
begin
setmode:=printmode:=false;
hypmode:=4;
objzl:=hyphzl:=proofzl:=czl:=1;
sourcefile(1):=real<::>
end;
end scan;
linelim:=300; wordlim:=75; mtextlim:=300; rtxtlim:=60;
headlim:=350; maxnotelim:=9;
typlim:=42; fontlim:=7; compchar:=continue:=err:=false;
begin comment inner block;
boolean nl,sp,ff,bs,u1,toptext,wrterr,nopf,stdspace,
compinit,runhead,finis,headmode,notemode,shiftlead,nstext,
saveword,savecode,hyp,spamax,dropjust,newpage,codemode,
toppage,shyp,ssaveword,blind,mtext,smtext,ssavecode,startofword,
word,more,line1,first,bool1,bool2,leftspa,startofline,
ref,odd,hypdigit,prognl,back,progpage,proofline,
FL,LD,saveLD,SL,eqmode,writeeq,innotout,notnl,rtxt,datemode;
long p0mask,p1mask,p2mask,p3mask,stmask,l1;
integer mode,msline,ht,saveht,rtfont,remlin,dt,language,
font,tabcount,newpstd,newpar,linewidth,lmarg,rmarg,pagelength,
sep,minlead,chapstd,chapstart,folip,upperp,textp,
sh1,mtfont,sh2,sh3,sc1,sc2,swidth,lineno,notenumw,stdlead,
headp,nump1,pnfont,pagnum,nummode,leading,maxspace,minspace,
runfont,normsp,i,j,k,q1,q2,a,b,d,h1,h2,h3,c1,c2,s1,s2,w,tabno,
linecount,pc,lin,printmask,codemask,ulinemask,figroom,figsize,
fnoteno,fn,rh,rhfont,accuw,censp,savelead,savemode,
savell,oldfont,notefont,fcount,klass,v,hypno,wid,comno,nlpar,
ds,fs,delin,subleading,slmarg,srmarg,savelmarg,savermarg,
vtsize,vtroom,displ,savemd,savenlpar,eqnl2,
rfch1,rfch2,rfch3,rfch4,saverfch1,rfzero;
real unit,point,snitspace,maxfactor,minfactor,normw,saveminus;
boolean array linebuf(1:linelim),codebuf(0:150),swordbuf(0:wordlim),
margtext(1:mtextlim),rhead(1:headlim),
rmargtxt(1:rtxtlim),dtxt(1:36);
integer array pib,pis,tabpar(1:24),comtab(1:typlim+2),
printbuf,pco(0:24),sstab(1:18),fontcode(1:fontlim),
convert,width,intab(0:127),fnfont(1:maxnotelim),mref(1:100);
zone c(czl,1,stderror),pr(proofzl,1,stderror),set(objzl,1,stderror),
hyphinf(hyphzl,1,stderror),fnote(128,1,blockpr);
procedure blockpr(z,s,b); zone z; integer s,b;
if false add s then stderror(z,s,b) else b:=512;
procedure testvar;
begin boolean k; integer i,j,m;
procedure d(b);value b; boolean b;
write(out,<<dd>,if b then 1 else 0,<:,:>);
if pagnum>=tstp1 and pagnum<=tstp2 then
begin
k:=false add 44;
write(out,nl,2,<<ddd>,<:page :>,pagnum,<:, line :>,
lineno,if blind then<:, blind.:> else <:.:>,nl,2);
d(compinit); d(runhead); d(finis); d(headmode); d(notemode);
d(shiftlead); d(saveword); d(savecode); d(hyp); d(dropjust);
outchar(out,10);
d(datemode); d(newpage); d(codemode); d(word); d(more);
d(line1); d(first); d(leftspa); d(smtext); d(spamax);
write(out,nl,2,<<-dddd>,mode,k,1,font,k,1,newpar,k,1,
linewidth,k,1,lmarg,k,1,rmarg,k,1,leading,k,1,runfont,k,1,
w,k,1,tabcount,k,1,nl,1,h1,k,1,h2,k,1,h3,k,1,
sh1,k,1,sh2,k,1,sh3,k,1,c1,k,1,c2,k,1,sc1,k,1,sc2,k,1,nl,1,
linecount,k,1,pc,k,1,lin,k,1,
figroom,k,1,fn,k,1,rh,k,1,
accuw,k,1,censp,k,1,nummode,k,1,
figsize,k,1,nl,1,fnoteno,k,1,hypno,k,1,slmarg,k,1,srmarg,k,1,
swidth,k,1,v,k,1,wid,k,1,nl,2);
for i:=1,2,3 do
begin
j:=case i of (codemask,printmask,ulinemask);
for m:=-23 step 1 until 0 do
outchar(out,if false add (j shift m) then 49 else 48);
outchar(out,10)
end;
setposition(out,0,0)
end;
if setmode then setposition(set,0,0);
if printmode then setposition(pr,0,0);
<*only one segment is necessary during tests*>
end testvar;
procedure etext;
error(<:EF: no command:>,2);
procedure error(s,a); value a; string s; integer a;
<*handling of logical errors*>
begin
write(out,<:***typol, :>,s); where; err:=err or a>1;
if a=2 then goto exit else if a=3 then goto eexit;
end error;
procedure where;
if check then write(out,<:; manus :>,<<ddd>,msline,nl,1)
else
write(out,<:; page :>,<<ddd>,pagnum,<:, line :>,lineno,
<:; manus :>,msline,nl,1);
integer procedure readmschar(z,c); zone z; integer c;
begin integer i;
readmschar:=i:=readchar(z,c);
compchar:=compchar or i=7;
if notnl and (c=10 or c=12) then msline:=msline+1;
notnl:=c<>10 and c<>12
end procedure readchar from manuscript;
integer procedure readfnchar(z,c); zone z; integer c;
begin
readfnchar:=readchar(z,c);
if c=3 then
begin readfnchar:=c:=0; readstop(c)
end
end footnote reading;
procedure digit(b); value b; boolean b;
comment b=true: makes the input table ready for number reading
with the terminator comma and current separator,
b=false: restores the input table according to current mode;
begin integer i;
if b then
begin
for i:=48 step 1 until 57 do intab(i):=2 shift 12+i;
intab(44):=10 shift 12+44;
<*due to compchar in readmschar, not 7 but 10*>
intab(32):=32;
if hypdigit then
begin
saveminus:=real<::> add intab(43) shift 24 add intab(45);
intab(10):=7 shift 12+10;
intab(43):=3 shift 12+43;
intab(45):=3 shift 12+45;
end
else intab(sep):=10 shift 12+sep <*see intab(44) above*>
end else
begin
for i:=48 step 1 until 57,44 do intab(i):=5 shift 12+i;
intab(32):=(if mode=1 then 2 else 5) shift 12+32;
if hypdigit then
begin
intab(43):=saveminus shift (-24) extract 24;
intab(45):=saveminus extract 24;
intab(10):=2 shift 12+10;
end
else intab(sep):=3 shift 12+sep;
end
end digit;
integer procedure hyph(a,n1,n2,n3,n4);
value n1,n2,n3,n4;
boolean array a; integer n1,n2,n3,n4;
begin
integer pnt,i,k,storen1,n,p;
integer array class(0:127);
integer procedure breakpt (a,n1,n2,n3,n4);
boolean array a; integer n1,n2,n3,n4;
begin
comment
procedure hyph is called when a hyphenation of a
line is wanted.
depending on the value of the global variable
hypmode the information is taken either from procedure
breakpt or from procedure breakpt and the console or
from the backing store. (see description of hypmode).
the value of hyph points at the element in array a after
which the break should be made.
procedure breakpt has the same parameters as
procedure hyph and contains an algorithm for finding
a natural breakpoint or a hyphenation point.
in case that an english text is to be processed
the corresponding procedure ebreakpt for english
hyphenation will be called.
the following possibilities are examined in the
mentioned sequence:
1. a natural breakpoint i.e. a point after
a punktuation character (p.ex.,:) or a
natural terminator (p.ex + -)).
2. a pair of consonants which can not be
pronounced.
3. a consonant between two vowels
4. two consonants between two vowels.
parameters:
a a boolean array, each element containing a character
of the line to be hyphenated or breaked.
composed characters will have the format:
<character><1-unit backspaces><character>
<1-unit backspaces>....<1-unit spaces>
each element contained in one element
of a.
n1 an integer pointing at an element of the
first character of the actual string (word)
in a.
n2 an integer pointing at an element of the
first character after which a break or
hyphenation may be made
n3 an integer pointing at an element of the
last character before which a break or
hyphenation may be made.
n4 an integer pointing at an element of the last
character of the actual string (word).
global variables:
language an integer denoting the language
of the actual text: 1 for danish
and 2 for english.
linelim. an integer denoting the upper limit
of the array a which should be declared
a(1:linelim).
hypmode an integer selecting the way of furnishing
the hyphenation information.
hypmode=1 the procedure prints on the console a
proposal of hyphenation (made by call of
procedure breakpt) which the user can
accept by typing + or reject by typing
- and the correct position of hyphenation.
the hyphenation - information is stored in
zone hyphinf.
hypmode=2 like hypmode=1 but the information is
not stored.
hypmode=3 the hyphenation - information is read
from zone hypheninf
hypmode=4 the hyphenation - information is taken
from the procedure breakpt without
communication with the user.
variables:
class an integer array classifying the characters as
follow, where the characters are shown by their
ISO-values.
class 0
0
class 1 (elements for composed characters only)
39,94,95,96,126
class 2 (punctnation characters)
33,44,46,58,59,63
class 3 (natural terminators)
35,36,37,38,41,43,45,60,61,62,64
class 4 (vowels)
65,69,73,79,85,89,91,92,93
97,101,105,111,117,121,123,124,125
class 5 (consonants)
class 6 (digits)
class 7
34,40,42,47 and 15<=characters<=31
class 8 (backspace)
5,8
class 9 (1-unit space)
1
2,3,4,5,6,7
class 12 spec. backspaces in start of underlined char.
2
pair an integer one dimensional array containing a
tabel denoting the pairs of consonants which
can be pronaunced together before the vowel
in a syllable.
the vertical entrance corresponding to the
index of pair denotes the left consonant and
the horizontal entrance corresponding to the
bit number of the elements in pair denote the
right consonant.
a bit=1 denotes that the pair can be pronounced.
bcdefghijklmnopqrstuvwxz
b 000100010000010010010000
c 000100110000010000010000
d 000100010000010010011100
e 111111111111111111111111
f 000100010010110010010000
g 000100010010110010010000
h 000100011000010000011100
i 111111111111111111111111
j 000100010000010000010000
k 000100010010110010011100
l 000100010000010000010000
m 000100010000010000010000
n 000100010000010000010000
o 111111111111111111111111
p 000100010000010010010000
q 000100010000010000010000
r 000100010000010000010000
s 000101011111111000111100
t 000100010000010010011100
u 111111111111111111111111
v 000100010000010010010000
w 000100010000010010010000
x 000100010000010000010000
z 000100010000010000010000
i,k,n,p working variables
storen1 the unmodified value of n1 which will
be stored if hypmod=1
pnt assigned the value of procedure breakpt
and modified to the character no. counted
from the left slash and read from the
console, in hypmode 1 and 2.
in hypmode=3 pnt is assigned the value of the
stored breakpoint
rightn2 pointers pointing in a at the rightmost element
of n2 and
rightn3 n3 respectively.
rightn3add1 pointer pointing in a at the rightmost
element of the character to the right of n3
leftn2 pointers pointing in a at the leftmost
element of n2
leftn3 and n3 respectively.
konr the values of right and left
konl character respectively in a pair of
consonants.
class2 a boolean set true when a class2 or class3
character is met during searching for a
natural breakpoint
;
integer i,n, rightn2,rightn3,leftn2,leftn3,k,p,rightn3add1,
konr,konl,q,r;
boolean class2; integer array pair(0:23);
integer procedure pack(o1,o2,o3,o4,o5,o6,o7,o8);
integer o1,o2,o3,o4,o5,o6,o7,o8;
begin comment the parameters which should be octal digits
will be packed in pack in succeding groups of 3 bits;
integer k,o,i;
k:=0; i:=21;
for o:=o1,o2,o3,o4,o5,o6,o7,o8 do
begin
k:=k+o shift i;
i:=i-3;
end;
pack:=k;
end pack;
comment initialising of tabel of pairs of consonants;
pair(0):=pack(0,4,2,0,2,2,2,0);
pair(1):=pack(0,4,6,0,2,0,2,0);
pair(2):=pack(0,4,2,0,2,2,3,4);
pair(3):=pack(7,7,7,7,7,7,7,6);
pair(4):=pack(0,4,2,2,6,2,2,0);
pair(5):=pack(0,4,2,2,6,2,2,0);
pair(6):=pack(0,4,3,0,2,0,3,4);
pair(7):=pack(7,7,7,7,7,7,7,6);
pair(8):=pack(0,4,2,0,2,0,2,0);
pair(9):=pack(0,4,2,2,6,2,3,0);
pair(10):=pack(0,4,2,0,2,0,2,0);
pair(11):=pack(0,4,2,0,2,0,2,0);
pair(12):=pack(0,4,2,0,2,0,2,0);
pair(13):=pack(7,7,7,7,7,7,7,6);
pair(14):=pack(0,4,2,0,2,2,2,0);
pair(15):=pack(0,4,2,0,2,0,2,0);
pair(16):=pack(0,4,2,0,2,0,2,0);
pair(17):=pack(0,5,3,7,7,0,7,4);
pair(18):=pack(0,4,2,0,2,2,3,4);
pair(19):=pack(7,7,7,7,7,7,7,6);
pair(20):=pack(0,4,2,0,2,2,2,0);
pair(21):=pack(0,4,2,0,2,2,2,0);
pair(22):=pack(0,4,2,0,2,0,2,0);
breakpt:=0;
comment natural break
a natural break is made after a class 2 or a class 3
character if they are not followed by a class 2 character.
the scan is made against left from the rightmost element
of n2.
;
leftn2:=charleft(n2,a); leftn3:=charleft(n3,a);
rightn3:=charright(n3,a);
rightn3add1:=charright(rightn3+1,a); rightn2:=charright(n2,a);
n4:=charright(n4,a); n1:=charleft(n1,a);
comment find punctuation character;
i:=leftn2-1; class2:=false;
for i:=i+1 while i<=leftn3-1 and -,class2 do
begin
k:=class(a(i) extract 7);
class2:=k=2 or k=3
end;
if class2 then
begin comment find the last of succeeding punctuation
characters if any occur;
k:=charright(i-1,a); p:=k+1;
for k:=charright(p,a) while class2 and k<=rightn3add1 do
begin
class2:=false;
for i:=p step 1 until k do
if class(a(i) extract 7)=2 then class2:=true;
n:=p; p:=k+1
end;
if n<=leftn3 then begin breakpt:=-(n-1);goto breakend end;
end;
comment hyphenation
foerst soeges en vokal bagfra hvorefter der soeges et
konsonantpar.
herefter slaas der op i den tosidede tabel pair med de
to konsonanter som indgangsvaerdier.
den aktuelle bit i pair er 1 hvis konsonanterne kan udtales
sammen og ellers 0.
er bitten 0 deles ordet det paagaeldende sted.
find vokal;
k:=charright(n4,a);
i:=k +1;
vokal:
for i:=i-1 while class(a(i) extract 7)<>4 and i>=leftn2 do;
if i>leftn2 then
begin
comment find konsonant;
i:=i+1;
kons: for i:=i-1 while class(a(i) extract 7)<>5 and i>rightn2 do;
nykonl: if i>rightn2 then
begin
konr:=a(i) extract 7;
konr:=konr-(if konr=90 then 67 else if konr=122 then 99 else
if konr>90 then 98 else 66); comment konv. til
pair-entrance;
comment find nabokonsonant;
i:=charleft(i,a)-1;
k:=charleft(i,a);
i:=i+1;
for i:=i-1 while class(a(i) extract 7)<>5 and i>=k do;
if i<k then
begin comment ingen nabokonsonant;
i:=i+1;
goto kons
end;
konl:=a(i) extract 7;
konl:=konl-(if konl=90 then 67 else if konl=122 then 99 else
if konl>90 then 98 else 66);
if (pair(konl) shift (konr-23)) extract 1 <>0 then
goto nykonl else
if i>=leftn3 then
begin
i:=charleft(i,a);
goto vokal
end
else
begin
breakpt:=charright(i,a);
goto breakend
end
end
comment deling foran konsonant mellem to vokaler.
find vokal;
i:=charright(rightn3+1,a)+1;
vok: for i:=i-1 while i>rightn2 and class(a(i) extract 7)<>4 do;
if i>rightn2 then
begin comment vokal fundet, find nabokonsonant;
n:=p:=charleft(i,a); k:=charleft(p-1,a);
for n:=n-1 while n>=k and class(a(n) extract 7)<>5 do;
if n<k then
begin
i:=p;
goto vok
end;
comment konsonant fundet, find nabovokal;
p:=charleft(k-1,a); n:=k;
if p>=n1 then
begin
for n:=n-1 while n>=p and class(a(n) extract 7)<>4 do;
if n>=p then
begin
breakpt:=k-1;
goto breakend
end
else
begin
i:=p;
goto vok
end
end;
end;
comment deling mellem to vokaler mellem to konsonanter.
find vokal;
i:=1+(if n4>rightn3 then charright(rightn3+1,a) else
rightn3); q:=charright(rightn2+1,a);
voc: for i:=i-1 while i>q and class(a(i) extract 7)<>4 do;
if i>q then
begin comment vokal fundet. find nabokonsonant;
n:=p:=charleft(i,a); k:=charleft(p-1,a);
for n:=n-1 while n>=k and class(a(n) extract 7)<>5 do;
if n<k then
begin
i:=p;
goto voc
end;
comment konsonant fundet, find ny nabokonsonant;
n:=k; p:=charleft(k-1,a);
if p>charright(n1,a) then
begin
for n:=n-1 while n>=p and class(a(n) extract 7)<>5 do;
if n<p then
begin
i:=k;
goto voc
end;
comment konsonant fundet, find nabovokal;
n:=p; r:=charleft(p-1,a);
for n:=n-1 while n>r and class(a(n) extract 7)<>4 do;
if n<r then
begin
i:=p;
goto voc
end;
comment vokal fundet;
breakpt:=k-1;
goto breakend
end
end i>q;
end;
breakend:
end breakpt;
integer procedure charright (p,a); value p; integer p;
boolean array a; comment the procedure scans towards
right to find the rightmost element of a given character
in the array a. p is the index pointing in a at an
arbitrary element of the actual character;
begin
integer k, m,q;
if p=linelim then
begin
charright:= linelim;
goto fin
end;
k:=p-1;
m:= class(a(p)extract 7); q:=class(a(p+1) extract 7);
for k:=k+1 while
(q>7 and q<>12) or
(m<>9 and m>7) do
begin
if k=linelim-1 then
begin
charright:=linelim;
goto fin
end;
m:=q;
q:=class(a(k+2) extract 7);
end;
charright:=k;
fin: end charright;
procedure outstring(p,q);
value p,q; integer p,q;
begin integer k; boolean class8;
class8:=false;
for i:=p step 1 until q do
begin
k:=class(a(i) extract 7);
write(c,
if k<8 and (a(i) extract 7<15 or a(i) extract 7>31) then a(i)
else if k=7 then false add 42
else if k=8 and -,class8 then false add 8 else false,1);
class8:=k=8;
end
end outstring;
integer procedure charleft(p,a);
value p; integer p; boolean array a;
comment the procedure is similar to
charright but looks for the leftmost
element of the actual character;
begin
integer k,m,q;
if p=1 then
begin
charleft:=1;
goto fin
end;
k:=p+1; m:=class(a(p) extract 7); q:=class(a(p-1) extract 7);
for k:=k - 1 while
(m>7 and m<>12) or q=8 or q=12 do
begin
if k=2 then
begin
charleft:=1;
goto fin
end;
m:=q;
q:=class(a(k-2) extract 7);
end;
charleft:=k;
fin: end charleft;
integer procedure ebreakpt(A,n1,n2,n3,n4) ;
value n1,n2,n3,n4 ;
boolean array A ;
integer n1,n2,n3,n4 ;
begin
integer array class(0:127) , B(1:29) ,word,posn(0:n4-n1+2);
integer i,j,k,l,m,a,b,c,d ,m1,m2,m3,m4,class2,bs,fs ;
boolean init,dsmk ,composite,charset,newm2,newm3 ;
comment set up arrays and constants ;
for i := 0 step 1 until 127 do
class(i) := case i + 1 of
(3,7,7,7,7,7,7,7,
3,7,7,7,7,7,7,7,
7,7,7,7,7,7,7,7,
7,7,7,7,7,7,7,7,
7,8,3,3,3,9,9,3,
3,8,9,3,8,6,5,3,
4,4,4,4,4,4,4,4,
4,4,8,8,9,9,9,8,
9,1,2,2,2,1,2,2,
2,1,2,2,2,2,2,1,
2,2,2,2,2,1,2,2,
2,1,2,1,1,1,9,9,
9,1,2,2,2,1,2,2,
2,1,2,2,2,2,2,1,
2,2,2,2,2,1,2,2,
2,1,2,1,1,1,9,3 ) ;
for i := 1 step 1 until 29 do
B(i) := case i of
(9,8,6,8,9,8,6,1,9,5,
5,5,4,3,10,6,5,2,7,6,
9,5,6,5,9,5,9,9,9 ) ;
ebreakpt := 0 ;
m1 := 1 ; m2 := n2-n1+1 ;
m3 := n3-n1+1 ; m4 := n4-n1+1 ;
word(0) := word(m4+1) := 0 ;
bs := 8 ; composite := false ; fs := 5 ;
comment check for composite chars ;
for i := 1 step 1 until m4 do
begin
word(i) := A(n1+i-1) extract 7 ;
posn(i) := n1+i-1 ;
if word(i) = bs or word(i) = fs then composite := true ;
end ;
if composite then
begin comment word tidy-remove composites ;
j := 0 ;
for i := 1,i+1 while j<m4 do
begin
class2 := 0 ; charset := false ;
ABOVE:
for j := j+1 while word(j)=bs do ;
if word(j)=39 or (word(j)>93 and word(j)<97)
or word(j)=126 then
begin comment class 1 ;
if -, charset then goto INSERT
end
else
begin comment class2 ;
class2 := class2+1 ;
INSERT:
word(i) := word(j) ;
charset := true
end ;
if word(j+1)=bs then goto ABOVE ;
for j := j+1 while word(j)=fs do ;
if class2>1 then goto OUT ;
comment no ebreakpt can be found ;
j := j-1 ;posn(i) := n1+j-1 ;
comment posn of last char in composite ;
end dealing with one composite posn ;
m4 := i-1 ; newm2 := newm3 := true ;
for i := 1 step 1 until m4 do
begin
if newm2 then
begin
if posn(i)>=n2 then
begin m2 := i ;newm2 := false end ;
end
else
if newm3 then
begin
if posn(i)>=n3 then
begin m3 := i ; newm3 := false end ;
end ;
end find new m2,m3 ;
end word tidy ;
comment look for natural break ;
for i := m3-1 step -1 until m2 do
begin
j := case class(word(i)) of (1,1,1,1,1,2,3,4,4 ) ;
k := case class(word(i+1)) of (1,1,1,2,3,1,1,3,1);
l := case(j-1)*3+k of (1,1,1,2,1,2,2,2,2,2,2,1) ;
if l = 2 then
begin
ebreakpt := -posn(i) ; goto OUT
end natural breakpoint found ;
comment table used for case statement :
i+1 other digit punctuation
i
alphanum. 1 1 1
hyphen,minus 2 1 2
non-printing 2 2 2
non-alphan. 2 2 1 ;
end ;
comment natural break not found,find start and end
characters of word ;
for i := m2+1,i-1 while i>m1 and class(word(i-1))<6 do ;
a := i ; comment first of word ;
for i := m2-1,i+1 while i<m4 and class(word(i+1))<6 do ;
b:= i ; comment last of word ;
comment search valid last vowel in word ;
init := true ;
for i := b step -1 until m2+1 do
begin
j := class(word(i)) ; if j>3 then j := 3 ;
k := word(i) mod 32 ;
case j of
begin
comment 1 vowel ;
begin
if k<>5 or (-, init and -, dsmk) then goto VFOUND ;
init := dsmk := false
end ;
comment 2 consonant ;
begin
dsmk := if init and (k=4 or k=19) then true else false ;
init := false ;
end;
comment 3 other,no action ; ;
end of case statement ;
end of loop ;
comment no vowel found ;
goto OUT ;
VFOUND:
c := if i>m3 then m3 else i ;
comment find consonant to start new line ;
for i := c step -1 until m2+1 do
if class(word(i)) = 2 then
begin comment consonant found ;
j := word(i) mod 32 ;
k := B(j) ;
l := if class(word(i-1))>2 then 5 else B(word(i-1) mod 32 ) ;
if k>4 or l<6 then goto BELOW ;
m := case(l-6)*4+k of
(1,1,2,2,1,2,2,2,2,1,2,2,2,1,1,2,2,1,1,1) ;
comment table used in case statement :
i 1,h 2,r 3,n 4,m
i-1
6,invalid with r,h 1 1 2 2
7,------------ h 1 2 2 2
8,------------ r 2 1 2 2
9, vowels - o 2 1 1 2
10, o 2 1 1 1
5 is class of other characters ;
case m of
begin
comment 1 no action ; ;
comment 2 test for double consonant ;
BELOW:
if class(word(i+1))<>2 or j <> word(i+1) mod 32
then goto CFOUND ;
end of case statement ;
end of consonant check ;
goto OUT ; comment no break point ;
comment look for vowel before break ;
CFOUND:
d := i ;
for i := a step 1 until d-1 do
if class(word(i))=1 then
begin
ebreakpt := -posn(d-1) ;
if class(word(d-1))<3 then ebreakpt := posn(d-1) ;
goto OUT
end ;
OUT:
end of ebreakpt procedure ;
for n:=3 step 1 until 14 do class(n):=11; class(1):=9;
class(2):=12; class(5):=class(8):=8; class(0):=0;
for n:=15 step 1 until 31 do class(n):=7;
n:=32;
for i:=11,2,7,
3,3,3,3,1,
7,3,7,3,2,
3,2,7,6,6,
6,6,6,6,6,
6,6,6,2,2,
3,3,3,2,3 do
begin
class (n):=i;
n:=n+1
end;
for n:=65 step 1 until 127 do class(n):=5;
for i:= 65,69,73,79,85,89,91,92,93 do
class(i):= class(i+32):=4;
class(94):= class(95):= class (126):=1;
class(127):=10;
storen1:=n1;
n:=case hypmode of (1,1,2,3);
digit(true);
case n of
begin
begin
comment hypmode=1 or 2 i. e. hyph.-information read
on-line;
pnt:=if language=2 then ebreakpt(a,n1,n2,n3,n4)
else breakpt(a,n1,n2,n3,n4);
n2:=charleft(n2,a); n3:=charleft(n3,a);
n:=if pnt=0 then n3-1 else abs(pnt);
write(c,<:<10>:>);
outstring(n1,n2-1); outchar(c,47); outstring(n2,n);
if pnt<>0 then
begin
if pnt>0 then outchar(c,45); outchar(c,10)
end;
outstring(n+1,n3-1); outchar(c,47); outstring(n3,n4);
if pnt<>0 then
begin
W: write(c,<:<10>+/-: :>); setposition(c,0,0);
for i:=readchar(c,k) while -,(k=43 or k=45) do
if k=10 then
begin
setposition(c,0,0); goto W
end;
setposition(c,0,0);
end else k:=45;
if k=43 then p:=hyph:=pnt else
begin
posagain: setposition(c,0,0);
write(c,<:<10>position: :>); setposition(c,0,0);
read(c,pnt); repeatchar(c); readchar(c,k);
if k<>10 or pnt>=n3 then goto posagain; setposition(c,0,0);
if pnt=0 then hyph:=0 else
begin
k:=abs(pnt); p:=n2-1;
for i:=1 step 1 until k do p:=charright(p+1,a);
if p<n2 or p>=n3 then
begin
write(c,<:<10>position outside limits.:>);
goto posagain
end;
p:=hyph:=sign(pnt)*p;
end;
end;
if hypmode=1 then
write(hyphinf,<<ddd>,storen1,<:,:>,p,<:<10>:>);
end hypmode=1 or 2;
begin comment hypmode=3, hyphenation information read from
zone hyphinf where it has been stored in a preceeding run;
read(hyphinf,storen1,pnt);
if n1=storen1 then hyph:=pnt else
error(<:error in hyphen file:>,2)
end hypmode=3;
begin comment hypmode=4 , hyphenation-information taken from
procedure breakpt only;
hyph:=breakpt(a,n1,n2,n3,n4);
end
end case;
digit(false);
end procedure hyph;
\f
integer procedure typol;
comment reads and executes a command or numerical name from the
source file.
order comno mask type comm. jump typol
nl 1 46 2 1opt 1
rj 2 45 0 + 6
sj 3 44 0 + 6
ft 4 43 1 6
np 5 42 2 1opt 2
ta 6 41 2 24opt + 6
lm 7 40 1 6
lw 8 39 1 6
fg 9 38 1 4
fn 10 37 1,s 5
sc 11 36 0 6
ns 12 35 2,s 3 1
ts 13 34 1 6
ps 14 33 2 2opt 3,6
rh 15 32 2,s 2opt 6
sb 16 31 3 1+1opt 6
ct 17 30 0 + 6
qr 18 29 0 + 6
pl 19 28 2 5opt 6
pn 20 27 2 6
ld 21 26 1 6
mt 22 25 1,s 6
cm 23 24 3,s 6
se 24 23 3 1 6
ef 25 22 0 3
ds 26 21 3 1opt 6
sl 27 20 1 6
fl 28 19 1 6
rm 29 18 1 6
lt 30 17 1,s 6
ht 31 16 3 1opt 6
pf 32 15 1 6
rt 33 14 1,s 6
fs 34 13 3 1opt 6
cd 35 12 1 6
vs 36 11 1 6
lg 37 10 1 6
pd 38 9 2 6
rd 39 8 3 5opt 6
eq 40 7 2,s 3 1
ss 41 6 0 6
lc 42 5 0 6 ;
begin
integer p1,p2,com,q1,q2,n1,n2,i;
integer array par(1:24);
procedure typolerror(c1,c2,s); value c1,c2;
integer c1,c2; string s;
begin
write(out,<:***typol, :>,false add c1,1,
false add c2,1,<:: :>,s);
where;
if check then
begin
repeatchar(in); q1:=q2:=0;
for q1:=q1+1 while q2<>sep and q1<75 do readmschar(in,q2);
comno:=0; goto outtyp
end else
begin err:=true; goto exit
end
end typolerror;
boolean procedure scan;
begin
integer s;
repeatchar(in); readmschar(in,s);
if stmask shift comno<0 and
(if comno=12 or comno=40 then par(2)<>-1 else par(1)<>-1)
or s=sep then
begin scan:=false; goto ud
end;
rep: s:=32; for i:=i while s=32 do readmschar(in,s);
if s>47 and s<58 or s=45 then repeatchar(in)
else if s=sep then
begin scan:=false; goto ud
end else
begin
if s=44 then i:=i+1 else typolerror(n1,n2,<:argument:>);
goto rep
end;
scan:=true;
ud:
end scan;
q1:=q2:=32;
for i:=i while q1=32 do readmschar(in,q1);
for i:=i while q2=32 do readmschar(in,q2);
n1:=q1; n2:=q2;
if q1<97 then q1:=q1+32;
if q2<97 then q2:=q2+32;
com:=q1 shift 8 add q2;
i:=0;
for i:=i+1 while comtab(i)<>com & i<typlim+1 do;
if i>typlim then typolerror(n1,n2,<:unknown:>);
n1:=q1-32; n2:=q2-32;
comno:=i;
digit(true);
for i:=1,2,3,4,5 do par(i):=-1;
i:=0;
if p3mask shift comno<0 then
begin
if comno=39 then goto COMNO;
if comno<>23 then <*assign <char> or <sep> to p1*>
begin
p1:=32;
for i:=i while p1=32 do readmschar(in,p1);
if comno=16 then <*sb: assign <char> to p1 and <arg> to p2*>
begin
if p1>47 and p1<58 then <*sb<arg>*>
begin
repeatchar(in); read(in,p2); p1:=0
end else
begin <*sb<char>,<arg>*>
q1:=32;
for i:=i while q1=32 do readmschar(in,q1);
if q1=44 then read(in,p2)
else typolerror(n1,n2,<:command:>)
end
end
end
end else
for i:=i+1 while scan and i<25 do read(in,par(i));
if i=25 then typolerror(n1,n2,<:index(25):>);
if p0mask shift comno<0 then
begin
if i>1 then typolerror(n1,n2,<:parameter:>)
end else
if p1mask shift comno<0 then
begin
p1:=par(1);
if i>2 or p1=-1 then typolerror(n1,n2,<:argument:>)
end else
if p2mask shift comno<0 then
begin
if comno=6 then tabno:=i-1; p1:=par(1); p2:=par(2);
if (comno=12 or comno=38 or comno=40) and i<>3
or (comno=1 or comno=5) and i>2 or comno=19 and i>6 then
typolerror(n1,n2,<:arguments:>)
end else
if p3mask shift comno<0 then
begin
if comno<>23 and comno<>34 then
begin
if comno<>16 then
begin
if p1<33 or p1>47 and p1<58 or p1=44 then
typolerror(n1,n2,<:character:>)
end else
if p2<1 or p2>18 then typolerror(n1,n2,<:index(0,19):>)
end
end else error(<:set mask:>,2);
if stmask shift comno>=0 then
begin comment not FN, NS, RH, MT, CM, LT, RT, or EQ;
repeatchar(in); readmschar(in,q2);
if q2<>sep then
begin comment read until separator met;
for i:=i while q2<>sep do readmschar(in,q2);
end;
end;
if comno=18 then comno:=17; comment process QR like CT;
if comno=30 then comno:=22; <*process LT as MT*>
digit(false);
COMNO:
case comno of
begin
begin <*1:NL*>
nlpar:=if p1>-1 then p1 else 1;
if prognl then
begin prognl:=false; nlpar:=nlpar-1
end;
q1:=(pagelength-linecount)/leading; if q1<1 then q1:=1;
if nlpar>q1 then nlpar:=q1+1;
if toptext and w=0 then nlpar:=0;
dropjust:=true
end;
begin <*2:RJ*>
if mode>3 then calcensp; if mode=1 then goto outtyp;
mode:=1;
setclass(true);
goto if startofline then just else outnonjust
end;
begin <*3:SJ*>
if mode>3 then calcensp; if mode=2 then goto outtyp;
q1:=mode; mode:=2;
setclass(false);
if startofline then goto nonjust else
begin if q1=1 then
begin dropjust:=true; goto linejust
end
else goto outnonjust
end;
end;
begin <*4:FT*>
if p1>0 and p1<5 then adjwidth(p1)
else typolerror(70,84,<:out of bounds:>);
if setmode and diablo then
begin
codebuf(pc):=false add fontcode(p1);
codebuf(pc+1):=false add 27; codebuf(pc+2):=false add 31;
codebuf(pc+3):=false add (if (false add p1) then 13 else 11);
justpc(4)
end;
if printmode then loadprbuf(2,p1);
font:=p1
end;
begin <*5:NP*>
newpar:=if p1>-1 then p1/unit else newpstd;
newpstd:=newpar;
if prognl then
begin prognl:=false; nlpar:=0
end;
if toptext and w=0 then nlpar:=0;
dropjust:=true
end;
begin <*6:TA*>
if p1=-1 then typolerror(84,65,<:argument 1:>);
if mode>3 then calcensp;
q1:=mode; mode:=3;
setclass(false); q2:=0;
for i:=1 step 1 until tabno do
begin p2:=tabpar(i):=par(i)/unit; q2:=q2+p2
end;
if q2>linewidth then error(<:TA: tabsum>LW:>,1);
for i:=tabno+1 step 1 until 24 do tabpar(i):=0;
if startofline then goto tabul else
begin if q1=1 then
begin dropjust:=true; goto linejust
end
else goto outnonjust
end;
end;
begin <*7:LM*>
q1:=p1/unit;
q2:=linewidth-q1+lmarg;
if q2<0 then typolerror(76,77,<:(LW-RM)<LM:>);
if startofline and -,mtext then
begin linewidth:=q2; lmarg:=q1
end
else slmarg:=q1
end;
begin <*8:LW*>
q1:=p1/unit;
if startofline then
begin
q2:=q1-lmarg-rmarg;
if q2<0 then typolerror(76,87,<:LW<(LM+RM):>);
linewidth:=q2
end
else swidth:=q1
end;
begin <*9:FG*>
q1:=p1/point;
if pagelength-linecount>=q1 then
begin comment room for figure on actual page;
q2:=q1/leading; <*number of NL*>
if startofline then
outnl(if prognl then q2-2 else q2-1)
else figsize:=q2-1; prognl:=false;
end
else
begin comment not room for figure on actual page,
save information;
figroom:=figroom+q1;
end
end;
begin <*10,FN*>
integer xnotenumw; real xnormw;
fnoteno:=fnoteno+1; fnfont(fnoteno):=p1;
if diablo then
begin
xnormw:=if false add p1 then 6 else 5;
xnotenumw:=4*(if false add p1 then 6 else 5)
end
else
begin
xnormw:=normw; xnotenumw:=notenumw
end;
readmschar(in,q1); q2:=fn; fn:=fn-1; intable(0);
for fn:=fn+1 while q1<>sep do
begin
if -,notearea and fn=768 then typolerror(70,78,<:chars:>);
outchar(fnote,q1); readmschar(in,q1)
end;
outchar(fnote,3) <*ETX*>; k:=linecount; intable(intab);
linecount:=linecount+(round((fn-q2)*xnormw/
(linewidth+lmarg+rmarg-xnotenumw))+1)*minlead;
if fnoteno>1 ! linecount-k>minlead then shiftlead:=true;
linecount:=linecount+leading;
comment estimated calculation of linespace for the note;
w:=w+1; comment place mark in text;
linebuf(lin):=false add (fnoteno+48);
linebuf(lin+1):=false add 41;
pib(w):=lin; pis(w):=lin+1;
lin:=lin+2; startofline:=prognl:=false;
accuw:=accuw+width(49)+width(41);
if (linecount+36)>pagelength then
typolerror(70,78,<:pagelength:>)
end;
<*11:SC*>;
begin <*12:NS*>
if nstext or p1=-1 or p2=-1 then
typolerror(78,83,if nstext then <:double text:>
else <:argument:>);
mtfont:=p1; nlpar:=p2;
q1:=i:=0;
for i:=i+1 while q1<>sep do
begin comment save new section text in margtext;
if i>mtextlim then typolerror(78,83,<:chars:>);
readmschar(in,q1);
if q1=8 then
begin backspace(margtext,i,false); i:=i-1
end
else
begin
if q1>127 then delim(q1);
margtext(i):=false add q1
end;
end;
wrterr:=true;
margtext(i-1):=false; nstext:=true;
if prognl then
begin prognl:=false; nlpar:=nlpar-1;
end;
if pagelength-linecount-nlpar*leading<2*leading then
begin newpage:=true; chapstart:=upperp;
end;
if toptext and w=0 then nlpar:=0;
dropjust:=true;
end;
<*13:TS*>;
begin <*14:PS*>
q2:=if p2>-1 then (pagelength-linecount)-p2/point
else -1;
if q2<0 or compinit then
begin
chapstart:=if p1>-1 then p1/point else chapstd;
if toppage then comno:=0 else newpage:=dropjust:=true;
end else comno:=0;
end;
begin <*15:RH*>
if p1>-1 then
begin
i:=0; q1:=0;
for i:=i+1 while q1<>sep do
begin comment save head in array rhead;
if i>headlim then typolerror(82,72,<:chars:>);
readmschar(in,q1); rhead(i):=false add q1
end;
rhead(i-1):=false; runhead:=true;
rhfont:=p1
end else
begin runhead:=false; rhfont:=1
end;
if nopf then pnfont:=rhfont
end;
begin <*16,SB*>
<* sstab(1:18); the special symbols may be defined through
convert(14:31); actually, they are defined through
convert(15:22) for diablo and convert(15:20) for printer. *>
if diablo and p2>8 or printer and p2>6 then
typolerror(83,66,<:<arg>:>);
q1:=case machine of (20,22);
if p1<>0 and
(p1=sep or p1=ht or p1=ds or p1<14 or p1<32 and p1>q1) then
typolerror(83,66,<:invalid data:>);
q2:=sstab(p2);
if q2<>0 then
begin comment SS in use, restore class and value for old <char.>;
q1:=q2 extract 7; comment value;
intab(q1):= if q1=45 then (if mode=1 then 6 else 5) shift 12+45
else if q1=95 then (if mode=1 then 4 else 5) shift 12+95
else q2;
end;
if p1>32 or p1=0 then
begin comment <char.> present and not used as SS or no <char.>;
sstab(p2):=if p1>32 then intab(p1) else 0;
if p1>32 then intab(p1):=5 shift 12+p2+14;
end
else if p1>14 then
begin comment <char.> present and in use as SS;
sstab(p2):=sstab(p1-14); sstab(p1-14):=0;
intab(sstab(p2) extract 7):=5 shift 12+p2 +14;
end else typolerror(83,66,<:invalid arg:>)
end;
begin <*17:CT,QR*>
q1:=mode; mode:=if com extract 7=116 then 4 else 5;
if q1=mode then goto outtyp;
setclass(false);
if startofline then goto (if mode=4 then center else centrh)
else
begin if q1=1 then
begin dropjust:=true; goto linejust
end
else goto outnonjust
end
end;
<*18:(QR)*>;
begin <*19:PL*>
if p1<>-1 then folip:=p1/point;
if p2<>-1 then upperp:=p2/point;
if par(3)<>-1 then textp:=par(3)/point;
if par(4)<>-1 then headp:=par(4)/point;
if par(5)<>-1 then nump1:=par(5)/point;
pagelength:=upperp+textp
end;
begin <*20:PN*>
nummode:=p1; pagnum:=if p2>-1 then p2 else pagnum
end;
begin <*21:LD*>
leading:=p1; LD:=false add (round(p1*2/3)+1); defvmi
end;
begin <*22:MT,LT*>
if smtext then typolerror(n1,n2,<:double txt:>);
mtfont:=p1;
q1:=i:=0;
for i:=i+1 while q1<>sep do
begin comment save margin text in array margtext;
if i>mtextlim then typolerror(n1,n2,<:chars:>);
readmschar(in,q1);
if q1=8 then
begin backspace(margtext,i,false); i:=i-1
end
else
begin
if q1>127 then delim(q1);
margtext(i):=false add q1
end
end;
wrterr:=true;
margtext(i-1):=false;
if startofline and -,mtext then
begin
setmtext(<:left:>);
toptext:=false
end else
if startofline and mtext then typolerror(n1,n2,<:double txt:>)
else smtext:=true;
end;
begin <*23:CM, special actions or tests may be coded here*>
repeatchar(in); readchar(in,q2);
if q2<>sep then
begin for i:=i while q2<>sep do readmschar(in,q2)
end
end;
begin <*24:SE*>
if p1=ds or p1=ht then typolerror(83,69,<:<char>:>);
intab(sep):=5 shift 12+sep;
intab(p1):=3 shift 12+p1;
sep:=p1
end;
<*25:EF*> finis:=dropjust:=true;
begin <*26:DS*>
if p1=128 then goto outtyp;
intab(ds):=delin;
if p1<>sep then
begin
delin:=intab(p1);
intab(p1):=5 shift 12 + 128;
ds:=p1
end else ds:=delin:=0
end;
begin <*27:SL*>
subleading:=p1; SL:=false add (2*round(p1*2/3)+1)
end;
begin <*28:FL*>
minlead:=p1; FL:=false add (round(p1*2/3)+1)
end;
begin <*29:RM*>
q1:=p1/unit;
q2:=linewidth-q1+rmarg;
if q2<0 then typolerror(82,77,<:(LW-LM)<RM:>);
if startofline then
begin
linewidth:=q2;
rmarg:=q1
end
else srmarg:=q1
end;
<*30:LT*>;
begin <*31:HT*>
if p1=ds then typolerror(72,84,<:<char>:>);
intab(ht):=saveht;
if p1<>sep then
begin
saveht:=intab(p1); ht:=p1;
if mode=3 then intab(p1):=6 shift 12 + p1
end else
begin
ht:=saveht:=9;
intab(9):=if mode<>3 then 9 else 6 shift 12 + 9
end
end;
begin <*32:PF*>
if p1<5 and p1>0 then
begin pnfont:=p1; nopf:=false
end else
if p1=-1 then
begin pnfont:=rhfont; nopf:=true
end
else typolerror(80,70,<:<arg>:>)
end;
begin <*33:RT*>
if rtxt then typolerror(82,84,<:double text:>);
rtfont:=p1; q1:=i:=0;
for i:=i+1 while q1<>sep do
begin
if i>rtxtlim then typolerror(82,84,<:chars:>);
readmschar(in,q1);
if q1=8 then
begin
backspace(rmargtxt,i,false); i:=i-1
end else
begin
if q1>127 then delim(q1);
rmargtxt(i):=false add q1
end
end;
wrterr:=true;
rmargtxt(i-1):=false; rtxt:=true
end;
begin <*34:FS*>
if p1<-1 or p1>127 then typolerror(70,83,<:index(-1,128):>);
fs:=if p1=sep then 0 else p1
end;
begin <*35:CD*>
if p1>5 then typolerror(67,68,<:argument:>);
q1:=date(p1,dtxt);
if mode>1 then
begin
if lin+q1>linelim then typolerror(67,68,<:line: chars:>);
w:=w+1; if w>24 then typolerror(67,68,<:line: words:>);
pib(w):=lin;
for q2:=1 step 1 until q1 do
begin linebuf(lin):=dtxt(q2); lin:=lin+1
end;
accuw:=accuw+p1; pis(w):=lin-1
end else
begin
datemode:=true; dt:=1
end
end;
begin <*36:VS*>
q1:=p1/point; <*dim as leading, i.e. points*>
if pagelength-linecount>=q1 then
begin
q2:=q1/leading-1;
if startofline then outnl(if prognl then q2-1 else q2)
else vtsize:=q2;
dropjust:=true; prognl:=false
end else
begin
vtroom:=q1-pagelength+linecount;
newpage:=dropjust:=true; comno:=14
end
end;
begin <*37:LG*>
if p1>2 then typolerror(76,71,<:argument:>);
language:=p1
end;
begin <*38:PD*>
q1:=par(2); odd:=p1=1;
displ:=if q1>-1 then q1/unit else 0
end;
begin <*39:RD*>
intab(rfch1):=saverfch1;
saverfch1:=rfch1:=rfch2:=rfch2:=rfch4:=0;
p1:=32; for p2:=readmschar(in,p1) while p1=32 do;
if p2=2 then
begin repeatchar(in); read(in,rfzero); repeatchar(in)
end else
if p1=sep then
begin
if ref then writeref;
for q1:=1 step 1 until 100 do mref(q1):=0;
rfzero:=0; ref:=false; goto RDOUT
end else typolerror(82,68,<:argument:>);
for q1:=1,2,3,4 do
begin
p1:=32; for p2:=readmschar(in,p1) while p1=32 do;
if p1=44 then
begin p1:=32; for p2:=readmschar(in,p1) while p1=32 do;
end;
if p1=44 then typolerror(82,68,<:reference delimiter:>);
if p1=sep then
begin
case q1 of
begin
goto RDOUT; error(<:2. ref.delimiter:>,2) <*hard error*>;
goto RDASS; error(<:4. ref.delimiter:>,1)
end
end else
case q1 of
begin rfch1:=p1; rfch2:=p1; rfch3:=p1; rfch4:=p1
end
end delimiters;
p1:=32; for p2:=readmschar(in,p1) while p1=32 do;
if p1<>sep then typolerror(82,68,<:arguments:>);
RDASS:
if rfch1=ds or rfch1=ht and mode=3 or rfch1=45 or rfch1=95 then
typolerror(82,68,<:1. ref.delimiter:>);
saverfch1:=intab(rfch1); intab(rfch1):=9 shift 12 + rfch1;
RDOUT: digit(false)
end;
begin <*40:EQ*>
nlpar:=p1;
if prognl then
begin prognl:=false; nlpar:=nlpar-1;
end;
q1:=(pagelength-linecount)/leading;
if nlpar>q1 then
begin
if q1<1 then
begin savenlpar:=nlpar; nlpar:=2
end else
begin savenlpar:=nlpar-q1; nlpar:=q1+1
end;
newpage:=true
end;
dropjust:=eqmode:=true; savemode:=mode;
eqnl2:=if p2<2 then 1 else p2; comno:=1
end;
<*41:SS*> stdspace:=-,stdspace;
<*42:LC*> proofline:=-,proofline;
end case comno;
outtyp:
typol:=if comno=1 ! comno=12 then 1 else if comno=5 then 2 else
if comno=14 ! comno=25 then 3 else if comno=36
then 4 else if comno=10 then 5 else 6;
end typol;
procedure writeref;
begin integer i;
write(out,<:<10><10>Table of reference equivalences.<10>
The first number in a pair is the reference as written on the
object document, the second is the reference as read from the
source file.<10><10>:>);
i:=0;
for i:=i+1 while mref(i)<>0 do write(out,<<ddddd>,rfzero+i,
<: :>,mref(i),if i mod 4=0 then <:;<10>:> else <:; :>);
write(out,<:<10><10>:>)
end writeref;
integer procedure date(p,ba);
<*p: call value, p1; return value, width;
date: return value, number of characters*>
integer p; boolean array ba;
begin
integer d,m,y,i,j,k; real r1,r2;
integer field fi; zone zd(7,1,stderror); <*7 to keep false,3*>
r1:=r2:=0;
systime(1,0,r1); i:=systime(2,r1,r2);
d:=i//10000; m:=i mod 10000//100; y:=i mod 100;
i:=71; j:=0;
for i:=i+1 while i<y do j:=j+(if i//4*4=i/4*4 then 366 else 365);
i:=if y//4*4=i/4*4 then 29 else 28;
k:=-j;
if m>2 then
j:=j+(case m-2 of (31,62,92,123,153,184,215,245,276,306))+i
else if m=2 then j:=j+31;
j:=j+d-1; k:=k+j+1;
j:=(j+6) mod 7; if j=0 then j:=7; <*j=day in week*>
k:=k+4-j; k:=k mod (if i=29 then 366 else 365);
i:=k//7+1; <*i=week number*>
open(zd,0,<:SEHDATE:>,0);
if mode>1 then outchar(zd,32);
P: case p of
begin
write(zd,<<zd>,19,y,<:.:>,m,<:.:>,d);
case language of
begin
write(zd,<<d>,d,<:. :>,case m of (<:januar:>,<:februar:>,
<:marts:>,<:april:>,<:maj:>,<:juni:>,<:juli:>,<:august:>,
<:september:>,<:oktober:>,<:november:>,<:december:>),<: :>,
19,y);
write(zd,<<d>,d,if d=1 or d=21 or d=31 then <:st :> else
if d=2 or d=22 then <:nd :> else if d=3 or d=23 then <:rd :>
else <:th :>,case m of (<:January:>,<:February:>,<:March:>,
<:April:>,<:May:>,<:June:>,<:July:>,<:August:>,<:September:>,
<:October:>,<:November:>,<:December:>),<: :>,19,y)
end;
begin
case language of
begin
write(zd,case j of (<:mandag:>,<:tirsdag:>,<:onsdag:>,
<:torsdag:>,<:fredag:>,<:lørdag:>,<:søndag:>),<: den :>);
write(zd,case j of (<:Monday:>,<:Tuesday:>,<:Wednesday:>,
<:Thursday:>,<:Friday:>,<:Saturday:>,<:Sunday:>),<: the :>)
end;
p:=2; goto P
end;
case language of
begin
begin
write(zd,case j of (<:Mandag:>,<:Tirsdag:>,<:Onsdag:>,
<:Torsdag:>,<:Fredag:>,<:Lørdag:>,<:Søndag:>),<: den :>);
p:=2; goto P
end;
begin
p:=3; goto P
end
end;
case language of
begin
write(zd,<:uge :>,<<d>,i,<:, 19:>,y);
write(zd,<:Week :>,<<d>,i,<:, 19:>,y)
end
end p;
setpos(zd,24);
i:=j:=fi:=p:=0;
for i:=if i=3 then 1 else i+1 while j<37 do
begin
j:=j+1; fi:=fi+(if i=1 then 2 else 0);
k:=zd.fi shift (case i of (-16,-8,0)) extract 8;
ba(j):=false add k;
if k=0 then goto D;
p:=p+width(k)
end;
D: date:=j-1;
end date;
procedure loadprbuf(n,t); value n,t; integer n,t;
<*loads printbuf.
n=1, bit 0-11, t spaces;
n=2, bit 12-17, fount t;
n=3, bit 18-23, leading t*>
begin integer q1;
if w>23 then goto outlpr;
q1:=if printmask shift w<0 then printbuf(w) else 0;
printbuf(w):=case n of (
q1 shift (-12) shift 12 add t,
q1 shift (-18) shift 6 add t shift 12 add (q1 extract 12),
t shift 18 add (q1 extract 18));
if printmask shift w>=0 then
printmask:=printmask+1 shift (23-w);
outlpr:
end loadprbuf;
procedure printprbuf(t); value t; integer t;
<*prints the information in printbuf*>
begin integer q1;
write(pr,sp,t extract 12);
q1:=t shift (-12);
if q1<>0 then
begin
if q1 extract 6>0 then
write(pr,<:<60>ft:>,<<d>,q1 extract 6,<:<62>:>);
q1:=q1 shift (-6);
if q1>0 then
write(pr,<:<60>ld:>,<<d>,q1,<:<62>:>)
end
end printprbuf;
procedure placenum(numcode); value numcode; integer numcode;
comment write pagenumber according to the parameter numcode
from PN, pnfont from RH;
begin integer line,numw,dignum,s,m; boolean left;
if numcode=0 then goto fin;
dignum:=if pagnum<10 then 1 else if pagnum<100 then 2 else 3;
s:=case dignum of (real<<d>,real<<dd>,real<<ddd>);
left:=pagnum mod 2=0; m:=numcode;
line:=lmarg+rmarg + linewidth; numw:=dignum * width(49);
q1:= if m=1!m=2 then (line-numw)//2 else
if (m=5!m=4&-,left)&-,runhead!m=3&-,left then line-numw else
if (m=5!m=4&-,left)&runhead then line-accuw-censp-numw else 0;
if q1>0 then outspace(q1,false,-2);
outnum(pagnum,dignum,s);
if m=4&left&runhead then censp:=(line-accuw)//2-numw;
fin:
end placenum;
procedure outnum(p,d,s);value p,d,s;integer p,d; real s;
<*outputs the pagenumber p with d digits, layout s, and font pnfont*>
begin integer q1, q2;
if pnfont<>runfont then
begin outfont(pnfont); if machine>1 then adjwidth(pnfont)
end;
if printmode then write(pr,string s,p);
if setmode then
begin
q1:=p//100; q2:=p mod 100//10;
q1:=if q1>0 then q1+48 else 0; q2:=if d>1 then q2+48 else 0;
write(set,false add convert(q1),1,false add convert(q2),1,
false add convert(p mod 10+48),1);
end;
if pnfont<>runfont then
begin outfont(runfont); if machine>1 then adjwidth(runfont)
end;
end outnum;
procedure backspace(buf,p,norm);
value norm; boolean norm; integer p; boolean array buf;
comment processes a composite character: <char1><BS><char2>
or <char1><bs><char2><bs><char3>.
p-1 points in buf on char1.
norm is false when called from proc. typol.
The widest character is placed first.
If the composite character contain an underline or a overline
a common right edge is established in case of end of word else
a common left edge;
begin
integer q1,q2,q3,we,c1,c2,c3,wc1,wc2,wc3;
boolean wordend,three,underover;
boolean procedure readq(tex,t); integer t; boolean array tex;
comment;
begin
qread(tex,t,c2); qread(tex,t,we);
if we=8 then
begin comment 3-double composite char.;
qread(tex,t,c3); qread(tex,t,we);
readq:=true
end else
begin comment 2-double composite char.;
c3:=0; readq:=false
end;
t:=t-1
end readq;
procedure max(c1,c2,c3); integer c1,c2,c3;
comment max changes possible the positions of the call characters
so the widest is placed first and so on;
begin integer i,w1,w2,w3,s1,s2,s3; integer array pos(1:3);
for i:=1,2,3 do pos(i):=i;
w1:=width(c1); w2:=width(c2); w3:=width(c3);
if w1<w2 then
begin pos(1):=2;
if w2<w3 then begin pos(1):=3; pos(3):=1 end
else if w3>w1 then begin pos(2):=3; pos(3):=1 end
else pos(2):=1
end
else if w2<w3 then begin pos(2):=3; pos(3):=2 end;
s1:=c1; s2:=c2; s3:=c3;
c1:=case pos(1) of (s1,s2,s3);
c2:=case pos(2) of (s1,s2,s3);
c3:=case pos(3) of (s1,s2,s3)
end max;
if p>linelim-5 or p>mtextlim-5 then error(<:line: chars:>,2);
c1:=buf(p-1) extract 7; p:=p-1;
if norm then accuw:=accuw-width(c1);
if headmode then three:=readq(rhead,rh) else
begin
if notemode then
begin readfnchar(fnote,c2); readfnchar(fnote,we)
end else
begin readmschar(in,c2); readmschar(in,we)
end;
if we=8 then <*comp.chars. in three levels*>
begin
if notemode then
begin readfnchar(fnote,c3); readfnchar(fnote,we)
end else
begin readmschar(in,c3); readmschar(in,we)
end;
three:=true
end else <*comp.chars. in two levels*>
begin c3:=0; three:=false
end;
if notemode then repeatchar(fnote) else repeatchar(in)
end;
if we=8 then
begin
error(<:composite chars:>,if check then 1 else 2);
for q1:=readmschar(in,we) while
(we<>ht and we<>10 and we<>12 and we<>32 and we<>sep) do;
end;
wordend:=we=ht or we=10 or we=12 or we=32 or we=sep;
comment place the widest char. in c1 and the width in wc1;
max(c1,c2,c3);
wc1:=width(c1); wc2:=width(c2); wc3:=width(c3);
if diablo then wc1:=wc2:=wc3:=1;
if c2=95 or c2=126 then
begin comment a under- or overline must be first char.;
q1:=c1; q2:=wc1; c1:=c2; wc1:=wc2; c2:=q1; wc2:=q2;
end;
underover:=if c1=95 or c1=126 then true else false;
if wordend and underover then
begin comment terminated an under- or overlined word in a nice way;
for q1:=p step 1 until p+wc1-wc2-1 do buf(q1):=false add 2;
comment iso 2 is used to signify preceding bss used by the
hyph. routine;
p:=p+wc1-wc2;
end;
buf(p):=false add c1; p:=p+1;
q3:=p+(if underover and wordend then wc2 else wc1)-1;
for q1:=p step 1 until q3 do buf(q1):=bs;
p:=p+(if wordend then wc2 else wc1);
buf(p):=false add c2;
p:=p+1;
if three then
begin
for q1:=p step 1 until p+wc2-1 do buf(q1):=bs;
p:=p+wc2;
buf(p):=false add c3; p:=p+1
end;
if underover then
begin
if three then
begin
for q1:=p step 1 until p+wc2-wc3-1 do buf(q1):=u1;
p:=p+wc2-wc3
end;
if norm then accuw:=accuw+width(c2);
end else
begin
for q1:=p step 1 until p+wc1-(if three then wc3 else wc2)-1 do
buf(q1):=u1;
p:=p+wc1-(if three then wc3 else wc2);
if norm then accuw:=accuw+width(c1)
end;
back:=true;
end backspace;
integer procedure hypcall(wid); integer wid;
comment generates a call of the hyphenation routine hyph
and takes care of placing a eventual hyphen in linebuf,
if hyphenation is successfull wid is assigned the length
in units from the breakpoint to the end of word;
begin integer n1,n2,n3,n4,a,b,i,q1;
n1:=pib(w); n4:=pis(w); linebuf(n4+1):=false;
a:=accuw+(w-1)*maxspace - linewidth + width(45);
b:=accuw+(w-1)*minspace - linewidth + width(45);
i:=pis(w)+1; q1:=0;
for i:=i-1 while q1<=a do
begin
if i=0 then error(<:justification:>,if check then 1 else 2)
else q1:=q1 + width(linebuf(i) extract 7)
end;
n2:=i+1; if n2<n1 then n2:=n1;
i:=pis(w)+1; q1:=0;
for i:=i-1 while q1<b do q1:=q1 + width(linebuf(i) extract 7);
n3:=i+1; if n3<n1 then n3:=n1;
if hypmode<3 then setposition(c,0,0);
hypcall:=q1:=hyph(linebuf,n1,n2,n3,n4);
if hypmode<3 then setposition(c,0,0);
if q1<>0 then
begin comment calculate wid;
q1:=abs q1+1; wid:=0;
for i:=q1 step 1 until pis(w) do
wid:=wid + width(linebuf(i) extract 7)
end
else wid:=0
end hypcall;
procedure justpc(t); value t; integer t;
comment adjust pc and pco after putting t characters in codebuf;
begin
if w>23 then error(<:line: words:>,2);
pc:=pc+t;
pco(w):=if codemode then pco(w)+t else t;
if -,codemode then
begin codemask:=codemask+1 shift (23-w); codemode:=true
end
end just pc;
procedure outspace(un,m,p); value un,m,p; integer un,p; boolean m;
comment shares un units in a minimum number of space characters,
if m=true the characters are placed in codebuf (printbuf),
if m=false the characters are outputted via the zone set(pr),
if p>-1 & ulinemask shift p<0
then the spaces are underlined (only set.mach.),
if p=-1 only output for setting machine if setmode,
if p=-2 output for setting machine and printer;
begin integer i,a1,a2,a3,q1; boolean b;
if un<=0 then goto esp;
if setmode then
begin
case machine of
begin
begin <*printer*>
if p>-1 & ulinemask shift p<0 then
write(set,false add 95,un)
else if m then
begin for i:=pc step 1 until pc+un-1 do codebuf (i):=sp;
justpc(un)
end
else write(set,sp,un)
end;
begin <*diablo*>
a1:=un//normsp; a2:=un mod normsp;
if p>-1 and ulinemask shift p<0 then
begin
write(set,false add 95,a1);
if a2>0 then <*graphics on, bs, graphics off, _*>
write(set,<:<27>3:>,false add 8,normsp-a2,<:<27>4<95>:>)
end
else
begin
if a2>0 then
begin
if m then
begin
codebuf(pc):=codebuf(pc+4):=false add 27;
codebuf(pc+1):=codebuf(pc+5):=false add 31;
codebuf(pc+3):=sp;
codebuf(pc+6):=
false add (if false add runfont then 13 else 11);
codebuf(pc+2):=false add (a2*2+1)
end
else
write(set,<:<27><31>:>,false add (a2*2+1),1,<: <27><31>:>,
false add (if false add runfont then 13 else 11),1);
end;
if m then q1:=if a2>0 then pc+7 else pc;
if a1>0 then
begin
if m then
begin
for i:=q1 step 1 until q1+a1-1 do
codebuf(i):=sp
end
else write(set,sp,a1)
end;
if m then justpc(a1+(if a2>0 then 7 else 0))
end
end
end case;
end setmode;
if p=-2 & printmode then
begin comment output for printer;
q1:=un/normw; q1:=if q1=0 then 1 else q1;
if m then
begin
printbuf(w):=if printmask shift w<0 then
printbuf(w) shift (-12) shift 12 + q1 else q1;
if printmask shift w>=0 then printmask:=printmask+1 shift (23-w)
end
else write(pr,sp,q1)
end
;esp:
end outspace;
procedure outfont(f); value f; integer f;
comment generates output via zone set according to font no. f;
begin runfont:=f;
if setmode then outchar(set,fontcode(f)); defhmi(f)
end outfont;
procedure settext(p); value p; integer p;
comment outputs a textunit placed in linebuf(pib(p):pis(p))
via zone set converted to the actual typesetting code;
begin integer i,v,u,t,u1,ps; boolean bo;
ps:=pis(p);
for i:=pib(p) step 1 until ps do
begin
u:=linebuf(i) extract 12;
if u>127 then
begin
u1:=u shift (-7); u:=u extract 7
end else u1:=0;
blind:=blind and u=32;
v:=convert(u);
case machine of
begin
outchar(set,v);
begin <*diablo*>
if u1>0 then
write(set,<:<27><30>:>,SL,1,
if u1=1 then <:<27>D:> else <:<27>U:>,
false add v,1,
if u1=1 then <:<27>U:> else <:<27>D:>,
<:<27><30>:>,LD,1)
else if u=30 or u=31 then
begin
t:=if u=30 then (linecount-subleading)
else (linecount+subleading);
bo:=if u=30 then (t>=0)
else (t<=pagelength or notemode);
if bo then
begin linecount:=t;
write(set,<:<27><30>:>,SL,1,
if u=30 then <:<27>D:> else <:<27>U:>,
<:<27><30>:>,LD,1)
end
end
else outchar(set,v)
end diablo;
end machine;
end
end settext;
procedure setmtext(s); string s;
begin
integer i,v,u,q1,oldfont,q2,q3,u1,t,txtfont;
boolean bw,right,bo;
i:=q1:=0; oldfont:=runfont; u:=-1; bw:=true;
right:=real(s)=real<:right:>;
txtfont:=if right then rtfont else mtfont;
if right then
begin
for i:=i+1 while u<>0 do
begin u:=rmargtxt(i) extract 7; q1:=q1+width(u)
end;
if q1>rmarg then error(<:RT: width:>,1)
else outspace(rmarg-q1,false,-2);
i:=q1:=0; u:=-1
end;
if txtfont<>runfont then
begin outfont(txtfont); if machine>1 then adjwidth(txtfont)
end;
for i:=i+1 while u<>0 do
begin
if right then goto RDCH;
u:=margtext(i) extract 7;
q1:=q1+width(u);
if q1>lmarg and -,nstext then
begin outspace(lmarg-q1+width(u),false,-2);
goto errmarg
end
else
if q1>linewidth and nstext and bw then
begin
error(<:linewidth exceeded:>,1); bw:=false
end;
RDCH:
if setmode then
begin
u:=(if right then rmargtxt(i) else margtext(i)) extract 12;
if u>127 then
begin
u1:=u shift (-7); u:=u extract 7;
end else u1:=0;
v:=convert(u);
case machine of
begin
outchar(set,v);
begin <*diablo*>
if u1>0 then
write(set,<:<27><30>:>,SL,1,
if u1=1 then <:<27>D:> else <:<27>U:>,
false add v,1,
if u1=1 then <:<27>U:> else <:<27>D:>,
<:<27><30>:>,LD,1)
else if u=30 or u=31 then
begin
t:=if u=30 then (linecount-subleading)
else (linecount+subleading);
bo:=if u=30 then t>=0 else t<=pagelength;
if bo then
begin linecount:=t;
write(set,<:<27><30>:>,SL,1,
if u=30 then <:<27>D:> else <:<27>U:>,
<:<27><30>:>,LD,1)
end
end
else outchar(set,v)
end diablo;
end machine;
end setmode;
if printmode then
begin
u:=(if right then rmargtxt(i) else margtext(i)) extract 7;
v:=if u>31 then u
else if u>14 and u<30 then
(if u-14=6 then 32 else sstab(u-14) extract 7)
else if u=2 or u=5 then 8
else if u<15 then u
else 0;
outchar(pr,v)
end printmode;
end u<>0;
if nstext or right then goto resetfont;
outspace(lmarg-q1,false,-2);
errmarg:
if lmarg-q1<0 then error(<:LT: width:>,1);
resetfont:
if txtfont<>oldfont then
begin outfont(oldfont); if machine>1 then adjwidth(oldfont)
end;
if nstext then nstext:=false
else if right then rtxt:=false
else mtext:=true;
end setmtext;
procedure outcode(p); value p; integer p;
comment outputs code placed in codebuf(pc:pc+pco(p)-1) via zone set;
begin integer i,t,q2;
t:=pc+pco(p)-1;
for i:=pc step 1 until t do
begin
q2:=codebuf(i) extract 7;
if q2>16 and q2<21 then runfont:=q2-16;
outchar(set,q2)
end;
pc:=t+1
end outcode;
procedure outnl(n); value n; integer n;
comment outputs n <NL> characters and adjusts linecount;
begin integer p;
if leading>18 and printer then
p:=leading//stdlead*n else p:=n;
if setmode then write(set,nl,p);
if displ>0 and p>0 then
begin
if -,odd or (odd and pagnum mod 2=1) then outspace(displ,false,-1)
<*odd means displacement for odd pagenumbers only*>
end;
if printmode then
begin
if diablo then p:=leading//stdlead*n;
write(pr,nl,if p=0 then 1 else p);
if proofline then write(pr,<<zdd>,msline mod 1000,<: :>);
end;
if -,notemode&n>0 then linecount:=linecount+n*leading
end outnl;
integer procedure qread(tex,p,v);
boolean array tex; integer p,v;
comment reads next character into v from tex and increase the
pointer p by 1,
qread is assigned the class of v defined as the
actual content of intab,
v=0 indicates end of string;
begin
v:=tex(p) extract 12; p:=p+1;
qread:=if (v>15 and v<32) or v>127 then 5 else
intab(v) shift (-12) extract 4;
if v=0 then
begin readstop(v); if v=-1 then p:=p-1
end
end qread;
procedure readstop(c); integer c;
begin
if datemode then
begin datemode:=word:=false; goto OUTQR
end;
if first & linewidth-accuw-(w-1)*normsp>=0 then dropjust:=true
else
if first & linewidth-accuw-(w-1)*minspace<0 then c:=-1;
word:=more:=false;
OUTQR:
end readstop;
procedure delim(v); integer v;
begin integer p,p1,q;
integer procedure rd(t); integer t;
rd:=if headmode then qread(rhead,rh,t) else
if notemode then readfnchar(fnote,t) else readmschar(in,t);
if v shift (-7) extract 1 = 1 then
begin comment special delimiter, must by followed
by u,d,h,l,b, or i
return value for v
after return value
b 5 (backspace)
i 1 (next char ignored)
u 30 (half LF up)
d 31 (half LF down)
h<c> c+128 (half LF up <c> half LF down)
l<c> c+256 (half LF down <c> half LF up)
;
rd(p);
if p=98 then v:=5 else
if p=105 then
begin
if rd(p1)<>2 then <*q=2 for p1=10,12,and (for mode=1) 32*>
begin
if wrterr then error(<:DS: invalid char:>,1); wrterr:=false
end else
v:=1 <*convert(1)=0 , width(1)=0*>
end else
if p=117 then v:=30 else
if p=100 then v:=31 else
if p=104 or p=108 then
begin
q:=rd(p1);
if q<4 or q>6 or p1>127 then
begin
if wrterr then error(<:DS: invalid char:>,1);
v:=63; wrterr:=false
end else
v:=(if p=104 then 128 else 256)+p1
end
else
begin
if wrterr then error(<:DS: invalid char:>,1);
v:=63; wrterr:=false
end;
end
end delim;
procedure notsep(s); label s;
comment used in notemode and headmode when separator
is changed between the command FN or RH and the setting;
begin
klass:=5; goto s
end notsep;
procedure calcensp;
comment calculates censp as the spacewidth in units to be
generated to get the textline centered or quadded right;
begin
if accuw>0 then
begin
censp:=if mode=4!headmode then
(linewidth+(if headmode then lmarg+rmarg else 0)-accuw)//2
else linewidth-accuw;
if censp<0 then censp:=0;
end
else censp:=0
end calcensp;
procedure setclass(just); value just; boolean just;
comment just=true: set input classes for justification mode
just=false: set input classes for nonjust, tabul,
centering and quadding right mode;
begin integer i;
if just then
begin
intab(32):=2 shift 12+32;
if intab(95) extract 7=95 then intab(95):=4 shift 12+95;
if intab(45) extract 7=45 then intab(45):=6 shift 12+45;
intab(ht):=saveht;
end else
begin
intab(32):=5 shift 12+32;
for i:=45,95 do
if intab(i) extract 7=i then intab(i):=5 shift 12+i;
intab(ht):=if mode<>3 then saveht else 6 shift 12 + ht
end;
end setclass;
procedure defvmi; <*diablo: define Vertical Motion Index*>
begin
if setmode and diablo then write(set,<:<27><30>:>,LD,1);
if printmode then printprbuf(leading shift 18);
end VMI;
procedure defhmi(ft); <*diablo: define Horizontal Motion Index*>
value ft; integer ft;
begin
if setmode and diablo then
write(set,<:<27><31>:>,if false add ft then <:<13>:> else <:<11>:>);
if printmode then printprbuf(ft shift 12)
end HMI;
procedure adjwidth(ft); <*diablo: adjust type width*>
value ft; integer ft;
begin
integer i,w;
if diablo then
begin
w:=if false add ft then 6 else 5;
for i:=15 step 1 until 22,32 step 1 until 126 do width(i):=w;
width(2):=width(5):=-w;
normsp:=w; notenumw:=4*w;
normw:=w; maxspace:=2*w-2; minspace:=w-1
end
end adjwidth;
integer procedure references;
begin integer i,j,tref,wd; boolean outdigit;
procedure print(ch); value ch; integer ch;
begin linebuf(lin):=false add ch; lin:=lin+1; wd:=wd+width(ch)
end;
ref:=true; intable(0); wd:=0;
if rfch3<>0 then print(rfch3);
R: if notemode then read(fnote,tref) else read(in,tref); i:=0;
for i:=i+1 while mref(i)<>tref and mref(i)<>0 do
if i=100 then error(<:ref. index > 99:>,2);
if mref(i)=0 then mref(i):=tref; tref:=i+rfzero;
if tref>9999 then error(<:ref. no. > 9999:>,2);
outdigit:=false;
for i:=1,2,3,4 do
begin
j:=case i of (tref//1000,tref//100,tref//10,tref mod 10);
outdigit:=outdigit or j>0;
if outdigit then print(48+j)
end;
if notemode then repeatchar(fnote) else repeatchar(in);
j:=32;
for i:=i while j=32 do
if notemode then readfnchar(fnote,j) else readmschar(in,j);
if j<>rfch2 then
begin
if j<>44 then error(<:ref. terminator:>,2);
print(44); goto R
end;
if rfch4<>0 then print(rfch4);
intable(intab); references:=wd
end references;
procedure setpos(z,zdes16); value zdes16; zone z; integer zdes16;
begin integer array zdes(1:20);
if notearea and zdes16<>24 then setposition(fnote,0,0)
else
begin
getzone6(z,zdes);
if zdes(13)=3 then write(z,false,3); <*for 3, see proc. date*>
zdes(12):=1; zdes(13):=0; zdes(14):=zdes(19); zdes(16):=zdes16;
setzone6(z,zdes)
end
end setpos;
procedure cut(z,b);
value b; zone z; boolean b;
begin
integer i; integer array ia(1:20);
getzone6(z,ia);
if b then write(z,false,100,false add
(if ia(1)=4 then 25 else 0),1);
getzone6(z,ia);
if ia(1)=4 then
begin
i:=ia(9)+1; monitor(42)lookup:(z,0)tail:(ia);
ia(1):=i; monitor(44)change:(z,0)tail:(ia)
end
end cut;
\f
<* Start of programme *>
begin <*block with connect*>
procedure connect(z,name); zone z; array name;
begin integer array tail(1:10);
open(z,4,name,0);
i:=monitor(42)lookup:(z,0,tail);
if i<>0 then harderror(i,name)
end connect;
procedure harderror(q,name); value q; integer q; array name;
begin
i:=1; write(out,<:***typol end, connect :>,
string name(increase(i)),q,nl,1);
fpproc(7,0,0,3) <*break to parent*>
end harderror;
nl:=false add 10; sp:=false add 32;
ff:=false add 12; bs:=false add 5;
if printmode then connect(pr,prooffile);
if setmode then connect(set,objfile);
if notearea then connect(fnote,notefile)
else open(fnote,0,<:SEHNOTE:>,1 shift 5);
if hypmode=1 or hypmode=3 then connect(hyphinf,hyphfile);
if hypmode<3 then open(c,8,cons,0);
if sourcefile(1)<>real<::> then
begin
fpproc(29,0)stack:(in,0);
fpproc(27,i)connect:(in,sourcefile);
if i<>0 then harderror(i,sourcefile)
end;
if test then
begin
write(out,
<:<10>machine :>,machine,
<:<10>notearea :>,if notearea then <:yes:> else <:no:>,
<:<10>setmode :>,if setmode then <:yes:> else <:no:>,
<:<10>printmode :>,if printmode then <:yes:> else <:no:>,
<:<10>hypmode :>,hypmode);
outchar(out,10);
setposition(out,0,0)
end;
end block with connect;
systime(1,0,ra(1));
write(out,<:<10>typesetting begin. :>,<< zd dd dd>,
systime(2,ra(1),ra(2)),ra(2),nl,1);
<*initialize tables and variables dependent of machine*>
case machine of
begin
begin comment RC 610 Line Printer;
for i:=0 step 1 until 14,21 step 1 until 31,127 do
width(i):=convert(i):=0; <*i=1 is used in delim*>
for i:=32 step 1 until 126 do convert(i):=i;
for i:=15 step 1 until 20 do
convert(i):=case i-14 of (37,63,34,125,93,32);
for i:=15 step 1 until 20,32 step 1 until 126 do width(i):=1;
convert(5):=8;
width(5):=width(8):=-1;
unit:=2.54;
u1:=false; <*justo: u1:=false add 1; convert(1):=8;*>
normsp:=1; for i:=1,2,3,4 do fontcode(i):=127;
normw:=1.0; notenumw:=4;
minspace:=1; maxspace:=2; maxfactor:=0.67; minfactor:=1.0;
end Printer;
begin comment Diablo 1620;
for i:=0 step 1 until 14,23 step 1 until 31,127 do
width(i):=convert(i):=0; <*i=1 is used in delim*>
for i:=32 step 1 until 126 do convert(i):=i;
for i:=15 step 1 until 22 do
convert(i):=case i-14 of(35,36,37,38,64,32,94,126);
convert(5):=convert(2):=8; convert(10):=10;
unit:=25.4/60; <* dim: mm/unit.
Note that the unit yields carriage increments in steps of
1/60 in (not 1/120 in); this is due to the operation of
the graphics mode of the Diablo, cf. the Diablo manual.*>
minfactor:=1.3; maxfactor:=0.6; u1:=false;
<*u1=step one unit; not used because the Diablo is operated with
the same width for all characters*>
for i:=1,2,3,4 do fontcode(i):=16+i;
<*DC1,DC2,DC3,DC4. fount 1,3: 10 ch/in; fount 2,4: 12 ch/in*>
end Diablo
end case machine;
comment initialize variables independent of machine;
begin
integer procedure q(s); string s;
q:=real s shift (-32) extract 16;
for i:=1 step 1 until typlim do comtab(i):=case i of (
q(<:nl:>),q(<:rj:>),q(<:sj:>),q(<:ft:>),q(<:np:>),q(<:ta:>),
q(<:lm:>),q(<:lw:>),q(<:fg:>),q(<:fn:>),q(<:sc:>),q(<:ns:>),
q(<:ts:>),q(<:ps:>),q(<:rh:>),q(<:sb:>),q(<:ct:>),q(<:qr:>),
q(<:pl:>),q(<:pn:>),q(<:ld:>),q(<:mt:>),q(<:cm:>),q(<:se:>),
q(<:ef:>),q(<:ds:>),q(<:sl:>),q(<:fl:>),q(<:rm:>),q(<:lt:>),
q(<:ht:>),q(<:pf:>),q(<:rt:>),q(<:fs:>),q(<:cd:>),q(<:vs:>),
q(<:lg:>),q(<:pd:>),q(<:rd:>),q(<:eq:>),q(<:ss:>),q(<:lc:>));
end;
ds:=fs:=delin:=0; ht:=saveht:=9;
for i:=0 step 1 until 31,127 do intab(i):=i; intab(25):=8 shift 12+25;
for i:=10,12,32 do intab(i):=2 shift 12+i;
intab(3):=10 shift 12+3; <*ETX is used in footnotes*>
intab(8):=7 shift 12+8;
for i:=33 step 1 until 126 do intab(i):=5 shift 12+i;
intab(95):=4 shift 12+95; intab(45):=6 shift 12+45;
sep:=42; intab(42):=3 shift 12+42;
tableindex:=0; intable(intab);
for i:=1 step 1 until 18 do sstab(i):=0;
compinit:=startofword:=toptext:=notnl:=wrterr:=nopf:=true;
runhead:=finis:=headmode:=notemode:=saveword:=datemode:=
hypdigit:=savecode:=hyp:=spamax:=progpage:=back:=stdspace:=
toppage:=eqmode:=writeeq:=proofline:=false;
subleading:=6; minlead:=leading:=stdlead:=12; <* dim: point *>
FL:=SL:=LD:=false add 9;
point:=25.4/72; <* dim: mm/point *>
comment A4-format;
folip:=297/point; upperp:=30/point; textp:=235/point;
headp:=18/point; nump1:=10/point; pagelength:=textp+upperp;
chapstart:=chapstd:=30/point;
lmarg:=rmarg:=newpar:=0; linewidth:=160/unit;
newpstd:=10/unit;
pagnum:=1; vtsize:=vtroom:=nummode:=msline:=displ:=savenlpar:=0;
font:=pnfont:=runfont:=rtfont:=rhfont:=fn:=lineno:=nlpar:=1;
if machine>1 then adjwidth(font);
tabcount:=h1:=h2:=h3:=sh1:=sh2:=sh3:=c1:=c2:=sc1:=sc2:=0;
w:=codemask:=printmask:=ulinemask:=wid:=hypno:=rh:=0;
language:=mode:=1;
l1:=extend 1;
p0mask:= extend 0 + l1 shift 45 + l1 shift 44 + l1 shift 36
+ l1 shift 30 + l1 shift 29 + l1 shift 22 + l1 shift 6
+ l1 shift 5;
<*RJ, SJ, SC, CT, QR, EF, SS, LC*>
p1mask:= extend 0 + l1 shift 43 + l1 shift 40 + l1 shift 39
+ l1 shift 38 + l1 shift 37 + l1 shift 34 + l1 shift 26
+ l1 shift 25 + l1 shift 20 + l1 shift 19 + l1 shift 18
+ l1 shift 17 + l1 shift 15 + l1 shift 14 + l1 shift 12
+ l1 shift 11 + l1 shift 10;
<*FT, LM, LW, FG, FN, TS, LD, MT,
SL, FL, RM, LT, PF, RT, CD, VS, LG*>
p2mask:= extend 0 + l1 shift 46 + l1 shift 42 + l1 shift 41
+ l1 shift 35 + l1 shift 33 + l1 shift 32 + l1 shift 28
+ l1 shift 27 + l1 shift 9 + l1 shift 7;
<*NL, NP, TA, NS, PS, RH, PL, PN, PD, EQ*>
p3mask:= extend 0 + l1 shift 31 + l1 shift 24 + l1 shift 23
+ l1 shift 21 + l1 shift 16 + l1 shift 13 + l1 shift 8;
<*SB, CM, SE, DS, HT, FS, RD*>
stmask:= extend 0 + l1 shift 37 + l1 shift 35 + l1 shift 32
+ l1 shift 25 + l1 shift 24 + l1 shift 17 + l1 shift 14
+ l1 shift 7;
<*FN, NS, RH, MT, CM, LT, RT, EQ*>
figroom:=linecount:=figsize:=fnoteno:=censp:=saverfch1:=rfch1:=0;
for i:=1 step 1 until 100 do mref(i):=0;
slmarg:=srmarg:=swidth:=-1;
newpage:=ssaveword:=ssavecode:=smtext:=mtext:=
nstext:=prognl:=rtxt:=ref:=false;
if printmode then outchar(pr,12);
ra(1):=systime(1,0,ra(2)); blocksread:=0;
goto lineinit;
\f
pageshift:
if compinit then
begin
compinit:=false;
if printmode then
begin
q1:=date(1,dtxt);
write(pr,<:Proof for :>,if diablo then <:diablo, :> else
<:printer, :>);
for q2:=1 step 1 until q1 do outchar(pr,dtxt(q2) extract 7);
outchar(pr,46);
end;
goto firstpage
end;
ssaveword:=ssavecode:=false;
if saveword then
begin comment save information about word to be transferred
to next page;
ssaveword:=true; saveword:=false;
if h2-h1>wordlim then
begin
error(<:saveword: chars:>,if check then 1 else 2);
h2:=wordlim;
h3:=if h3>h2 then h2-1 else h3
end;
shyp:=hyp; sh1:=h1; sh2:=h2; sh3:=h3;
for i:=0 step 1 until h2-h1 do swordbuf(i):=linebuf(i+h1);
end;
if savecode then
begin comment save information about code to be transferred
to next page;
ssavecode:=true; savecode:=false;
sc1:=c1; sc2:=c2
end;
if fnoteno=0 then goto pagenumb;
comment write footnotes in justifying mode;
if newpage ! finis then outnl((pagelength-linecount)/leading);
comment if pageshift because of PS or EF then lead to bottom;
q1:=width(convert(fs));
if q1>0 then
begin
q1:=round((linewidth+lmarg+rmarg)/q1);
if setmode then write(set,false add fs,q1);
if printmode then write(pr,false add fs,q1)
end;
outnl(1); <* end separation between text and footnotes *>
if mode<>1 then setclass(true);
savelead:=leading; saveLD:=LD;
if leading<>minlead & shiftlead then
begin comment use minleading for footnotes;
leading:=minlead; LD:=FL; defvmi
end;
savemd:=mode; mode:=1; notemode:=true;
savell:=linewidth; savelmarg:=lmarg; savermarg:=rmarg;
linewidth:=linewidth+lmarg+rmarg; lmarg:=rmarg:=0;
oldfont:=notefont:=runfont;
fcount:=0; fn:=1; setpos(fnote,0);
outnote:
fcount:=fcount+1; accuw:=0;
if fcount>maxnotelim then error(<:FN: no>9:>,2);
if fcount<=fnoteno then
begin comment more footnotes;
q1:=fnfont(fcount);
if q1<> notefont then
begin comment change font;
notefont:=q1;
outfont(q1); if machine>1 then adjwidth(q1)
end;
if setmode then write(set,false add convert(fcount+48),1,
false add convert(41),1,sp,2);
if printmode then write(pr,<<d>, fcount,<:)__:>);
accuw:=accuw+notenumw;
goto notestart
end
else
begin comment restore variables;
if savemd <>1 then setclass(false);
if leading<>savelead then
begin leading:=savelead; LD:=saveLD; defvmi
end;
outnl(nlpar+1); <*SEH: adjust linecount error before notemode*>
lmarg:=savelmarg; rmarg:=savermarg;
mode:=savemd; fnoteno:=0;
linewidth:=savell; notemode:=false;
if notefont<>oldfont then
begin outfont(oldfont); if machine>1 then adjwidth(oldfont)
end
end;
pagenumb:
if nummode=1 ! nummode=3 then
begin <*place pagenumber at pagebottom*>
outnl((folip-linecount-nump1)/leading);
placenum(nummode)
end;
pagnum:=pagnum+1;
if printmode then outchar(pr,12);
firstpage:
if setmode then
begin
outchar(set,case machine of (12,139));
defvmi; defhmi(runfont)
end;
<*position on page limit*>
if finis then
begin
continue:=compchar and (setmode and printer or printmode);
goto exit
end;
fnoteno:=linecount:=0; fn:=nlpar:=lineno:=1; setpos(fnote,0);
shiftlead:=false;
if nummode=2 then
begin <*pagenumber centered on pagestop*>
outnl(nump1/leading); lineno:=2;
placenum(nummode); outnl((headp-nump1)/leading)
end
else outnl(headp/leading);
if (nummode=4 ! nummode=5) & -,runhead then
begin comment pagenumber to left or right and no head;
placenum(nummode); outnl((upperp-headp)/leading); lineno:=2
end
else if runhead then
begin comment running head;
if mode=1 then setclass(false);
headmode:=line1:=true; rh:=1;
savelead:=leading; saveLD:=LD;
if leading<>stdlead then
begin leading:=stdlead; LD:=false add 9; defvmi
end;
goto lineinit;
headlab:
headmode:=false;
if font<>runfont then
begin outfont(font); if machine>1 then adjwidth(font)
end;
if savelead<>leading then
begin leading:=savelead; LD:=saveLD; defvmi
end;
if mode=1 then setclass(true);
outnl((upperp-linecount)/leading)
end
else outnl((upperp-headp)/leading);
comment position is now on first normal line;
if newpage then
begin <*PS*>
outnl((chapstart-upperp)/leading); newpage:=false
end;
if vtroom>0 then
begin
q1:=pagelength-linecount;
if vtroom<=q1 then
begin outnl(vtroom/leading); vtroom:=0;
end else
begin outnl(q1/leading+1); vtroom:=vtroom-q1
end
end;
if figroom>0 then
begin comment figure(s) saved from previous page;
q1:=pagelength-linecount;
if figroom<=q1 then
begin outnl(figroom/leading); figroom:=0;
end else
begin outnl(q1/leading+1); figroom:=figroom-q1
end
end;
if savenlpar>0 then
begin
q1:=(pagelength-linecount)/leading;
if savenlpar<=q1 then
begin outnl(savenlpar); savenlpar:=0
end else
begin outnl(q1+1); savenlpar:=savenlpar-q1
end
end;
if ssaveword then
begin comment restore inf. about word to be saved;
saveword:=true;
hyp:=shyp; h1:=sh1; h2:=sh2; h3:=sh3;
for i:=0 step 1 until h2-h1 do linebuf(h1+i):=swordbuf(i);
end;
if ssavecode then
begin comment restore inf. about code to be saved;
savecode :=true; c1:=sc1; c2:=sc2;
end;
toptext:=true;
if progpage then
begin progpage:=false; toppage:=true;
end;
\f
lineinit:
if smtext then
begin comment margin text in the following line;
setmtext(<:left:>); smtext:=toptext:=false
end;
if slmarg>-1 then
begin
q1:=linewidth;
linewidth:=(if swidth>-1 then swidth else linewidth)
- slmarg+lmarg;
if linewidth<0 then
begin
error(<:LM>(LW-RM):>,if check then 1 else 2);
linewidth:=q1; slmarg:=0
end;
lmarg:=slmarg; slmarg:=-1
end;
if srmarg>-1 then
begin
q1:=linewidth;
linewidth:=(if swidth>-1 then swidth else linewidth)
-srmarg+rmarg;
if linewidth<0 then
begin
error(<:RM>(LW-LM):>,if check then 1 else 2);
linewidth:=q1; srmarg:=0
end;
rmarg:=srmarg; srmarg:=-1
end;
if swidth>-1 then
begin
q1:=linewidth;
linewidth:=swidth-lmarg-rmarg;
if linewidth<0 then
begin
error(<:LW<(LM+RM):>,if check then 1 else 2);
linewidth:=q1
end;
swidth:=-1
end;
if vtsize>0 then
begin outnl(vtsize); vtsize:=0
end;
if figsize>0 then
begin outnl(figsize); figsize:=0
end;
accuw:=0;
if notemode then
begin outspace(notenumw,false,-2); accuw:=notenumw
end;
notestart:
q1:=nlpar; lin:=pc:=nlpar:=1;
more:=first:=startofline:=true; codemode:=dropjust:=false;
if notemode then goto just; comment footnotes;
if headmode then goto centrh;
if nstext then
begin comment set new section text;
if lmarg>0 and q1>0 then outspace(lmarg,false,-2);
comment only if <linefeed> in NS command>0;
setmtext(<:nstxt:>); toptext:=false; outnl(1)
end;
if linecount>=pagelength then
begin progpage:=true; goto pageshift
end;
if newpar>0 then
begin comment new paragraph;
outspace(newpar,false,-2); accuw:=newpar; newpar:=0;
end;
goto case mode of (just,nonjust,tabul,center,centrh);
just:
if saveword then
begin comment word or part of word from previous line;
if hyp then
begin comment hyphenation in previous line;
linebuf(1):=false add h3; accuw:=accuw+width(h3);
i:=2; q1:=h2-h1+2;
end
else
begin i:=1; q1:=h2-h1+1
end;
j:=0;
for i:=i step 1 until q1 do
begin
linebuf(i):=linebuf(h1+j); j:=j+1;
accuw:=accuw+width(linebuf(i) extract 7)
end;
w:=pib(1):=1; pis(1):=q1;
lin:=q1+1; hyp:=false;
if ulinemask<0 then
begin comment word followed by a underline was saved;
ulinemask:=1 shift 22
end else ulinemask:=0;
toppage:=startofline:=prognl:=false
end else ulinemask:=0;
if savecode then
begin comment code saved from previous line;
for j:=c2 step 1 until c2+c1-1 do
codebuf(pc+j-c2):=codebuf(j);
justpc(c1);
end;
bool1:=notemode and saveword and v=0 or linewidth-accuw<=0;
saveword:=savecode:=false;
if bool1 then goto outline;
if eqmode then
begin
mode:=5; setclass(false); nlpar:=eqnl2; writeeq:=true;
goto centrh
end;
justfn: <*mode=1*>
more:=true;
for i:=i while more do
begin
klass:=if notemode then readfnchar(fnote,v) else
if datemode then qread(dtxt,dt,v) else
readmschar(in,v);
if klass=6 then klass:=5; comment hyphen in start of word ok;
branch:
case klass+1 of
begin <*0*>; <*1*>; <*2*>;
begin <*3, separator*>
if notemode then notsep(branch);
q1:=typol;
if q1<5 ! q1=5 & linewidth-accuw-(w-1)*maxspace<=0 then
more:=false;
end;
begin <*4, underline*>
if notemode then
begin readfnchar(fnote,q1); repeatchar(fnote)
end else
begin readmschar(in,q1); repeatchar(in)
end;
if ulinemask shift w >=0 or q1=8 then goto TXT1
end;
TXT1:
begin <*5, start of word*>
toppage:=codemode:=startofline:=prognl:=false; word:=true;
w:=w+1;
if w>24 then error(<:RJ-line: words:>,2);
pib(w):=lin;
for i:=i while word do
begin
next: if startofword then startofword:=false else
klass:=if notemode then readfnchar(fnote,v) else
if datemode then qread(dtxt,dt,v) else
readmschar(in,v);
if klass<>4 then back:=false;
e1: case klass+1 of
begin <*0*>; <*1*>;
<*2*> word:=false;
begin <*3, separator*>
if notemode then notsep(e1);
word:=false; repeatchar(in)
end;
begin <*4, underline*>
if lin>linelim then error(<:RJ-line: chars:>,2);
if notemode then
begin readfnchar(fnote,q1); repeatchar(fnote)
end else
begin readmschar(in,q1); repeatchar(in)
end;
if q1<>8 and back then
begin word:=false;
ulinemask:=ulinemask add (1 shift (23-w))
end else goto e2;
end;
e2: begin <*5, part of word*>
if v>127 then delim(v);
linebuf(lin):=false add v; lin:= lin+1;
accuw:=accuw+width(v extract 7);
end;
begin <*6, hyphen*>
klass:=if notemode then readfnchar(fnote,q1) else
readmschar(in,q1);
if q1=10 then
begin
for i:=i while klass=2 do
klass:=if notemode then readfnchar(fnote,q1)
else readmschar(in,q1);
if klass=3 and -,notemode then
begin
linebuf(lin):=false add v; lin:=lin+1;
accuw:=accuw+width(v);
pis(w):=lin-1; startofword:=true;
goto branch
end separator met;
if notemode then repeatchar(fnote) else repeatchar(in);
goto next
end
else
begin
if notemode then repeatchar(fnote) else repeatchar(in);
goto e2
end
end;
backspace(linebuf,lin,true); <*7*>
<*8*> etext;
<*9*> accuw:=accuw+references
end case;
end word;
startofword:=true;
pis(w):=lin-1;
if linewidth-accuw-(w-1)*maxspace<=0 then more:=false
end; <*6*>; <*7*>;
<*8*> etext;
begin <*9, reference delimiter*>
if notemode then repeatchar(fnote) else repeatchar(in); goto TXT1
end
end case;
end more;
goto outline;
nonjust: <*mode=2*>
for i:=i while more do
begin
klass:=readmschar(in,v);
case klass+1 of
begin <*0*>; <*1*>;
<*2*> more:=false;
<*3*> if typol<5 then more:=false;
<*4*>;
TXT2:
begin <*5, start of textunit*>
toppage:=codemode:=startofline:=prognl:=false; word:=true;
w:=w+1;
if w>24 then error(<:SJ-line: words:>,2);
pib(w):=lin;
repeatchar(in);
for i:=i while word do
begin
klass:=readmschar(in,v);
case klass+1 of
begin <*0*>; <*1*>;
<*2*> word:=more:=false;
begin <*3, separator*>
word:=false; repeatchar(in);
end; <*4*>;
begin <*5, part of textunit*>
if lin>linelim then error(<:SJ-line: chars:>,2);
if v>127 then delim(v);
linebuf(lin):=false add v; lin:=lin+1;
accuw:=accuw+width(v extract 7);
end; <*6*>;
<*7*> backspace(linebuf,lin,true);
<*8*> etext;
<*9*> accuw:=accuw+references
end case;
end word;
pis(w):=lin-1;
end; <*6*>; <*7*>;
<*8*> etext;
<*9*> goto TXT2
end case;
end more;
goto outline;
tabul: <*mode=3*>
tabcount:=1; q2:=k:=accuw; comment q2 holds the width of the text
between the tab. marks;
for i:=i while more do
begin
klass:=readmschar(in,v);
case klass+1 of
begin <*0*>; <*1*>;
<*2*> more:=false;
<*3*> if typol<5 then more:=false; <*4*>;
TXT3:
begin <*5, start of textunit*>
toppage:=codemode:=startofline:=prognl:=false; word:=true;
w:=w+1;
if w>24 then error(<:TA-line: words:>,2);
pib(w):=lin;
repeatchar(in);
for i:=i while word do
begin
klass:=readmschar(in,v);
case klass+1 of
begin <*0*>; <*1*>;
<*2*> more:=word:=false;
begin <*3, separator*>
word:=false; repeatchar(in)
end; <*4*>;
begin <*5, part of textunit*>
if lin>linelim then error(<:TA-line: chars:>,2);
if v>127 then delim(v);
linebuf(lin):=false add v; lin:=lin+1;
q2:=q2+width(v extract 7)
end;
begin <*6, HT, horizontal tab.
Calculates and outputs spaces, q1, from the
actual position to the nearest tab. mark*>
word:=false; repeatchar(in)
end;
<*7*> backspace(linebuf,lin,true);
<*8*> etext;
<*9*> accuw:=accuw+references
end case;
end word;
pis(w):=lin-1; accuw:=accuw+q2; k:=q2; q2:=0
end textunit;
begin <*6, HT*>
q1:=tabpar(tabcount)-k;
for tabcount:=tabcount+1 while q1<0 & tabcount<tabno+1 do
q1:=q1+tabpar(tabcount);
if tabcount>=tabno+1 & q1<0 then
begin <*no further tab.marks in line*>
error(<:tabmarks exceeded:>,1); q1:=0;
comment read until end of line;
end else outspace(q1,true,-2);
accuw:=accuw+q1;
q2:=k:=0;
end; <*7*>;
<*8*> etext;
<*9*> goto TXT3
end case
end more;
goto outline;
center: <*mode=4, CT*>
v:=32; for i:=i while v=32 do readmschar(in,v); repeatchar(in);
centrh: <*mode=5, QR*>
for i:=i while more do
begin
klass:=if headmode then qread(rhead,rh,v) else readmschar(in,v);
cen:
case klass+1 of
begin <*0*>; <*1*>;
<*2*> more:=false;
begin <*3*>
if headmode then notsep(cen);
if eqmode then more:=false
else if typol<5 then more:=false
else if startofline then goto center
end; <*4*>;
TXT45:
begin <*5, start of textunit*>
toppage:=codemode:=startofline:=prognl:=false; word:=true;
w:=w+1;
if w>24 then error(<:QR!CT-line: words:>,2);
pib(w):=lin;
if headmode then rh:=rh-1 else repeatchar(in);
for i:=i while word do
begin
klass:=if headmode then qread(rhead,rh,v) else readmschar(in,v);
ce1: case klass+1 of
begin <*0*>; <*1*>;
<*2*> word:=more:=false;
begin <*3, separator*>
if headmode then notsep(ce1); word:=false;
if eqmode then more:=false else repeatchar(in)
end; <*4*>;
begin <*5, part of textunit*>
if lin>linelim then error(<:QR!CT-line: chars:>,2);
if v>127 then delim(v);
linebuf(lin):=false add v; lin:=lin+1;
accuw:=accuw+width(v extract 7)
end; <*6*>;
<*7*> backspace(linebuf,lin,true);
<*8*> etext;
<*9*> if headmode then error(<:refs in running head:>,2)
else accuw:=accuw+references
end case;
end word;
pis(w):=lin-1
end textunit; <*6*>; <*7*>;
<*8*> etext;
<*9*> if headmode then error(<:refs in running head:>,2)
else goto TXT45
end case;
end more;
calcensp;
\f
outline: wrterr:=true;
if mode=1 & -,headmode ! notemode then goto linejust;
comment output line in nonjust,tabul or centr mode;
outnonjust:
if linewidth+(if headmode then lmarg+rmarg else 0)-accuw<0
then error(<:linewidth:>,1);
pc:=1; blind:=true;
bool1:=headmode&nummode=4&pagnum mod 2=0&line1;
bool2:=headmode&(nummode=5!nummode=4&pagnum mod 2=1)&line1;
if mtext then mtext:=false else
if lmarg>0 & -,headmode and w>0 then outspace(lmarg,false,-2);
if headmode and runfont<>rhfont then
begin outfont(rhfont); adjwidth(rhfont)
end;
if bool1 then placenum(4);
if censp>0 then outspace(censp,false,-2);
if setmode then
begin comment output for setting machine;
if codemask<0 then outcode(0);
for i:=1 step 1 until w do
begin
settext(i);
if codemask shift i <0 then outcode(i)
end
end;
if printmode then
begin comment output for printer;
if printmask<0 then printprbuf(printbuf(0));
for i:=1 step 1 until w do
begin
for j:=pib(i) step 1 until pis(i) do
begin
q1:=linebuf(j) extract 7;
blind:=blind and q1=32;
q1:=if q1>31 then q1
else if q1>14 and q1<30 then
(if q1-14=6 then 32 else sstab(q1-14) extract 7)
else if q1=2 or q1=5 then 8
else if q1=6 then 32
else if q1<15 then q1
else 0;
outchar(pr,q1)
end;
if printmask shift i<0 then printprbuf(printbuf(i))
end;
end;
if eqmode and writeeq then
begin
eqmode:=writeeq:=false; mode:=savemode; setclass(mode=1)
end;
if test then testvar;
if bool2 then placenum(nummode);
if -,blind then lineno:=lineno+1;
if toptext and w=0 then nlpar:=0;
if -,headmode and w>0 then toptext:=false;
censp:=0;
if rtxt then
begin
outspace(linewidth-accuw,false,-2);
setmtext(<:right:>); rtxt:=false
end;
outnl(nlpar); line1:=false; w:=codemask:=printmask:=0;
goto if v=0 then headlab
else if (newpage ! finis) & -,headmode then pageshift
else lineinit;
linejust:
remlin:=linewidth-accuw-(w-1)*normsp;
if dropjust and remlin>=0 then goto outputline;
hypno:=-999;
if first then
begin comment the justification part starts here,
the width of the words read until now is with
max. spacing bigger than or equal the linewidth;
if linewidth-accuw-(w-1)*minspace>=0 then
begin comment hyphenation not necessary;
if w>1 then
begin
if (linewidth-accuw)/(w-1)>=maxfactor*maxspace then
begin comment max. spacing;
first:=false;goto justfn
end
end
end
else
begin hypdigit:=true; hypno:=hypcall(wid); hypdigit:=false;
end;
end
else
begin comment the next word is read trying to change
the max. spacing;
q1:=linewidth-accuw; q2:=w-1;
snitspace:=q1/q2;
if q1-q2*minspace>=0 then
begin comment justification possible;
if snitspace>=minfactor*minspace & snitspace<maxfactor*maxspace
then first:=true
else
begin comment not normal spacing;
if snitspace>=maxfactor*maxspace then goto justfn
else
if -,spamax then first:=true
end
end
end;
if first then
begin comment all words read participate in this line;
if hypno<>-999 then
begin comment hyphenation has taken place;
if hypno<>0 then
begin comment no problems;
h1:=abs hypno+(if hypno>0 then 2 else 1);
h2:=pis(w); saveword:=true;
if hypno>0 then
begin comment hyphen;
h3:=linebuf(hypno+1) extract 7; hyp:=true;
linebuf(hypno+1):=false add 45
end;
pis(w):=if hypno>0 then hypno+1 else abs hypno;
accuw:=accuw-(if hypno>0 then wid-width(45) else wid)
end
else
begin comment problems,justify by increasing maxspace;
if w>2 then goto savelastword else
error(<:justification:>,if check then 1 else 2)
end
end hypno<>-999
end first
else
savelastword:
begin comment the last word read is saved to the next line;
h1:=pib(w); h2:=pis(w); saveword:=true;
if ulinemask shift w<0 then ulinemask:=ulinemask+1 shift 23;
w:=w-1;
if codemask shift w<0 then
begin comment save generated code to the next line;
c1:=pco(w); c2:=pc-pco(w); savecode:=true
end;
for i:=h1 step 1 until h2 do
accuw:=accuw-width(linebuf(i) extract 7);
end;
if -,notemode then prognl:=true;
comment calculate the spacing;
q1:=linewidth-accuw; q2:=w-1;
if q2=0 then q2:=10000;
snitspace:=q1/q2;
spamax:=snitspace>=maxfactor*maxspace;
s1:=q1//q2; k:=q1 mod q2;
s2:=if k>0 then s1+1 else s1;
outputline:
if mtext then mtext:=false else
if lmarg>0 and nlpar>0 then outspace(lmarg,false,-2);
pc:=1;
if setmode then
begin comment output for setting machine;
if codemask<0 then outcode(0);
for i:=1 step 1 until w do
begin
settext(i);
if codemask shift i<0 then outcode(i);
q1:=if dropjust or stdspace then normsp else
if leftspa then (if i>k then s1 else s2) else
if i>q2-k then s2 else s1;
comment q1=the wordspace in units between word no. i and i+1;
if i<w then
outspace(q1,false,if ulinemask shift i < 0 then i else -1);
end;
if k>0 & -,dropjust then leftspa:=-,leftspa
end setmode;
if printmode then
begin comment output for printer;
if printmask<0 then printprbuf(printbuf(0));
for i:=1 step 1 until w do
begin
for j:=pib(i) step 1 until pis(i) do
begin
q1:=linebuf(j) extract 7;
q1:=if q1>31 then q1
else if q1>14 and q1<30 then
(if q1-14=6 then 32 else sstab(q1-14) extract 7)
else if q1=2 or q1=5 then 8
else if q1<15 then q1
else 0;
outchar(pr,q1)
end;
q1:=if i<w and ulinemask shift i>=0 then 32
else if i<w then 95 else 0;
if q1>0 then outchar(pr,q1);
if printmask shift i<0 then printprbuf(printbuf(i));
end;
end printmode;
if test then testvar;
if w>0 then begin lineno:=lineno+1; toptext:=false end;
if -,compinit then
begin
if rtxt then
begin
if -,prognl then outspace(linewidth-accuw-remlin,false,-2);
setmtext(<:right:>); rtxt:=false
end;
outnl(nlpar);
end;
w:=codemask:=printmask:=0;
goto if notemode & v=0 & -,saveword then outnote
else if (newpage ! finis) & -,notemode then pageshift
else lineinit;
exit:
if setmode then <* outend and cut *>
begin
bool1:=false;
if diablo then outchar(set,150)
else bool1:=true;
if -,err then cut(set,bool1)
end;
if printmode then
begin
outchar(pr,25); if -,err then cut(pr,false)
end;
if hypmode=1 then
begin
outchar(hyphinf,25); if -,err then cut(hyphinf,false)
end;
if hypmode<3 then close(c,true);
eexit:
close(pr,true); close(set,true); close(hyphinf,true);
if notearea then close(fnote,true);
if ref then writeref;
end inner block;
if continue and -,err then <*block for composite chars on printer*>
begin
boolean b1,b2,b3,system2;
integer i,ch,class,val,key,segm,ff;
integer array lin1,lin2,lin3(1:300),intab(0:127),ia(1:20);
zone set(128,1,stderror);
procedure outline(n); integer n;
begin
for i:=1 step 1 until n do outchar(set,lin1(i));
if b2 then
begin
outchar(set,13);
for i:=1 step 1 until n do outchar(set,lin2(i))
end;
if b3 then
begin
outchar(set,13);
for i:=1 step 1 until n do outchar(set,lin3(i))
end;
b1:=b2:=b3:=false; n:=0
end outline;
for i:=0 step 1 until 31,127 do intab(i):=7 shift 12+i;
for i:=32 step 1 until 126 do intab(i):=6 shift 12+i;
intab(10):=2 shift 12+10; intab(12):=3 shift 12+12;
intab(8):=4 shift 12+8; intab(25):=5 shift 12+25;
intable(intab); tableindex:=0;
if rc8000 then system2:=false
else
begin
open(set,4,<:hcørc4000:>,0);
system2:=monitor(42)lookup:(set,0)tail:(ia)=0;
if system2 then
system2:=(ia(10)=ia(9) extract 12) and ia(10)=666;
close(set,true)
end;
if sourcefile(1)=real<::> then fpproc(29,0)stack:(in,0);
if setmode and printer then
begin
sourcefile(1):=objfile(1); sourcefile(2):=objfile(2)
end else goto CON;
RUN: fpproc(27,i)connect:(in,sourcefile);
if system2 then
begin
message:
headandtail undeclared does not harm the program execution;
headandtail(sourcefile,ia); key:=ia(1) extract 12; segm:=ia(8)
end else
begin monitor(42)lookup:(in,0,ia); segm:=ia(1)
end;
if segm shift (-11) = 1 then goto CON;
ch:=monitor(68)generatename:(set,0,ia); getzone6(set,ia);
objfile(1):=real<::> add ia(2) shift 24 add ia(3);
objfile(2):=real<::> add ia(4) shift 24 add ia(5);
ia(1):=2*segm; for i:=2 step 1 until 10 do ia(i):=0;
ff:=monitor(40)createentry:(set,0)tail:(ia);
if ch+ff<>0 then
begin
write(out,<:***typol: generate name =:>,ch,
<:; create entry =:>,ff,<:<10>:>); goto CON
end;
if system2 then monitor(50)permanent:(set,key)tail:(ia);
open(set,4,objfile,0);
b1:=b2:=b3:=false; ch:=ff:=0;
next:
class:=readchar(in,val);
rep:
case class of
begin
<*1*>;
begin <*2; 10*>
if b1 then outline(ch);
outchar(set,10); goto next
end;
begin <*3; 12*>
if b1 then outline(ch); ff:=ff+1;
outchar(set,12); goto next
end;
begin <*4; 8*>
readchar(in,lin2(ch)); b2:=true;
class:=readchar(in,val);
if class=4 then
begin
readchar(in,lin3(ch)); b3:=true; goto next
end;
goto rep
end;
begin <*5; 25*>
if b1 then outline(ch);
write(set,<:<12><25>:>)
end;
begin <*6; 32-126*>
ch:=ch+1;
if ch>300 then
begin write(out,<:***typol: rereading:>,ff,<:<10>:>); goto CON
end;
lin1(ch):=val; b1:=true;
lin2(ch):=lin3(ch):=32;
goto next
end;
goto next <*7; 0-31,127*>
end case;
monitor(48)removeentry:(in,0,ia);
getposition(set,0,segm); ia(1):=segm+1; close(set,true);
monitor(44)changeentry:(set,i)tail:(ia);
ia(1):=sourcefile(1) shift (-24) extract 24;
ia(2):=sourcefile(1) extract 24;
ia(3):=sourcefile(2) shift (-24) extract 24;
ia(4):=sourcefile(2) extract 24;
monitor(46)renameentry:(set,0,ia);
CON: if printmode then
begin
sourcefile(1):=prooffile(1); sourcefile(2):=prooffile(2);
printmode:=false; goto RUN
end;
fpproc(30,i)unstack:(in,0);
end compchar;
if time then
begin
write(out,<:segment transfer time: :>,blocksread//55,<:<10>:>);
ra(1):=systime(1,ra(2),ra(2))-ra(1);
write(out,<:cpu and real time: :>,<<dddddd.d>,ra(1),ra(2),<:<10>:>);
end;
if err and -,check then
write(out,<:***typol: reading of manuscript not finished<10>:>);
write(out,<:typesetting end. :>);
systime(1,0,ra(1));
write(out,<< zd dd dd>,systime(2,ra(1),ra(2)),ra(2),<:<10>:>);
fpproc(7,0,0,0)
end
▶EOF◀