DataMuseum.dk

Presents historical artifacts from the history of:

RC4000/8000/9000

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about RC4000/8000/9000

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦b7b19e402⟧ TextFile

    Length: 43776 (0xab00)
    Types: TextFile
    Names: »htfilsystem «

Derivation

└─⟦cde9d517b⟧ Bits:30007477 RC8000 Backup tape fra HT's bus-radio system
    └─⟦6a563b143⟧ 
        └─ ⟦this⟧ »htfilsystem « 

TextFile

filsystem.
:1: filsystem_parametre.
\f

message filparm side 1 - 800529/jg/cl;

integer
  fil_op_længde,
  dbantez,dbantsz,dbanttz,
  dbmaxtf, dbmaxsf, dbblokt,
  dbmaxb,dbbidlængde,dbbidmax,
  dbmaxef;
real
  dbsnavn, dbtnavn;
:2: filsystem_initialisering af parametre.
\f

message filparminit side 1 - 801030/jg;

fil_op_længde:= data + 18 <*halvord*>;


dbantez:=        1;
dbantsz:=        2;
dbanttz:=        3;  <* >=2 aht. samtidig tilgang*>
dbblokt:=        8;
dbmaxsf:=        7;
dbbidlængde:=    3;
dbbidmax:=       5;
dbmaxb:=   dbmaxsf * dbbidmax;
dbmaxef:=       12;
dbsnavn:=real<:spoolfil:>;
dbtnavn:=real<:tabelfil:>;
\f

message filparminit side 2 - 801030/jg;


<* reserver og check spoolfil og tabelfil *>
begin integer s,i,funk,f;
 zone z(128,1,stderror); integer array tail(1:10);

for f:=1,2 do
begin
  open(z,4,string (case f of(dbsnavn,dbtnavn)),0);
  for funk:=52<*create*>,8<*reserve*>,42<*lookup*> do
  begin
    s:=monitor(funk,z,i,tail);
    if s<>0 then system(9,funk*100+s,
      case f of(<:<10>spoolfil:>,<:<10>tabelfil:>));
  end;
  case f of begin
    begin integer antseg; <*spoolfil*>
      antseg:=dbmaxb * dbbidlængde;
      if tail(1) < antseg then
      begin
        tail(1):=antseg;
        s:=monitor(44<*change*>,z,i,tail);
        if s<>0 then
          system(9,44*100+s,<:<10>spoolfil:>);
      end;
    end;
    begin <*tabelfil*>
      dbmaxtf:=tail(10);
      if dbmaxtf<1 or dbmaxtf>1023 then 
        system(9,dbmaxtf,<:<10>tabelfil:>);
    end
  end case;
  close(z,false);
end for;
end;
:3: filclaim
\f

message filclaim, side 1 - 810202/cl;

maxcoru:= maxcoru+6;
maxsem:= maxsem+2;
maxsemch:= maxsemch+6;
:4: filglobal.
\f

message filglobal side 1 - 790302/jg;

integer
  dbantsf,dbkatsfri,
  dbantb,dbkatbfri,
  dbantef,dbkatefri,
  dbsidstesz,dbsidstetz,
  dbsegmax,
  filskrevet,fillæst;
integer
  bs_kats_fri, bs_kate_fri,
  cs_opret_fil, cs_tilknyt_fil,
  cs_frigiv_fil, cs_slet_fil,
  cs_opret_spoolfil, cs_opret_eksternfil;
integer array
  dbkatt(1:dbmaxtf,1:2),
  dbkats(1:dbmaxsf,1:2),
  dbkate(1:dbmaxef,1:6),
  dbkatz(1:dbantez+dbantsz+dbanttz,1:2);
boolean array
  dbkatb(1:dbmaxb);
zone array
  fil(dbantez+dbantsz+dbanttz,128,1,stderror);
\f

message hentfildim side 1 - 781120/jg;


integer procedure hentfildim(fdim);
integer array fdim;
<*inddata filref i fdim(4),uddata fdim(1:8)*>

begin integer ftype,fno,katf,i,s;
  ftype:=fdim(4) shift (-10);
  fno:=fdim(4) extract 10;
  if ftype>3 or ftype=0 or fno=0 then
    begin s:=1; goto udgang; end;
  if fno>(case ftype of(dbmaxtf,dbmaxsf,dbmaxef)) then
    begin s:=1; goto udgang end; <*paramfejl*>
  katf:=case ftype of(dbkatt(fno,1),dbkats(fno,1),dbkate(fno,1));
  if katf extract 9 = 0 then
    begin s:=2; goto udgang end; <*tom indgang*>

  fdim(1):=katf shift (-9); <*post antal*>
  fdim(2):=katf extract 9;  <*post længde*>
  fdim(3):=case ftype of(   <*seg antal*>
    dbkatt(fno,2) extract 18 - (if fno=1 then dbblokt else dbkatt(fno-1,2)
    extract 18), dbkats(fno,2) shift (-12) extract 6 * dbbidlængde,
    dbkate(fno,2) extract 18);
  for i:=5 step 1 until 8 do <*externt filnavn*>
    fdim(i):=if ftype=3 then dbkate(fno,i-2) else 0;
  s:=0;
udgang:
  hentfildim:=s;
<*+2*>
<*tz*> if testbit24 and overvåget then                         <*zt*>
<*tz*>   begin                                                 <*zt*>
<*tz*>     write(out,<:<10>hentfildim::>,s,<: :>);             <*zt*>
<*tz*>     pfdim(fdim);                                        <*zt*>
<*tz*>     ud;                                                 <*zt*>
<*tz*>   end;                                                  <*zt*>
<*-2*>
end hentfildim;
\f

message sætfildim side 1 - 780916/jg;

integer procedure sætfildim(fdim);
integer array fdim;
<*inddata fdim(1:4), segant ingen effekt for tabel- og spoolfil*>

begin
  integer ftype,fno,katf,s,pl;
  integer array gdim(1:8);
  gdim(4):=fdim(4);
  s:=hentfildim(gdim);
  if s>0 then
    goto udgang;
  fno:=fdim(4) extract 10;
  ftype:=fdim(4) shift (-10);
  pl:= fdim(2) extract 12;
  if fdim(1)<0 or pl<1 or pl>256 or fdim(3)<0 then
    begin
      s:=1; <*parameter fejl*>
      goto udgang
    end;
  if fdim(1)>256//pl*fdim(3) then
    begin
      s:=1;
      goto udgang;
    end;

  <*segant*>
  if ftype=3 then
    begin integer segant;
      segant:= fdim(3);
      if segant > dbsegmax then
        begin
          s:=4; <*ingen plads*>
          goto udgang
        end;
\f

message sætfildim side 2 - 780916/jg;


      if segant<>gdim(3) then
        begin integer i,z,s; array field enavn; integer array tail(1:10);
          z:=dbkate(fno,2) shift (-19); if z>0 then begin
          if dbkatz(z,1) extract 12=fdim(4) then <*zone tilknyttet*>
            begin integer array zd(1:20);
              getzone6(fil(z),zd);
              if zd(13)>5 and zd(9)>=segant then
                begin <*dødt segment skal ikke udskrives*>
                  zd(13):=5;
                  setzone6(fil(z),zd)
                end
            end end;
