DataMuseum.dk

top - metrics - download

    Length: 50688 (0xc600)
    Types: TextFile
    Names: »kattekst«

└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ.  Detaljer om "HC8000" projekt.
    └─⟦0364f57e3⟧ 
        └─⟦this⟧ »kattekst« 
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
    └─⟦4334b4c0b⟧ 
        └─⟦this⟧ »kattekst« 

TextFile

begin <* program, niveau 1 *>
 integer lbrug_inf_kons; <* den samlet længde målt i ord *>
                         <* af de informationskonstanter *>
                         <* brugeren kan ændre           *>
 integer lbrug_kpost_felt;<* antal felt_typer, som brugeren *>
                          <* kan ændre i en katalogpost     *>
 integer anttilstande;    <* antal tilstande i aktions      *>
                          <*tabellen                        *>
 integer antinputordre;   <* antal inputordre i aktions     *>
                          <* tabellen                       *>

<* index til brug ved opslag, efter felter i kpfl arrayet   *>
integer type_index, titel_index, for_index, bib_index;
integer res_index, ankomst_index, journal_index, stikord_index;
integer beskriv_index, ord_index, søgemængde_index, mængdestr_index;



anttilstande:=17; antinputordre:=42;
lbrug_kpost_felt:=9;
lbrug_inf_kons:=12;

<*initialisering af index til opslag i kpfl_arrayet*>
bib_index:=i:=1;
res_index:=i:=i+1;
ankomst_index:=i+1;
type_index:=i:=i+1;
titel_index:=i:=i+1;
journal_index:=i:=i+1;
beskriv_index:=i:=i+1;
for_index:=i+1;
stikord_index:=i:=i+1;
ord_index:=i:=i+1;
søgemængder_index:=i:=i+1;
mængdestr_index:=i:=i+1;


begin     <*niveau2*>
zone znykatpost(128,1,stderror);
zone zkatpost(128,1,stderror);
zone zinvlist(128,1,stderror);
zone zværdiliste(128,1,stderror);
zone filinf(128,1,stderror);
zone værinf(128,1,stderror);
zone znykatpost(128,1,stderror);
zone znykatpost(128,1,stderror);
<*konstanter til opbevaring af indholdet af *>
<*værdiliste_filens informationsområde*>
integer vfværførst, <*nummeret på første segment der*>
                    <*indeholder en værdiliste_post*>
        vfværantal; <*antal poster i værdilisten*>
long array ordretabel(i:antinputordre);
integer array aktionstabel(0:(anttilstande-1),1:(antinputordre+1));

<*konstanter til predefinition af (f)elt_(l)ængder, i en*>
<*katalogpost*>
integer array k_p_fl(1:lbrug_inf_kons);

<*fil_informations konstanter svarende til brugerens gamle fil*>

  <*reference konstanter*>

integer gfkatstart, <*segmentnummeret på første katalogpost*>
        gfkatstr,   <*kaatalogets størelse i antal poster   *>
        gfinvstart; <*segmentnummeeret på første post i     *>
                    <*inverteret liste delen                *>

<*konstanter brugeren kan ændre*>
<*konstanter i (g)ammel (f)il (f)eltlængder*>
integer array k_gf_fl(1:lbrug_inf_kons);

<*filinformations konstanter svarende til brugerens*>
<*(n)ye (f)il, dvs, efter modyfy                    *>

<*referencer konstanter*>
integer nykatstart,nykatstr, nyinvstart;

<*konstanter brugeren kan ændre*>
<*konstanter (n)y (f)il (f)elt (l)ængder*>
integer array k_if_fl(1:lbrug_inf_kons);

<*(k)katalog (i)nformations_post*>
integer field
<*reference felter*>
      kikatstart,kikatstr,kiinvstart;
integer array field kiarraystart;<*starten på det array der indeholder*>
                                 <*resten af konstanterne              *>

<*katalog_posten*>
boolean field slettet,<*=true dersom posten er slettet ellers false*>
              udvidet,<*=true dersom posten er slettet ellers false*>
              mor;    <*=true dersom posten er en moder ellers false*>
integer field modadr, <*pegerpind til eventuel moder*>
              barnadr,<*pegepind til eventuel post_udvidelse*>
              forantal,<*antal forfattere i brug*>
          stiktegnantal;<*aktuelt antal tegn i stikords_streng*>
long array field kpostarraystart;<*starten på det array der    *>
                       <*indeholder det for brugere synlige del*>
                       <*af posten*>
integer array kpost(1:lbrug_kpost_felt)
  ;<*omdeholder start indexet for de forskellige felter i kpostarraystart*>

<*post i (v)ærdiliste (f)ilen*>
long array lield vford; <*tekst ordets start*>
integer field vfantal,<*antal af referencer i inverteretfilliste*>
              vfref;  <*nummeret på den første post i den inverte_*>
                      <*rede liste*>

<*post i værdi liste informationsdelen*>
integer field viførst, <*segmentnummeret på første post i værdi_listen*>
              viantal; <*antal poster i værdilisten*>

<*post i inverteret liste*>
integer field ilfeltkode,<*feltkode_delen*>
              ifkatref,  <*reference til katalogpost*>
              ilinvref;  <*reference til næste post i listen*>

<*post i nængde_index_array,dvs.indgang til en resultat_søgemængde*>
integer field
        søgførst, <*peger på første element i søgemængden*>
        søgsidst; <peger på sidste element i søgemængden*>


<*variabler til brug ved manipulation af poster, zone erklæringer og*>
<*arrayerklæringer*>

integer lfilinf, <*længden af katalog filinformationsområdet i *>
                 <*enheder i værdifilen*>
        lværinf; <*længden af informations området i værdifilen*>


<*vdr, katalogpost*>
boolean gf_ktp_seg;<*=true dersom en katalogpost i gammel brugerfil*>
                   <*kan være inden for (netop) eet segment*>
        gf_ktp_antal,<*vdr gammel brugerfil, antal katalogposter i*>
                     <*segment eller antal segmenter på katalogpost*>
        gf_ktp_længde;<*vdr gammel brugerfil, længde af en katalogpost*>
                      <*i antal dobbeltord*>
 <*vdr værdiliste_post*>

boolean vf_vær_seg;<*=true dersom en værdilistepost kan være indefor et*>
                   <*netop et segment*>
integer vf_vær_længde,<*vdr.værdiliste_fil, længde af en post i antal*>
                   <*dobbeltord*>
        vf_vær_antal; <*vdr værdilistefil,antal poster i et segment eller*>
                   <*antal segmenter pr. post*>


 <*vdr. inverteret liste*>
boolean gf_inv_seg; <*vdr gammel brugerfil*>
                    <*=true dersom en inverteret_liste post kan være indenfor*>
                    <*et segment*>
integer gf_inv_længde,<*vdr gammel brugerfil, størelse i antal dobbeltord*>
                     <*af en post i inverteret liste*>
        gf_inv_antal;<*vdr gammel brugerfil;antal inverteret_liste_poster*>
                     <*i et segment eller antal segmenter pr. post*>
<*andre variabler*>

integer aktion, <*resultatet ved opslag i aktionstabellen*>
       tilstand,<*første index ved opslag i aktions tabellen*>
    nordrekode, <*kode for nyordre*>
    gordrekode, <*kode for forrige ordre*>
          ful,  <*angiver om et array er fyldt op efter kald af*>
                <*readstring*>
            i,  <*tællervariabel*>
      katpostnr,<*nummeret på den katalogpost, der for øjeblikket er*>
                <*under ændring, skal bruges når en hovedordre skal*>
                <*afsluttes*>
   ledigkatpost,<*nummeret på næste ledige katalogpost i brugerfilen*>
    mængdenr,   <*nummeret på en søgeresultatmængde*>
   elementantal,<*antal af elementer i en resultatsøgemængde*>
