|
|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 3840 (0xf00)
Types: TextFile
Names: »DELKEY.PAS«
└─⟦08ea08c61⟧ Bits:30003924 PolyPascal programmer
└─⟦this⟧ »DELKEY.PAS«
└─⟦bffadc512⟧ Bits:30003938 SW1502 PolyPascal 3.10 (dk) til RC Partner
└─⟦bffadc512⟧ Bits:30004539 SW1402 PolyPascal v3.10 (dk) til Piccoline
└─⟦this⟧ »DELKEY.PAS«
æ*******************************************************å
æ å
æ PolyFile Version 1.10 å
æ å
æ DELKEY module å
æ å
æ Copyright (C) 1985 å
æ PolyData MicroCenter A/S å
æ å
æ*******************************************************å
æ$I-,K-,R-å
PROCEDURE deletekey(VAR idxf: indexfile; VAR pdr: integer; VAR pk);
VAR
pkey: p_keystr AT pk;
usize: boolean;
n: p_nodrcp;
PROCEDURE delb(npr: integer);
VAR
c,i,k,l,r,xpr: integer;
n: p_nodrcp;
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;
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»