\f

message sætfildim side 3 - 801031/jg;


          enavn:=8;  <*ændr fil størrelse*>
          i:=1;
          open(zdummy,0,string gdim.enavn(increase(i)),0);
          s:=monitor(42,zdummy,0,tail); <*lookup*>
          if s>0 then
            fejlreaktion(1,s,<:lookup entry:>,0);
          tail(1):=segant;
          s:=monitor(44,zdummy,0,tail); <*change entry*>
          close(zdummy,false);
          if s<>0 then
            begin
            if s=6 then
              begin  <*ingen plads*>
                s:=4; goto udgang
              end
            else fejlreaktion(1,s,<:change entry:>,0);
            end;
          dbkate(fno,2):=dbkate(fno,2) shift (-18) shift (18)
            add segant;
\f

message sætfildim side 4 - 801013/jg;


        end;
      fdim(3):=segant
    end
  else
    if fdim(3)>gdim(3) then
      begin
        s:=4; <*altid ingen plads*>
        goto udgang
      end
    else fdim(3):=gdim(3); <*samme længde*>
  <*postantal,postlængde*>
  katf:=fdim(1) shift 9  add pl;
  case ftype of begin
    dbkatt(fno,1):=katf;
    dbkats(fno,1):=katf;
    dbkate(fno,1):=katf end;
udgang:
  sætfildim:=s;
<*+2*>
<*tz*> if testbit24 and overvåget then                          <*zt*>
<*tz*>   begin integer i;                                       <*zt*>
<*tz*>     write(out,<:<10>sætfildim::>,s,<: :>);               <*zt*>
<*tz*>     for i:=1 step 1 until 3 do gdim(i):=fdim(i);         <*zt*>
<*tz*>     pfdim(gdim);                                         <*zt*>
<*tz*>     ud;                                                  <*zt*>
<*tz*>   end;                                                   <*zt*>
<*-2*>
end sætfildim;
\f

message findfilenavn side 1 - 780916/jg;

integer procedure findfilenavn(navn);
real array navn;

begin
  integer fno; array field enavn;
  for fno:=1 step 1 until dbmaxef do
   if dbkate(fno,1) extract 9>0 then <*optaget indgang*>
      begin
        enavn:=fno*12+4;
        if navn(1)=dbkate.enavn(1) and
           navn(2)=dbkate.enavn(2) then
          begin
            findfilenavn:=fno;
            goto udgang
          end
      end;
  findfilenavn:=0;
udgang:
end findfilenavn;
\f

message læsfil side 1 - 781120/jg;

integer procedure læsfil(filref,postindex,zoneno);
value filref,postindex;
integer filref,postindex,zoneno;
<*+2*>
<*tz*> begin integer i,o,s;                                       <*zt*>
<*tz*> i:=fillæst;o:=filskrevet; s:=                              <*zt*>
<*-2*>

læsfil:=tilgangfil(filref,postindex,zoneno,5);

<*+2*>
<*tz*> if testbit24 and overvåget then                            <*zt*>
<*tz*>   begin                                                    <*zt*>
<*tz*>     write(out,<:<10>læsfil::>,s,filref,postindex,zoneno,   <*zt*>
<*tz*>     <: io::>,fillæst-i,filskrevet-o);ud;                   <*zt*>
<*tz*>   end;                                                     <*zt*>
<*tz*> end procedure;                                             <*zt*>
<*-2*>
\f

message skrivfil side 1 - 781120/jg;

integer procedure skrivfil(filref,postindex,zoneno);
value filref,postindex;
integer filref,postindex,zoneno;
<*+2*>
<*tz*> begin integer i,o,s;                                       <*zt*>
<*tz*> i:=fillæst;o:=filskrevet; s:=                              <*zt*>
<*-2*>

skrivfil:=tilgangfil(filref,postindex,zoneno,6);

<*+2*>
<*tz*> if testbit24 and overvåget then                            <*zt*>
<*tz*>   begin                                                    <*zt*>
<*tz*>     write(out,<:<10>skrivfil::>,s,filref,postindex,zoneno, <*zt*>
<*tz*>     <: io::>,fillæst-i,filskrevet-o);ud;                   <*zt*>
<*tz*>   end;                                                     <*zt*>
<*tz*> end procedure;                                             <*zt*>
<*-2*>
\f

message modiffil side 1 - 781120/jg;

integer procedure modiffil(filref,postindex,zoneno);
value filref,postindex;
integer filref,postindex,zoneno;
<*+2*>
<*tz*> begin integer i,o,s;                                       <*zt*>
<*tz*> i:=fillæst;o:=filskrevet; s:=                              <*zt*>
<*-2*>

modiffil:=tilgangfil(filref,postindex,zoneno,7);

<*+2*>
<*tz*> if testbit24 and overvåget then                            <*zt*>
<*tz*>   begin                                                    <*zt*>
<*tz*>     write(out,<:<10>modiffil::>,s,filref,postindex,zoneno, <*zt*>
<*tz*>     <: io::>,fillæst-i,filskrevet-o);ud;                   <*zt*>
<*tz*>   end;                                                     <*zt*>
<*tz*> end procedure;                                             <*zt*>
<*-2*>
\f

message tilgangfil side 1 - 781003/jg;

integer procedure tilgangfil(filref,postindex,zoneno,operation);
value filref,postindex,operation;
integer filref,postindex,zoneno,operation;
<*proceduren kaldes fra læsfil,skrivfil og modiffil*>

begin
  integer ftype,fno,f,pl,pr,pps,seg,zno,zstate,katf,st;
  integer array zd(1:20),fdim(1:8);



            <*hent katalog*>

  fdim(4):=filref;
  st:=hentfildim(fdim);
  if st<>0 then
    goto udgang; <*parameter fejl eller fil findes ikke*>
  fno:=filref extract 10;
  ftype:=filref shift (-10);
  pl:=fdim(2);
  katf:=case ftype of(dbkatt(fno,2),dbkats(fno,2),dbkate(fno,2));
\f

message tilgangfil side 2 - 781003/jg;



            <*find segment adr og check postindex*>

  pps:=256//pl; <*poster pr segment*>
  seg:=(postindex-1)//pps; <*relativt segment*>
  pr:=(postindex-1) mod pps; <*post relativ til seg*>
  if postindex <1 then
    begin <*parameter fejl*>
      st:=1;
      goto udgang
    end;
  if seg>=fdim(3) then
    begin <*post findes ikke*>
      st:=3;
      goto udgang
    end;
  case ftype of
    begin <*find absolut segment*>

      <*tabelfil*>
      seg:=seg+(if fno=1 then dbblokt else dbkatt(fno-1,2) extract 18);

      begin <*spoolfil*>
        integer i,bidno;
        bidno:=katf extract 12;
        for i:=seg//dbbidlængde step -1 until 1 do
          bidno:=dbkatb(bidno) extract 12;
        seg:=(bidno-1)*dbbidlængde+seg mod dbbidlængde
      end;

      <*extern fil,seg ok*>

    end case find abs seg;
