DataMuseum.dk

top - download

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

└─⟦0d02879d3⟧ Bits:30004605 COMPAS Pascal version 3.03
    └─ ⟦this⟧ »DELKEY.PAS« 
└─⟦c96461903⟧ Bits:30002787 SW1602 COMPAS Pascal Version 3.07 Release 1.1
    └─ ⟦this⟧ »DELKEY.PAS« 

TextFile

(***********************************************************)
(*                                                         *)
(*                   C-FILE Version 1.00                   *)
(*                                                         *)
(*                      DELKEY module                      *)
(*                                                         *)
(*                  Copyright (C) 1984 by                  *)
(*                Poly-Data microcenter ApS                *)
(*                                                         *)
(***********************************************************)

(*$A+,K-,R-*)

PROCEDURE DELETEKEY(VAR IDXF: INDEXFILE; VAR PDR: INTEGER; VAR PK);
VAR
  PKEY: C_KEYSTR AT PK;
  USIZE: BOOLEAN;
  N: C_NODRCP;

(*$A-*)

PROCEDURE DELB(NPR: INTEGER);
VAR
  C,I,K,L,R,XPR: INTEGER;
  N: C_NODRCP;

(*$A+*)

PROCEDURE UFLOW(NPR,MPR,R: INTEGER);
VAR
  I,K,LE,LPR: INTEGER;
  N,M,L: C_NODRCP;
BEGIN
  C_GETN(IDXF,NPR,N); C_GETN(IDXF,MPR,M);
  IF R<N^.NE THEN
  BEGIN
    R:=R+1; LPR:=N^.EÆRÅ.NR; C_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; C_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; C_RETN(L);
      USIZE:=N^.NE<NODEHALF;
    END;
    C_UPDN(M);
  END ELSE
  BEGIN
    IF R=1 THEN LPR:=N^.NR0 ELSE LPR:=N^.EÆR-1Å.NR; C_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; C_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; C_RETN(M);
      USIZE:=N^.NE<NODEHALF;
    END;
    C_UPDN(L);
  END;
  C_UPDN(N);
END;

(*$A-*)

PROCEDURE DELA(MPR: INTEGER);
VAR
  C,XPR: INTEGER;
  M: C_NODRCP;
BEGIN
  C_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
      C_GETN(IDXF,NPR,N);
      EÆNEÅ.NR:=N^.EÆKÅ.NR; N^.EÆKÅ:=EÆNEÅ;
      NE:=NE-1; USIZE:=NE<NODEHALF;
      C_UPDN(N); C_UPDN(M);
    END;
  END;
END;

BEGIN
  IF NPR=0 THEN
  BEGIN
    OK:=FALSE; USIZE:=FALSE;
  END ELSE
  BEGIN
    C_GETN(IDXF,NPR,N);
    WITH N^ DO
    BEGIN
      L:=1; R:=NE;
      REPEAT
        K:=(L+R) DIV 2;
        C:=C_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Å;
	  C_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
    C_XKEY(PKEY,KLEN); OK:=TRUE; DELB(RR);
    IF USIZE THEN
    BEGIN
      C_GETN(IDXF,RR,N);
      IF N^.NE=0 THEN
      BEGIN
        RR:=N^.NR0; C_RETN(N);
      END;
    END;
  END;
END;
«eof»