DataMuseum.dk

; sl 13.1.72  sldisksort                                        page 1
sldisksort=set 5
sldisksort=algol index.no list.no
external procedure sldisksort(filnavn,læ,antalindiv,segmprblok,ngl);
value segmprblok; string filnavn;
integer læ,antalindiv,segmprblok,ngl;
begin integer fysisksubbloklængde, fysiskbloklængde, b;
      integer array ia(1:20); array ra(1:2);
      fysisksubbloklængde := 512 ⨯ segmprblok;
      b:= (system(2,b,ra)-8⨯512)//(2⨯fysisksubbloklængde);
      fysiskbloklængde := b ⨯ fysisksubbloklængde;
      segmprblok := b ⨯ segmprblok;
begin integer diff, fa, indivlæ2, logiskbloklængde,
      logisksubbloklængde, nedbasis, nedplads, nedslut, opbasis,
      opplads, opslut, slut2, start2, subblokstart, transporter;
      integer field indivlæ; real r; real field i;
      array field m, ned, op; integer array nuvblok(0:1);
      zone z(fysiskbloklængde//2,1,blproc);
      real mid;  real field nøgle;
procedure blproc(z,s,b); zone z; integer s, b;
if s extract 19 < 1 shift 18 or ia(4)<>5 shift 12 then
stderror(z,s,b);
procedure io(plads,operation); integer plads, operation;
begin b:=nuvblok(plads)⨯segmprblok;
      if b>=0 then
      begin ia(4):= operation shift 12;
            ia(7):= b;
            ia(5):= b:= fa + plads⨯fysiskbloklængde;
            ia(6):= b + fysiskbloklængde - 2;
            setshare(z,ia,1);
            monitor(16,z,1,ia); check(z);
      end
end io;
[stop]
comment sl 13.1.72                                                page 2;
procedure quicksort(start,slut,enblok); value start, slut, enblok;
integer start, slut; boolean enblok;
begin
for m:=(start+slut)//indivlæ2⨯indivlæ while start<slut-indivlæ2 do
begin op:= start-opbasis; ned:= slut-nedbasis; m:= m-opbasis;
      if -,enblok then
      begin transporter:=0;
            transport(m,opbasis,opplads,nedplads);
            nedslut:=ned; opslut:=op;
      end;
      mid:= z.m.nøgle;
søgned:  ned:= ned-indivlæ; if ned < nedslut then
      begin transport(ned,nedbasis,nedplads,opplads);
            nedslut:= subblokstart;
      end;
      if z.ned.nøgle > mid then goto søgned;
søgop:   op:= op+indivlæ; if op >= opslut then
      begin transport(op,opbasis,opplads,nedplads);
            opslut:= subblokstart + logisksubbloklængde;
            if transporter=3 then enblok:= nedslut=subblokstart;
      end;
      if z.op.nøgle < mid then goto søgop;
      if op+opbasis < ned+nedbasis then
      begin for i:=4 step 4 until indivlæ do
            begin r:=z.op.i; z.op.i:=z.ned.i; z.ned.i:=r end;
            if indivlæ extract 2 > 0 then
            begin i:= z.op.indivlæ; z.op.indivlæ:=z.ned.indivlæ;
                  z.ned.indivlæ:=i;
            end;
            goto søgned;
      end;
      slut2:= op+opbasis; start2:= start; start:= ned+nedbasis;
      if slut-start < slut2-start2 then
      begin i:=slut; slut:=slut2; slut2:=i;
            i:=start; start:=start2; start2:=i;
      end;
      if start2<slut2-indivlæ2 then quicksort(start2,slut2,enblok);
end for m;
end quicksort;
[stop]
comment sl 13.1.72                                                page 3;
procedure transport(fysisk,basis,plads,andenplads);
integer fysisk, basis, plads, andenplads;
begin integer logisk, blok, blokrel, subbloknr, blokbasis;
      logisk:= fysisk+basis;
      blok:= logisk//logiskbloklængde; blokrel:= logisk mod logiskbloklængde;
      if blok = nuvblok(0) then plads := 0 else
      if blok = nuvblok(1) then plads := 1 else
      begin plads := 1-andenplads; io(plads,5);
            nuvblok(plads):= blok; io(plads,3);
      end;
      subbloknr := blokrel//logisksubbloklængde;
      blokbasis := plads ⨯ fysiskbloklængde;
      fysisk := blokrel + subbloknr ⨯ diff + blokbasis;
      subblokstart := subbloknr ⨯ fysisksubbloklængde + blokbasis;
      basis := logisk - fysisk;
      transporter := transporter + 1;
end transport;
      open(z,4,filnavn,1 shift 18); close(z,false);
      getzone(z,ia); fa:=ia(19)+1; getshare(z,ia,1);
      nøgle:=ngl; indivlæ:=læ; indivlæ2:=2⨯indivlæ;
      if nøgle<4 or indivlæ<nøgle then system(9,nøgle,<:<10>index   :>);
      diff:= fysisksubbloklængde mod indivlæ;
      logisksubbloklængde := fysisksubbloklængde - diff;
      logiskbloklængde := b ⨯ logisksubbloklængde;
      nuvblok(0) := nuvblok(1) := -1;
      opbasis:= nedbasis:= nedplads:= 0;
      quicksort(-indivlæ, indivlæ⨯antalindiv, false);
      io(0,5); io(1,5);
end zone blok;
end disksort;
end
[stop]