\f

message tilgangfil side 3 - 801030/jg;

            <*alloker zone*>

  zno:=katf shift(-19);
  case ftype of begin

    begin <*tabelfil*>
      integer førstetz;
      førstetz:=dbkatz(dbsidstetz,2);
      if zno=0 then
        zno:=førstetz
      else if dbkatz(zno,1)<>filref then
        zno:=førstetz
      else if zno <> førstetz and zno <> dbsidstetz then
        begin integer z;
          for z:=zno,dbkatz(z,2) while dbkatz(z,2)<>zno do;
          dbkatz(z,2):=dbkatz(zno,2);
          dbkatz(zno,2):=førstetz;
          dbkatz(dbsidstetz,2):=zno;
        end;
      dbsidstetz:=zno
    end;
\f

message tilgangfil side 4 - 801030/jg;


    begin <*spoolfil*>
      integer p,zslut,z;
      if zno>0 then begin if dbkatz(zno,1) =filref then
        goto udgangs end; <*strategi 1*>
      p:=0;
      zno:=dbsidstesz; <*strategi 4 hvis bedre ikke findes*>
      zslut:= <*if dbantez>dbantef then 1 else*> dbantez+1;
      for z:=dbantez+dbantsz step -1 until zslut do
      begin integer zfref;
        zfref:=dbkatz(z,1);
        if zfref extract 10=0 then <*fri zone*>
          begin <*strategi 2*>
            zno:=z;
            goto udgangs
          end
        else
          if zfref shift (-10)=2 then
            begin <*zone tilknyttet spoolfil*>
              integer q;
              q:=dbkatz(z,2); <*prioritet*>
              if q>p then
                begin <*strategi 3*>
                  p:=q;
                  zno:=z
                end
            end;
      end z;
    udgangs:
      if zno> dbantez then dbsidstesz:=zno;
    end;
\f

message tilgangfil side 5 - 780916/jg;

    begin <*extern fil*>
      integer z;
      if zno=0 then
        zno:=1 
      else if dbkatz(zno,1) = filref then
             goto udgange; <*strategi  1*>
      for z:=1 step 1 until dbantez do
      begin integer zfref;
        zfref:=dbkatz(z,1);
        if zfref=0 then <*zone fri*>
          begin zno:=z; goto udgange end <*strategi 2*>
        else if zfref shift (-10) =2 then <*spoolfil*>
               zno:=z; <*strategi 3*>  <*else strategi 4-5*>
      end z;
    udgange:
    end
  end case alloker zone;



         <*åbn zone*>

  if zno<=dbantez then
    begin <*extern zone;spool og tabel zoner altid åbne*>
      integer zfref;
      zfref:=dbkatz(zno,1);
      if zfref<>0 and zfref<>filref and ftype=3 then
            begin <*luk hvis ny extern fil*>
              getzone6(fil(zno),zd);
              if zd(13)>5 then filskrevet:=filskrevet+1;
              zfref:=0;
              close(fil(zno),false); 
            end;
      if zfref=0 then
        begin <*åbn zone*>
          array field enavn; integer i;
          enavn:=4*2; i:=1;
          open(fil(zno),4,case ftype-1 of(string dbsnavn,
            string fdim.enavn(increase(i))),0)
        end
    end;
\f

message tilgangfil side 6 - 780916/jg;



            <*hent segment og sæt zone descriptor*>

  getzone6(fil(zno),zd);
  zstate:=zd(13);
  if zstate=0 or zd(9)<>seg then
    begin <*positioner*>
      if zstate>5 then
        filskrevet:=filskrevet+1;
      setposition(fil(zno),0,seg);
      if -,(operation=6 and pr=0) then
        begin <*læs seg medmindre op er skriv første post*>
          inrec6(fil(zno),512);
          fillæst:=fillæst+1
        end;
      zstate:=operation
    end
  else <*zstate:=max(operation,zone state)*>
    if operation>zstate then
      zstate:=operation;
  zd(9):=seg;
  zd(13):=zstate;
  zd(16):=pl shift 1;
  zd(14):=zd(19)+pr*zd(16);
  setzone6(fil(zno),zd);
\f

message tilgangfil side 7 - 780916/jg;



         <*opdater kataloger*>

  katf:=zno shift 19 add (katf extract 19);
  case ftype of
    begin
      dbkatt(fno,2):=katf;
      dbkats(fno,2):=katf;
      dbkate(fno,2):=katf
    end;
  dbkatz(zno,1):= filref;
 if ftype=3 then dbkatz(zno,2):=0 else
  <*if ftype=1 then allerede opd under zoneallokering*>
  if ftype=2 then dbkatz(zno,2):= <*prioritet spoolfil*>
    if zstate=5 then (if pr=pps-1 then 2 else 1)
    else if zstate=6 and pr=pps-1 then 3 else 0;



            <*udgang*>

udgang:
  if st=0 then
    zoneno:=zno
  else zoneno:=0; <*fejl*>
  tilgangfil:=st;
end tilgangfil;
\f


message pfilsystem side 1 - 781003/jg;

procedure pfilparm(z);
  zone z;
write(z,<:<10>dbantez=:>,dbantez,<: dbantsz=:>,dbantsz,<: dbanttz=:>,
  dbanttz,<:<10>dbmaxtf=:>,dbmaxtf,<: dbblokt=:>,dbblokt,<: dbmaxsf=:>,dbmaxsf,
  <:<10>dbmaxb=:>,dbmaxb,<:  dbbidlængde=:>,dbbidlængde,<:   dbbidmax=:>,
  dbbidmax,<:<10>dbmaxef=:>,dbmaxef);

procedure pfilglobal(z);
  zone z;
write(z,<:<10>dbantsf=:>,dbantsf,<: dbkatsfri=:>,dbkatsfri,
  <:<10>dbantb=:>,dbantb,<:  dbkatbfri=:>,dbkatbfri,
  <:<10>dbantef=:>,dbantef,<: dbkatefri=:>,dbkatefri,
  <:<10>dbsidstesz=:>,dbsidstesz,<: dbsidstetz=:>,dbsidstetz,
  <:<10>filskrevet=:>,filskrevet,<: fillæst=:>,fillæst,
  <:<10>dbsnavn=:>,string dbsnavn,<: dbtnavn=:>,string dbtnavn);


procedure pdbkate(z,i);
value i; integer i;
  zone z;
begin integer j; array field navn;
  navn:=i*12+4; j:=1;
  write(z,<:<10>dbkate(:>,i,<:)=:>,
  dbkate(i,1) shift (-9),
  dbkate(i,1) extract 9,
  dbkate(i,2) shift (-19),
  dbkate(i,2) shift (-18) extract 1,
  dbkate(i,2) extract 18,
  <: :>,string dbkate.navn(increase(j)));
end;
\f

message pfilsystem side 2 - 781003/jg;



procedure pdbkats(z,i);
value i; integer i;
  zone z;
