DataMuseum.dk

top - download

    Length: 37781 (0x9395)
    Types: TextFile
    Names: »NSYNDIA.PAS«

└─⟦0634bcb0f⟧ Bits:30010529 ABA: RTP syndia RC macro DVBS1.SW2114.src.2.6-7 PN 99110141
    └─⟦this⟧ »NSYNDIA.PAS« 

TextFile

(*$U+*)\r
program syndia(output,input_f,list);\r
\r
type\r
alfa=string[12];\r
iso=char;\r
\r
var\r
nl,cr:char;\r
macro_no:integer;\r
pos_adjust,help: integer;\r
\r
const\r
max=1000;\r
def_max=300;\r
name_def_max=6000;\r
title_max=100;\r
d_fill=2;\r
d_pagelength=70;\r
d_linelength=87;\r
d_head=4;\r
d_line_space=4;\r
d_left_margin=2;\r
d_pmargin=12;\r
d_indent=2;\r
d_center=0;\r
d_time='            ';\r
d_date='            ';\r
d_page_nr=0;\r
d_qume=false;\r
d_rctekst=true;\r
d_rcindex=true;\r
d_tpt=15;\r
d_rctpt=10;\r
d_lpt=6;\r
d_rclpt=6;\r
d_rcwidth=58;\r
d_frame=false;\r
\r
type\r
nodeptr=^node;\r
  nodeptrs=array[boolean] of nodeptr;\r
\r
node=record\r
length:integer;\r
split,more:integer;\r
indiff,outdiff:integer;\r
case art:char of\r
't','n','e':(namestart,namelength:integer);\r
'&','+','!','/':(childs:nodeptrs)\r
end;\r
\r
var\r
is_error: boolean;\r
list, input_f:text;\r
temp:text;\r
token:char;\r
lastch:char;\r
tokenstart,tokenlength:integer;\r
namebuffer:array[0..max] of char;\r
name_def_free: integer;\r
def_free: integer;\r
def_next: integer;\r
def_overflow: boolean;\r
name_def:array[0..name_def_max] of char;\r
def:array[0..def_max] of record\r
             namestart,namelength,page: integer;\r
             macro: string[8];\r
           end;\r
             \r
lineno:integer;\r
morequme:boolean;\r
moreframe:boolean;\r
moretimes:integer;\r
frametermfirst,frametermlast,framenonterm:char;\r
connectline:char;\r
line_ch:char;\r
period_pos: integer;\r
\r
(* system parameters *)\r
input_file,syntax_file:alfa;\r
param_no:integer;\r
param_error,param_finis:boolean;\r
fill:integer;\r
connection:boolean;\r
pagelength,linelength:integer;\r
head,left_margin,pmargin,make_margin,indent,center:integer;\r
line_space:integer;\r
title: string[title_max];\r
date_v:alfa;\r
time_v:alfa;\r
page_nr:integer;\r
write_page_nr:boolean;\r
qume:boolean;\r
rctekst, rcindex:boolean;\r
tpt,lpt,rctpt, rclpt, rcwidth:integer;\r
frame:boolean;\r
i: integer;\r
space_written: integer;\r
\r
procedure write_ch(ch: char);\r
begin\r
  if ch=' ' then space_written:= space_written + 1 else\r
  begin\r
    if space_written > 0 then begin\r
      write(list,' ': space_written);\r
      space_written:= 0;\r
    end;\r
    write(list, ch);\r
  end;\r
end;\r
procedure start_line(margin: integer);\r
begin\r
  if tpt=15 then write(list,chr(163)); (* set / *)\r
  space_written:= margin;\r
end;\r
\r
procedure writeformat(tpt,lpt: integer;format:char);\r
var i:integer;\r
begin\r
  write(list,chr(4),chr(0),'-',format,chr(tpt),chr(0),chr(lpt),chr(0),chr(0));\r
  write(list,chr(0),chr(0),chr(2),chr(1),chr(rcwidth),'1',chr(0));\r
  for i:=16 to 39 do write(list,chr(0));\r
  for i:=40 to 54 do write(list,chr(5 + (i-40)*10));\r
  write(list,chr(255));\r
  write(list,chr(4));\r
end;\r
\r
procedure page(var f: text);\r
begin\r
  writeln(f,chr(12));\r
end;\r
\r
function nextch:char;\r
var ch:char;\r
begin\r
if lastch=' ' then\r
begin\r
repeat\r
if eof(input_f) then\r
begin\r
ch:='.';\r
end\r
else begin\r
  if eoln(input_f) then \r
  begin readln(input_f); ch:=' '; end\r
  else read(input_f,ch);\r
end;\r
until (' '<=ch) and (ch<='~');\r
if ('A'<=ch) and (ch<='Z') then ch:=chr(ord(ch)-ord('A')+ord('a'));\r
nextch:=ch;\r
end\r
else\r
begin\r
nextch:=lastch;\r
lastch:=' ';\r
end;\r
end;\r
\r
procedure putinput(c:char);\r
begin\r
  if lastch=' ' then lastch:=c;\r
end;\r
\r
procedure skip(c:char);\r
begin\r
while token=c do token:=nextch;\r
end;\r
\r
procedure insertch(var i:integer; ch:char);\r
begin\r
if i<=max then\r
begin\r
namebuffer[i]:=ch;\r
i:=i+1;\r
end;\r
end;\r
\r
procedure readstring;\r
var i:integer;\r
ch:char;\r
begin\r
tokenstart:=tokenstart+tokenlength;\r
  i:=tokenstart;\r
  repeat\r
