DataMuseum.dk

top - download

    Length: 3744 (0xea0)
    Notes: Mikados TextFile, Mikados_K
    Names: »CREATE«

└─⟦71b125bce⟧ Bits:30004621 CREATE og ISFHEAD kildekode
    └─ ⟦this⟧ »CREATE« 

Text

PROCEDURE CREATE(VAR FILENAME:STRING;NREC,RECSIZE,KEYFLDS:INTEGER;
                 VAR KEYS:KEYDESCRIPTION;
                 VAR IER:INTEGER);
VAR NBUC,NBLK,BLKPRBUC,RECPRBUC,RECPRBLK,FLHSIZE,BUTSIZE,BLTSIZE,BLKSIZE,
    KEYSIZE,SEGINFLH,SEGINBUT,SEGINBUC,SEGINBLT,SEGINBLK,
    FILESIZE,
    I,J,TABLESIZE:INTEGER;
    F:ISF;
    NOOFSEGS:STRING(4);
BEGIN
  FOR I:=1 TO 232 DO F^(I):=0;
  IER:=0;
  IF (NREC<1) OR (RECSIZE<1) OR (KEYFLDS<1) THEN IER:=-5;
  IF KEYFLDS>9 THEN IER:=-14;
  IF IER<>0 THEN EXIT(CREATE);
  KEYSIZE:=0;
  FOR I:=1 TO KEYFLDS DO
  BEGIN
       IF (KEYS(I,1)<1) OR (KEYS(I,1)+KEYS(I,2)>RECSIZE+1)OR(KEYS(I,3)=0)THEN
       BEGIN
               IER:=-15;
               EXIT(CREATE)
       END;
       KEYSIZE:=KEYSIZE+KEYS(I,2)
  END;
  RECPRBLK:=TRUNC(EXP(LN(NREC*SQR(KEYSIZE+2)/SQR(RECSIZE))/3));
  IF RECPRBLK=0 THEN RECPRBLK:=1;
  SEGINBLK:=(RECSIZE*RECPRBLK-1) DIV 232 + 1;
  RECPRBLK:=SEGINBLK*232 DIV RECSIZE;
  NBLK  :=(NREC-1) DIV RECPRBLK +1;
  BLKPRBUC:=TRUNC(SQRT(NBLK));
  NBUC:=(NBLK-1) DIV BLKPRBUC +1;
  NBLK:=BLKPRBUC*NBUC;
  NREC:=NBLK*RECPRBLK;
  RECPRBUC:=RECPRBLK*BLKPRBUC;
  FLHSIZE:=51;
  BUTSIZE:=NBUC*(KEYSIZE+2);
  BLTSIZE:=BLKPRBUC*(KEYSIZE+2);
  BLKSIZE:=RECPRBLK*RECSIZE;
  SEGINFLH:=(FLHSIZE-1) DIV 232 +1;
  SEGINBUT:=(BUTSIZE-1) DIV 232 +1;
  SEGINBLT:=(BLTSIZE-1) DIV 232 +1;
  SEGINBUC:=SEGINBLT+SEGINBLK*BLKPRBUC;
  FILESIZE:=(SEGINFLH+SEGINBUT+SEGINBUC*NBUC)*464 DIV 256 +1;
  TABLESIZE:=BUTSIZE+BLTSIZE+BLKSIZE+RECSIZE+KEYSIZE;
  NOOFSEGS:='    ';
  FOR I:=4 DOWNTO 1 DO
  BEGIN
       NOOFSEGS(I):=CHR(FILESIZE MOD 10 + 48);
       FILESIZE:=FILESIZE DIV 10
  END;
  FILENAME:=CONCAT(FILENAME,':',NOOFSEGS,':I');
  WRITELN(LIST,'FILE CREATED : ',FILENAME);
  WRITELN(LIST,'NBUC      ',NBUC,'  NBLK      ',NBLK,'  NREC      ',NREC);
  WRITELN(LIST,'BLKPRBUC  ',BLKPRBUC,'  RECPRBUC  ',RECPRBUC,'  RECPRBLK  ',
                RECPRBLK);
  WRITELN(LIST,'KEYFLDS   ',KEYFLDS,'  FLHSIZE   ',FLHSIZE,'  BUTSIZE   ',
                BUTSIZE);
  WRITELN(LIST,'BLTSIZE   ',BLTSIZE,'  BLKSIZE   ',BLKSIZE,'  RECSIZE   ',
                RECSIZE);
  WRITELN(LIST,'KEYSIZE   ',KEYSIZE,'  SEGINFLH  ',SEGINFLH,'  SEGINBUT  ',
                SEGINBUT);
  WRITELN(LIST,'SEGINBUC  ',SEGINBUC,'  SEGINBLT  ',SEGINBLT,'  SEGINBLK  ',
                SEGINBLK);
  WRITELN(LIST,'TABLESIZE ',TABLESIZE,'  FILESIZE  ',FILESIZE);WRITELN(LIST);
  REWRITE(F,FILENAME);
  IER:=IORESULT;
  IF IER<>0 THEN EXIT(CREATE);
  F^(1):=NBUC;
  F^(2):=NBLK;
  F^(3):=NREC;
  F^(4):=BLKPRBUC;
  F^(5):=RECPRBUC;
  F^(6):=RECPRBLK;
  F^(7):=KEYFLDS;
  F^(8):=FLHSIZE;
  F^(9):=BUTSIZE;
  F^(10):=BLTSIZE;
  F^(11):=BLKSIZE;
  F^(12):=RECSIZE;
  F^(13):=KEYSIZE;
  F^(14):=SEGINFLH;
  F^(15):=SEGINBUT;
  F^(16):=SEGINBUC;
  F^(17):=SEGINBLT;
  F^(18):=SEGINBLK;
  FOR I:=19 TO 24 DO F^(I):=0;
  FOR I:=1 TO 9 DO
     FOR J:=1 TO 3 DO F^(21+3*I+J):=KEYS(I,J);
  SEEK(F,1);
  IF IORESULT<>0 THEN
  BEGIN
       IER:=IORESULT;
       EXIT(CREATE)
  END;
  PUT(F);
  IER:=IORESULT;
  WRITE(LIST,'FILE CREATED, RESULT : ',IER);WRITELN(LIST);
END;