write(z,<:<10>dbkats(:>,i,<:)=:>,
  dbkats(i,1) shift (-9),
  dbkats(i,1) extract 9,
  dbkats(i,2) shift (-19),
  dbkats(i,2) shift (-18) extract 1,
  dbkats(i,2) shift (-12) extract 6,
  dbkats(i,2) extract 12);

procedure pdbkatb(z,i);
value i;integer i;
  zone z;
write(z,<:<10>dbkatb(:>,i,<:)=:>,
  dbkatb(i) extract 12);

procedure pdbkatt(z,i);
value i; integer i;
  zone z;
write(z,<:<10>dbkatt(:>,i,<:)=:>,
  dbkatt(i,1) shift (-9),
  dbkatt(i,1) extract 9,
  dbkatt(i,2) shift (-19),
  dbkatt(i,2) shift (-18) extract 1,
  dbkatt(i,2) extract 18);

procedure pdbkatz(z,i);
value i; integer i;
  zone z;
write(z,<:<10>dbkatz(:>,i,<:)=:>,
  dbkatz(i,1),dbkatz(i,2));
\f

message pfilsystem side 3 - 781003/jg;



procedure pfil(z,i);
value i; integer i;
  zone z;
begin integer j,k; array field navn; integer array zd(1:20);
  navn:=2; k:=1;
  getzone6(fil(i),zd);
  write(z,<:<10>fil(:>,i,<:)=:>,
  zd(1) shift (-12),<:+:>,zd(1) extract 12,<: :>,
  string zd.navn(increase(k)));
  for j:=6 step 1 until 10 do write(z,zd(j));
  write(z,<:<10>:>);
  for j:=11 step 1 until 20 do write(z,zd(j));
end;

procedure pfilsystem(z);
  zone z;
begin integer i;

  write(z,<:<12>udskrift af variable i filsystem:>);
      write(z,<:<10><10>filparm::>);
      pfilparm(z);
      write(z,<:<10><10>filglobal::>);
      pfilglobal(z);
      write(z,<:<10><10>fil: zone descriptor:>);
  for i:=1 step 1 until dbantez+dbantsz+dbanttz do pfil(z,i);
  write(z,<:<10><10>dbkatz: filref ezdis/szprioritet/tzref:>);
      for i:=1 step 1 until dbantez+dbantsz+dbanttz do pdbkatz(z,i);
      write(z,<:<10><10>dbkate: pa pl zref dis stot/kateref enavn:>);
      for i :=1 step 1 until dbmaxef do pdbkate(z,i);
      write(z,<:<10><10>dbkats: pa pl zref dis bant bref/katsref:>);
      for i:=1 step 1 until dbmaxsf do pdbkats(z,i);
      write(z,<:<10><10>dbkatb: katbref:>);
      for i:=1 step 1 until dbmaxb do pdbkatb(z,i);
      write(z,<:<10><10>dbkatt: pa pl zref dis stot:>);
      for i:=1 step 1 until dbmaxtf do pdbkatt(z,i);
end pfilsystem;
\f

message pfilsystem side 4 - 781003/jg;



procedure pfdim(fdim);
integer array fdim;
begin
  integer i;
  array field navn;
  i:=1;navn:=8;
  write(out,<:fdim::>,fdim(1),fdim(2),fdim(3),fdim(4),<: :>,
  string fdim.navn(increase(i)));
end pfdim;
\f

message opretfil side 0 - 810529/cl;

procedure opretfil;
  <* checker parametre og vidresender operation
     til opret_spoolfil eller opret_eksternfil *>

begin
  integer array field op;
  integer status,pant,pl,segant,p_nøgle,fno,ftype;

  procedure skriv_opret_fil(z,omfang);
    value                    omfang;
    zone                   z;
    integer                  omfang;
  begin
    write(z,"nl",1,<:+++ opret fil            :>);
    if omfang > 0 then
    disable
    begin
      skriv_coru(z,abs curr_coruno);
      write(z,"nl",1,<<d>,
        <:op     :>,op,"nl",1,
        <:status :>,status,"nl",1,
        <:pant   :>,pant,"nl",1,
        <:pl     :>,pl,"nl",1,
        <:segant :>,segant,"nl",1,
        <:p-nøgle:>,p_nøgle,"nl",1,
        <:fno    :>,fno,"nl",1,
        <:ftype  :>,ftype,"nl",1,
        <::>);
    end;
  end skriv_opret_fil;
\f

message opretfil side 1 - 810526/cl;

  trap(opretfil_trap);
<*+2*>
<**>  disable if testbit28 then
<**>    skriv_opret_fil(out,0);
<*-2*>

  stack_claim(if cm_test then 200 else 150);

<*+2*>
<**> if testbit28 then write(out,"nl",1,<:+++ opret fil            :>);
<*-2*>

trin1:
  waitch(cs_opret_fil,op,true,-1);

trin2: <* check parametre *>
  disable begin

    ftype:= d.op.data(4) shift (-10);
    fno:= d.op.data(4) extract 10;
    if ftype<2 or ftype>3 or fno<>0 then
    begin
      status:= 1; <*parameterfejl*>
      goto returner;
    end;

    pant:= d.op.data(1);
    pl:= d.op.data(2);
    segant:= d.op.data(3);
    p_nøgle:= d.op.opkode shift (-12);
    if pant<0 or pl<1 or pl>256 or segant<(case ftype-1 of(1,0))
      or p_nøgle<>0 and p_nøgle<>2 and p_nøgle<>3 then
        status:= 1 <*parameterfejl *>
    else
    if pant>256//pl*segant then status:= 1 else
    if segant>(case ftype-1 of(dbbidmax*dbbidlængde,dbsegmax)) then
      status:= 4 <*ingen plads*>
    else
      status:=0;
\f

message opretfil side 2 - 810526/cl;


returner:

    d.op.data(9):= status;

<*+2*>
<*tz*> if testbit24 and overvåget and status<>0 then    <*zt*>
<*tz*> begin                                            <*zt*>
<*tz*>   write(out,<:<10>opretfil::>,status,<: :>);     <*zt*>
<*tz*>   pfdim(d.op.data);                              <*zt*>
<*tz*>   write(out,<: op::>,op,d.op.retur); ud;         <*zt*>
<*tz*> end;                                             <*zt*>
<*-2*>

    <*returner eller vidresend operation*>
    signalch(if status>0 then d.op.retur else
      case ftype-1 of(cs_opret_spoolfil,cs_opret_eksternfil),
      op,d.op.optype);
  end;
  goto trin1;
opretfil_trap:
  disable skriv_opret_fil(zbillede,1);

end opretfil;
\f

message tilknytfil side 0 - 810526/cl;

procedure tilknytfil;
  <* tilknytter ekstern fil og returnerer intern filid *>

