DataMuseum.dk

top - download

    Length: 3712 (0xe80)
    Types: TextFile
    Names: »NPFKEY.PAS«

└─⟦b6ad1e534⟧ Bits:30002857 COMPAS-80 V3.03 for JET80 CP/M
    └─ ⟦this⟧ »NPFKEY.PAS« 

TextFile

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

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

PROCEDURE NEXTKEY(VAR IDXF: INDEXFILE; VAR PDR: INTEGER; VAR PK);
VAR
  PKEY: C_KEYSTR AT PK;
  R: INTEGER;
  N: C_NODRCP;
BEGIN
  WITH IDXF DO
  BEGIN
    IF PP=0 THEN R:=RR ELSE
    WITH PATHÆPPÅ DO
    BEGIN
      C_GETN(IDXF,NR,N); R:=N^.EÆEPÅ.NR;
    END;
    WHILE R<>0 DO
    BEGIN
      PP:=PP+1;
      WITH PATHÆPPÅ DO
      BEGIN
        NR:=R; EP:=0;
      END;
      C_GETN(IDXF,R,N); R:=N^.NR0;
    END;
    IF PP<>0 THEN
    BEGIN
      WHILE (PP>1) AND (PATHÆPPÅ.EP=N^.NE) DO
      BEGIN
        PP:=PP-1; C_GETN(IDXF,PATHÆPPÅ.NR,N);
      END;
      IF PATHÆPPÅ.EP<N^.NE THEN WITH PATHÆPPÅ DO
      BEGIN
        EP:=EP+1;
        WITH N^.EÆEPÅ DO
        BEGIN
          PKEY:=KEY; PDR:=DR;
        END;
      END ELSE PP:=0;
    END;
    OK:=PP<>0;
  END;
END;

PROCEDURE PREVKEY(VAR IDXF: INDEXFILE; VAR PDR: INTEGER; VAR PK);
VAR
  PKEY: C_KEYSTR AT PK;
  R: INTEGER;
  N: C_NODRCP;
BEGIN
  WITH IDXF DO
  BEGIN
    IF PP=0 THEN R:=RR ELSE
    WITH PATHÆPPÅ DO
    BEGIN
      C_GETN(IDXF,NR,N); EP:=EP-1;
      IF EP=0 THEN R:=N^.NR0 ELSE R:=N^.EÆEPÅ.NR;
    END;
    WHILE R<>0 DO
    BEGIN
      C_GETN(IDXF,R,N); PP:=PP+1;
      WITH PATHÆPPÅ DO
      BEGIN
        NR:=R; EP:=N^.NE;
      END;
      WITH N^ DO R:=EÆNEÅ.NR;
    END;
    IF PP<>0 THEN
    BEGIN
      WHILE (PP>1) AND (PATHÆPPÅ.EP=0) DO
      BEGIN
        PP:=PP-1; C_GETN(IDXF,PATHÆPPÅ.NR,N);
      END;
      IF PATHÆPPÅ.EP>0 THEN WITH N^.EÆPATHÆPPÅ.EPÅ DO
      BEGIN
        PKEY:=KEY; PDR:=DR;
      END ELSE PP:=0;
    END;
    OK:=PP<>0;
  END;
END;

PROCEDURE C_FINKEY(VAR IDXF: INDEXFILE; VAR PDR: INTEGER; VAR PK);
VAR
  PKEY: C_KEYSTR AT PK;
  NPR,C,K,L,R: INTEGER;
  RKEY: C_KEYSTR;
  N: C_NODRCP;
BEGIN
  WITH IDXF DO
  BEGIN
    C_XKEY(PKEY,KLEN); OK:=FALSE; PP:=0; NPR:=RR;
    WHILE (NPR<>0) AND NOT OK DO
    BEGIN
      PP:=PP+1; PATHÆPPÅ.NR:=NPR; 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,0,EÆKÅ.DR,DUPKEY);
          IF C<=0 THEN R:=K-1; IF C>=0 THEN L:=K+1;
        UNTIL R<L;
        IF L-R>1 THEN
        BEGIN
          PDR:=EÆKÅ.DR; R:=K; OK:=TRUE;
        END;
        IF R=0 THEN NPR:=NR0 ELSE NPR:=EÆRÅ.NR;
      END;
      PATHÆPPÅ.EP:=R;
    END;
    IF NOT OK AND (PP>0) THEN
    BEGIN
      WHILE (PP>1) AND (PATHÆPPÅ.EP=0) DO PP:=PP-1;
      IF PATHÆPPÅ.EP=0 THEN PP:=0;
    END;
  END;
END;

PROCEDURE FINDKEY(VAR IDXF: INDEXFILE; VAR PDR: INTEGER; VAR PK);
VAR
  PKEY: C_KEYSTR AT PK;
  TKEY: C_KEYSTR;
BEGIN
  C_FINKEY(IDXF,PDR,PKEY);
  IF NOT OK AND IDXF.DUPKEY THEN
  BEGIN
    TKEY:=PKEY; NEXTKEY(IDXF,PDR,PKEY);
    OK:=OK AND (PKEY=TKEY);
  END;
END;

PROCEDURE SEARCHKEY(VAR IDXF: INDEXFILE; VAR PDR: INTEGER; VAR PK);
VAR
  PKEY: C_KEYSTR AT PK;
BEGIN
  C_FINKEY(IDXF,PDR,PKEY);
  IF NOT OK THEN NEXTKEY(IDXF,PDR,PKEY);
END;
«eof»