ch:=nextch;\r
while (ch<>'''') and not eof(input_f) do\r
begin\r
insertch(i,ch);\r
ch:=nextch;\r
end;\r
ch:=nextch;\r
if ch='''' then insertch(i,ch);\r
until ch<>'''';\r
putinput(ch);\r
tokenlength:=i-tokenstart;\r
token:='a';\r
end;\r
\r
procedure readalfa;\r
var\r
ch:char;\r
  i:integer;\r
begin\r
ch:=token;\r
tokenstart:=tokenstart+tokenlength;\r
i:=tokenstart;\r
while ch=' ' do ch:=nextch;\r
if ('a'<=ch) and (ch<='z') then\r
repeat\r
insertch(i,ch);\r
ch:=nextch;\r
until not((('a'<=ch)and(ch<='z'))or(('0'<=ch)and(ch<='9')));\r
putinput(ch);\r
token:='a';\r
tokenlength:=i-tokenstart;\r
end;\r
\r
\r
procedure gettoken;\r
begin\r
if not is_error then\r
begin\r
token:=nextch;\r
skip(' ');\r
if ('a'<=token) and (token<='z') then\r
begin\r
readalfa;\r
end else\r
case token of\r
'''':begin\r
readstring;\r
end;\r
'"':;\r
end;\r
end;\r
end;\r
\r
procedure check_page(length:integer);\r
var i:integer;\r
   take:integer;\r
   title_length:integer;\r
begin\r
if not rctekst then \r
begin\r
  lineno:=lineno+line_space+length;\r
  if lineno>=pagelength then\r
  begin\r
lineno:=head+line_space+length;\r
page(list);\r
take:=1;\r
if write_page_nr then take:=take+10;\r
if date_v<>' ' then take:=take+10;\r
if time_v<>' ' then take:=take+10;\r
for i:=1 to head-1 do writeln(list);\r
if take>1 then\r
begin\r
if left_margin>0 then write(list,' ':left_margin);\r
title_length:= linelength-left_margin-take;\r
if title_length>len(title)\r
then write(list,title:len(title),' ':title_length-len(title))\r
else write(list,title:title_length);\r
write(list,' ');\r
if date_v<>' ' then write(list,date_v:10);\r
if time_v<>' ' then write(list,time_v:10);\r
if write_page_nr then writeln(list,'page',page_nr:6)\r
else writeln(list);\r
end else writeln(list);\r
page_nr:=page_nr+1;\r
end;\r
for i:=1 to line_space do writeln(list);\r
end;\r
end;\r
\r
procedure comment;\r
var lines:integer;\r
   i:integer;\r
 last:iso;\r
 ch: char;\r
begin\r
if rctekst\r
then begin\r
repeat lastch:=' '; gettoken; until token='"';\r
lastch:=' ';\r
gettoken;\r
end\r
else begin\r
  assign(temp,'syndia.tmp');\r
  rewrite(temp);\r
lines:=0;\r
last:=nl;\r
if not eof(input_f) then\r
if eoln(input_f) then readln(input_f);\r
read(input_f,ch);\r
  while (ch<>'"') and not eof(input_f) do\r
begin\r
if last=nl then\r
begin\r
for i:=1 to left_margin do\r
begin\r
write(temp,' ');\r
end;\r
lines:=lines+1;\r
end;\r
write(temp,ch);\r
last:=ch;\r
if eoln(input_f) then begin ch:=chr(10); readln(input_f) end else read(input_f,ch); \r
end;\r
if last<>nl then\r
begin\r
writeln(temp)\r
end;\r
if ch='"' then;\r
gettoken;\r
check_page(lines);\r
close(temp);\r
reset(temp);\r
while not eof(temp) do\r
begin\r
  if eoln(temp) then begin readln(temp); writeln(list) end else\r
  begin read(temp,ch); write(list,ch); end;\r
end;\r
close(temp);\r
end;\r
end;\r
\r
procedure rule;\r
var\r
left,rigth,lab:nodeptr;\r
currentline:integer;\r
i:integer;\r
defined:boolean;\r
new_ptr:^integer;\r
help:integer;\r
macro:string[8];\r
  \r
function maxi(a,b:integer):integer;\r
begin\r
if a<b\r
then maxi:=b\r
else maxi:=a;\r
end;\r
\r
procedure error(readtoken,expected:char);\r
begin\r
writeln(' **** error input read = ',readtoken,'  expected = ',expected);\r
writeln('      syntax rule skipped');\r
while (token<>';') and (token<>'.') do gettoken;\r
is_error:=true;\r
end;\r
\r
procedure check(c:char);\r
begin\r
   if token<>c then error(token,c);\r
  gettoken;\r
end;\r
\r
procedure terminal(var expr:nodeptr);\r
begin\r
new(expr(*,'t'*));\r
with expr^ do\r
begin\r
art:='t';\r
length:=tokenlength+2*fill;\r
namestart:=tokenstart;\r
namelength:=tokenlength;\r
split:=1;\r
more:=0;\r
indiff:=0;\r
outdiff:=0;\r
end;\r
gettoken;\r
end;\r
\r
procedure nonterminal(var expr:nodeptr);\r
begin\r
new(expr(*,'n'*));\r
with expr^ do\r
begin\r
art:='n';\r
  length:=tokenlength+2*fill;\r
  namestart:=tokenstart;\r
  namelength:=tokenlength;\r
split:=1;\r
more:=0;\r
indiff:=0;\r
outdiff:=0;\r
end;\r
gettoken;\r
end;\r
\r
procedure empty(var expr:nodeptr);\r
begin\r
new(expr(*,'e'*));\r
with expr^ do\r
begin\r
art:='e';\r
length:=1;\r
namestart:=0;\r
namelength:=0;\r
split:=1;\r
more:=0;\r
indiff:=0;\r
outdiff:=0;\r
end;\r
end;\r
\r
procedure expression(var expr:nodeptr);\r
\r
var\r
first,stop:boolean;\r
exp:nodeptrs;\r
\r
procedure repexpression(var expr:nodeptr);\r
begin\r
new(expr(*,'/'*));\r
with expr^ do\r
begin\r
art:='/';\r
expression(childs[true]);\r
if (token=']') or (token='-')\r
then empty(childs[false])\r
else begin\r
check('/');\r
expression(childs[false]);\r
end;\r
length:=maxi(childs[true]^.length, childs[false]^.length)+4;\r
split:=childs[false]^.split+childs[false]^.more+childs[true]^.split+1;\r
more:=childs[true]^.more;\r
indiff:=childs[true]^.indiff;\r
outdiff:=childs[true]^.outdiff;\r
end;\r
end;\r
\r
procedure checklength(expr:nodeptr;l:integer;a:char);\r
begin\r
with expr^ do\r
if art=a then\r
begin\r
length:=l;\r
checklength(childs[true],l,a);\r
checklength(childs[false],l,a);\r
end;\r
end;\r
\r
procedure alternativ(var exp:nodeptrs);\r
var\r
expr:nodeptr;\r
l1,l2:integer;\r
begin\r
new(expr(*,'!'*));\r
with expr^ do\r
begin\r
with exp[true]^ do\r
if art='!' then l1:=length-4\r
else l1:=length;\r
with exp[false]^ do\r
if art='!' then l2:=length-4\r
else l2:=length;\r
art:='!';\r
length:=maxi(l1,l2)+4;\r
split:=exp[true]^.split;\r
more:=exp[true]^.more+exp[false]^.split+exp[false]^.more+1;\r
indiff:=exp[true]^.indiff;\r
outdiff:=exp[true]^.outdiff;\r
checklength(exp[true],length,'!');\r
checklength(exp[false],length,'!');\r
childs:=exp;\r
end;\r
exp[true]:=expr;\r
end;\r
\r
procedure break_line(var exp:nodeptrs);\r
var\r
expr:nodeptr;\r
l1,l2:integer;\r
begin\r
new(expr(*,'&'*));\r
with expr^ do\r
begin\r
with exp[true]^ do\r
if art='&' then l1:=length-4\r
else l1:=length;\r
with exp[false]^ do\r
if art='&' then l2:=length-4\r
else l2:=length;\r
art:='&';\r
length:=maxi(l1,l2)+4;\r
with exp[true]^ do l1:=split+more+2;\r
split:=l1;\r
with exp[false]^ do l2:=split+more+1;\r
more:=l2;\r
with exp[true]^ do l1:=indiff+more+2;\r
indiff:=l1;\r
with exp[false]^ do l2:=split+outdiff+1;\r
outdiff:=l2;\r
checklength(exp[true],length,'&');\r
checklength(exp[false],length,'&');\r
childs:=exp;\r
end;\r
exp[true]:=expr;\r
end;\r
\r
procedure concatnate(var exp:nodeptrs);\r
var\r
expr:nodeptr;\r
l1,l2:integer;\r
begin\r
new(expr(*,'+'*));\r
with expr^ do\r
begin\r
art:='+';\r
length:=exp[true]^.length+exp[false]^.length+1;\r
with exp[true]^ do l1:=split+outdiff;\r
with exp[false]^ do l2:=split-indiff;\r
split:=maxi(l1,l2);\r
with exp[true]^ do l1:=more-outdiff;\r
with exp[false]^ do l2:=more+indiff;\r
more:=maxi(l1,l2);\r
with exp[true]^ do l1:=indiff+outdiff;\r
with exp[false]^ do l2:=indiff+outdiff;\r
indiff:=l1;\r
outdiff:=l2;\r
childs:=exp;\r
end;\r
exp[true]:=expr;\r
end;\r
\r
begin (* expression *)\r
first:=true;\r
stop:=false;\r
repeat\r
  case token of\r
'a': terminal(exp[first]);\r
'<': begin\r
gettoken;\r
nonterminal(exp[first]);\r
check('>');\r
end;\r
'(': begin\r
gettoken;\r
expression(exp[first]);\r
check(')');\r
end;\r
'+','[': begin\r
gettoken;\r
repexpression(exp[first]);\r
if token='-' then token:=']';\r
check(']');\r
end;\r
'!': begin\r
gettoken;\r
if first then empty(exp[first]);\r
expression(exp[false]);\r
alternativ(exp);\r
first:=true;\r
end;\r
'&': begin\r
gettoken;\r
if first then empty(exp[first]);\r
expression(exp[false]);\r
break_line(exp);\r
first:=true;\r
end;\r
';','/',']','-',')': begin\r
if first then empty(exp[first]);\r
stop:=true;\r
first:=true;\r
end;\r
otherwise error(token,'?');\r
end;\r
if first\r
then first:=false\r
else concatnate(exp);\r
until stop or is_error;\r
expr:=exp[true];\r
end; (* expression *)\r
\r
procedure writeframe(l:integer);\r
var i:integer;\r
begin\r
for i:=1 to l do write_ch('_');\r
moreframe:=false;\r
end;\r
\r
procedure writequme(expr:nodeptr);\r
var i:integer;\r
begin\r
if moretimes=2 then\r
begin\r
morequme:=false;\r
with expr^ do\r
for i:=namestart to namestart+namelength-1 do\r
if i<=max then\r
if namebuffer[i]='^' then write_ch('*') else\r
if namebuffer[i]='*' then write_ch('X') else write_ch(' ')\r
else write_ch(' ')\r
end\r
else writeframe(expr^.namelength);\r
end;\r
\r
procedure writenonterminal(expr:nodeptr);\r
var i:integer;\r
ch:char;\r
begin\r
if moretimes=0 then\r
begin\r
moreframe:=frame;\r
with expr^ do\r
for i:=namestart to namestart+namelength-1 do\r
if i<=max then\r
begin\r
 ch:=namebuffer[i];\r
 if (ch='*') or (ch='^') then\r
 begin  \r
  morequme:=qume;\r
  if ch='*' then ch:='+'; \r
 end;\r
 write_ch(ch);\r
 if namebuffer[i]='*' then morequme:=qume;\r
end\r
else write_ch(' ')\r
end\r
else writequme(expr);\r
end;\r
\r
procedure writeterminal(expr:nodeptr);\r
var i:integer;\r
ch:char;\r
begin\r
if moretimes=0 then\r
begin\r
moreframe:=frame;\r
with expr^ do\r
for i:=namestart to namestart+namelength-1 do\r
if i<=max then\r
begin\r
ch:=namebuffer[i];\r
if ('a'<=ch) and (ch<='z') then ch:=chr(ord(ch)+ord('A')-ord('a'));\r
write_ch(ch);\r
if ch='*' then morequme:=qume;\r
end\r
else write_ch(' ')\r
end\r
else writequme(expr);\r
end;\r
\r
procedure writetree(expr:nodeptr; currentline:integer;\r
return:boolean; length:integer;\r
infillupch,infilldownch,outfillupch,outfilldownch:char);\r
\r
var\r
ch:char;\r
fillch1,fillch2:array[boolean] of char;\r
fillch3:char;\r
i,fill_length:integer;\r
\r
procedure find_fillch(line:integer;upch,downch:char;var ch1,ch2:char);\r
begin\r
if line=0 then\r
begin\r
ch1:=line_ch;\r
ch2:=line_ch;\r
end\r
else\r
begin\r
ch2:=' ';\r
if line<0 then ch1:=upch else ch1:=downch;\r
end;\r
end;\r
\r
procedure writeblank(length:integer);\r
var i:integer;\r
begin\r
space_written:= space_written + length;\r
(*for i:=1 to length do write(list,' ');*)\r
end;\r
\r
procedure writech(ch:char);\r
begin\r
if connection and (moretimes=0) then write_ch(ch) else write_ch(' ');\r
end;\r
\r
procedure writefill(ch:char;before:boolean;framech:char);\r
var i:integer;\r
begin\r
if not before then\r
begin\r
if fill>=2 then writech(framech);\r
writech(ch);\r
for i:=3 to fill do writech(line_ch);\r
end else\r
begin\r
for i:=3 to fill do writech(line_ch);\r
writech(ch);\r
if fill>=2 then writech(framech);\r
end;\r
end;\r
\r
begin\r
if (-expr^.split<=currentline) and (currentline<=expr^.more) then\r
begin\r
fill_length:=length-expr^.length;\r
find_fillch(currentline+expr^.indiff,infillupch,infilldownch,\r
fillch1[not return],fillch2[not return]);\r
find_fillch(currentline-expr^.outdiff,outfillupch,outfilldownch,\r
fillch1[return],fillch2[return]);\r
if currentline=0 then fillch3:=line_ch else fillch3:=' ';\r
if 2<=fill_length then\r
begin\r
writech(fillch1[true]);\r
infillupch:=' ';\r
outfillupch:=' ';\r
infilldownch:=' ';\r
outfilldownch:=' ';\r
end;\r
for i:=2 to fill_length div 2 do writech(fillch2[true]);\r
case expr^.art of\r
't':\r
if currentline=0 then\r
begin\r
if return then writefill(line_ch,true,frametermfirst)\r
else writefill('>',true,frametermfirst);\r
writeterminal(expr);\r
if return then writefill('<',false,frametermlast)\r
else writefill(line_ch,false,frametermlast);\r
end\r
else if (currentline=-1) and frame then\r
begin\r
writeblank(fill);\r
writeframe(expr^.namelength);\r
writeblank(fill);\r
end else\r
writeblank(expr^.namelength+2*fill);\r
'n':\r
if currentline=0 then\r
begin\r
if return then writefill(line_ch,true,framenonterm)\r
else writefill('>',true,framenonterm);\r
writenonterminal(expr);\r
if return then writefill('<',false,framenonterm)\r
else writefill(line_ch,false,framenonterm);\r
end\r
else if (currentline=-1) and frame then\r
begin\r
writeblank(fill);\r
writeframe(expr^.namelength);\r
writeblank(fill);\r
end\r
else writeblank(expr^.namelength+2*fill);\r
'e':\r
if currentline=0 then\r
begin\r
if return then writech('<')\r
else writech('>');\r
end\r
else writeblank(1);\r
'+':\r
begin\r
with expr^.childs[not return]^ do\r
if (-split<=currentline+outdiff) and (currentline+outdiff<=more) then\r
writetree(expr^.childs[not return],currentline+outdiff,return,length,\r
' ',' ',' ',' ')\r
else writeblank(length);\r
writech(fillch3);\r
with expr^.childs[return]^ do\r
if (-split<=currentline-indiff) and (currentline-indiff<=more) then\r
writetree(expr^.childs[return],currentline-indiff,return,length,\r
' ',' ',' ',' ')\r
else writeblank(length);\r
end;\r
'!':\r
with expr^ do\r
begin\r
writetree(childs[true],currentline,return,length,\r
infillupch,connectline,outfillupch,connectline);\r
writetree(childs[false],\r
currentline-childs[true]^.more-childs[false]^.split-1,\r
return,length,connectline,infilldownch,connectline,outfilldownch);\r
end;\r
'&':\r
with expr^ do\r
begin\r
writetree(childs[true],currentline+childs[true]^.more+2,return,length,\r
infillupch,' ',outfillupch,connectline);\r
if currentline=0 then for i:=1 to length do writech(line_ch);\r
if currentline=-1 then\r
begin\r
if return then writech(connectline);\r
writeblank(length-1);\r
if not return then writech(connectline);\r
end;\r
writetree(childs[false],currentline-childs[false]^.split-1,return,length,\r
connectline,infilldownch,' ',outfilldownch);\r
end;\r
'/':\r
begin\r
with expr^ do\r
begin\r
writetree(childs[false],\r
currentline+childs[false]^.more+childs[true]^.split+1,\r
not return,length,' ',connectline,' ',connectline);\r
writetree(childs[true],currentline,return,length,\r
connectline,' ',connectline,' ');\r
end;\r
end;\r
end;\r
for i:=2 to (fill_length+1) div 2 do writech(fillch2[false]);\r
if 1<=fill_length then writech(fillch1[false]);\r
end;\r
end;\r
\r
  procedure hline(from_pos, to_pos: integer);\r
  begin\r
  if connection then\r
  begin\r
    writeln(list,' ');\r
    write(list,chr(1),'Ramme "3 0 ');\r
    if (pmargin<>pos_adjust) \r
    then write(list,from_pos+pos_adjust)\r
    else write(list,'+',from_pos:1);\r
    write(list,to_pos-from_pos:4);\r
    write(list,' 0 "');\r
  end;\r
  end;\r
  \r
  procedure vline(pos, length: integer);\r
  begin\r
  if connection then\r
  begin\r
    writeln(list,' ');\r
    write(list,chr(1),'Ramme "3 0 ');\r
    if (pmargin<>pos_adjust)\r
    then write(list,pos+pos_adjust)\r
    else write(list,'+',pos:1);\r
    write(list,' 0 ',length:4);\r
    write(list,' "');\r
  end;\r
  end;\r
  \r
  procedure newpos(line: boolean; var linepos, pos: integer; addpos: integer);\r
  begin\r
    if line then\r
    begin\r
      if linepos<0 then linepos:=pos;\r
    end else\r
    begin\r
      if linepos>=0 then hline(linepos, pos);\r
      linepos:=-1;\r
    end;\r
    pos:=pos+addpos;\r
  end;\r
\r
procedure writerammetree(expr: nodeptr; currentline:integer;\r
                         return: boolean; length: integer;\r
                         var linepos, pos:integer; vmade:boolean);\r
var line_in, line_out, fill_length, vlength:integer;\r
    help_expr: nodeptr;\r
    help_bool: boolean;\r
\r
begin\r
if (-expr^.split<=currentline) and (currentline<=expr^.more) then\r
begin\r
if return then\r
begin line_in:= expr^.outdiff; line_out:= -expr^.indiff; end else\r
begin line_in:= -expr^.indiff; line_out:= expr^.outdiff end;\r
fill_length:=length-expr^.length;\r
newpos(currentline=line_in, linepos, pos, fill_length div 2);\r
case expr^.art of\r
't','n':\r
begin\r
  if (*return and*) ((pmargin*tpt) mod rctpt <> 0) then help:=1 else help:=0;\r
  if fill<2 then\r
  begin\r
    newpos(currentline=0, linepos, pos, fill);\r
    newpos(false, linepos, pos, expr^.namelength+help);\r
    if fill>help then\r
      newpos(currentline=0, linepos, pos, fill-help);\r
  end\r
  else begin\r
    if fill>=2 then\r
      newpos(currentline=0, linepos, pos, fill-1); \r
    newpos(false, linepos, pos, expr^.namelength+2+help);\r
    if fill-1-help>0 then\r
    newpos(currentline=0, linepos, pos, fill-1-help);\r
  end;\r
end;\r
'e': newpos(currentline=0, linepos, pos, 1);\r
'+':\r
begin\r
with expr^.childs[not return]^ do\r
if (-split<=currentline+outdiff) and (currentline+outdiff<=more) then\r
writerammetree(expr^.childs[not return],currentline+outdiff,return,length,\r
linepos, pos, false)\r
else newpos(false, linepos, pos, length);\r
newpos(currentline=0, linepos, pos, 1);\r
with expr^.childs[return]^ do\r
if (-split<=currentline-indiff) and (currentline-indiff<=more) then\r
writerammetree(expr^.childs[return],currentline-indiff,return,length,\r
linepos, pos, false)\r
else newpos(false, linepos, pos, length);\r
end;\r
'!':\r
with expr^ do\r
begin\r
vlength:=childs[true]^.more;\r
help_expr:= childs[false];\r
while (help_expr^.art='!') and (length=help_expr^.length) do\r
begin\r
with help_expr^.childs[true]^ do\r
vlength:=vlength+split+more+1;\r
help_expr:=help_expr^.childs[false];\r
end;\r
vlength:=vlength+help_expr^.split+1;\r
if currentline=line_in then vline(pos,vlength-line_in-help_expr^.indiff);\r
writerammetree(childs[true],currentline,return,length,linepos, pos,\r
(childs[true]^.art='!') and (childs[true]^.length=length));\r
writerammetree(childs[false],\r
currentline-childs[true]^.more-childs[false]^.split-1,\r
return,length,linepos,pos,\r
(childs[false]^.art='!') and (childs[false]^.length=length));\r
if currentline=line_out then vline(pos,vlength+line_out+help_expr^.outdiff);\r
end;\r
'&':\r
with expr^ do\r
begin\r
if currentline=0 \r
then vline(pos, childs[false]^.split + 1 - childs[false]^.indiff);\r
writerammetree(childs[true],currentline+childs[true]^.more+2,return,length,\r
linepos, pos, false);\r
if currentline=0 then newpos(true, linepos, pos, length );\r
writerammetree(childs[false],currentline-childs[false]^.split-1,return,length,\r
linepos, pos, false);\r
if currentline=childs[true]^.outdiff-childs[true]^.more-2\r
then vline(pos,-currentline);\r
end;\r
'/':\r
begin\r
with expr^ do\r
begin\r
vlength:=childs[true]^.split+childs[false]^.more+1;\r
if currentline=line_in - vlength -childs[false]^.indiff \r
then vline(pos, -currentline);\r
writerammetree(childs[false],\r
currentline+childs[false]^.more+childs[true]^.split+1,\r
not return,length,linepos, pos, false);\r
writerammetree(childs[true],currentline,return,length,\r
linepos, pos, false);\r
if currentline=line_out - vlength +childs[true]^.outdiff\r
then vline(pos, -currentline);\r
end;\r
end;\r
end;\r
newpos(currentline=line_out, linepos, pos, (fill_length+1) div 2 );\r
end;\r
end;\r
\r
procedure writelineoftree(expr:nodeptr;line,length,out:integer);\r
var ramme_linepos, ramme_pos: integer;\r
begin\r
moreframe:=false;\r
morequme:=false;\r
moretimes:=0;\r
repeat\r
if moretimes>0 then\r
begin\r
write(list,cr);\r
if not moreframe then moretimes:=2;\r
end;\r
start_line(make_margin+indent);\r
(*for i:=1 to make_margin+indent do write(list,' ');*)\r
writetree(expr,line,false,length,' ',' ',' ',' ');\r
moretimes:=moretimes+1;\r
until not(moreframe or morequme) or is_error;\r
if (line=out) and connection then begin\r
write_ch('>');\r
end;\r
if rctekst then begin\r
ramme_linepos:=-1;\r
ramme_pos:= make_margin+indent+1;\r
writerammetree(expr,line,false,length,ramme_linepos,ramme_pos,false);\r
if (line=out) and connection then newpos(true, ramme_linepos, ramme_pos, 1);\r
newpos(false,ramme_linepos,ramme_pos,0);\r
end;\r
end;\r
\r
begin (* rule *)\r
 defined:=false;\r
 if token='"' then comment else\r
 begin\r
  mark(new_ptr); \r
  macro[0]:=chr(0);\r
  if token='$' then \r
  begin\r
   gettoken;\r
   if token='a' then \r
   begin\r
    if tokenlength>8 then tokenlength:=8;\r
    for i:=1 to 8 do\r
     if i<=tokenlength then macro[i]:=namebuffer[tokenstart-1+i]\r
     else macro[i]:=' ';\r
    macro[0]:=chr(tokenlength);\r
    tokenlength:=0;\r
   end;\r
  end;\r
  if len(macro)=0 then\r
  begin\r
   macro[0]:=chr(8);\r
   macro:='syndia  ';\r
   macro[8]:= chr((macro_no mod 10)+ord('0'));\r
   help:=macro_no div 10;\r
   if help<10 then macro[7]:=chr(help+ord('0'))\r
   else macro[7]:=chr(help-10+ord('A'));\r
   macro_no:=macro_no+1;\r
  end;\r
  if token='a' then terminal(lab)\r
  else empty(lab);\r
  check('<');\r
  nonterminal(left);\r
  if not is_error then\r
  begin\r
   write('rule: ');\r
   with left^ do\r
   begin\r
    for i:=namestart to namestart+namelength-1 do\r
    if i<=max then write(namebuffer[i])\r
    else write(' ');\r
    for i:=namelength to 30 do write(' ');\r
   end;\r
   if rctekst then write(', macro ',macro)\r
   else\r
   writeln;\r
   defined:=true;\r
   check('>');\r
   check('=');\r
   expression(rigth);\r
   check_page(2+rigth^.split+rigth^.more);\r
   morequme:=false;\r
   moreframe:=false;\r
   moretimes:=0;\r
   (* index *)\r
   if (def_free<def_max) and (name_def_free+left^.namelength<=name_def_max) then \r
   begin\r
    def[def_free].page:= page_nr-1;\r
    def[def_free].namestart:=name_def_free;\r
    def[def_free].namelength:=left^.namelength;\r
    def[def_free].macro:= macro;\r
    for i:=left^.namestart to left^.namestart+left^.namelength-1 do\r
    begin\r
     name_def[name_def_free]:=namebuffer[i];\r
     name_def_free:=name_def_free+1;\r
    end;\r
    def_free:= def_free+1;\r
   end else def_overflow:= true;\r
   make_margin:=center - rigth^.length div 2 - fill - 1;\r
   if make_margin<left_margin then make_margin:= left_margin; \r
   if rctekst then begin\r
    writeln(list,chr(22),'mk startdef ',macro);\r
    writeformat(tpt,lpt,'M');\r
    writeformat(rctpt,rclpt,'L');\r
    writeln(list,chr(10));\r
    writeln(list);\r
    (**)\r
    write(list,chr(14),chr(10)); \r
    (**)\r
   end;\r
   \r
   if rcindex then begin\r
   space_written:= 0;\r
   write(list,chr(22),'so ');\r
   writenonterminal(left);\r
   writeln(list,':');\r
   end;\r
   start_line(make_margin);\r
   (*for i:=1 to make_margin do write(list,' ');*)\r
   (* \r
   if rcindex then \r
   begin\r
   write_ch(chr(191));\r
   write(list,chr(202+ord('S')-ord('A')));\r
   write(list,chr(202+ord('O')-ord('A')));\r
   \r
   for i:=1 to make_margin do write(list,' ');\r
   space_written:= 0;\r
   writeln(list);\r
   write_ch(chr(22));\r
   write_ch('s');\r
   write_ch('o');\r
   end;\r
   *)\r
   writenonterminal(left);\r
   (* if rcindex then write_ch(chr(190)); *) \r
   write_ch(':');\r
   write_ch(' ');\r
   write_ch(' ');\r
   write_ch(' ');\r
   writeterminal(lab);\r
   if morequme then \r
   begin\r
    write(list,cr);\r
    start_line(make_margin);\r
    (* for i:=1 to make_margin do write(list,' '); *)\r
    moretimes:=2;\r
    writenonterminal(left);\r
    write_ch(' ');\r
    write_ch(' ');\r
    write_ch(' ');\r
    writeterminal(lab);\r
   end;\r
   with rigth^ do\r
   begin\r
    for currentline:=-split to outdiff do\r
    begin\r
     writeln(list);\r
     writelineoftree(rigth,currentline,length+fill*2+2,outdiff);\r
    end;\r
    for currentline:=1+outdiff to more do\r
    begin\r
     writeln(list);\r
     writelineoftree(rigth,currentline,length+fill*2+2,outdiff);\r
    end;\r
    writeln(list);\r
   end;\r
   if rctekst then \r
   begin\r
    (**)\r
    write(list,chr(15),chr(10)); \r
    (**)\r
    writeln(list);\r
    writeln(list);\r
    writeln(list,chr(22),'mk sidsteformat');\r
    write(list,chr(22),'mk slutdef');\r
    writeln(list);\r
   end;\r
if fill=1 then i:=fill+2+make_margin+indent\r
else i:=fill+1+make_margin+indent;\r
if rigth^.length+i>linelength then\r
writeln(' !!!! warning line to long, length = ',rigth^.length:1)\r
;\r
end; (* ok *)\r
is_error:=false;\r
if not defined then writeln(' rule is undefined !!!!!');\r
writeln;\r
release(new_ptr);\r
tokenstart:=0;\r
tokenlength:=0;\r
end;\r
end;\r
\r
procedure int_to_alfa(i:integer;var a:alfa);\r
var length,j:integer;\r
   sign:boolean;\r
begin\r
  if i<0 then length:=1\r
  else if i>0 then length:=0\r
  else length:=1;\r
sign:=i<0;\r
j:=abs(i);\r
  while j>0 do\r
  begin j:=j div 10; length:=length+1; end;\r
  for j:=length+1 to 12 do a[j]:=' ';\r
  for j:=length downto 1 do\r
  begin a[j]:=chr(i mod 10 + ord('0')); i:=i div 10; end;\r
 if sign then a[1]:='-';\r
end;\r
\r
procedure system_param;\r
var str:string[255];\r
    command:string[12];\r
    help:string[12];\r
    str_pos,number:integer;\r
    found: boolean;\r
    i: integer;\r
    \r
  procedure param_number(var v: integer; default: integer);\r
  var h:integer;\r
  begin\r
    help:=copy(str,str_pos+1,len(str));\r
    val(help,h,str_pos);\r
    if h<1 then h:=default;\r
    if str_pos<>0 then\r
    begin\r
       param_error:=true; \r
    end else v:=h;\r
  end;\r
  \r
  procedure param_boolean(var b: boolean);\r
  begin\r
    help:=copy(str,str_pos+1,len(str));\r
    if help='yes' then b:=true else\r
    if help='no' then b:=false else \r
    begin param_error:=true; end;\r
  end;\r
  \r
begin\r
  found:=false;\r
  repeat\r
  if param_no>argcnt then \r
  begin param_finis:= true; found:=true; end\r
  else begin\r
    str:=argstr(param_no);\r
    str_pos:=pos('=',str);\r
    if str_pos=0 then\r
    begin input_file:=str; found:=true;\r
      period_pos:=pos('.',input_file);\r
      if period_pos=0 then input_file:=concat(input_file,'.syn');\r
    end\r
    else if (str_pos>13) or (str_pos=1) then \r
    begin param_error:= true; end\r
    else begin\r
      command:=copy(str,1,str_pos-1);\r
      for i:=1 to len(str) do\r
        if str[i]='_' then str[i]:=' ';\r
      if command='fill' then param_number(fill, d_fill) else\r
      if command='width' then  param_number(linelength, d_linelength) else\r
      if command='rcwidth' then  param_number(rcwidth, d_rcwidth) else\r
(*\r
      if command='length' then param_number(pagelength, d_pagelength) else\r
      if command='between' then param_number(line_space, d_line_space) else\r
      if command='head' then param_number(head, d_head) else\r
*)\r
      if command='rcmargin' then param_number(pmargin, d_pmargin) else\r
      if command='margin' then param_number(left_margin, d_left_margin) else\r
      if command='indent' then param_number(indent, d_indent) else\r
      if command='center' then param_number(center, d_center) else\r
 (*\r
      if command='title' then title:=copy(str,str_pos+1,len(str)) else\r
      if command='date' then date_v:=copy(str,str_pos+1,len(str)) else\r
      if command='time' then time_v:=copy(str,str_pos+1,len(str)) else\r
      if command='page' then begin\r
        param_number(page_nr, d_page_nr);\r
        if page_nr=0 then begin\r
          page_nr:=1;\r
          write_page_nr:= false;\r
        end else write_page_nr:=true;\r
      end else\r
 *)\r
      if command='connect' then param_boolean(connection) else\r
      if command='frame' then param_boolean(frame) else\r
 (*\r
      if command='qume' then param_boolean(qume) else\r
 *)\r
      if command='rctekst' then param_boolean(rctekst) else\r
      if command='rcindex' then param_boolean(rcindex) else\r
      if command='tpt' then param_number(tpt, d_tpt) else\r
      if command='lpt' then param_number(lpt, d_lpt) else\r
      if command='rctpt' then param_number(rctpt, d_rctpt) else\r
      if command='rclpt' then param_number(rclpt, d_rclpt) else\r
      begin param_error:= true; end;\r
    end;\r
  end;\r
  if param_error then\r
  begin\r
    writeln(output);\r
    writeln(output);\r
    writeln(output,' !!!!!!!!!!!!!            error in parameter: ',str);\r
    writeln(output);\r
    param_error:= false;\r
  end;\r
  param_no:=param_no+1;\r
  until found;\r
end;\r
\r
(*\r
procedure system_param;\r
const\r
power12=4096;\r
equality=6;\r
point=8;\r
var\r
sep,int:integer;\r
i:integer;\r
alf:alfa;\r
begin\r
if param_no=1 then\r
if system(param_no,int,alf) div power12=equality then\r
begin\r
param_no:=param_no+1;\r
sep:=system(0,int,syntax_file);\r
if (sep mod power12)<>10  then syntax_file:='synlist';\r
end;\r
sep:=system(param_no,int,input_file);\r
if (sep mod power12)<>10 then\r
begin\r
if sep=0 then param_finis:=true\r
else param_error:=true;\r
param_no:=param_no+1;\r
input_file:='input';\r
end else\r
begin\r
param_no:=param_no+1;\r
sep:=system(param_no,int,alf);\r
if (sep div power12)=point then\r
if (input_file='fill') and ((sep mod power12)=4) then\r
begin\r
if int<1 then fill:=d_fill else fill:=int;\r
param_no:=param_no+1;\r
system_param;\r
end else\r
if (input_file='width') and ((sep mod power12)=4) then\r
begin\r
if int<1 then linelength:=d_linelength else linelength:=int;\r
param_no:=param_no+1;\r
system_param;\r
end else\r
if (input_file='length') and ((sep mod power12)=4) then\r
begin\r
if int<1 then pagelength:=d_pagelength else pagelength:=int;\r
param_no:=param_no+1;\r
system_param;\r
end else\r
if (input_file='head') and ((sep mod power12)=4) then\r
begin\r
if int<1 then head:=d_head else head:=int;\r
param_no:=param_no+1;\r
system_param;\r
end else\r
if (input_file='margin') and ((sep mod power12)=4) then\r
begin\r
if int<1 then left_margin:=d_left_margin else left_margin:=int;\r
param_no:=param_no+1;\r
system_param;\r
end else\r
if (input_file='indent') and ((sep mod power12)=4) then\r
begin\r
if int<1 then indent:=d_indent else indent:=int;\r
param_no:=param_no+1;\r
system_param;\r
end else\r
if (input_file='between') and ((sep mod power12)=4) then\r
begin\r
if int<1 then line_space:=d_line_space else line_space:=int;\r
param_no:=param_no+1;\r
system_param;\r
end else\r
if (input_file='title') then\r
begin\r
title_pos:=0;\r
for i:=1 to title_max do title[i]:=' ';\r
repeat\r
if (sep mod power12)=4 then\r
int_to_alfa(int,alf);\r
for i:=1  to 12 do\r
begin\r
if (alf[i]<>' ') and (title_pos<title_max) then\r
begin\r
title_pos:=title_pos+1;\r
title[title_pos]:=alf[i];\r
 end;\r
end;\r
if (title_pos<title_max) then\r
 begin\r
title_pos:=title_pos+1;\r
title[title_pos]:=' ';\r
end;\r
param_no:=param_no+1;\r
sep:=system(param_no,int,alf);\r
until (sep  div power12)<>point;\r
system_param;\r
end else\r
if (input_file='date') then\r
begin\r
  if (sep mod power12)=4 then\r
  begin\r
    if int=0 then date(date_v)\r
    else  int_to_alfa(int,date_v);\r
  end else date_v:=alf;\r
param_no:=param_no+1;\r
 system_param;\r
end else\r
if (input_file='time') then\r
begin\r
  if (sep mod power12)=4 then\r
  begin\r
    if int=0 then time(time_v)\r
    else int_to_alfa(int,time_v);\r
  end else time_v:=alf;\r
  param_no:=param_no+1;\r
  system_param;\r
end else\r
if (input_file='page') and ((sep mod power12)=4) then\r
begin\r
if int<1 then page_nr:=d_page_nr else page_nr:=int;\r
param_no:=param_no+1;\r
system_param;\r
end else\r
if (input_file='connect') and ((sep mod power12)=10) and\r
((alf='no') or (alf='yes')) then\r
begin\r
connection:=(alf='yes');\r
param_no:=param_no+1;\r
system_param;\r
end else\r
if (input_file='qume') and ((sep mod power12)=10) and\r
((alf='no') or (alf='yes')) then\r
begin\r
qume:=(alf='yes');\r
param_no:=param_no+1;\r
system_param;\r
end else\r
if (input_file='frame') and ((sep mod power12)=10) and\r
((alf='no') or (alf='yes')) then\r
begin\r
frame:=(alf='yes');\r
param_no:=param_no+1;\r
system_param;\r
end else\r
begin\r
param_error:=true;\r
param_no:=param_no+1;\r
input_file:='input';\r
end;\r
end;\r
end;\r
*)\r
\r
function find_next_def: integer;\r
var next_def,next_length,next_start,index_def,j: integer;\r
    length: integer;\r
begin\r
  next_def:=0;\r
  while (def[next_def].page=0) and (next_def<def_free-1) do\r
  next_def:=next_def+1;\r
  next_start:=def[next_def].namestart;\r
  next_length:=def[next_def].namelength;\r
  for index_def:=1 to def_free-1 do\r
  with def[index_def] do\r
  if page<>0 then\r
  begin\r
    if next_length<=namelength then length:=next_length\r
    else length:=namelength;\r
    i:=0;\r
    while (i<length) and (name_def[i+next_start]=name_def[i+namestart])\r
    do i:=i+1;\r
    if ((i>=length) and (next_length>length)) or\r
       ((i<length) and (name_def[i+next_start]>name_def[i+namestart]))\r
    then begin\r
      next_def:=index_def;\r
      next_start:=namestart;\r
      next_length:=namelength;  \r
    end;\r
  end;\r
  if def[next_def].page=0 then find_next_def:=-1 else\r
  begin\r
    find_next_def:=next_def;\r
  end;\r
end;\r
\r
begin\r
(* RC8000 initialize *)\r
nl:=chr(10);\r
cr:=chr(13);\r
macro_no:=0;\r
is_error:= false;\r
param_no:=1;\r
param_finis:=false;\r
param_error:=false;\r
syntax_file:='syndia.lst';\r
input_file:='KBD:';\r
fill:=d_fill;\r
pagelength:=d_pagelength;\r
linelength:=d_linelength;\r
head:=d_head;\r
left_margin:=d_left_margin;\r
pmargin:=d_pmargin;\r
make_margin:=d_left_margin;\r
indent:=d_indent;\r
center:=d_center;\r
line_space:=d_line_space;\r
title:='';\r
date_v:=d_date;\r
time_v:=d_time;\r
page_nr:=d_page_nr;\r
if page_nr=0 then begin\r
page_nr:=1;\r
write_page_nr:= false;\r
end else write_page_nr:=true;\r
connection:=true;\r
qume:=d_qume;\r
rctekst:=d_rctekst;\r
rcindex:=d_rcindex;\r
tpt:=d_tpt;\r
lpt:=d_lpt;\r
rctpt:=d_rctpt;\r
rclpt:=d_rclpt;\r
rcwidth:=d_rcwidth;\r
frame:=d_frame;\r
name_def_free:=0;\r
for def_free:=0 to def_max do def[def_free].page:=0;\r
def_free:=0;\r
def_overflow:= false;\r
system_param;\r
if input_file<>'KBD:' then \r
begin\r
  period_pos:=pos('.',input_file);\r
  if period_pos=0 then period_pos:=len(input_file)\r
  else period_pos:=period_pos-1;\r
  syntax_file:=copy(input_file,1,period_pos);\r
  if rctekst then syntax_file:=concat(syntax_file,'.wp')\r
  else syntax_file:=concat(syntax_file,'.lst');\r
end;\r
writeln(' syntax diagrams printed on ',syntax_file);\r
writeln(' ***************************************');\r
writeln;\r
assign(list,syntax_file);\r
rewrite(list);\r
if rctekst then\r
begin\r
for i:=0 to 7 do write(list,chr(0));\r
write(list,chr(66));\r
write(list,chr(6));\r
write(list,chr(6));\r
write(list,'RC630',chr(0),chr(0),chr(0));\r
for i:=19 to 26 do write(list,chr(0));\r
write(list,chr(pmargin));\r
write(list,'N');\r
for i:=29 to 70 do write(list,chr(0));\r
writeformat(rctpt,rclpt,'L');\r
(*write(list,chr(10));*)\r
writeln(list,chr(22));\r
end;\r
repeat\r
line_ch:='-';\r
if qume then connectline:='*' else connectline:=chr(137) (*'!'*);\r
if rctekst then begin \r
connectline:=' '; line_ch:=' ';\r
end;\r
if rctpt<=0 then help:=12 else help:=rctpt;\r
pos_adjust:= pmargin*( 119 div help + 1 );\r
if tpt<=0 then help:=12 else help:=tpt;\r
pos_adjust:= pos_adjust div (119 div help + 1);\r
if frame then\r
begin\r
frametermfirst:='(';\r
frametermlast:=')';\r
framenonterm:=connectline;\r
end else\r
begin\r
frametermfirst:=' ';\r
frametermlast:=' ';\r
framenonterm:=' ';\r
end;\r
writeln;\r
write(' syntax input from ',input_file);\r
lastch:=' ';\r
token:=' ';\r
tokenstart:=0;\r
lineno:=pagelength;\r
tokenlength:=0;\r
token:='.';\r
assign(input_f,input_file);\r
(*$I-*) reset(input_f) (*$I+*);\r
if iores>0 then writeln(', file does not exist') else gettoken; \r
writeln;\r
writeln(' -------------------------------');\r
writeln;\r
while token<>'.' do\r
begin\r
rule;\r
if token=';' then gettoken;\r
end;\r
close(input_f);\r
system_param;\r
until param_finis;\r
line_space:=0;\r
lineno:=pagelength; (* new page *)\r
check_page(3);\r
if rctekst then\r
begin\r
  writeln(list,chr(22),'mk startdef drawall');\r
  for def_next:=0 to def_free-1 do\r
  with def[def_next] do\r
  begin\r
  write(list,chr(22),'** ');\r
  for name_def_free:=namestart to namestart+namelength-1\r
  do write(list,name_def[name_def_free]);\r
  writeln(list);\r
  writeln(list,chr(22),'ma ',macro);\r
  end;\r
  write(list,chr(22),'mk slutdef');\r
  writeln(list);\r
end else\r
begin\r
writeln(list);\r
if def_overflow then \r
begin\r
  writeln(list,' ***************** INDEX table not complete ');\r
end else writeln(list);\r
writeln(list);\r
def_next:=find_next_def;\r
while (def_next>=0) do\r
with def[def_next] do\r
begin\r
  check_page(1);\r
  if left_margin>0 then write(list,' ':left_margin);\r
  for name_def_free:=namestart to namestart+namelength-1\r
   do write(list,name_def[name_def_free]);\r
  write(list,'  ');\r
  for name_def_free:=namelength to linelength-left_margin-20 \r
  do write(list,'.');\r
  writeln(list,page:5);\r
  page:=0;\r
  def_next:=find_next_def;\r
end;\r
end;\r
close(list);\r
end.\r
\r