begin
  integer array field op;
  integer status,i,fno,segant,pa,pl,sliceant,s;
  array field enavn;
  integer array tail(1:10);

  procedure skriv_tilknyt_fil(z,omfang);
    value                       omfang;
    zone                      z;
    integer                     omfang;
  begin
    write(z,"nl",1,<:+++ tilknyt fil          :>);
    if omfang > 0 then
    disable
    begin real array field raf;
      skriv_coru(z,abs curr_coruno);
      write(z,"nl",1,<<d>,
        <:op      :>,op,"nl",1,
        <:status  :>,status,"nl",1,
        <:i       :>,i,"nl",1,
        <:fno     :>,fno,"nl",1,
        <:segant  :>,segant,"nl",1,
        <:pa      :>,pa,"nl",1,
        <:pl      :>,pl,"nl",1,
        <:sliceant:>,sliceant,"nl",1,
        <:s       :>,s,"nl",1,
        <::>);
      raf:= 0;
      write(z,<:tail::>); skriv_hele(z,tail.raf,20,128);
      write(z,<:ia::>); skriv_hele(z,ia.raf,20,128);
    end;
  end skriv_tilknyt_fil;
\f

message tilknytfil side 1 - 810529/cl;

  stack_claim(if cm_test then 200 else 150);
  trap(tilknytfil_trap);

<*+2*>
<**> if testbit28 then
<**>   skriv_tilknyt_fil(out,0);
<*-2*>

trin1:
  waitch(cs_tilknyt_fil,op,true,-1);

trin2:
  wait(bs_kate_fri);

trin3:
  disable begin

    <* find ekstern rapportfil *>
    enavn:= 8;
    if find_fil_enavn(d.op.data.enavn)>0 then
    begin
      status:= 6; <* fil i brug *>
      goto returner;
    end;
    open(zdummy,0,d.op.data.enavn,0);
    s:= monitor(42)lookup entry:(zdummy,0,tail);
    if s<>0 then
    begin
      if s=3 then status:= 2 <* fil findes ikke *>
     else if s=6 then status:= 1 <* parameterfejl, navn *>
     else fejlreaktion(1,s,<:lookup entry:>,0);
      goto returner;
    end;
    if tail(9)<>d.op.data(4) <* contentskey,subno *> then
    begin
      status:= 5; <* forkert indhold *> goto returner;
    end;
    segant:= tail(1);
    if segant>db_seg_max then
      segant:= db_seg_max;
    pa:= tail(10);
    pl:= tail(7) extract 12;
    if pl < 1 or pl > 256 then
    begin status:= 7; goto returner; end;
\f

message tilknytfil side 2 - 810529/cl;
    if pa>256//pl*segant then
    begin status:= 7; goto returner; end;

    <* reserver *>
    s:= monitor(52)create area:(zdummy,0,ia);
    if s<>0 then
    begin
      if s=3 then status:= 2 <* fil findes ikke *>
      else if s=1 <* areaclaims exeeded *> then
      begin
        status:= 4;
        fejlreaktion(1,s,<:create area:>,1);
      end
      else fejlreaktion(1,s,<:create area:>,0);
      goto returner;
    end;

    s:= monitor(8)reserve:(zdummy,0,ia);
    if s<>0 then
    begin
      if s<3 then status:= 6 <* i brug *>
      else fejlreaktion(1,s,<:reserve:>,0);
      monitor(64)remove area:(zdummy,0,ia);
      goto returner;
    end;

    tail(7):= 1 shift 12 +pl; <* tilknyttet *>
    s:= monitor(44)change entry:(zdummy,0,tail);
    if s<>0 then fejlreaktion(1,s,<:change entry:>,0);

    <* opdater katalog *>
    dbantef:= dbantef+1;
    fno:= dbkatefri;
    dbkatefri:= dbkate(fno,2);
    dbkate(fno,1):= pa shift 9 add pl; <* postantal,postlængde *>
    dbkate(fno,2):= segant;
    for i:= 5 step 1 until 8 do
      dbkate(fno,i-2):= d.op.data(i);

    <* returparametre *>
    d.op.data(1):= pa;
    d.op.data(2):= pl;
    d.op.data(3):= segant;
    d.op.data(4):= 3 shift 10 +fno;
    status:= 0;
\f

message tilknytfil side 3 - 810526/cl;


returner:
    close(zdummy,false);
    d.op.data(9):= status;


<*+2*>
<*tz*> if testbit24 and overvåget then                 <*zt*>
<*tz*> begin                                           <*zt*>
<*tz*>   write(out,<:<10>tilknytfil::>,status,<: :>);  <*zt*>
<*tz*>   pfdim(d.op.data);                             <*zt*>
<*tz*>   write(out,<: op::>,op,d.op.retur); ud;        <*zt*>
<*tz*> end;                                            <*zt*>
<*-2*>

    signalch(d.op.retur,op,d.op.optype);
    if dbantef < dbmaxef then
      signalbin(bs_kate_fri);
  end;
  goto trin1;
tilknytfil_trap:
  disable skriv_tilknyt_fil(zbillede,1);
end tilknyt_fil;
\f

message frigivfil side 0 - 810529/cl;

procedure frigivfil;
  <* frigiver en tilknyttet ekstern fil *>

begin
  integer array field op;
  integer status,fref,ftype,fno,s,i,z;
  array field enavn;
  integer array tail(1:10);

  procedure skriv_frigiv_fil(zud,omfang);
    value                        omfang;
    zone                     zud;
    integer                      omfang;
  begin
    write(zud,"nl",1,<:+++ frigiv fil           :>);
    if omfang > 0 then
    disable
    begin real array field raf;
      skriv_coru(zud,abs curr_coruno);
      write(zud,"nl",1,<<d>,
        <:op    :>,op,"nl",1,
        <:status:>,status,"nl",1,
        <:fref  :>,fref,"nl",1,
        <:ftype :>,ftype,"nl",1,
        <:fno   :>,fno,"nl",1,
        <:s     :>,s,"nl",1,
        <:i     :>,i,"nl",1,
        <:z     :>,z,"nl",1,
        <::>);
      raf:= 0;
      write(zud,<:tail::>); skriv_hele(zud,tail.raf,20,128);
    end;
  end skriv_frigiv_fil;
\f

message frigivfil side 1 - 810526/cl;


  stack_claim(if cm_test then 200 else 150);
  trap(frigivfil_trap);

<*+2*>
<**>  disable if testbit28 then
<**>    skriv_frigiv_fil(out,0);
<*-2*>

trin1:
  waitch(cs_frigiv_fil,op,true,-1);

trin2:
  disable begin

    <* find fil *>
    fref:= d.op.data(4);
    ftype:= fref shift (-10);
    fno:= fref extract 10;
    if ftype=0 or ftype>3 or fno=0 then
    begin status:= 1; goto returner; end;
    if fno>(case ftype of(dbmaxtf,dbmaxsf,dbmaxef)) then
    begin status:= 1; goto returner; end;
    if case ftype of(dbkatt(fno,1),dbkats(fno,1),dbkate(fno,1))
       extract 9 = 0 then
    begin
     status:= 2; <* fil findes ikke *>
     goto returner;
    end;
    if ftype <> 3 then
    begin status:= 5; goto returner; end;

    <* frigiv evt. tilknyttet zone og areaprocess *>
    z:= dbkate(fno,2) shift (-19);
    if z > 0 then
    begin
      if dbkatz(z,1)=fref then
      begin integer array zd(1:20);
        getzone6(fil(z),zd);
        if zd(13)>5 then filskrevet:= filskrevet +1;
        close(fil(z),true);
        dbkatz(z,1):= 0;
      end;
    end;