mængdeindexnæste,<*næste ledige index i mængdeindex arrayet*>
søgemængdenæste,<*næste ledige index i søgemængdearrayet*>
  fra, til,     <*hjælpevariable angiver index fra og til i*>
                <*søgemængder*>
lighedstegn,    <*delimitor, som bruges i underordre, er initielt *>
                <*ligtegnet '='*>
dollertegn;     <*reservationstegn, for tekststreng*>
real array brugerfil(1:5); <*navn på brugerfil*>
real array værdifil(1:5);<*navn på værdilistefil*>
long array ordretekst(1:1);<*indholder de første bogstaver af*>
                           <*en ordre*>

boolean
      initja, <*=true dersom init_proceduren skal kaldes ellers false*>
     aflutja, <*=false dersom der er opstået fejl i hovedordre       *>
              <*der bevirker at denne ikke kan afsluttes*>
     opdatja, <*false dersom der kun er foretaget søgning i kataloget*>
     fortsæt; <*=false bevirker at programmet starter*>


integer field shovord, <*angiver sidste hovedordre*>
              fhovord, <*angiver første hovedordre*>
           snfeltord,  <*sidste normale feltunderordre*>
            sfeltord,  <*sidste postfeltunderordre*>
            ffeltord,  <*første postfeltunderordre*>
            fsøgord,   <*første søgeunderkordre*>
            ssøgord,   <*sidste søge_underordre*>
            fkomord,   <*første kombineret søgeunderordre*>
            skomord,   <*sidste kombineret søgeunderordre*>
          fmodifyord,  <*førstemmodify underordre*>
          smodifyord,  <*sidste modify underordre*>
              forord,  <*koden på underordre outhor*>
            stikord,   <*koden på underordren keyword*>

<************************************************************>
<***         procedure dobbeltordlængde                   ***>
<*************************************************************>

procedure dobeltordlængde(resultat,i);
integer resultat,i;

<*resultat sættes lig i delt med 4 og derefter*>
<*hvor nødvendigt rundet op*>
begin
integer j; <*hjælpevariabel*>
j:=i;
j:=i//4
if i mod 4 >0 then
begin
  j:=j+1;
end;
resultat:=1;
end;

<************************************************************>
<***   procedure post_skriv_læs_konstanter                ***>
<************************************************************>
procedure post_skriv_læs_konstanter(længde,antal,iseg);

value længde;
integer længde, antal;
boolean iseg;

