⟦feec64c31⟧

TextFileVerbose

job stb 400 time 1 0 0,
size 26000,
perm disc1 1000 10
indexsort=set 1 disc1
scope user indexsort
indexsort=algol
\f


begin <***************************************************
*
*       i n d e x s o r t
*
* this program is used to assist an author in producing 
* an index to his manual.
*
* its function is described in rcsl-no. 52-aa1014
*
* programmed october 1979 by oer
* modified   november 1980 by stb    (capital letters)
*
*********************************************************>

\f

 
<********************************************>
<*    declarations                          *>
<********************************************>
 
   
   zone zin,zout,zhelp,zsort(128,1,stderror);
   real array rec(1:18), names(1:6);
real array infile(1:2),outfile(1:2),keyw(1:4),keytxt(1:2),maxpage(1:2);
real array act_text(1:6);
   integer array table(0:255), param(1:7), key_descr(1:6,1:2);
   
   integer i,j,k,no_of_recs,max_length,result,explanation,max_point,act_point;
integer line_no,out_pos,out_line,out_page,in_char,act_char,p1,p2,p3;
boolean test;
boolean field capitals;
   
   integer field len,point,typ;
   real eof;
integer array field iaf;
real array field in_text,syn_text, sort_text;
\f

   
   procedure set_table;
   begin <*defines an in_table with all
      characters having class 'text' except 'em' and 'nl'.
      'nul' is blind *>
      integer i,j,k;
      
      for i:=1 step 1 until 255 do
      table(i):=6 shift 12 + i;
      
      table(0):=0;
      table(10):=8 shift 12 + 10;
      table(25):=8 shift 12 + 25;
table(36):=7 shift 12 + 36;
for j:=48 step 1 until 57 do
table(j):=2 shift 12 + j;
      table(13):=13;
      intable(table);
   end set table;
\f

 
procedure create_sort_text;
begin <* copies rec.in_text to rec.sort_text while
converting capital letters to small letters.
if any capital letters occured then rec.capitals is set
to true *>

boolean caps;
integer point, in_char, sort_char,j;
real in_db_word, sort_db_word;

caps:=false;

for point:=1 step 1 until 5 do
begin <* copy a double word *>
in_db_word:=rec.in_text(point);
sort_db_word:=real<::>;

if in_db_word <> real<::> then
for j:=-40 step 8 until 0 do
begin <* copy a letter *>
in_char:=in_db_word shift j extract 8;

if (in_char>64) and (in_char<94) then
begin 
caps:=true;
sort_char:=in_char+32;
end
else
sort_char:=in_char;

sort_db_word:=sort_db_word shift 8 add sort_char;
end;

rec.sort_text(point):=sort_db_word;
end;

rec.capitals:=caps;
end create sort text;


\f


procedure testout(text,int);
string text;
integer int;
begin
write(out,text,"sp",1,int,"nl",1);
setposition(out,0,0);
end;
\f

 
integer procedure jobpar(no,txtar);
integer no;
real array txtar ;
begin
  integer i,j;
  i:=system(4,no,txtar);
  j:=1;
  while (keyw(j)<>txtar(1)) and (j<4) do j:=j+1;
  if j=4 then
   write(out,<:invalid jobparameter :>,no,"nl",1) 
 else
   jobpar:=j;
end procedure jobpar;
\f

 
procedure err1;
write(out,<:missing word in bossline :>,line_no,"nl",1);
 
procedure err2;
write(out,<:word too long in bossline :>,line_no,"nl",1);
 
procedure err3;
write(out,<:pagenumber too big in bossline :>,line_no,"nl",1);
\f

 
<********************************************>
<*    initializations                       *>
<********************************************>
 
   set_table;
keyw(1):=real <:in:>;
keyw(2):=real <:out:>;
keyw(3):=real <:max:>;
keyw(4):=real <:err:>;
 
sort_text:=4;
syn_text:=52;
in_text:=32;
for i:=1 step 1 until 6 do
act_text(i):=real <::>;
   