\f

message frigivfil side 2 - 810526/cl;

    <* opdater tail *>
    enavn:= fno*12+4;
    open(zdummy,0,dbkate.enavn,0);
    s:= monitor(42)lookup entry:(zdummy,0,tail);
    if s<>0 then fejlreaktion(1,s,<:lookup entry:>,0);
    tail(7):= dbkate(fno,1) extract 9; <* ej tilknyttet,postlængde *>
    tail(10):=dbkate(fno,1) shift (-9);<* postantal *>
    s:= monitor(44)change entry:(zdummy,0,tail);
    if s<>0 then fejlreaktion(1,s,<:change entry:>,0);
    monitor(64)remove process:(zdummy,0,tail);
    close(zdummy,true);

    <* frigiv indgang *>
    for i:= 1, 3 step 1 until 6 do
      dbkate(fno,1):= 0;
    dbkate(fno,2):= dbkatefri;
    dbkatefri:= fno;
    dbantef:= dbantef -1;
    signalbin(bs_kate_fri);
    d.op.data(4):= 0; <* filref null *>
    status:= 0;

returner:
    d.op.data(9):= status;
<*+2*>
<*tz*> if testbit24 and overvåget then                  <*zt*>
<*tz*> begin                                            <*zt*>
<*tz*>   write(out,<:<10>frigivfil::>,status,<: :>);    <*zt*>
<*tz*>   pfdim(d.op.data);                              <*zt*>
<*tz*>   write(out,<: op::>,op,d.op.retur); ud;         <*zt*>
<*tz*> end;                                             <*zt*>
<*-2*>

    signalch(d.op.retur,op,d.op.optype);
  end;
  goto trin1;
frigiv_fil_trap:
   disable skriv_frigiv_fil(zbillede,1);
end frigivfil;
\f

message sletfil side 0 - 810526/cl;

procedure sletfil;
  <* sletter en spool- eller ekstern fil *>

begin
  integer array field op;
  integer fref,fno,ftype,status;

  procedure skriv_slet_fil(z,omfang);
    value                    omfang;
    zone                   z;
    integer                  omfang;
  begin
    write(z,"nl",1,<:+++ slet fil             :>);
    if omfang > 0 then
    disable
    begin
      skriv_coru(z,abs curr_coruno);
      write(z,"nl",1,<<d>,
        <:op    :>,op,"nl",1,
        <:fref  :>,fref,"nl",1,
        <:fno   :>,fno,"nl",1,
        <:ftype :>,ftype,"nl",1,
        <:status:>,status,"nl",1,
        <::>);
    end;
  end skriv_slet_fil;
\f

message sletfil side 1 - 810526/cl;

  stack_claim(if cm_test then 200 else 150);

  trap(sletfil_trap);
<*+2*>
<**>  disable if testbit28 then
<**>    skriv_slet_fil(out,0);
<*-2*>

trin1:
  waitch(cs_slet_fil,op,true,-1);

trin2:
  disable begin

    <* find fil *>
    fref:= d.op.data(4);
    ftype:= fref shift (-10);
    fno:= fref extract 10;
    if ftype=0 or ftype>3 or fno=0 then
    begin status:= 1; goto returner; end;
    if fno>(case ftype of(dbmaxtf,dbmaxsf,dbmaxef)) then
    begin status:= 1; goto returner; end;
    if case ftype of(dbkatt(fno,1),dbkats(fno,1),dbkate(fno,1))
      extract 9 = 0 then
    begin
      status:= 2; <* fil findes ikke *>
      goto returner;
    end;


    <* slet spool- eller ekstern fil *>
    case ftype of
    begin

      <* tabelfil - ingen aktion *>
      ;
\f

message sletfil side 2 - 810203/cl;

      <* spoolfil *>
      begin
        integer z,bidno,bf,bidant,i;

        <* hvis tilknyttet så frigiv *>
        z:= dbkats(fno,2) shift (-19);
        if z>0 then
        begin
          if dbkatz(z,1)=fref then
          begin integer array zd(1:20);
            dbkatz(z,1):= 2 shift 10;
            getzone6(fil(z),zd); <*annuler evt. udskrivning*>
            if zd(13)>5 then
            begin zd(13):= 0; setzone6(fil(z),zd); end;
          end;
        end;

        <* frigiv bidder *>
        bidno:= bf:= dbkats(fno,2) extract 12; <*bid start*>
        bidant:= dbkats(fno,2) shift (-12) extract 6;
        for i:= bidant -1 step -1 until 1 do
          bidno:= dbkatb(bidno) extract 12;
        dbkatb(bidno):= false add dbkatbfri;
        dbkatbfri:= bf;
        dbantb:= dbantb-bidant;

        <* frigiv indgang *>
        dbkats(fno,1):= 0;
        dbkats(fno,2):= dbkatsfri;
        dbkatsfri:= fno;
        dbantsf:= dbantsf -1;
        signalbin(bs_kats_fri);
      end spoolfil;
\f

message sletfil side 3 - 810203/cl;

      <* extern fil *>
      begin
        integer i,s,z;
        real array field enavn;
        integer array tail(1:10);

        <* find head and tail *>
        enavn:= fno*12+4;
        open(zdummy,0,dbkate.enavn,0);
        s:= monitor(42)lookup entry:(zdummy,0,tail);
        if s<>0 then fejlreaktion(1,s,<:lookup entry:>,0);

        <*frigiv evt. tilknyttet zone og areaprocess*>
        z:=dbkate(fno,2) shift (-19);
        if z>0 then
        begin
          if dbkatz(z,1)=fref then
          begin integer array zd(1:20);
            getzone6(fil(z),zd);
            if zd(13)>5 then <* udskrivning *>
            begin <*annuler*>
              zd(13):= 0;
              setzone6(fil(z),zd);
            end;
            close(fil(z),true);
            dbkatz(z,1):= 0;
          end;
        end;

        <* fjern entry *>
        s:= monitor(48)remove entry:(zdummy,0,tail);
        if s<>0 then fejlreaktion(1,s,<:remove entry:>,0);
        close(zdummy,true);

        <* frigiv indgang *>
        for i:=1, 3 step 1 until 6 do
          dbkate(fno,i):= 0;
        dbkate(fno,2):= dbkatefri;
        dbkatefri:= fno;
        dbantef:= dbantef -1;
        signalbin(bs_kate_fri);
      end eksternfil;

    end ftype;
\f

message sletfil side 4 - 810526/cl;


    status:= 0;
    if ftype > 1 then
      d.op.data(4):= 0; <*filref null*>

returner:
    d.op.data(9):= status;

