DataMuseum.dk

top - download

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

└─⟦5630b2e42⟧ Bits:30009005 START APRIL 1985 aft april 1985 (PASCAL kildetekster)
    └─⟦this⟧ »FORSKYD.K« 
└─⟦6c21327e0⟧ Bits:30008986 LINIMATIC K-FILER (IKKE HELT UPTODTATE)
    └─⟦this⟧ »FORSKYD.K« 

Mikados K File

(*$P*)
PROCEDURE FSKDIBLK(BLKPEG:INTEGER);
VAR I,J,K:INTEGER;
BEGIN
  WITH FILEHEAD(CURRHEAD) 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(FØRSTE,SIZE,TABLESIZE,TABLE:INTEGER):INTEGER;
VAR NÆSTE,FORRIGE,TESTV:INTEGER;
BEGIN
  WITH FILEHEAD(CURRHEAD) 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;           
(*$R-*) 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     
(*$R+*)  TESTV:=FORRIGE-FØRSTE;                                           
      NÆSTE:=NÆSTE+1;                                                     
      FORRIGE:=FORRIGE-1                                                  
    END;                                                                  
    FINDDIR:=TESTV                                                        
  END
END;
 
FUNCTION RETNING(VAR PLADSIBUKET:BOOLEAN):INTEGER;
BEGIN
  WITH FILEHEAD(CURRHEAD) DO
  BEGIN
   PLADSIBUKET:=Z(BUT+(BUCINZONE-1)*ENTRYSIZE+1)<RECPRBUC;
   IF PLADSIBUKET THEN
      RETNING:=FINDDIR(BLKINZONE,RECPRBLK,BLKPRBUC,BLT)
   ELSE
      RETNING:=FINDDIR(BUCINZONE,RECPRBUC,NBUC,BUT);
  END
END;
(*$P*)
PROCEDURE FSKDUBLK(VAR F:ISF);
VAR I,RDPOST,WRPOST,AFSTAND,DIR:INTEGER;
    COPFRA,COPTIL:ZONEADR;
    PLADSIBUKET:BOOLEAN;
BEGIN
  WITH FILEHEAD(CURRHEAD) DO
  BEGIN
    AFSTAND:=RETNING(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(WRPOST+RECPRBLK-1);
      COPSEGS(F,Z(BLT+(BLKINZONE-1)*ENTRYSIZE),BLKSIZE,BLK+(WRPOST-1)*
                                                    RECSIZE,SKRIV);
      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(F,BUCINZONE+DIR);
        IF DIR=1 THEN BLKINZONE:=1 ELSE BLKINZONE:=BLKPRBUC;
        AFSTAND:=AFSTAND-DIR;
        IF AFSTAND=0 THEN AFSTAND:=RETNING(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(F,BLKINZONE+DIR,RDPOST);
      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(Z(BLT+(BLKINZONE-1)*ENTRYSIZE+1)+1);
  END
END;