test:=true;
   len:=2;
iaf:=0;
capitals:=29;
   point:=28;
 typ:=26;
p1:=0; p2:=0; p3:=0;
line_no:=10;
\f

 
<********************************************>
<*    read jobparameters                    *>
<********************************************>
 
 
for j:=1 step 2 until 5 do
begin
   case jobpar(j,keytxt) of
   begin
    begin  <* jobparameter 1 *>
     i:=system(4,j+1,infile);
     k:=1;

     open(zin,4,string infile(increase(k)),0);
p1:=1;
    end;
   begin  <* jobparameter 2 *>
i:=system(4,j+1,outfile);
k:=1;
open (zout,4,string outfile(increase(k)),0);
p2:=1;
end;
begin  <* jobparameter 3 *>
 i:=system(4,j+1,maxpage);
max_point:=maxpage(1);
p3:=1;
end;
end case;
end for;
if i=0 then write(out,<:jobparametererrror :>,j+1,"nl",1);
   open(zhelp,4,<:helplist:>,0);
   
if p1=0 then open(zin,4,<:in:>,0);
if p2=0 then open(zout,4,<:out:>,0);
if p3=0 then max_point:=100;
\f

 
<********************************************>
   <* now read the lines and copy them to zhelp as records *>
<********************************************>
   
   no_of_recs:=0;
   max_length:=52;
act_point:=0;
act_char:=0;
   
   
   repeat
for i:=1 step 1 until 18 do
rec(i):=real<::>;
i:=readchar(zin,j);
line_no:=line_no+10;
case i of
begin
;
begin   <* pagenumber *>
repeatchar(zin);
read(zin,act_point);
if act_point > max_point then err3;
end;
;;;
begin  <* character *>
if j=35 then
begin    <* f or ff *>
readchar(zin,j);
if j=35 then
begin   <* ff  *>
k:=readstring(zin,rec,9);
if k=0 then err1;
if k>5 then err2;
rec.len:=32;
rec.typ:=3;
rec.point:=act_point;
end
else
begin    <*  f  *>
repeatchar(zin);
k:=readstring(zin,rec,9);
if k=0 then err1;
if k>5 then err2;
rec.len:=32;
rec.typ:=2;
rec.point:=act_point;
end
end
else
begin   <* keyword *>
repeatchar(zin);
k:=readstring(zin,rec,9);
if k=0 then err1;
if k>5 then err2;
rec.len:=32;
rec.typ:=1;
rec.point:=act_point;
end;
end;
begin <* synonym *>
k:=readstring(zin,rec,9);
if k=0 then err1;
if k>5 then err2;
k:=readstring(zin,rec,14);
if k=0 then err1;
if k>5 then err2;
rec.len:=72;
rec.typ:=4;
max_length:=72;
end;
;
end case;
 
if (j<48) or (j>57) then
begin
create_sort_text;

if rec.capitals and (rec.typ<>4) then rec.len:=52;

outvar(zhelp,rec);
no_of_recs:=no_of_recs+1;
end;
 
until i=8;
 
for i:=1 step 1 until 12 do
rec(i):=real<::>;
rec.len:=32;
outvar(zhelp,rec);
 
close(zhelp,false);
\f


<* now set up the parameters for the call of mdsortproc *>
 
<**********************************************>
param(1):=1; <* segments pr in_block *>
param(2):=1; <* clear input is ok *>
param(3):=1; <* segments pr out_block *>
param(4):=0; <* variable record length *>
param(5):=max_length;
param(6):=6; <* no of keys *>
param(7):=0; <* don't print expected time *>

key_descr(1,1):=3; <* type = long, ascending *>
key_descr(1,2):=8; <* position *>
 
key_descr(2,1):=3;
key_descr(2,2):=12;
 
key_descr(3,1):=3;
key_descr(3,2):=16;
 
key_descr(4,1):=3;
key_descr(4,2):=20;
 
key_descr(5,1):=3;
key_descr(5,2):=24;
 