<*+2*>
<*tz*> if testbit24 and overvåget then                  <*zt*>
<*tz*> begin                                            <*zt*>
<*tz*>   write(out,<:<10>sletfil::>,status,<: :>);      <*zt*>
<*tz*>   pfdim(d.op.data);                              <*zt*>
<*tz*>   write(out,<: op::>,op,d.op.retur); ud;         <*zt*>
<*tz*> end;                                             <*zt*>
<*-2*>
    
     signalch(d.op.retur,op,d.op.optype);
  end;
  goto trin1;
sletfil_trap:
    disable skriv_slet_fil(zbillede,1);
end sletfil;
\f

message opretspoolfil side 0 - 810526/cl;

procedure opretspoolfil;
  <* opretter en spoolfil og returnerer intern filid *>

begin
  integer array field op;
  integer bidantal,fno,i,bs,bidstart;

  procedure skriv_opret_spoolfil(z,omfang);
    value                          omfang;
    zone                         z;
    integer                        omfang;
  begin
    write(z,"nl",1,<:+++ opret spoolfil       :>);
    if omfang > 0 then
    disable
    begin
      skriv_coru(z,abs curr_coruno);
      write(z,"nl",1,<<d>,
        <:op      :>,op,"nl",1,
        <:bidantal:>,bidantal,"nl",1,
        <:fno     :>,fno,"nl",1,
        <:i       :>,i,"nl",1,
        <:bs      :>,bs,"nl",1,
        <:bidstart:>,bidstart,"nl",1,
        <::>);
      end;
    end skriv_opret_spoolfil;
\f

message opretspoolfil side 1 - 810526/cl;

  stack_claim(if cm_test then 200 else 150);

  signalbin(bs_kats_fri); <*initialiseres til åben*>

  trap(opretspool_trap);
<*+2*>
<**>  disable if testbit28 then
<**>    skriv_opret_spoolfil(out,0);
<*-2*>
trin1:
  waitch(cs_opret_spoolfil,op,true,-1);

trin2:
  bidantal:= (d.op.data(3)<*segant*> - 1)//dbbidlængde +1;
  wait(bs_kats_fri);

trin3:
  if bidantal>dbmaxb-dbantb then <*ikke plads,vent*>
  begin
    wait(bs_kats_fri);
    goto trin3;
  end;
  disable begin

    <*alloker bidder*>
    bs:= bidstart:= dbkatbfri;
    for i:= bidantal-1 step -1 until 1 do
      bs:= dbkatb(bs) extract 12;
    dbkatbfri:= dbkatb(bs) extract 12;
    dbkatb(bs):= false; <*sidste ref null*>
    dbantb:= dbantb+bidantal;

    <*alloker indgang*>
    fno:= dbkatsfri;
    dbkatsfri:= dbkats(fno,2);
    dbantsf:= dbantsf +1;
    dbkats(fno,1):= d.op.data(1) shift 9 <*postantal*> add
                    d.op.data(2) extract 9; <*postlængde*>
    dbkats(fno,2):= bidantal shift 12 add bidstart; <*zone null*>
\f

message opretspoolfil side 2 - 810526/cl;

    <*returner*>
    d.op.data(3):= bidantal*dbbidlængde; <*segantal*>
    d.op.data(4):= 2 shift 10 add fno; <*filref*>
    for i:= 5 step 1 until 8 do <*filnavn null*>
      d.op.data(i):= 0;
    d.op.data(9):= 0; <*status ok*>

<*+2*>
<*tz*> if testbit24 and overvåget then                  <*zt*>
<*tz*> begin                                            <*zt*>
<*tz*>   write(out,<:<10>opretfil::>,0,<: :>);          <*zt*>
<*tz*>   pfdim(d.op.data);                              <*zt*>
<*tz*>   write(out,<: op:>,op,d.op.retur); ud;          <*zt*>
<*tz*> end;                                             <*zt*>
<*-2*>

    signalch(d.op.retur,op,d.op.optype);
    if dbantsf<dbmaxsf then signalbin(bs_kats_fri);
  end;
  goto trin1;

opretspool_trap:
    disable skriv_opret_spoolfil(zbillede,1);

end opretspoolfil;
\f

message opreteksternfil side 0 - 810526/cl;

procedure opreteksternfil;
  <* opretter og knytter en ekstern fil *>

begin
  integer array field op;
  integer status,s,i,fno,p_nøgle;
  integer array tail(1:10),zd(1:20);
  real r;
  real array field enavn;

  procedure skriv_opret_ekstfil(z,omfang);
    value                         omfang;
    zone                        z;
    integer                       omfang;
  begin
    write(z,"nl",1,<:+++ opret ekstern fil    :>);
    if omfang > 0 then
    disable
    begin real array field raf;
      skriv_coru(z,abs curr_coruno);
      write(z,"nl",1,<<d>,
        <:op     :>,op,"nl",1,
        <:status :>,status,"nl",1,
        <:s      :>,s,"nl",1,
        <:i      :>,i,"nl",1,
        <:fno    :>,fno,"nl",1,
        <:p-nøgle:>,p_nøgle,"nl",1,
        <::>);
      raf:= 0;
      write(z,<:tail::>); skriv_hele(z,tail.raf,20,128);
      write(z,<:zd::>); skriv_hele(z,zd.raf,40,28);
    end;
  end skriv_opret_ekstfil;
\f

message opreteksternfil side 1 - 810526/cl;

  stack_claim(if cm_test then 200 else 150);

  signalbin(bs_kate_fri); <*initialiseres til åben*>

  trap(opretekst_trap);
<*+2*>
<**>  disable if testbit28 then
<**>    skriv_opret_ekstfil(out,0);
<*-2*>
trin1:
  waitch(cs_opret_eksternfil,op,true,-1);

trin2:
  wait(bs_kate_fri);

trin3:
  <*opret temporær fil og tilknyt den*>
  disable begin

    enavn:= 8;
    <*opret*>
    open(zdummy,0,d.op.data.enavn,0);
    tail(1):= d.op.data(3); <*segant*>
    tail(2):= 1;
    tail(6):= systime(7,0,r); <*shortclock*>
    tail(7):= 1 shift 12 +d.op.data(2) extract 12; <*tilknyttet,postlgd*>
    tail(8):= 0;
    tail(9):= 31 shift 12; <*contentskey=ekstern fil,subnr=0*>
    tail(10):= d.op.data(1); <*postantal*>
    s:= monitor(40)create entry:(zdummy,0,tail);
    if s<>0 then
    begin
      if s=4 <*claims exeeded*> then
      begin
        status:= 4;
        fejlreaktion(1,s,<:create entry:>,1);
        goto returner;
      end;
      if s=3 <*navn ikke unikt*> then
      begin status:= 6; goto returner; end;
      fejlreaktion(1,s,<:create entry:>,0);
    end;
\f

