DataMuseum.dk

top - download

    Length: 3840 (0xf00)
    Types: TextFile
    Names: »DELKEY.PAS«

└─⟦692ac107c⟧ Bits:30005923 PolyPascal-80 V3.10 arbejdsdiskette 1
    └─ ⟦this⟧ »DELKEY.PAS« 

TextFile

æ*******************************************************å
æ                                                       å
æ                 PolyFile Version 1.10                 å
æ                                                       å
æ                     DELKEY module                     å
æ                                                       å
æ                   Copyright (C) 1985                  å
æ                PolyData MicroCenter A/S               å
æ                                                       å
æ*******************************************************å

æ$A+,I-,R-å

PROCEDURE deletekey(VAR idxf: indexfile; VAR pdr: integer; VAR pk);
VAR
  pkey: p_keystr AT pk;
  usize: boolean;
  n: p_nodrcp;

æ$A-å

PROCEDURE delb(npr: integer);
VAR
  c,i,k,l,r,xpr: integer;
  n: p_nodrcp;

æ$A+å

PROCEDURE uflow(npr,mpr,r: integer);
VAR
  i,k,le,lpr: integer;
  n,m,l: p_nodrcp;
BEGIN
  p_getn(idxf,npr,n); p_getn(idxf,mpr,m);
  IF r<n^.ne THEN
  BEGIN
    r:=r+1; lpr:=n^.eÆrÅ.nr; p_getn(idxf,lpr,l);
    k:=(l^.ne-nodehalf+1) DIV 2;
    m^.eÆnodehalfÅ:=n^.eÆrÅ; m^.eÆnodehalfÅ.nr:=l^.nr0;
    IF k>0 THEN
    BEGIN
      FOR i:=1 TO k-1 DO m^.eÆi+nodehalfÅ:=l^.eÆiÅ;
      n^.eÆrÅ:=l^.eÆkÅ; n^.eÆrÅ.nr:=lpr;
      l^.nr0:=l^.eÆkÅ.nr; l^.ne:=l^.ne-k;
      FOR i:=1 TO l^.ne DO l^.eÆiÅ:=l^.eÆi+kÅ;
      m^.ne:=nodehalf-1+k; usize:=false; p_updn(l);
    END ELSE
    BEGIN
      FOR i:=1 TO nodehalf DO m^.eÆi+nodehalfÅ:=l^.eÆiÅ;
      FOR i:=r TO n^.ne-1 DO n^.eÆiÅ:=n^.eÆi+1Å;
      m^.ne:=nodesize; n^.ne:=n^.ne-1; p_retn(l);
      usize:=n^.ne<nodehalf;
    END;
    p_updn(m);
  END ELSE
  BEGIN
    IF r=1 THEN lpr:=n^.nr0 ELSE lpr:=n^.eÆr-1Å.nr; p_getn(idxf,lpr,l);
    le:=l^.ne+1; k:=(le-nodehalf) DIV 2;
    IF k>0 THEN
    BEGIN
      FOR i:=nodehalf-1 DOWNTO 1 DO m^.eÆi+kÅ:=m^.eÆiÅ;
      m^.eÆkÅ:=n^.eÆrÅ; m^.eÆkÅ.nr:=m^.nr0; le:=le-k;
      FOR i:=k-1 DOWNTO 1 DO m^.eÆiÅ:=l^.eÆi+leÅ;
      m^.nr0:=l^.eÆleÅ.nr; n^.eÆrÅ:=l^.eÆleÅ; n^.eÆrÅ.nr:=mpr;
      l^.ne:=le-1; m^.ne:=nodehalf-1+k; usize:=false; p_updn(m);
    END ELSE
    BEGIN
      l^.eÆleÅ:=n^.eÆrÅ; l^.eÆleÅ.nr:=m^.nr0;
      FOR i:=1 TO nodehalf-1 DO l^.eÆi+leÅ:=m^.eÆiÅ;
      l^.ne:=nodesize; n^.ne:=n^.ne-1; p_retn(m);
      usize:=n^.ne<nodehalf;
    END;
    p_updn(l);
  END;
  p_updn(n);
END;

æ$A-å

PROCEDURE dela(mpr: integer);
VAR
  c,xpr: integer;
  m: p_nodrcp;
BEGIN
  p_getn(idxf,mpr,m);
  WITH m^ DO
  BEGIN
    xpr:=eÆneÅ.nr;
    IF xpr<>0 THEN
    BEGIN
      c:=ne; dela(xpr); IF usize THEN uflow(mpr,xpr,c);
    END ELSE
    BEGIN
      p_getn(idxf,npr,n);
      eÆneÅ.nr:=n^.eÆkÅ.nr; n^.eÆkÅ:=eÆneÅ;
      ne:=ne-1; usize:=ne<nodehalf;
      p_updn(n); p_updn(m);
    END;
  END;
END;

BEGIN
  IF npr=0 THEN
  BEGIN
    ok:=false; usize:=false;
  END ELSE
  BEGIN
    p_getn(idxf,npr,n);
    WITH n^ DO
    BEGIN
      l:=1; r:=ne;
      REPEAT
        k:=(l+r) DIV 2;
        c:=p_ckey(pkey,eÆkÅ.key,pdr,eÆkÅ.dr,idxf.dupkey);
        IF c<=0 THEN r:=k-1; IF c>=0 THEN l:=k+1;
      UNTIL l>r;
      IF r=0 THEN xpr:=nr0 ELSE xpr:=eÆrÅ.nr;
      IF l-r>1 THEN
      BEGIN
	pdr:=eÆkÅ.dr;
	IF xpr=0 THEN
	BEGIN
	  ne:=ne-1; usize:=ne<nodehalf;
	  FOR i:=k TO ne DO eÆiÅ:=eÆi+1Å;
	  p_updn(n);
	END ELSE
	BEGIN
	  dela(xpr); IF usize THEN uflow(npr,xpr,r);
	END;
      END ELSE
      BEGIN
        delb(xpr); IF usize THEN uflow(npr,xpr,r);
      END;
    END;
  END;
END;

BEGIN
  WITH idxf DO
  BEGIN
    p_xkey(pkey,klen); ok:=true; delb(rr);
    IF usize THEN
    BEGIN
      p_getn(idxf,rr,n);
      IF n^.ne=0 THEN
      BEGIN
        rr:=n^.nr0; p_retn(n);
      END;
    END;
    pp:=0;
  END;
END;
«eof»