|
|
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: 3712 (0xe80)
Types: TextFile
Names: »NPFKEY.PAS«
└─⟦0d02879d3⟧ Bits:30004605 COMPAS Pascal version 3.03
└─⟦this⟧ »NPFKEY.PAS«
└─⟦b6ad1e534⟧ Bits:30002857 COMPAS-80 V3.03 for JET80 CP/M
└─⟦this⟧ »NPFKEY.PAS«
└─⟦c96461903⟧ Bits:30002787 SW1602 COMPAS Pascal Version 3.07 Release 1.1
└─⟦this⟧ »NPFKEY.PAS«
(***********************************************************)
(* *)
(* 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»