message opreteksternfil side 2 - 810203/cl;

    p_nøgle:= d.op.opkode shift (-12);
    s:= monitor(50)permanent_entry:(zdummy,p_nøgle,tail);
    if s<>0 then
    begin
      if s=6 then
      begin <*claims exeeded*>
        status:= 4;
        fejlreaktion(1,s,<:permanent entry:>,1);
        monitor(48)remove entry:(zdummy,0,tail);
        goto returner;
      end
      else fejlreaktion(1,s,<:permanent entry:>,0);
    end;

    <*reserver*>
    s:= monitor(52)create areaprocess:(zdummy,0,zd);
    if s<>0 then
    begin
      fejlreaktion(1,s,<:create area:>,if s=1 then 1 else 0);
      status:= 4;
      monitor(48)remove entry:(zdummy,0,zd);
      goto returner;
    end;

    s:= monitor(8)reserve:(zdummy,0,zd);
    if s<>0 then fejlreaktion(1,s,<:reserve:>,0);

    <*tilknyt*>
    dbantef:= dbantef +1;
    fno:= dbkatefri;
    dbkatefri:= dbkate(fno,2);
    dbkate(fno,1):= tail(10) shift 9 add (tail(7) extract 12);
    dbkate(fno,2):= tail(1);
    getzone6(zdummy,zd);
    for i:= 2 step 1 until 5 do
      dbkate(fno,i+1):= d.op.data(3+i):= zd(i); <*navn*>
    d.op.data(3):= tail(1);
    d.op.data(4):= 3 shift 10 +fno;
    status:= 0;
\f

message opreteksternfil side 3 - 810526/cl;

returner:

    close(zdummy,false);
    d.op.data(9):= status;

<*+2*>
<*tz*> if testbit24 and overvåget then                  <*zt*>
<*tz*> begin                                            <*zt*>
<*tz*>   write(out,<:<10>opretfil::>,status,<: :>);     <*zt*>
<*tz*>   pfdim(d.op.data);                              <*zt*>
<*tz*>   write(out,<: op::>,op,d.op.retur); ud;         <*zt*>
<*tz*> end;                                             <*zt*>
<*-2*>

    signalch(d.op.retur,op,d.op.optype);
    if dbantef<dbmaxef then signalbin(bs_kate_fri);
  end;
  goto trin1;

opretekst_trap:
    disable skriv_opret_ekstfil(zbillede,1);

end opreteksternfil;

:5: filinit.

\f

message fil_init side 1 - 801030/jg;

begin integer i,antz,tz,s;
      real array field raf;

filskrevet:=fillæst:=0;                                    <*fil*>
dbsegmax:= 2**18-1;

tz:=dbantez+dbantsz; antz:=tz+dbanttz;
for i:=1 step 1 until dbantez do
  begin open(fil(i),4,<::>,0); close(fil(i),false) end;
for i:=dbantez+1 step 1 until tz do
  open(fil(i),4,string dbsnavn,0);
for i:=tz+1 step 1 until antz do
  open(fil(i),4,string dbtnavn,0);

for i:=1 step 1 until dbantez do                        <*dbkatz*>
  dbkatz(i,1):=dbkatz(i,2):=0;
for i:=dbantez+1 step 1 until tz do
  begin dbkatz(i,1):=2 shift 10;dbkatz(i,2):=0 end;
for i:=tz+1 step 1 until antz do
  begin dbkatz(i,1):=1 shift 10;dbkatz(i,2):=i+1 end;
dbkatz(antz,2):=tz+1;
dbsidstetz:=antz;
dbsidstesz:=tz;

for i:=1 step 1 until dbmaxef do                        <*dbkate*>
  begin integer j;
    for j:=1,3 step 1 until 6 do
      dbkate(i,j):=0;
    dbkate(i,2):=i+1;
  end;
dbkate(dbmaxef,2):=0;
dbkatefri:=1;
dbantef:=0;
\f

message fil_init side 2 - 801030/jg;


for i:= 1 step 1 until dbmaxsf do                       <*dbkats*>
  begin
    dbkats(i,1):=0;
    dbkats(i,2):=i+1;
  end;
dbkats(dbmaxsf,2):=0;
dbkatsfri:=1;
dbantsf:=0;

for i:=1 step 1 until dbmaxb do                         <*dbkatb*>
  dbkatb(i):=false add (i+1);
dbkatb(dbmaxb):=false;
dbkatbfri:=1;
dbantb:=0;
raf:=4;
for i:=1 step 1 until dbmaxtf do
  begin
    inrec6(fil(antz),4);
    dbkatt.raf(i):=fil(antz,1);
  end;
inrec6(fil(antz),4);
if fil(antz,1)<>real extend 8388607 shift 24 add 8388607 then
  fejl_reaktion(1,dbmaxtf,<:tabelfil init:>,0);
setposition(fil(antz),0,0);

end filsystem;
\f

message fil_init side 3 - 810209/cl;

bs_kats_fri:= nextsem;
<*+3*> skriv_new_sem(out,1,bs_kats_fri,<:bs-kats-fri:>);
<*-3*>
bs_kate_fri:= nextsem;
<*+3*> skriv_new_sem(out,1,bs_kate_fri,<:bs-kate-fri:>);
<*-3*>
cs_opret_fil:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_opret_fil,<:cs-opret-fil:>);
<*-3*>
cs_tilknyt_fil:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_tilknyt_fil,<:cs-tilknyt-fil:>);
<*-3*>
cs_frigiv_fil:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_frigiv_fil,<:cs-frigiv-fil:>);
<*-3*>
cs_slet_fil:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_slet_fil,<:cs-slet-fil:>);
<*-3*>
cs_opret_spoolfil:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_opret_spoolfil,<:cs-opret-spoolfil:>);
<*-3*>
cs_opret_eksternfil:= nextsemch;
<*+3*> skriv_new_sem(out,3,cs_opret_eksternfil,<:cs-opret-ekst-fil:>);
<*-3*>
\f

message fil_init side 4 810209/cl;


<* initialisering af filsystemcoroutiner *>

i:= nextcoru(001,10,true);
j:= newactivity(i,0,opretfil);
<*+3*> skriv_newactivity(out,i,j);
<*-3*>

i:= nextcoru(002,10,true);
j:= newactivity(i,0,tilknytfil);
<*+3*> skriv_newactivity(out,i,j);
<*-3*>

i:= nextcoru(003,10,true);
j:= newactivity(i,0,frigivfil);
<*+3*> skriv_newactivity(out,i,j);
<*-3*>

i:= nextcoru(004,10,true);
j:= newactivity(i,0,sletfil);
<*+3*> skriv_newactivity(out,i,j);
<*-3*>

i:= nextcoru(005,10,true);
j:= newactivity(i,0,opretspoolfil);
<*+3*> skriv_newactivity(out,i,j);
<*-3*>

i:= nextcoru(006,10,true);
j:= newactivity(i,0,opreteksternfil);
<*+3*> skriv_newactivity(out,i,j);
<*-3*>
:6: filsystem: trap
pfilsystem(zbillede);

:7: filsystem: finale
\f

message filsystem finale side 1 - 810428/cl;

<* lukning af zoner *>
write(out,<:lukker filsystem:>); ud;
for i:= 1 step 1 until dbantez+dbantsz+dbanttz do
  close(fil(i),true);
▶EOF◀