<*sætter iseg lig true dersom længde > størrelse af et segment*>
<*ellers false*>
<*forseg=true:angiver antal hvor mange gange (helt antal)længde*>
<*går op i størelsenn af eet segment*>
<*forseg=false:angiveraantalhhvormmange((heltaantal)segmenter*>
<*der går på een længde. Længde er målt i antal dobbeltord*>

begin
if længde>= 128 then 
 begin
  iseg:=false;
antal:=længde//128;
if (længde mod 128) > 0 then
 begin
 antal:=antal+1;
 end;
end 
else
begin
  iseg:=true;
  antal:=128//længde
end;
end;

<***********************************************************>
<***           procedure pak                             ***>
<***********************************************************>

long procedure pak(val1,val2,val3,val4,val5,val6);
value val1,val2,val3,val4,val5,val6;
integer val1,val2,val3,val4,val5,val6;

<*pakker tegnene i de 6 parametre i et long*>
<*således at val1 ligger i de første 8 bit *>

begin
long dummy;
dummy:=0;
pak:=dummy shift 8 add val1 shift 8 add val2
     shift 8 add val3 shift 8 add val4 shift 8
     add val5 shift 8 add val6;
end;

<**************************************************************>
<***           procedure pakud                              ***>
<**************************************************************>

procedure pakud(fra,val1,val2,val3,val4,val5,val6);
value fra;
long fra;
integer val1,val2,val3,val4,val5,val6;
<*pakker tegn ud fra variabler fra, således val val1*>
<*indeholder tegnet i de første 8 bit val2 tegnet i de næste 8 bit*>

begin
val1:=fra shift(-40) extract 8;
val2:=fra shift(-32) extract 8;
val3:=fra shift(-24) extract 8;
val4:=fra shift(-16) extract 8;
val5:=fra shift(-8) extract 8;
val6:=fra shift 8;
end;

<*************************************************************>
<***            procedure skip_linie_rest                  ***>
<*************************************************************>
procedure skip_linie_rest;
<*skiper resten af en linie på in zonen*>
begin
integer ch;
read(in,ch);
while ch <> 'nl' do
  begin
  readchar(in,ch);
  end;
end;

<**************************************************************>
<***             procedure skipblanke                       ***>
<**************************************************************>

procedure skipblanke;
begin
integer ch;
readchar(in,ch);
while ch='sp' do
begin
  readchar(in,ch);
end;
repeatchar(in);
end;
<***************************************************************>
<***           procedure skipordrerest                        ***>
procedure skipordrerest;

<***************************************************************>
<***          procedure ordreidentifikation                  ***>
<***************************************************************>

integer procedure ordreidentifikation(ordretekst, antinputordre);
value ordretekst,antinputordre;
long array ordretekst;
begin
 integer nr,i;
 nr:=antinputordre+1;
 for i:=1 step 1 until antinputordre do
 begin
  if  ordretekst(1):=ordretabel(i) then nr:=i;
 end;
ordreidentifikation:=nr
end;

<****************************************************************>
<***             procedure indsæt_for                         ***>
<****************************************************************>

procedure indsæt_for(buffer, for, fnr);
value for, fnr;
long array buffer, for;
integer fnr;

<*indsætter forfatter værdien for som forfatter nr=fnr *>
<*i bufferen buffer, sætter forfatterantallet op med 1*>
begin
integer start, slut,i;
start:=kpost(for_index)+(fnr-1)*k_gf_fl(for_index);
slut:=start+k_gf_fl(for_index)-1;
buffer.forantal:=buffer.forantal+1;
for i:=start step 1 until slut do
 begin
 buffer.kpostarraystart(i):=for(i-start+1);
 end;
end;
<*************************************************************>
<***           procedure indsæt_stiktegn                   ***>
<*************************************************************>

procedure indsæt_stiktegn(post,nr,val1);
value nr,val;
long array post; <*post hvori et tegn i stikordsfeltet skal*>
                 <*indsættes*>
integer nr, <*nummeret på det tegn der skal indsættes*>
      val1; <*det tegn der skal indsættes*>

<*proceduren indsætter et tegn i stikordsfeltet for posten post.*>
<*Tegnene i feltet er nummereret fra 1 og opefter. Tegnet val,  *>
<*som skal indsættes, bliver indsat som tegn nummer llg nr. Post*>
<*feltet som angiver antallet af tegn i stikordsfeltet som er i *>
<*brug forbliver uforandret*>

begin
long højre, <*tegnene til højre for det teng der skal  indsættes i*>
            <*resten af longet er fuldt op med nuller 0*>
    venstre,<*tegnerne til venstre*>
      midt, <*tegnet der skal indsættes placeret i position nr.  *>
            <*ellers fyldt op med nuller*>
      val2; <*hjælpe buffer*>
integer felt_index, <*indexet for det array_element hvori tegnet  *>
                    <*skal indsættes*>
            relnr;  <*relativt tegn nummer i arraylement*>
felt_index:=kpost(stikord_index)+nr//6;
relnr:=nr mod 6 +1;
val2:=post.kpostarraystart(felt_index);
if relnr = 6 then
begin
  højre:=val2 shift 48;
end;
else
begin
  højre:=val2 shift (8*relnr) shift(-8*relnr);
end;
if relnr =1 then
begin
  venstre:=val2 shift 48;
end;
else
begin
  venstre:=val2 shift(-8*(7-relnr)) shift (8*(7-relnr));
end;
midt:=0;
midt:=midt shift 48 add val1 shift(6-relnr);
prsk.kpostarraystart(felt_index):=venstre+midt+højre;
end; <*indsæt_stiktegn*>


<*************************************************************>
<***       procedure indsæt_stikord                        ***>
<*************************************************************>

boolean procedure indsæt_stikord(post,itegnbuf,fra,til);
value itegnbuf;
long array post; <*indeholder katalogposter*>
integer array;<*indeholder det stikord der skal indsættes,*>
              <*arrayet går fra 1:længden af et ord. Hvert*>
              <*arrayelement indeholder et tegn af ordet  *>
integer fra,til,<*hvis der ikke er plads til stikordet, vil*>
               <*fra og til angive de inclusive grænser for*>
               <*den medtagne del af stikordet             *>

<*indsætter stikordet i tegnbuf i stikordsfeltet for poster POST*>
<*funktionsværdien er false dersom der ikke er plads til stikordet*>
<*fra og til angiver da hvilken del af ordet der er medtaget*>
boolean procedure indsæt_stikord(post,itegnbuf,fra,til);
begin <*indsæt_stikord*>
boolean fejl;
integer i,f,t,feltlængde,blank;
feltlængde:=k_gf_fl(ord_index)*6;

i:=1;
fejl:=false;
<*skip blanke*>
while itegnbuf(i)='sp' and i < feltlængde do
begin
 i:=i+1;
end;
f:=i;
if f:=feltlængde then begin fejl:=true end;
<*indsæt begyndelses blanktegn*>
if not fejl and post.stiktegnantal < 6*k_gf_fl(stikord_index) then
begin
blank:='sp';
post.stiktegnantal:=post.stiktegnantal+1;
indsæt_stiktegn(post,post.stiktegnantal,blank);
end;

<*indsæt tegn i post_feltet*>
while itegnbuf(i)<>'sp' and i<=feltlængde and not fejl do
 begin
  if post.stiktegnantal >=6*k_gf_fl(stikord_index)
  then begin
  fejl:=true end;
  else
  begin
  post.stiktegnantal:=post.stiktegnantal+1;
  indsæt_stiktegn(post,post.stiktegnantal,itegnbuf(i));
  end;
i:=i+1;
end; <*while*>
t:=i;
fra:=f;
til:=t;
indsæt_stikord:=not fejl;
end; <*indsæt_stikord*>


<**************************************************************>
<***            procedure læs_stiktegn                      ***>
<**************************************************************>


procedure læs_stiktegn(nr,val,post);
value nr;
integer val, <*retur_værdi,det indlæste tegn*>
         nr; <*nummeret på tegnet i følgen af stikord,*>
             <*tegnene tænkes nummereret fra 1 og op efter*>
long array post;<*posten kvorfra stikords_tegnet skal læses*>

<*indlæser et tegn fra stikordsfeltet i posten post*>
<*hvilket tegn i følgen der ønskes angives ved nummeret NR*>
<*Det er op til omgivelserne at kontrollere at feltgrænserne ikke*>
<*overskrides*>

begin
integer elementnr;   <*index nummeret på det array element i*>
                     <*posten som indeholder tegn nummer nr*>
long element; <*buffer variabel*>

elementnr:=kpost(stikord_index)+(nr-1)//6;
element:=post.kpostarraystart(elementnr);
val:=element shift(-1*(6-nr mod 6 + 1)) extract 8;
end; <*læs_stiktegn*>
<*************************************************************>
<***           procedure søg-stikord                       ***>
<*************************************************************>

boolean procedure søg_stikor(post,itegnbuf,fra,til);
value post,itegnbuf;
long array post; <*posten hvori stikordet itegnbuf eftersøges*>
integer array itegnbuf;<*det stikord der skal søges efter,   *>
                  <*hvert array_element indeholder et tegn   *>
integer fra,til;  <*angiver det fremfundne stikords position *>
                  <*i tegnnumre,indenfor stikordstegn_strengen*>

<*eftersøger stikordet itegnbuf i stikordsfeltet for posten post*>
<*Funktions værdien er lig true, dersom stikordet fremfindes i  *>
<*såfald vil til og fra angive ordets position i stikords_strengen*>

begin
integer sordstart, <*(start)indexet for (s)øge(ord)et i itegnbuf*>
        sord_slut, <:(slut)indexet for (s)øge(ord)et i itegnbuf *>
             tegn,
            j,k,i;

boolean fundet; <*angiver om ordet er fundet*>
integer array itegnbuf4(1:k_gf_fl(ord_index)*6);

<*find start kog slut indexet for ordet der skal søges efter*>
<*og som er i itegnbuf*>

<*skipblanke*>
i:=1;
while itegnbuf(i)='sp' do
begin
 i:=i+1;
end;
sord_start:=i-1;
while itegnbuf(i)<>'sp' and i < 6*k_gf_fl(ord_index) do
begin
 i:=i+1;
end;
if itegnbuf(i)='sp' then
 begin
  i:=i-1;
 end;
sord_slut:=i;
<*søg efter ordet*>
fundet:=false;
i:=1;
while i <= post.stiktegnantal and not fundet do
begin
læs_stiktegn(i,tegn,post);
if tegn='sp' then
 begin
  i:=i+1;
 end;
 else
 begin
<*indlæs det første stikord*>
k:=1;
fra:=i;
itegnbuf4(k):=tegn;
while tegn <>'sp' and i < post.stiktegnantal do
 begin
  i:=i+1;
  k:=k+1;
  læs_stiktegn(i,tegn,post);
  if tegn <>'sp' then
   begin
    itegnbuf4(k):=tegn
   end;
 end; <*while*>
 til:=i;
if tegn='sp' then
begin
 k:=k-1;
 til:=i-1
end;
<*er længderne ens*>
if k=(sord_slut-sord_start+ 1) then
begin
 <*er værdierne ens*>
 for j:=1 step 1 until k do
  begin
   if itegnbuf(j):=itegnbuf(sord_start)+j-1)
   then begin
   fundet:=true;
   end;
 end; <*for*>
end;<*if k*>
end; <*else tegn = 'sp'*>
end;<*while*>
søg_stikord:=fundet;
end; <*søg_stikord*>





<*************************************************************>
<***              procedure init                           ***>
<*************************************************************>

procedure init;
begin
 integer i,j,k,n;
 
 <*indlæs filinformationen*>

 open(filinf,4,brugerfil,0);
 setposition(filinf,0,0);
 inrec6(filinf,lfilinf*4);
 nykatstart:=gfkatstart:=filinf.kikatstart;
 nykatstr:=gfkatstr:=filinf.kikatstr;
 nyinvstart:=gfinvstart:=filinf.kiinvstart;

 for i:=1 step 1 until lbrug_inf_kons do
 begin
 k_ny_fl(i):=k_gf_fl(i):=filinf.kiarraystart(i);
 end;
 close(filinf,true);
 ledigkatpost:=gfkatstr + 1;

<*initialisering af katalogpost*>
 slettet:=i:=1;
 udvidet:=i:=i+1;
 mor:=i:=i+1;
      i:=i+1; <*ubrugt*>
moradr:=i:=i+2;
barnadr:=i:=i+2;
forantal:=i:=i+2;
stiktegnantal:=i:=i+2;