key_descr(6,1):=2; <* integer, ascending *>
key_descr(6,2):=28;
names(1):=real<:helpl:> add 'i';
names(2):=real<:st:>;
names(3):=real<:outli:> add 's';
names(4):=real<:t:>;
names(5):=real<::>;
names(6):=real<::>;

mdsortproc(param,key_descr,names,eof,no_of_recs,result,explanation);

write(out,<:result was:>,result,explanation,"nl",1);
\f


open(zsort,4,<:outlist:>,0);

<*********************************************>
<*    make the outputfile                     *>
<*********************************************>

for i:=1 step 1 until 6 do act_text(i):=real<::>;
 
out_pos:=0;
out_line:=65;
out_page:=max_point;
act_char:=0;
 
for i:=1 step 1 until no_of_recs do
begin 
   invar(zsort);
<* first find out if a new word is coming *>
 
j:=1;
while (act_text(j)=zsort.sort_text(j)) and (j<6) do j:=j+1;
 
<* now if j is less than 6 it is a new word *>
 
if j<6 then
begin   <* new text *>
if out_line >60 then
begin
write(zout,"ff",1,"nl",1," ",28,out_page,"nl",3);
out_pos:=0;
out_page:=out_page+1;
out_line:=4;
end;
 
in_char:=zsort.sort_text(1) shift (-40) extract (8);
 
if act_char <> in_char then
begin <* new first-letter *>
act_char:=in_char;
write(zout,"nl",1);
out_line:=out_line+1;
end;
 
write(zout,"nl",1);
k:=1;
write(zout, ".", 39- write(zout, <:        :>,
_     if zsort.capitals then string zsort.in_text(increase(k))
_                     else string zsort.sort_text(increase(k))
_                                           ), <:  :>);
 
out_line:=out_line+1;
out_pos:=41;
 
for j:=1 step 1 until 5 do
act_text(j):=zsort.sort_text(j);
  
act_text(6):=real<::>;  <* type and page-no. *>
end;
 
if (act_text(6)<>zsort.sort_text(6)) or (j<6) then
begin

act_text(6):=zsort.sort_text(6);   <* type and point (i.e. pageno. *>
<* this is in order not to print the same pageno. twice, even
if the user has specified it twice on the same page (by mistake) *>
 
 
case zsort.typ of
begin
begin <* only pagenumber *>
if out_pos > 62 then
begin
out_pos:=write(zout,"nl",1," ",41,zsort.point);
out_line:=out_line+1;
end
else
if out_pos<> 41 then
out_pos:=out_pos+write(zout,<:,:>,zsort.point)
else
out_pos:=out_pos+write(zout,zsort.point);
end;
begin  <* pageno and f *>
if out_pos > 62 then
begin
out_pos:=write(zout,"nl",1," ",41,zsort.point,<: f.:>);
out_line:=out_line+1;
end
else
if out_pos<>41 then
out_pos:=out_pos+write(zout,<:,:>,zsort.point,<: f.:>)
else
out_pos:=out_pos+write(zout,zsort.point,<: f.:>);
end;
begin  <* pageno and ff *>
if out_pos > 62 then
begin
out_pos:=write(zout,"nl",1," ",41,zsort.point,<: ff.:>);
out_line:=out_line+1;
end
else
if out_pos <> 41 then
out_pos:=out_pos+write(zout,<:,:>,zsort.point,<: ff.:>)
else
out_pos:=out_pos+write(zout,zsort.point,<: ff.:>);
end;
begin  <* syn text *>
k:=1;
out_pos:=out_pos+write(zout,<: :>,string zsort.syn_text(increase(k)));
end;
 
end case;
end;
end  for;

write(zout,<:<25><25><25>:>);
close(zout,true);
end
if warning.yes
(message warning compilation of indexsort not ok
finis)
message compilation ok
finis
«eof»
DataMuseum.dk

RC3500

⟦feec64c31⟧ TextFileVerbose

Derivation

TextFileVerbose
