DataMuseum.dk

top - download

    Length: 3744 (0xea0)
    Types: TextFile
    Notes: Mikados_K
    Names: »FORSKYD.K«

└─⟦6b1c9961a⟧ Bits:30008989 INDPERM P1
    └─⟦this⟧ »FORSKYD.K« 
└─⟦a3d38fea3⟧ Bits:30008985 PRODUKTION NBT.
    └─⟦this⟧ »FORSKYD.K« 
└─⟦eb89399bc⟧ Bits:30008990 SOM ISFORIG, MEN KUN K-FILER
    └─⟦this⟧ »FORSKYD.K« 

Mikados K File

PROCEDURE FSKDIBLK(VAR ZO:ISFHEAD;BLKPEG:INTEGER);
VAR I,J,K:INTEGER;
BEGIN
  WITH ZO DO
  IF BLKPEG>0 THEN
    FOR I:=Z((BLKINZONE-1)*ENTRYSIZE+BLT+1) DOWNTO BLKPEG DO
      FOR J:=1 TO RECSIZE DO Z(BLK+I*RECSIZE-1+J):=Z(BLK+(I-1)*RECSIZE-1+J)
  ELSE
    FOR I:=-BLKPEG TO Z((BLKINZONE-1)*ENTRYSIZE+BLT+1)-1 DO
      FOR J:=1 TO RECSIZE DO Z(BLK+(I-1)*RECSIZE-1+J):=Z(BLK+I*RECSIZE-1+J)
END;
 
FUNCTION FINDDIR(VAR ZO:ISFHEAD;FØRSTE,SIZE,TABLESIZE,TABLE:INTEGER):INTEGER;
VAR NÆSTE,FORRIGE,TESTV:INTEGER;
BEGIN
  WITH ZO DO
  BEGIN
  TESTV:=TABLESIZE+1;
  NÆSTE:=FØRSTE+1;
  FORRIGE:=FØRSTE;
  WHILE TESTV=TABLESIZE+1 DO
  BEGIN
    IF (NÆSTE>TABLESIZE) AND (FORRIGE<1) THEN NÆSTE:=1 DIV 0;
    IF (NÆSTE<=TABLESIZE) AND (Z(TABLE+(NÆSTE-1)*ENTRYSIZE+1)<SIZE) THEN
       TESTV:=NÆSTE-FØRSTE;
    IF (FORRIGE>=1) AND (Z(TABLE+(FORRIGE-1)*ENTRYSIZE+1)<SIZE)THEN
       TESTV:=FORRIGE-FØRSTE;
    NÆSTE:=NÆSTE+1;
    FORRIGE:=FORRIGE-1
  END;
  FINDDIR:=TESTV
  END
END;
 
FUNCTION RETNING(VAR ZO:ISFHEAD;VAR PLADSIBUKET:BOOLEAN):INTEGER;
BEGIN
  WITH ZO DO
  BEGIN
   PLADSIBUKET:=Z(BUT+(BUCINZONE-1)*ENTRYSIZE+1)<RECPRBUC;
   IF PLADSIBUKET THEN
      RETNING:=FINDDIR(ZO,BLKINZONE,RECPRBLK,BLKPRBUC,BLT)
   ELSE
      RETNING:=FINDDIR(ZO,BUCINZONE,RECPRBUC,NBUC,BUT);
  END
END;
 
PROCEDURE FSKDUBLK(VAR ZO:ISFHEAD;VAR F:ISF);
VAR I,RDPOST,WRPOST,COPFRA,COPTIL,AFSTAND,DIR:INTEGER;
    PLADSIBUKET:BOOLEAN;
BEGIN
  IER:=0;
  WITH ZO DO
  BEGIN
    AFSTAND:=RETNING(ZO,PLADSIBUKET);
    IF AFSTAND>0 THEN
    BEGIN
       RDPOST:=2;WRPOST:=1;
       COPFRA:=BLK+BLKSIZE;COPTIL:=BLK;
       DIR:=1
    END ELSE
    BEGIN
       RDPOST:=1;WRPOST:=2;
       COPFRA:=BLK;COPTIL:=BLK+BLKSIZE;
       DIR:=-1
    END;
    WHILE AFSTAND<>0 DO
    BEGIN
      SÆTKEY(ZO,WRPOST+RECPRBLK-1);
      IF UPSTAT=SKRIV THEN
      COPSEGS(Z,F,Z(BLT+(BLKINZONE-1)*ENTRYSIZE),BLKSIZE,BLK+(WRPOST-1)*
                                                    RECSIZE,SKRIV);
      IF IER<>0 THEN EXIT(FSKDUBLK);
      BLKCHG:=FALSE;
      IF DIR=-1 THEN FOR I:=1 TO RECSIZE DO
         Z(COPTIL-1+I):=Z(COPFRA-1+I);
      IF ((BLKINZONE=1) AND (DIR=-1)) OR ((BLKINZONE=BLKPRBUC) AND (DIR=1))
      THEN BEGIN
        READTABLE(ZO,F,BUCINZONE+DIR);
        IF IER<>0 THEN EXIT(FSKDUBLK);
        IF DIR=1 THEN BLKINZONE:=1 ELSE BLKINZONE:=BLKPRBUC;
        AFSTAND:=AFSTAND-DIR;
        IF AFSTAND=0 THEN AFSTAND:=RETNING(ZO,PLADSIBUKET)+DIR;
        BLKINZONE:=BLKINZONE-DIR
      END;
      IF DIR=1 THEN FOR I:=1 TO RECSIZE DO
         Z(COPTIL-1+I):=Z(COPFRA-1+I);
      READBLOCK(ZO,F,BLKINZONE+DIR,RDPOST);
      IF IER<>0 THEN EXIT(FSKDUBLK);
      IF PLADSIBUKET AND (AFSTAND<>0) THEN AFSTAND:=AFSTAND-DIR
    END;
    DIR:=BLK+RECSIZE*Z(BLT+(BLKINZONE-1)*ENTRYSIZE+1)-1;
    IF RDPOST=1 THEN FOR I:=1 TO RECSIZE DO
       Z(DIR+I):=
       Z(COPTIL-1+I);
    BLKCHG:=TRUE;
    SÆTKEY(ZO,Z(BLT+(BLKINZONE-1)*ENTRYSIZE+1)+1);
    IER:=0
  END
END;