k:=kpostarraystart:=i;
j:=1;
 for i:=1 step 1 until lbrug_kpost_felt do
 begin
 n:=1;
if i:=for_index then begin n:=3; end;
j:=j+n*k_gf_fl(i);
k:=k+n*k_gf_fl(i);
kpost(i):=j_n*k_gf_fil(i);
end;
dobbeltordlængde(gf_ktp_længde,k);

<*udregning af konstanter til brug ved læsning og skrivning*>
<*katalogposter*>

post_skriv_læs_konstanter(gf_ktp_længde,gf_ktp_antal,gfktp_seg);

<*initialiserer værdilisten*>
open(værinf,4,værdifil,0);
setpostition(værinf,0,0);
inrec6(værinf.lværinf*4);
vfværførst:=værinf.viførst;
vfværantal:=værinf.viantal;
close(værinf,true);

<*initialisering af poster i værdifilen*>
vford:=i:=0;
       i:=i+4*gford;
vfantal:=i:=i+2;
vref:=i:=i+2;
dobbeltordlængde(vf_vær_længde,i);
post_skriv_læs_konstanter(vf_vær_længde,vf_vær_antal,vf_vær_seg);
end;

<*************************************************************>
<***     procedure skriv_ny_ga_katpost                     ***>
<*************************************************************>

procedure skriv_ny_ka_katpost(nr,buffer);
integer nr;

long array buffer;
<*skriver en katalog_post på brugerfilen eller den*>
<*temporere nye brugerfil*>
<*proceduren bruges ved udskrivning af ny moderposter*>
<*og postudvidelser*>

begin
if nr < gfkatstr then
 begin
<*posten skal lægges i brugerfilen*>
skriv_katalogpost(nr,gfkatstart,buffer);
 end 
 else
 begin
<*posten ligger i ny brugerfil*>
skriv_nykatalogpost(nr_gfkatstr,0,buffer);
end;
end;
 
<************************************************************>
<***     procedure læs_ny_ga_katpost                      ***>
<************************************************************>

integer nr;
long array buffer;

<*indlæser en katalogpost enten fra brugerfilen eller*>
<*fra den temporerer nye brugerfil. Proceduren bruges ved*>
<*indlæsning af ny indsatte poster samt postudvidelse*>

begin
if nr<gfkatstr then
begin
<*posten ligger i brugerfilen*>

  indlæs_katalogpost(nr,gfkatstart,buffer);
end 
else
begin
<*posten ligger i nybrugerfil*>
  indlæs_nykatalogpost(nr,gfkatstr,0,buffer);
end;
end;

<**************************************************************>
<***       procedure indsæt_i_array                         ***>
<**************************************************************>

value reslængde, værdiarray,værlængde;
long array resultat;<*længde=værdilængde/6*>
integer array værdiarray;
integer værlængde;

