|
DataMuseum.dkPresents historical artifacts from the history of: MIKADOS |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about MIKADOS Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 5056 (0x13c0)
Types: TextFile
Notes: Mikados_K
Names: »FORSKY1.K«
└─⟦5630b2e42⟧ Bits:30009005 START APRIL 1985 aft april 1985 (PASCAL kildetekster)
└─⟦this⟧ »FORSKY1.K«
└─⟦6c21327e0⟧ Bits:30008986 LINIMATIC K-FILER (IKKE HELT UPTODTATE)
└─⟦this⟧ »FORSKY1.K«
PROCEDURE FSKDIBLK(BLKPEG:INTEGER);
VAR I,J,K:INTEGER;
BEGIN
WITH FILEHEAD 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)
*)
MOVERIGHT(Z(BLK+(BLKPEG-1)*RECSIZE),Z(BLK+BLKPEG*RECSIZE),
2*RECSIZE*(Z((BLKINZONE-1)*ENTRYSIZE+BLT+1)-BLKPEG+1))
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)
*)
MOVELEFT(Z(BLK-BLKPEG*RECSIZE),Z(BLK-(BLKPEG+1)*RECSIZE),
2*RECSIZE*(Z((BLKINZONE-1)*ENTRYSIZE+BLT+1)+BLKPEG))
END;
FUNCTION FINDDIR(FØRSTE,SIZE,TABLESIZE,TABLE:INTEGER):INTEGER;
VAR NÆSTE,FORRIGE,TESTV:INTEGER;
BEGIN
WITH FILEHEAD 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 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 I,RDPOST,WRPOST,AFSTAND,DIR:INTEGER;
COPFRA,COPTIL:ZONEADR;
PLADSIBUKET:BOOLEAN;
BEGIN
WITH FILEHEAD 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(Z(BLT+(BLKINZONE-1)*ENTRYSIZE),BLKSIZE,BLK+(WRPOST-1)*
RECSIZE,SKRIV);
BLKCHG:=FALSE;
IF DIR=-1 THEN MOVELEFT(Z(COPFRA),Z(COPTIL),2*RECSIZE);
(*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(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 MOVELEFT(Z(COPFRA),Z(COPTIL),2*RECSIZE);
(*FOR I:=1 TO RECSIZE DO Z(COPTIL-1+I):=Z(COPFRA-1+I);*)
READBLOCK(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 MOVELEFT(Z(COPTIL),Z(DIR),2*RECSIZE);
(*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;
#PROCEDURE FSKDIBLK(BLKPEG:INTEGER);#▶12◀VAR I,J,K:INTEGER;▶12◀▶05◀BEGIN▶05◀▶12◀ WITH FILEHEAD DO▶12◀▶12◀ IF BLKPEG>0 THEN▶12◀▶02◀(*▶02◀< FOR I:=Z((BLKINZONE-1)*ENTRYSIZE+BLT+1) DOWNTO BLKPEG DO<K FOR J:=1 TO RECSIZE DO Z(BLK+I*RECSIZE-1+J):=Z(BLK+(I-1)*RECSIZE-1+J)K▶02◀*)▶02◀> MOVERIGHT(Z(BLK+(BLKPEG-1)*RECSIZE),Z(BLK+BLKPEG*RECSIZE),>D 2*RECSIZE*(Z((BLKINZONE-1)*ENTRYSIZE+BLT+1)-BLKPEG+1))D▶06◀ ELSE▶06◀▶02◀(*▶02◀; FOR I:=-BLKPEG TO Z((BLKINZONE-1)*ENTRYSIZE+BLT+1)-1 DO;K FOR J:=1 TO RECSIZE DO Z(BLK+(I-1)*RECSIZE-1+J):=Z(BLK+I*RECSIZE-1+J)K▶02◀*)▶02◀= MOVELEFT(Z(BLK-BLKPEG*RECSIZE),Z(BLK-(BLKPEG+1)*RECSIZE),=A 2*RECSIZE*(Z((BLKINZONE-1)*ENTRYSIZE+BLT+1)+BLKPEG))A▶04◀END;▶04◀▶01◀ ▶01◀>FUNCTION FINDDIR(FØRSTE,SIZE,TABLESIZE,TABLE:INTEGER):INTEGER;> VAR NÆSTE,FORRIGE,TESTV:INTEGER; ▶05◀BEGIN▶05◀▶12◀ WITH FILEHEAD DO▶12◀▶07◀ BEGIN▶07◀J TESTV:=TABLESIZE+1; JJ NÆSTE:=FØRSTE+1; JJ FORRIGE:=FØRSTE; JJ WHILE TESTV=TABLESIZE+1 DO JJ BEGIN JJ IF (NÆSTE>TABLESIZE) AND (FORRIGE<1) THEN NÆSTE:=1 DIV 0; JL(*$R-*) IF (NÆSTE<=TABLESIZE) AND (Z(TABLE+(NÆSTE-1)*ENTRYSIZE+1)<SIZE) THENLJ TESTV:=NÆSTE-FØRSTE; JK IF (FORRIGE>=1) AND (Z(TABLE+(FORRIGE-1)*ENTRYSIZE+1)<SIZE) THEN KJ(*$R+*) TESTV:=FORRIGE-FØRSTE; JJ NÆSTE:=NÆSTE+1; JJ FORRIGE:=FORRIGE-1 JJ END; JJ FINDDIR:=TESTV J▶05◀ END▶05◀▶04◀END;▶04◀▶01◀ ▶01◀2FUNCTION RETNING(VAR PLADSIBUKET:BOOLEAN):INTEGER;2▶05◀BEGIN▶05◀▶12◀ WITH FILEHEAD DO▶12◀▶07◀ BEGIN▶07◀: PLADSIBUKET:=Z(BUT+(BUCINZONE-1)*ENTRYSIZE+1)<RECPRBUC;:▶16◀ IF PLADSIBUKET THEN▶16◀7 RETNING:=FINDDIR(BLKINZONE,RECPRBLK,BLKPRBUC,BLT)7▶07◀ ELSE▶07◀4 RETNING:=FINDDIR(BUCINZONE,RECPRBUC,NBUC,BUT);4▶05◀ END▶05◀▶04◀END;▶04◀▶06◀(*$P*)▶06◀▶13◀PROCEDURE FSKDUBLK;▶13◀(VAR I,RDPOST,WRPOST,AFSTAND,DIR:INTEGER;(▶1a◀ COPFRA,COPTIL:ZONEADR;▶1a◀▶18◀ PLADSIBUKET:BOOLEAN;▶18◀▶05◀BEGIN▶05◀▶12◀ WITH FILEHEAD DO▶12◀▶07◀ BEGIN▶07◀" AFSTAND:=RETNING(PLADSIBUKET);"▶15◀ IF AFSTAND>0 THEN▶15◀ BEGIN ▶1a◀ RDPOST:=2;WRPOST:=1;▶1a◀& COPFRA:=BLK+BLKSIZE;COPTIL:=BLK;&\f
DIR:=1\f
\f
END ELSE\f
BEGIN ▶1a◀ RDPOST:=1;WRPOST:=2;▶1a◀& COPFRA:=BLK;COPTIL:=BLK+BLKSIZE;&\r DIR:=-1\r▶08◀ END;▶08◀▶17◀ WHILE AFSTAND<>0 DO▶17◀ BEGIN SÆTKEY(WRPOST+RECPRBLK-1); D COPSEGS(Z(BLT+(BLKINZONE-1)*ENTRYSIZE),BLKSIZE,BLK+(WRPOST-1)*DC RECSIZE,SKRIV);C▶14◀ BLKCHG:=FALSE;▶14◀= IF DIR=-1 THEN MOVELEFT(Z(COPFRA),Z(COPTIL),2*RECSIZE);=K (*FOR I:=1 TO RECSIZE DO Z(COPTIL-1+I):=Z(COPFRA-1+I);*)KK IF ((BLKINZONE=1) AND (DIR=-1)) OR ((BLKINZONE=BLKPRBUC) AND (DIR=1))K▶10◀ THEN BEGIN▶10◀! READTABLE(BUCINZONE+DIR);!< IF DIR=1 THEN BLKINZONE:=1 ELSE BLKINZONE:=BLKPRBUC;<▶1d◀ AFSTAND:=AFSTAND-DIR;▶1d◀< IF AFSTAND=0 THEN AFSTAND:=RETNING(PLADSIBUKET)+DIR;< BLKINZONE:=BLKINZONE-DIR
END;
< IF DIR=1 THEN MOVELEFT(Z(COPFRA),Z(COPTIL),2*RECSIZE);<J (*FOR I:=1 TO RECSIZE DO Z(COPTIL-1+I):=Z(COPFRA-1+I);*)J& READBLOCK(BLKINZONE+DIR,RDPOST);&? IF PLADSIBUKET AND (AFSTAND<>0) THEN AFSTAND:=AFSTAND-DIR?▶08◀ END;▶08◀@ DIR:=BLK+RECSIZE*Z(BLT+(BLKINZONE-1)*ENTRYSIZE+1); (*-1*)@: IF RDPOST=1 THEN MOVELEFT(Z(COPTIL),Z(DIR),2*RECSIZE);:F (*FOR I:=1 TO RECSIZE DO Z(DIR+I):=Z(COPTIL-1+I);*)F▶11◀ BLKCHG:=TRUE;▶11◀/ SÆTKEY(Z(BLT+(BLKINZONE-1)*ENTRYSIZE+1)+1);/▶05◀ END▶05◀▶04◀END;▶04◀▶00◀▶00◀▶04◀END;▶04◀▶00◀▶00◀ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc