DataMuseum.dk

top - download

    Length: 7680 (0x1e00)
    Types: TextFile
    Names: »DATMAN.PAS«

└─⟦c96461903⟧ Bits:30002787 SW1602 COMPAS Pascal Version 3.07 Release 1.1
    └─ ⟦this⟧ »DATMAN.PAS« 

TextFile

(***********************************************************)
(*                                                         *)
(*              C-FILE Version 1.00 (CP/M-86)              *)
(*                                                         *)
(*                      DATMAN module                      *)
(*                                                         *)
(*                  Copyright (C) 1984 by                  *)
(*                Poly-Data microcenter ApS                *)
(*                                                         *)
(***********************************************************)

(*$I-,K-,R-*)

TYPE
  C_STR14 = STRINGÆ14Å;
  DATAFILE = RECORD
               CASE INTEGER OF
                 0: (F: FILE OF BYTE;
                     FFRE,NFRE,INT1,INT2: INTEGER);
                 1: (FIL1: ARRAYÆ1..4Å OF BYTE;
                     NREC,RECL,CREC,FIL2: INTEGER;
                     CDRV: BYTE;
                     CNAM: ARRAYÆ1..8Å OF CHAR;
                     CTYP: ARRAYÆ1..3Å OF CHAR);
             END;
  C_KEYSTR = STRINGÆMAXKSIZEÅ;
  C_IDXREC = RECORD
               DR,NR: INTEGER;
               KEY: C_KEYSTR;
             END;
  C_NODREC = RECORD
               NE: 0..NODESIZE;
               NR0: INTEGER;
               E: ARRAYÆ1..NODESIZEÅ OF C_IDXREC;
             END;
  C_NODRCP = ^C_NODREC;
  C_PTHREC = RECORD
                NR,EP: INTEGER;
              END;
  C_PTHLST = ARRAYÆ1..MAXDEPTHÅ OF C_PTHREC;
  INDEXFILE = RECORD
                D: DATAFILE;
                DUPKEY: BOOLEAN;
                KLEN,RR,PP: INTEGER;
                PATH: C_PTHLST;
              END;
  C_INDXFP = ^INDEXFILE;
  C_NBFREC = RECORD
                N: C_NODREC;
                IFP: C_INDXFP;
                NR: INTEGER;
                UPD: BOOLEAN;
              END;
  C_NBFRCP = ^C_NBFREC;
  C_NODBUF = ARRAYÆ1..NBUFSIZEÅ OF C_NBFREC;
  C_NODMAP = ARRAYÆ1..NBUFSIZEÅ OF INTEGER;
  C_RECBUF = RECORD
                  CASE INTEGER OF
                    0: (N: C_NBFREC);
                    1: (R: ARRAYÆ1..MAXRSIZEÅ OF BYTE);
                END;

VAR
  IOSTS: INTEGER;
  OK: BOOLEAN;
  C_RBUF: C_RECBUF;
  C_NBUF: C_NODBUF;
  C_NMAP: C_NODMAP;

PROCEDURE C_IOCHK(VAR DATF: DATAFILE; R: INTEGER);
BEGIN
  IF IOSTS<>0 THEN WITH DATF DO
  BEGIN
    WRITELN;
    WRITELN('C-FILE I/O ERROR ',IOSTS);
    WRITELN('File ',CHR(CDRV+64),':',CNAM,'.',CTYP,' Record ',R);
    WRITELN('Program terminated');
    REPEAT UNTIL FALSE;
  END;
END;

PROCEDURE GETREC(VAR DATF: DATAFILE; R: INTEGER; VAR BUFFER);
VAR
  B: BYTE AT BUFFER;
BEGIN
  SEEK(DATF.F,R); READ(DATF.F,B);
  IOSTS:=IORES; C_IOCHK(DATF,R);
END;

PROCEDURE PUTREC(VAR DATF: DATAFILE; R: INTEGER; VAR BUFFER);
VAR
  B: BYTE AT BUFFER;
BEGIN
  SEEK(DATF.F,R); WRITE(DATF.F,B);
  IOSTS:=IORES; C_IOCHK(DATF,R);
END;

PROCEDURE MAKEFILE(VAR DATF: DATAFILE; FNAM: C_STR14; RECLEN: INTEGER);
BEGIN
  ASSIGN(DATF.F,FNAM); REWRITE(DATF.F); IOSTS:=IORES;
  IF IOSTS=3 THEN OK:=FALSE ELSE
  BEGIN
    C_IOCHK(DATF,0); DATF.RECL:=RECLEN; DATF.FFRE:=-1;
    DATF.NFRE:=0; DATF.INT1:=0; DATF.INT2:=0;
    MOVE(DATF.FFRE,C_RBUF,8); PUTREC(DATF,0,C_RBUF);
    OK:=TRUE;
  END;
END;

PROCEDURE OPENFILE(VAR DATF: DATAFILE; FNAM: C_STR14; RECLEN: INTEGER);
BEGIN
  ASSIGN(DATF.F,FNAM); RESET(DATF.F); IOSTS:=IORES;
  IF IOSTS=2 THEN OK:=FALSE ELSE
  BEGIN
    IF IOSTS=1 THEN IOSTS:=0;
    C_IOCHK(DATF,0); DATF.RECL:=RECLEN;
    GETREC(DATF,0,C_RBUF); MOVE(C_RBUF,DATF.FFRE,8);
    OK:=TRUE;
  END;
END;

PROCEDURE CLOSEFILE(VAR DATF: DATAFILE);
BEGIN
  MOVE(DATF.FFRE,C_RBUF,8); PUTREC(DATF,0,C_RBUF);
  CLOSE(DATF.F); IOSTS:=IORES; C_IOCHK(DATF,0);
END;

PROCEDURE ADDREC(VAR DATF: DATAFILE; VAR R: INTEGER; VAR BUFFER);
BEGIN
  IF DATF.FFRE=-1 THEN R:=DATF.NREC ELSE
  BEGIN
    R:=DATF.FFRE; GETREC(DATF,R,C_RBUF);
    MOVE(C_RBUF,DATF.FFRE,2); DATF.NFRE:=DATF.NFRE-1;
  END;
  PUTREC(DATF,R,BUFFER);
END;

PROCEDURE DELETEREC(VAR DATF: DATAFILE; R: INTEGER);
BEGIN
  MOVE(DATF.FFRE,C_RBUF,2); PUTREC(DATF,R,C_RBUF);
  DATF.FFRE:=R; DATF.NFRE:=DATF.NFRE+1;
END;

FUNCTION FILELEN(VAR DATF: DATAFILE): INTEGER;
BEGIN
  FILELEN:=DATF.NREC;
END;

FUNCTION USEDRECS(VAR DATF: DATAFILE): INTEGER;
BEGIN
  USEDRECS:=DATF.NREC-DATF.NFRE-1;
END;

PROCEDURE INITINDEX;
VAR
  I: INTEGER;
BEGIN
  FOR I:=1 TO NBUFSIZE DO
  BEGIN
    C_NBUFÆIÅ.IFP:=NIL; C_NBUFÆIÅ.UPD:=FALSE; C_NMAPÆIÅ:=I;
  END;
END;

PROCEDURE C_PACK(VAR N: C_NODREC; KLEN: INTEGER);
VAR
  I: INTEGER;
  P: ARRAYÆ0..MAXINTÅ OF BYTE AT N;
BEGIN
  IF KLEN<>MAXKSIZE THEN
  FOR I:=1 TO NODESIZE DO MOVE(N.EÆIÅ,PÆ(I-1)*(KLEN+5)+3Å,KLEN+5);
END;

PROCEDURE C_UNPACK(VAR N: C_NODREC; KLEN: INTEGER);
VAR
  I: INTEGER;
  P: ARRAYÆ0..MAXINTÅ OF BYTE AT N;
BEGIN
  IF KLEN<>MAXKSIZE THEN
  FOR I:=NODESIZE DOWNTO 1 DO MOVE(PÆ(I-1)*(KLEN+5)+3Å,N.EÆIÅ,KLEN+5);
END;

PROCEDURE MAKEINDEX(VAR IDXF: INDEXFILE; FNAM: C_STR14; KEYLEN,S: INTEGER);
VAR
  K: INTEGER;
BEGIN
  K:=(KEYLEN+5)*NODESIZE+3;
  MAKEFILE(IDXF.D,FNAM,K);
  IDXF.DUPKEY:=S<>0; IDXF.KLEN:=KEYLEN;
  IDXF.RR:=0; IDXF.PP:=0;
END;

PROCEDURE OPENINDEX(VAR IDXF: INDEXFILE; FNAM: C_STR14; KEYLEN,S: INTEGER);
VAR
  K: INTEGER;
BEGIN
  K:=(KEYLEN+5)*NODESIZE+3;
  OPENFILE(IDXF.D,FNAM,K);
  IDXF.DUPKEY:=S<>0; IDXF.KLEN:=KEYLEN;
  IDXF.RR:=IDXF.D.INT1; IDXF.PP:=0;
END;

PROCEDURE CLOSEINDEX(VAR IDXF: INDEXFILE);
VAR
  I: INTEGER;
BEGIN
  FOR I:=1 TO NBUFSIZE DO WITH C_NBUFÆIÅ DO
  IF IFP=ADDR(IDXF) THEN
  BEGIN
    IFP:=NIL;
    IF UPD THEN
    BEGIN
      C_PACK(N,IDXF.KLEN); PUTREC(IDXF.D,NR,N);
    END;
  END;
  IDXF.D.INT1:=IDXF.RR; CLOSEFILE(IDXF.D);
END;

PROCEDURE C_LAST(I: INTEGER);
VAR
  J,K: INTEGER;
BEGIN
  J:=1; WHILE (C_NMAPÆJÅ<>I) AND (J<NBUFSIZE) DO J:=J+1;
  FOR K:=J TO NBUFSIZE-1 DO C_NMAPÆKÅ:=C_NMAPÆK+1Å;
  C_NMAPÆNBUFSIZEÅ:=I;
END;

PROCEDURE C_GETN(VAR IDXF: INDEXFILE; R: INTEGER; VAR NP: C_NODRCP);
VAR
  I,J,K: INTEGER;
  FOUND: BOOLEAN;
BEGIN
  FOUND:=FALSE;
  FOR J:=1 TO NBUFSIZE DO IF NOT FOUND THEN WITH C_NBUFÆJÅ DO
  IF (IFP=ADDR(IDXF)) AND (NR=R) THEN
  BEGIN
    I:=J; FOUND:=TRUE;
  END;
  IF NOT FOUND THEN
  BEGIN
    I:=C_NMAPÆ1Å;
    WITH C_NBUFÆIÅ DO
    BEGIN
      IF UPD THEN
      BEGIN
        C_PACK(N,IFP^.KLEN); PUTREC(IFP^.D,NR,N);
      END;
      GETREC(IDXF.D,R,N); C_UNPACK(N,IDXF.KLEN);
      IFP:=ADDR(IDXF); NR:=R; UPD:=FALSE;
    END;
  END;
  C_LAST(I); NP:=ADDR(C_NBUFÆIÅ);
END;

PROCEDURE C_NEWN(VAR IDXF: INDEXFILE; VAR R: INTEGER; VAR NP: C_NODRCP);
VAR
  I: INTEGER;
BEGIN
  I:=C_NMAPÆ1Å;
  WITH C_NBUFÆIÅ DO
  BEGIN
    IF UPD THEN
    BEGIN
      C_PACK(N,IFP^.KLEN); PUTREC(IFP^.D,NR,N);
    END;
    ADDREC(IDXF.D,R,N);
    IFP:=ADDR(IDXF); NR:=R; UPD:=FALSE;
  END;
  C_LAST(I); NP:=ADDR(C_NBUFÆIÅ);
END;

PROCEDURE C_UPDN(NP: C_NODRCP);
VAR
  P: C_NBFRCP AT NP;
BEGIN
  P^.UPD:=TRUE;
END;

PROCEDURE C_RETN(VAR NP: C_NODRCP);
VAR
  P: C_NBFRCP AT NP;
BEGIN
  WITH P^ DO
  BEGIN
    DELETEREC(IFP^.D,NR); IFP:=NIL; UPD:=FALSE;
  END;
END;

PROCEDURE C_XKEY(VAR K; KLEN: INTEGER);
VAR
  KEY: C_KEYSTR AT K;
BEGIN
  IF ORD(KEYÆ0Å)>KLEN THEN KEYÆ0Å:=CHR(KLEN);
END;

FUNCTION C_CKEY(VAR K1,K2; DR1,DR2: INTEGER; DUP: BOOLEAN): INTEGER;
VAR
  KEY1: C_KEYSTR AT K1;
  KEY2: C_KEYSTR AT K2;
BEGIN
  IF KEY1=KEY2 THEN
  IF DUP THEN C_CKEY:=DR1-DR2 ELSE C_CKEY:=0 ELSE
  IF KEY1>KEY2 THEN C_CKEY:=1 ELSE C_CKEY:=-1;
END;

PROCEDURE CLEARKEY(VAR IDXF: INDEXFILE);
BEGIN
  IDXF.PP:=0;
END;
«eof»