<*tegnet i hvert enkelt værdiarray_element pakkes*>
<*og gemmes i resultat(arrayet*>

begin
integer i,j;
j:=1;
j:=1;
while i < værlængde do 
 begin
resultat(j):=pak(værdiarray(i),
                 værdiarray(i+1),
                 værdiarray(i+2),
                 værdiarray(i+3),
                 værdiarray(i+4),
                 værdiarray(i+5));
j:=j+1;
i:=i+6;
end;<*while*>
end;

<************************************************************>
<***             procedure læsheltal                      ***>
<************************************************************>

boolean procedure læsheltal(val);
integer val;
begin
skipblanke;
if readchar(in,val) < 0 then
 begin
læsheltal:=false;
 end;
 else
 begin
 læsheltal:=true;
 end;
end;

<*************************************************************>
<***        procedure udvid_katpost                        ***>
<*************************************************************>
procedure udvid_katpost(madres,for,postnr);
value postnr,for,madres;
long array for;
integer madres,postnr;
<*initialiserer en udvidet barnepost.Indsætter værdier*>
<*for som første forfatter.Postens nummer er angivet i postnr*>

begin
long array katpost(1:gf_ktp_længde);
integeri;
<*nulstil posten*>
for i:=1 step 1 until gf_ktp_længde do
begin
 katpost(i):=long<:    :> add 'sp';
end;
 katpost.udvidet:=false;
 katpost.mor:=false;
katpost.moradr:=madres;
katpost.forantal:=0;
 indsæt_for(katpost,for,1);
 skriv_ny_ga_katpost(postnr,katpost);
end;

<**************************************************************>
<***            procedure søg_for                           ***>
<**************************************************************>

boolean procedure søg_for(mpost,fpost,for,pnr,fnr,morja);
value mpost,for;
boolean morja;<*=true dersom posten med forfatter for er en mor*>
long array mpost,<*moderposten*>
           fpost,<*den post der indeholder forfatteren*>
             for;<*den forfatter der søges efter*>
integer pnr,<*nummeret på den post der indeholder forfatteren for*>
        fnr;<*nummeret på forfatteren idenfor den pågældende post*>

<*funktionen er falsk når forfatteren ikke kan findes*>

begin
boolean fundet, <*=true, dersom forfatteren er fundet*>
integer fonr,   <*svarer til fnr*>
        ponr;   <*svarer til pnr*>

boolean procedure søg_for_i_post(post,for,fnr);
long array post,<*posten hvori søgningen foregår*>
           for, <*angiver den forfatter der søges efter*>
integer fne;<*nummeret på forfatteren i den pågældende post*>

<*funktionen=false dersom forfatteren for ikke findes*>

begin
boolean fundet; <*=true dersom forfatteren for findes i den angivne*>
                <*post, ellers = false*>
integer jaantal,<*angiver hvor mange af arrayelementerne i et*>
                <*forfatterfelt der stemmer overens*>
          start,<*angiver start indexet for et af de tre forfatter_felter*>
           slut,<*angiver slut indexet for en af de tre forfatter*>
           j,k; <*lykke tællere*>

fundet:=false;
i:=0;
while not fundet and i < post.forantal do
begin
 i:=i+1;
 start:=kpost(for_index)+(i_1)*k-gf_fl(for_index);
 slut:=start+k_gf_fl(for_index)-1;
 jaantal:=0;
 for k:=start step 1 until slut do
 begin
  if for(k_start+1)=post.kpostarraystart(k) then
    begin
    jaantal:=jaantal+1;
    end;
 end;
 if jaantal=k-gf_fl(for_index) then
 begin
  fundet:=true;
 end;
end;<*while*>
fnr:=i;
søg_for_i_post:=fundet;
end; <*søg_for_i_post*>
morja:=false;
fundet:=false;
<*er forfatteren i mpost*>
if søg_for_i_post(mpost, for, fonr) then
begin
 fundet:=true;
 morja:=false;
 fnr:=fonr;
end;
else
begin
if not mpost.udvidet then
begin
  fundet:=false;
end 
else
begin
ponr:=mpost.barnadr
repeat
 læs_ny_ga_kpost(ponr,fpost);
 if søg_for_i_post(fpost,for,fonr) then
 begin
 fundet:=true;
 morja:=false;
 fnr:=fonr;
 end;
 ponr:=fpost.barnadr;
until fundet or not fpost.udvidet;
end;
end;<*else søg_for_i_post*>
søg_for:=fundet;
end; <*søg_for*>
 
<**************************************************************>
<***          procedure indsæt_for_i_katpost                ***>
<**************************************************************>
procedure indsæt_for_i_katpost(morpost,madresse,for);  
value for madresse;
long array morpost,
               for;<*den forfatter der skal indsættes*>
integer madresse;<*postnummeret på moderen*>

begin
long array makatpost(1:gf_ktp_længde);
<*bruges til opbevaring af eventuelle postudvidelser*>
integer katalogpostnr;

if morpost.udvidet then
begin
<*fremfind det sidste ikke udvidet barn*>
katalogpostnr:=morpost.barnadr;
læs_ny_ga_katpost(morpost.barnadr,makatpost);
while makatpost.udvidet do
begin
  katalogpostnr:=makatpost.barnadr;
  læs_ny_ga_katpost(katalogpostnr,makatpost);
end;<*while*>

if makatpost.forantal>=3 then
begin
<*sidste barn opdaterer*>
makatpost.mor:=false;
makatpost.udvidet:=true;
makatpost.barnadr:=ledigkatpost;
<*udskriv sidste barn*>

skriv_ny_ga_katpost(katalogpostnr,makatpost);

<*opret en udvidet post og indskriv forfatteren som den*>
<*første forfatter*>

udvid_katpost(katalogpostnr,for,ledigkatpost);
ledigkatpost:=ledigkatpost+1;
end; <*if*>
else
begin
  indsæt_for(makatpost,for,(makatpost.forantal+1));
  skriv_ny_ga_katpost(katalogpostnr,makatpost);

end; <*else*>
end <*if*>
else
begin
  if mopost.forantal >=3 then
   begin
   <*opdaterer moderen*>
   morpost.udvidet:=true;
   morpost.barnadr:=ledigkatpost;

<*opret postudvidelse og indsæt forfatter*>
udvid_katpost(madresse,for,ledigkatpost);  
ledigkatpost:=ledigkatpost+1;
end 
else
  begin
   indsæt_for(morpost,for,(morpost.forantal+1));
  end; <*else*>
end; <*else*>
end;<*indsæt_for_i_katpost*>
<***********************************************************>
<***        procedure ud_sidste_for                      ***>
<***********************************************************>

procedure ud_sidste_for(badresse,for,fnr,mor_ej_udvidet);
value badresse;
boolean mor_ej_udvidet;<*=true dersom moderen ikke længere*>
                       <*har nogle børn,dvs. post udvidelser*>
long array for;
integer fnr, <*nummeret på forfattere indenfor en post*>
     badresse;<*starten på koden af post udvidelser*>
<*proceduren fjerner den sidste forfatter i kæden af udvidet*>
<*poster og gemmer forfatteren i for. Listen af post udvidelser*>
<*opdateres, er der ikke længere nogle postudvidelser sætter*>
<*mor_udvidet = true*>

begin
integer mnr,nr,gnr,start,slut,i;
 long array makatpost(1:gf_ktp_længde);
mor_ej_udvidet:=false;
nr:=badresse;
repeat
  gnr:=nr;
  læs_ny_ga_katpost(nr,makatpost);
  nr:=makatpost.barnadr;
until not makatpost.udvidet;
start:=kpost(for_index)+(makatpost.forantal-1)* k_gf_fl(for_index);
slut:=start+k_gf_fl(for_index)-1;

<*overfør sidste forfatter*>
for i:=start step 1 until slut do
begin
 for(i_start+1):=makatpost.kpostarraystart(i);
end;
fnr:=makatpost.forantal;                 
makatpost.forantal:=makatpost.forantal-1;

<*var den overførte forfatter den sidste i posten*>
if makatpost.forantal  <=0 then
begin
  makatpost.slettet:=true;
  mnr:=makatpost.moradr;
skriv_ny_ga_katpost(gnr,makatpost);
læs_ny_ga_katpost(mnr,makatpost);
if makatpost.mor then
begin
  mor_ej_udvidet:=true;
end 
else
begin
makatpost.udvidet:=false;
end;        
end; <*if*>
end;<ud_sidste_for*>

<**************************************************************>
<***         procedure for_iorden                           ***>
<**************************************************************>
procedure for_iorden(post,ledig);
value ledig;
long array post;<*katalog post hvor forfatterne skal*>
                <*sættes i orden*>
integer ledig;  <*nummeret,indenfor posten. på den forfatter*>
                <*hvis felt er ledigt*>

<*Ordner følger af forfattere indenfor en post, således at der *>
<*ikke er en ledig plads mellem to forfattere, forfattere i brug*>
<*kommer lige efter hinanden, samt sætter antallet af forfatter*>
<*med 1*>

begin
 integer rykantal, <*antal forfattere der skal rykkes frem*>
             i,j;  <*lykke tæller*>

if ledig < post.forantal then 
  begin
   <*saml de forfattere der er i brug*>
    rykantal:=post.forantal-ledig;
    for i:=1 step 1 until rykantal do
    begin
      <*ryk forfattere i brug over i det ledig felt*>
      start:=kpostL(for_index)+(ledig-1)*k_gf_fl(for_index);
      slut:=start+k_gf_fl(for_index)-1;
      for j:=start step 1 until slut do
        begin
         post.kpostarraystart(j):=post.kpostarraystart(j+k_gf_fl(for_index));
        end;
      ledig:=ledig+1;
    end;<*for*>
  end; <*if*>
  <*nedtæl forfatter tæller*>
  post.forantal:=post.forantal-1;
end; <*for_iorden*>


<**************************************************************>
<***          procedure skriv_post_attribut                 ***>
<**************************************************************>

procedure skriv_post_attribut;
<*udskriver tegn forkortelsen,samt dertil hørende forklaring *>
<*for samtlige synlige for brugeren felter i en katalogpost. *>

begin
write(out,
     <:<10>:>,<:librar  (reservation place):>,
     <:<10>:>,<:reserv  (reservation date):>,
     <:<10>:>,<:arriva  (arrival date):>,
     <:<10>:>,<:type (journal type;njournal or something else:>,
     <:<10>:>,<:title (joournals title):>,
     <:<10>:>,<:author (first author):>,
     <:<10>:>,<:author (second author):>,
     <:<10>:>,<:author <third author):>,
     <:<10>:>,<:journa (journal:name,publications year,sidenr, bindingsnr:>,
     <:<10>:>,<:keywor (keywords field):>,
     <:<10>:>,<:descri (descriptor field):>);
     outendcur(10);
end;<*skriv_post_attribut*>


<*************************************************************>
<***          procedure skriv_kat_inf                      ***>
<*************************************************************>

<*udskriver katalog_informationskonstanter*>

begin
write(out,
     <:<10>:>,<:ltype(the max.length of the typefield) = :>,
              k_p_fl(type_index),
     <:<10>:>,<:ltitle(the max.length of the titlefield) = :>,
              k_p_fl(title_index),
      <:<10>:>,<:lauthor(the max. length of the authorfield) = :>,
              k_p_fl(for_index),
      <:<10>:>,<:llibrary(the max.length of the librarryfield = :>,
              k_p_fl(bib_index),
      <:<10>:>,<:lreservation(the max.length og the field for 
              reservation date = :>, k_p_fl(res_index),
      <:<10>:>,<:larrival(the max.length og the journal field = :>,
              k_p_fl(ankomst_index),
      <:<10>:>,<:ljournal(the max.length og the journal field = :>,
              k_pp_fl(journal_index),
      <:<10>:>,<:lkeyword(the max.length of the keywordd field = :>,
              k_p_fl(stikord_index),
      <:<10>:>,<:ldescription(the max.length of the description field = :>,
              k_p_fl(beskriv_index));
      outendcur(10);
end;<*skriv_kat_inf*>


<***************************************************************>
<***               procedure skrivfejl                       ***>
<***************************************************************>

procedure skrivfejl(nr);
integer nr;
case nr of
begin
  begin
  write(out,<:<10>:>,<:error:newca-order can only appear as first 
        order after entering the program:>);
  outendcur(10)
  end;
  begin
  write(out,<:<10>:>,<:warning: a main korder must be terminated
        with "return":>;
  outendcur(10)
  end;
  begin
  write(out,<:<10>:>,<:error: wrong set number, containing searchresult:>;
  outendcur(10)
  end;
  begin
  write(out,<:<10>:>,<:error: you can only change once at the time in
       the katalog_post. Main order .change not accepted.:>);
  outendcur(10);
  end;
  begin
  write(out,<:<10>:>,<:error error in the parameters of the main 
        order.Main order not accepted.:>);
  outendcur(10)
  end;
  begin
  write(out,<:<10>:>,warning: the specific area doas not exist:>);
  outendcur(10);
  end;
  begin
  write(out,<:<10>:>,<:type_error; catalog constant ekspected.
       The line is ignored.:>);
  outendcur(10)
  end;
  begin
  write(out,<:<10>:>,<:type error; positive integers ekspected.
       Sub_order ignored:>);
  outendcur(10)
  end;
  begin
  write(out,<:<10>:>,<:equality sign ekspected:>);
  outendcur(10);
  end;
  begin
  write(out,<:<10>:>,<:error: length of the field is expected.
       Sub_order ignored:>);
  outendcur(10);
  end;
  begin
  write(out,<:<10>:>,<:error:sub_order not aloud.
       Sub_order ignored:>);
  outendcur(10);
  end;
  begin
  write(out,<:<10>:>,<:equality sign is missing after sub_order:>);
  outendcur(10);
  end;
  begin
  write(out,<:<10>:>,<:length og the field is expected;
       maybe there are to many spases.:>);
  outendcur(10);
  end;
  begin
  write(out,<:<10>:>,<:equality sign must not be used as value:>);
  outendcur(10);
  end;
  begin
write(out,<:<10>:>,<:main order is expected.The reason for this
     is the arised error:>);
  outendcur(10)
  end;
  begin
  write(out,<:<10>:>,<:error:you can only start with the main order:>);
  outendcur(10)
  end;
  begin
  write(out,<:<10>:>,<:error: file parameters to the program is missing.
       The program is terminated:>);
  outendcur(10);
  end;
  begin
  write(out,<:<10>:>,<:error:file parameters are writed in the wrong
       order.The program is terminated.:>);
  outendcur(10);
  end;
  begin
  write(out,<:<10>:>,<:error:post doas not exist; write new main order:>);
  outendcur(10)
  end;
  begin
  write(out,<:<10>:>,<:error:error in the value;The value is ignored:>);
  outendcur(10)
  end;
end;
              

<*initialisering af feltlængder for en katalogpost*>

k_p_fl(bib_index):=4;
k_p_fl(res_index):=2;
k_p_fl(ankomst_index):=2;
k_p_fl(type_index):=3;
k_p_fl(titel_index):=11;
k_p_fl(journal_index):=7;
k_p_fl(beskriv_index):=33;
k_p_fl(for_index):=4;
k_p_fl(stikord_index):=18;
k_p_fl(ord_index):=3;
k_p_fl(søgemængder_index):=30;
k_p_fl(mængdestr_index):=300;

<*initialisering af kataloginformations_post*>

kikatstart:=i:=2;
kikatstr:=i:=i+2;
kiinvstart:=i:=i+2;
kiarraystart:=i;   
              i:=i+2*lbrug_ing_kons;
dobbeltordlængde(lfilinf,i);
         
<*initialisering af værdi_listeinformations post*>
viførst:=i:=2;
viantal:=i:=i+2;
dobbeltordlængde(lværing,i);

<*initialisering af inverteret_liste_post*>
ilfeltkode:=i:=2;
ilkatref:=i:=i+2;
ilinvref:=i:=i+2;
dobbeltordlængde(gf-inv-længde,i);

<*initialisering af post i mængde_index_array*>
søgførst:=i:=2;
søgsidst:=i:=i+2;

<*initialisering af delimitorer*>
lighedstegn:='=';
dollertegn:='?';

<*opdelings konstanter for aktions tabellen*>
fhovord:=1;
shovord:=16;
forord:=24;
stikord:=25;
ffeltord:=17;
snfeltord:=23;
sfeltord:=25;
fsøgord:=20;
ssøgord:=26;
fkomord:=28;
skomord:=30;
fmodifykord:=31;
smodifyord:=42;

<*initialisering af kordretabel*>
<*initialisering af aktionstabel*>
<*tildeling af værdier til variable der kan risikere at blive*>
<*brugt uden forinden at have tildelt værdier værdiernes     *>
<*størelse er ligegyldig*>

gf_ktp_længde:=128;
k_gf_fl(søgemængder_index):=k_p_fl(søgemængder_index);
k_gf_fl(mængdestr_index):=k_p_fl(mængdestr_index);



<*nulstil(nul) brugerfil- og værdifilarrays*>

for i:=1 step 1 until 5 do begin
  brugerfil(i):=0;
  værdifil(i):=0;
end;

<*initialisering af filparametre*>
if not(readinfp(brugerfil,1) and readinfp(værdifil,2)) then
begin
 fortsæt:=false;
 skrivfejl(17);
end;

<*initialisering*>
tilstand:=0;
søgemængdenæste:=1;
mængdeindex:=1;
afslutja:=true;
fortsæt:=true;
opdatja:=false;
gordrekode:=0; <*der findes ingen ordre der har koden nul*>
initja:=true;

while fortsæt do
begin
skipblanke;
ful:=readstring(in,ordretekst,1);
 if ful >= 0 then
 begin
   repeatshar(in)
 end;
nordrekode:=ordreidentifikation(ordretekst,antinputkode);
if fhovord <= nordrekode <=shovord then
 begin
 if afslutja and nordrekode <> gordrekode then
 begin
 afslut(gordrekode)
 end;
 gordrekode:=nordrekode;
 afslutja:=true;
end<*if*>
if fhovord < nordrekode <=shovord and initja then
 begin
 init;
 initja:=false
 end;
aktion:=aktionstabel(tilstand, nordrekode);
begin <*niveau 4*>
long array mængdeindex(1:k_gf_fl(søgemængder_index);
long array akatpost(1:gf_ktp_længde);
long array ainvlist(1:gf_inv_længde);
integer array søgmængde(1:k_gf_fl(søgemængder_index)*
                       k_gf_fl(mængdestr_index));
fejlfri:=true;
case aktion of
begin
<* 1 *>
begin
 tilstand:=1;
 if not tom_param then
 begin
  skrivfejl(2)
 end;
<*initialiserer brugerfilen katalog informationsområde*>
open(filinf,4,brugerfil,0);
filinf.kikatstart:=1;
filinf.kikatstr:=0;
filinf.kiinvstart:=1;
for i:=1 step 1 until lbrug_inf_kons do
 begin
  filinf.kiarraystart(i):=k_p_fl(i)
 end;
setpostion(filinf,0,0);
outrec6(filinf,lfilinf*4);
setposition(filinf,0,0);
close(filinf,true);

<*opret tom værdiliste*>
open(værinf,4,værdifil,0);
værinf.viførst:=1;
værinf.viantal:=0;
setposition(værinf,0,0);
outrec6(værinf,lværinf*4);
setposition(værinf,0,0);
close(værinf,true);
init;
skriv_kat_inf;
end;<*case 1 *>


<* 2 *>
begin
 tilstand:=2;
 if not tom_param then
 begin
  skrivfejl(2);
 end;
end; <* case 2 *>


<* 3 *>
begin
tilstand:=16;
afslutja:=false;
if not tom_param then
 begin
   skrivfejl(2)
 end;
end; <* case 3 *>


<* 4 *>
begin
tilstand:=3;
if not tom_param then
 begin
  skrivfejl(2)
 end;
<*opfyld arbejdsvariablen akatpost med blanke*>
for i:=1 step 1 until gf_ktp_længde do
begin
akatpost(i):=long<:     :> add 'sp'
end;
<*initialiserer katalogpostens hoved*>
akatpost.slettet:=false;
akatpost.udvidet:=false;
akatpost.mor:=true;
akatpost.forantal:=0;
akatpost.stiktegnantal:=0;
katpostnr:=ledigkatpost;
ledigkatpost:=ledigkatpost+1;
end;<* case 4 *>


<* case 5 *>


begin
 tilstand:=4;
 if not mængde_param(mængdenr,elementantal) then
 begin
  skrivfejl(3);
  afslutja:=false;
  tilstand:=16;
 end;
 else begin
 if elementantal <> 1 then
 begin
  skrivfejl(4);
  afslutja:=false;
  tilstand:=16;
 end;
else
begin
 katpostnr:=søgmængde(mængdeindex(mængdenr).søgførst);
if not indlæs_katalogpost(katpostnr,gfkatstart,akatpost) then
begin
 skrivfejl(19);
 tilstand:=false;
 afslutja:=false;
end;
end <*else*>
end<*else*>
end <*casse 5*>


<* 6 *>
begin
 tilstand:=5;
 if not mængde.param(mængdenr,elementantal) then
 begin
  skrivfejl(3);
  afslutja:=false;
  tilstand:=16;
 end;
else
 begin
 fori:=mængdeindex(mængdenr).søgførst step 1 
 until mængdeindex(mængdenr).søgsidst do
 begin
  akatpost.slettet:=true;
  skriv_katalogpost(i,gfkatstart,akatpost);
 end; <*for*>
opdatja:=true;
end;<*else*>
end;<*case*>


<* 7 *>
begin
 tilstand:=6;
 if not tom_param then
 begin
 skrivfejl(2)
 end;
end; <*case 7*>


<* 8 *>
begin
 tilstand:=7;
 if not tom_param then
 begin
 skrivfejl(2);
 end;
end; <*case 9*>

<* 9 *>
begin
 tilstand:=8;
 if not tom_param then
 begin
  skrivfejl(2);
 end;
mængdeindexnæste:=1;
søgemængdenæste:=1;
end; <*case 9*>


<* 10 *>
begin
 tilstand:=9;
 if not tom_param then
 begin
  skrivfejl(2);
 end;
skriv_post_attribut;
end; <*case 10*>


<* 11 *>
begin
 tilstand:=10;
 if not tom_param then
 begin
  skrivfejl(2);
 end;
skriv_kar_inf;
end;<*case 11*>


<* 12 *>
begin
 tilstand:=11;
 if not listd_param(mængdenr,fra,til) then
 begin
 skrivfejl(5);
 tilstand:=error;
 end;<*case 12*>


<* 13 *>
begin
boolean alt;
integer mfra,mtil;
tilstand:=12;
if not listk-param(mfra,mtil,alt) then
begin
  skrivfejl(5);
  afslutja:=false;
  tilstand:=16;
end; <* if *>
else
begin
if not skriv_nøgleord(mfra,mtil,alt)
then
begin
 skrivfejl(6);
end;
end; <*else*>
end; <*case 13 *>


<* 14 *>
begin
if not tom_param then
begin
 skrivfejl(2);
end;
if opdatja then
begin
 nypost;
 opdatsøgestruktur;
end;
goto slut;
end <*case 14 *>


<* 15 *>
begin
 tilstand:=13;
 if not tom_param then
 begin
  skrivfejl(2);
 end;
nypost;
ajourkat;
end; <*case 15*>


<* 16 *>
begin
integer val;
tilstand:=14;
if læstegn(val) then
begin
 lighedstegn:=val;
end;
write(out,<:<10>:>,<:lighedstegn = :>);
outchar(out,lighedstegn);
outendcur(10)
end; <* case 16 *>


<* 17 *>
begin
integer val;
tilstand:=15;
if læstegn(val) then
begin
 dollertegn:=val;
end;
write(out,<:<10>:>,<:dollertegn= :>);
outchar(out,dollertegn);
outendcur(10);
end; <*case 17*>


<* 17 *>
begin
skip_linie_rest;
skrivfejl(7);
end; <*case 17*>


<* 19 *>
begin
integer val;
if findlighed then
begin
if læsheltal(val) then
begin
  k_nf_fl(nordrekode-fmodifyord+1):=val;
end;
else
begin
 skrivfejl(8);
end;
end;<*if*>
else
begin
  skrivfejl(9);
end; <*else*>
skip_linie_linie_rest;
end; <*case 19*>


<* 20 *>
begin 
integer feltlængde,l,dummy,stoptegn,fra,til;
i:=nordrekode-ffeltord+1;
if i=stikord then
begin
  feltlængde:=k_gf_fl(ord_index);
end;
else
begin
  feltlængde:=k_gf_fl(i)
end;
stoptegn:=74; <*blot for at have værdi <> 'nl'*>
   if findlighed then
begin
long array ltegnbuf(1:feltlængde);
integer array itegnbuf(1:6*feltlængde);
<*nulstil tegnbuf*>
for i:=1 step 1 until 6*feltlængde do
begin
  itegnbuf(i):='sp';
end; <*for*>
if not læsværdistreng(dummy,stoptegn,itegnbuf,6*feltlængde) then
begin
  skrivfejl(10);
end <*if*>
else
begin
if stoptegn<>'nl' then
  begin
   skrivfejl(10);
  end
  else
  begin
   indsæt_i_array(ltegnbuf,itegnbuf,6*feltlængde);
    if ffeltord <=nordrekode <=snfeltord then
     begin
     for i:=kpost(nordrekode-ffeltord+1) step 1 until
     (kpost(nordrekode-ffeltord*2)-1) do
     begin
      akatpost.kpostarraystart(i):=ltegnbuf(i)
     end;
<*indsættelse f een forfatter*>
     if nordrekode=forord then
     begin
     indsæt_for_i_katpost(morpost,katpost,ltegnbuf);
     end;
<*indsættelse af et stikord*>
     if nordrekode=stikord then
     begin
     if not indsæt_stikord(akatpost,itegbuf,fra,til) then
     begin
     skrivfejl(13);
     write(out,<:part og keyword included = :>);
     for i:= fra step 1 until til do
     begin
        outchar(out,itegnbuf(i);
     end;
     outendcur(10);
    end;<*if*>
   end;<*stikord*>
  end;<*else nl*>            
end;<*else læsværdistreng*>
<*læs linierest*>
if stoptegn <> 'nl' then
 begin
  skip_linie_rest;
 end;
end;<*if findlighed*>
else
begin
skrivfejl(11);
skip_linie_rest;
end;<*else*>
end;<*case  20*>


<* 21 *>
begin
  skip_linie_rest;
  skrivfejl(11);
end; <*case 21*>


<* 22 *>
begin
 integer feltlængde,i,råtegn,stoptegn1,foraktion;
 integer råtegn2,stoptegn2,postnr1,fornr1,fornr2;
 integer forn3,stikaktion,sfra,stil,tegn;
long array indkatpost(1:gf_ktp_længde);
long array frakatpost(1:gf_ktp_længde);
boolean morja,mor_ej_udvidet;
i:=nordrekode-ffeltord+1;
stoptegn1:=stoptegn2:=74; <*blot for at have værdi<>'nl'*>
if i=stikord then
begin
 feltlængde:=k_gf_fl(ord_index);
end
else
begin
 feltlængde:=k_gf_fl(i)
end;
if findlighed then
begin
  integer array itegnbuf1(1:6*feltlængde);
  integer array itegnbuf2(1:6*feltlængde);
  long array ltegnbuf1(1:feltlængde);
  long array ltegnbuf2(1:feltlængde);
  long array ltegnbuf3(1:feltlængde);


for i:=1 step 1 until feltlængde do
begin
 ltegnbuf1(i):=long<:     :> add 'sp';
 ltegnbuf2(i):=long<:     :> add 'sp';
 ltegnbuf3(i):=long<:     :> add 'sp';
end;

<*nulstil tegn buffer*>
for i:=1 step 1 until 6*feltlængde do
begin
 itegnbuf1(i):='sp';
 itegnbuf2(i):='sp';
end;
if not læsværdistreng(råtegn1,stoptegn1nitegnbuf1,6*feltlængde) then
begin
  skrivfejl(10)
end;
else
begin
 indsæt_i_array(ltegnbuf1,itegnbuf1,6*læltlængde);
<*indsæt felter*>
if ffeltord <=nordrekode<=snfeltord then
begin
 if stoptegn=lighedstegn then
 begin
  skrivfejl(10);
 end;
 else
 begin
 for i:=kpost(nordrekode-ffeltord+1)step 1
 until (kpost(nordrekode-ffeltord+2)-1) do
 begin
  akatpost.kpostarraystart(i):=ltegnbuf(i);
 end;
end;
end;<*indsæt felter*>

<*forfatter*>
<*fejl*>
if nordrekode:=forord then begin
foraktion:=4;

if stoptegn1=lighedstegn and råtegn=0 then
begin
  foraktion:=1;
end;
<*ændre*>
if stoptegn1=lighedstegn and råtegn1<>0 then
begin
  foraktion:=2;
end;
<*indsæt*>
if stoptegn1='nl' and råtegn<>0 then
begin
  foraktion:=3;
end;

case foraktion of
begin
 <*slet*>
begin
if not læsværdistreng(råtegn2,stoptegn2,itegnbuf2,6*feltlængde) then
begin
  if stoptegn <> 'nl' then skip_linie_rest;
  skrivfejl(10);
end
else
begin
indsæt_i_array(ltegnbuf2,itegnbuf2,6*feltlængde);
if søg-for(akatpost,indkatpost,ltegnvuf2,postnr1,fornr1,morja) then
begin
     <*søg_for*>
if morja then
begin
 if akatpost.udvidet then
 begin
  ud_sidste_for(akatpost.barnadr,ltegnbuf3,fornr2,mor_ej_udvidet);
  indsæt_for(akatpost,ltegnbuf3,fornr1);
  if mor_ej_udvidet then
  begin
   akatpost.udvidet:=false;
  end;
 end;<*if akatpost.udvidet*>
 else
 begin
<*sæt forfatterne i orden*>
 for_iorden(akatpost,fornr1);
 end;<*else akatpost.udvidet*>
end  <*morja*>
else
begin
if indkatpost.udvidet then
 begin
ud_sidste_for(indkatpost.barnadr,ltegnbuf3,fornr2,mor_ej_udvidet);
indsæt_for(indkatpost,tegnbuf3,fornr1);
if mor_ej_udvidet then
begin
  indkatpost.udvidet:=false;
end;
end
else
 begin
  for_iorden(indkatpost,fornr1);
 end;<*else akatpost.udvidet*>
 skriv_ny_ga_katpost(postnr1,indkatpost);
end; <*else norja*>
end;<*søg_for*>
end;<*else læsværdistreng*>
end; <*slet*>

<*ændre*>
begin
if not læsværdistreng(råtegn2,stoptegn2,itegnbuf2,6*feltlængde) then
begin
 if stoptegn2 <>'nl' then skip_linie_rest;
 skrivfejl(10)
end;
else
begin
indsæt_i_array(ltegnbuf2,itegnbuf2,6*feltlængde);
if søg-for(akatpost,indkatpost,ltegnvuf2,postnr1,fornr1,morja) then
begin
if morja then
 begin
   akatpost.forantal:=akatpost.forantal-1;
   indsæt_for(akatpost,ltegnbuf1,fornr1);
 end;
 else
 begin
 indkatpost.forantal:=indkatpost.forantal-1;
 indsæt_for(indkatpost,ltegnbuf1,fornr1);
 skriv_ny_ga_katpost(postnr1,indkatpost);
 end; <*else morja*>
end
else
begin
 skrivfejl(20);
end;<*søg_for*>
end;<*læsværdistreng*>
end;<*ændre*>

<*indsæt*>
begin
indsæt_for_i_katpost(katpost,katpostnr,ltegnbuf1);
ennd;<*indsæt*>

<*fejl*>
begin
 skrivfejl(20);
end;<*fejl*>
end;<*case*>
end;<*forfatter*>

<*stikord*>
if nordrekode = stikord then
<*dan tilfælde_kode til case_sætning*>
<*fejl*>
stikaktion:=4;
<*slet*>
if stoptegn1=lighedstegn and råtegn1=0 then
begin
 stikaktion:=1;
end;

<*ændre*>
if stoptegn1=lighedstegn and råtegn1<>0 then
 begin
   stikaktion:=2;
 end;

<*indsæt*>
if stoptegn1='nl' and råtegn1 <>0 then
 begin
   stikaktion:=3;
 end;

case stikaktion of
begin
<*slet*>
 begin
  if not læsværdistreng(råtegn2,stoptegn2,itegnbuf2,6*feltlængde)
  then begin
  skrivfejl(20);
  end
  else
  begin
  if søg_stikord(akatpost,itegnbuf2,sfra,stil) then
   begin
   tegn:='sp';
   for i:=sfra step 1 until stil do
   begin
   <*indsæt blanke*>
   indsæt_stiktegn(akatpost,i,tegn);
   end;
  end;<*if søg_stikkord*>
 end;<*else læsværdistreng*>
end;<*slet*>

<*ændre*>
 begin
  if not læsværdistreng(råtegn2,stoptegn2,itegnbuf2,6*feltlængde) 
  then begin
  skrivfejl(20);
  end;
  else
  begin
  if not søg_stikord(akatpost,itegnbuf2,sfra,stil) then
    begin
      skrivfejl(21);
    end;
    else
    tegn:='sp';
<*blank til den gamle værdi*>
 for i:=sfra step 1 until stil do
   begin
    indsæt_stiktegn(akatpost,i,tegn);
   end;
<*indsæt det nye ord tilsidst*>
if not indsæt_stikord(akatpost,itegnbuf1,sfra,stil) then
begin
skrivfejl(13);
write(out,<:post og keyword included = :>);
for i:=sfra step 1 until stil do
begin
  outchar(out,itegnbuf1);
end;
  outendcur(10);
end;<*if not indsæt*>
end;<*else søg_stikord*>

end;<*else læsværdistreng*>
end;<*ændre*>

<*indsæt*>
begin
 if not indsæt_stikord(akatpost,itegnbuf1,sfra,stil) then
 begin
  skrivfejl(13);
  write(out,<:part of keyword included = :>);
  for i:=sfra step 1 until stil do
  begin
   outchar(out,itegnvuf1);
  end;
 outendcur(10);
 end;<*if not indsæt*>
end;<*indsæt*>

<*fejl*>
begin
 skrivfejl(20);
end; <*fejl*>
end;<*case*>
end;<*stikord*>
end+<*else læsværdistreng*>
if stopteng1 <> 'nl' and stoptegn2 <> 'nl' then
 begin
  skip_linie_rest
 end;
end <*if findlighedstegn*>
else
 begin
skrivfejl(11);
skip_linie_rest;
end; <*else*>
end;<*case 22*>
▶EOF◀