|
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: 12640 (0x3160)
Types: TextFile
Notes: Mikados_K
Names: »RAPPORT.K«
└─⟦5630b2e42⟧ Bits:30009005 START APRIL 1985 aft april 1985 (PASCAL kildetekster)
└─⟦this⟧ »RAPPORT.K«
└─⟦6c21327e0⟧ Bits:30008986 LINIMATIC K-FILER (IKKE HELT UPTODTATE)
└─⟦this⟧ »RAPPORT.K«
PROGRAM RAPPORT;
CONST MAXZONE=1000;
LÆS = 0;
SKRIV= 1;
TYPE ISF = FILE OF ARRAY (1..232) OF INTEGER;
AR = ARRAY (-4..-4) OF INTEGER;
FILNAVN=PACKED ARRAY (1..8) OF CHAR;
ISFHEAD = RECORD
NBUC,NBLK,NREC,
BLKPRBUC,RECPRBUC,RECPRBLK,
KEYFLDS,
FLHSIZE,BUTSIZE,BLTSIZE,BLKSIZE,RECSIZE,KEYSIZE,
SEGINFLH,SEGINBUT,SEGINBUC,SEGINBLT,SEGINBLK,
INITREC,BUCINUSE,BLKINUSE,RECINUSE,
BUCINZONE,BLKINZONE,BLKENTRY,
UPSTAT,IRPRBUC,IRPRBLK,
BUT,BLT,BLK,KEY1,KEY2,ENTRYSIZE :INTEGER;
FILEINIT,FILEOPEN,BUTCHG,BLTCHG,BLKCHG :BOOLEAN;
KEYPOS,KEYLNG,KEYSGN : ARRAY (1..9) OF INTEGER;
Z:AR;
FILENAME:FILNAVN
END;
ZZONE =RECORD
H:ISFHEAD;
T:ARRAY(1..MAXZONE) OF INTEGER
END;
VAR I,IER:INTEGER;
CH:STRING(1);
REGISTER:ISF;
FNAVN :STRING;
ZONE:ZZONE;
(*$P*)
(*$R-*)
PROCEDURE COPSEGS(VAR Z:AR;VAR F:ISF;SEGADR,WORDS,WORDADR,INOUT:INTEGER);
VAR I:INTEGER;
BEGIN
WORDADR:=WORDADR-1;
IF INOUT=LÆS THEN
BEGIN
SEEK(F,SEGADR);
IER:=IORESULT;
IF IER<>0 THEN EXIT(COPSEGS);
REPEAT
GET(F);
IF IORESULT<>0 THEN
BEGIN
IER:=IORESULT;
EXIT(COPSEGS)
END;
IF WORDS>231 THEN
BEGIN
FOR I:=1 TO 232 DO Z(WORDADR+I):=F^(I);
WORDADR:=WORDADR+232;
END ELSE FOR I:=1 TO WORDS DO Z(WORDADR+I):=F^(I);
WORDS:=WORDS-232
UNTIL WORDS<1
END ELSE
BEGIN
SEEK(F,SEGADR);
IER:=IORESULT;
IF IER<>0 THEN EXIT(COPSEGS);
REPEAT
IF WORDS>231 THEN
BEGIN
FOR I:=1 TO 232 DO F^(I):=Z(WORDADR+I);
WORDADR:=WORDADR+232;
END ELSE FOR I:=1 TO WORDS DO F^(I):=Z(WORDADR+I);
WORDS:=WORDS-232;
PUT(F);
IF IORESULT<>0 THEN
BEGIN
IER:=IORESULT;
EXIT(COPSEGS)
END
UNTIL WORDS<1
END
END;
(*$P*)
PROCEDURE IOPEN(VAR ZO:ISFHEAD;VAR F:ISF;MODE:INTEGER);
(*F ER ÅBNET FØR KALD; MED REWRITE*)
VAR I,J,NUM,BUC,K,BLKNUM:INTEGER;
BEGIN
WITH ZO DO
BEGIN
SEEK(F,1);
IER:=IORESULT;
IF IER<>0 THEN EXIT(IOPEN);
GET(F);
IER:=IORESULT;
IF IER<>0 THEN EXIT (IOPEN);
NBUC := F^(1);
NBLK := F^(2);
NREC := F^(3);
BLKPRBUC := F^(4);
RECPRBUC := F^(5);
RECPRBLK := F^(6);
KEYFLDS := F^(7);
FLHSIZE := F^(8);
BUTSIZE := F^(9);
BLTSIZE := F^(10);
BLKSIZE := F^(11);
RECSIZE := F^(12);
KEYSIZE := F^(13);
SEGINFLH := F^(14);
SEGINBUT := F^(15);
SEGINBUC := F^(16);
SEGINBLT := F^(17);
SEGINBLK := F^(18);
INITREC := F^(19);
BUCINUSE := F^(20);
BLKINUSE := F^(21);
RECINUSE := F^(22);
FILEINIT := F^(23)=1;
FILEOPEN := F^(24)=1;
FOR I:=1 TO 9 DO
BEGIN
KEYPOS(I):= F^(22+I*3);
KEYLNG(I):= F^(23+I*3);
KEYSGN(I):= F^(24+I*3)
END;
BUTCHG:=FALSE;
BLTCHG:=FALSE;
BLKCHG:=FALSE;
BUCINZONE:=0;
BLKINZONE:=0;
BLKENTRY:=0;
UPSTAT:=MODE;
BUT:=1;
BLT:=BUT+BUTSIZE;
BLK:=BLT+BLTSIZE;
KEY1:=BLK+BLKSIZE+RECSIZE;
KEY2:=BLK+BLKSIZE;
ENTRYSIZE:=KEYSIZE+2;
IF RECPRBUC<>RECPRBLK*BLKPRBUC THEN
BEGIN
IER:=-4;
EXIT (IOPEN)
(*FILEN ER IKKE ISF*)
END;
IF FILEINIT THEN COPSEGS(Z,F,2,BUTSIZE,BUT,LÆS);
IF IER<>0 THEN EXIT (IOPEN);
IF FILEOPEN THEN
BEGIN
IER:=-18;
IF NOT FILEINIT THEN
BEGIN
IER:=-19;
INITREC:=0;
BUCINUSE:=0;
BLKINUSE:=0;
RECINUSE:=0
END
ELSE
BEGIN
BUCINUSE:=0;
BLKINUSE:=0;
RECINUSE:=0;
FOR I:=1 TO NBUC DO
BEGIN
BUC:=BUT+(I-1)*ENTRYSIZE+1;
COPSEGS(Z,F,Z(BUC-1),BLTSIZE,BLT,LÆS);
IF IER<>0 THEN EXIT (IOPEN);
IER:=-18;
NUM:=0;
FOR J:=1 TO BLKPRBUC DO
BEGIN
BLKNUM:=BLT+1+(J-1)*ENTRYSIZE;
IF Z(BLKNUM)>0 THEN
BEGIN
NUM:=NUM+Z(BLKNUM);
BLKINUSE:=BLKINUSE+1;
K:=BLKNUM
END
END;
IF NUM>0 THEN
BEGIN
RECINUSE:=RECINUSE+NUM;
BUCINUSE:=BUCINUSE+1;
FOR J:=1 TO KEYSIZE DO
Z(BUC+J):=Z(K+J)
END;
BUTCHG:=TRUE;
Z(BUC):=NUM
END; (*FOR I*)
BUCINZONE:=NBUC
END
END; (*FILEOPEN*)
FILEOPEN:=TRUE;
IF UPSTAT=SKRIV THEN
BEGIN
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;
F^(19):=INITREC;
F^(20):=BUCINUSE;
F^(21):=BLKINUSE;
F^(22):=RECINUSE;
IF FILEINIT THEN F^(23):=1 ELSE F^(23):=0;
IF FILEOPEN THEN F^(24):=1 ELSE F^(24):=0;
FOR I:=1 TO 9 DO
BEGIN
F^(22+I*3):=KEYPOS(I);
F^(23+I*3):=KEYLNG(I);
F^(24+I*3):=KEYSGN(I)
END;
SEEK(F,1);
I:=IER;
IER:=IORESULT;
IF IER<>0 THEN EXIT(IOPEN);
PUT(F);
IER:=IORESULT;
IF IER<>0 THEN EXIT(IOPEN);
IER:=I
END
END
END (*IOPEN*);
(*$P*)
PROCEDURE READTABLE(VAR ZO:ISFHEAD;VAR F:ISF;BUTENTRY:INTEGER);
BEGIN
IER:=0;
WITH ZO DO
IF BUTENTRY<>BUCINZONE THEN
BEGIN
IF BLKCHG THEN
BEGIN
IF UPSTAT=SKRIV THEN
COPSEGS(Z,F,Z((BLKINZONE-1)*ENTRYSIZE+BLT),BLKSIZE,BLK,SKRIV);
IF IER<>0 THEN EXIT(READTABLE)
END;
IF BLTCHG THEN
BEGIN
IF UPSTAT=SKRIV THEN
COPSEGS(Z,F,Z((BUCINZONE-1)*ENTRYSIZE+BUT),BLTSIZE,BLT,SKRIV);
IF IER<>0 THEN EXIT(READTABLE)
END;
BLKCHG:=FALSE;
BLTCHG:=FALSE;
COPSEGS(Z,F,Z((BUTENTRY-1)*ENTRYSIZE+BUT),BLTSIZE,BLT,LÆS);
IF IER<>0 THEN EXIT(READTABLE);
BUCINZONE:=BUTENTRY;
BLKINZONE:=0
END
END;
PROCEDURE READBLOCK(VAR ZO:ISFHEAD;VAR F:ISF;BLTENTRY,STARTPOST:INTEGER);
BEGIN
IER:=0;
WITH ZO DO
IF BLTENTRY<>BLKINZONE THEN
BEGIN
IF BLKCHG THEN
BEGIN
IF UPSTAT=SKRIV THEN
COPSEGS(Z,F,Z((BLKINZONE-1)*ENTRYSIZE+BLT),BLKSIZE,BLK,SKRIV);
BLKCHG:=FALSE;
IF IER<>0 THEN EXIT(READBLOCK)
END;
COPSEGS(Z,F,Z((BLTENTRY-1)*ENTRYSIZE+BLT),BLKSIZE,BLK+(STARTPOST-1)*
RECSIZE,LÆS);
IF IER<>0 THEN EXIT(READBLOCK);
BLKINZONE:=BLTENTRY
END
END;
(*$P*)
PROCEDURE REPORT(VAR ZO:ISFHEAD;VAR F:ISF;SBUC:INTEGER);
VAR I,J,K,L,N:INTEGER;
PROCEDURE W(T:STRING;NR:INTEGER);
BEGIN
N:=N+1;
WRITE(LIST,' ',T,NR:6);
IF N=6 THEN
BEGIN
WRITELN(LIST);
N:=0
END
END;
BEGIN
WITH ZO DO
BEGIN
WRITELN(LIST,'REPORT');
WRITELN(LIST);
WRITELN(LIST,'FILEHEAD-INFORMATION');
WRITELN(LIST);
N:=0;
W('NBUC :',NBUC);W('NBLK :',NBLK);
W('NREC :',NREC);
W('BLKPRBUC:',BLKPRBUC);
W('RECPRBUC:',RECPRBUC);
W('RECPRBLK:',RECPRBLK);
W('KEYFLDS :',KEYFLDS);
W('FLHSIZE :',FLHSIZE);
W('BUTSIZE :',BUTSIZE);
W('BLTSIZE :',BLTSIZE);
W('BLKSIZE :',BLKSIZE);
W('RECSIZE :',RECSIZE);
W('KEYSIZE :',KEYSIZE);
W('SEGINFLH:',SEGINFLH);
W('SEGINBUT:',SEGINBUT);
W('SEGINBUC:',SEGINBUC);
W('SEGINBLT:',SEGINBLT);
W('SEGINBLK:',SEGINBLK);
WRITELN(LIST);
WRITELN(LIST,'FILE-STATUS');
WRITELN(LIST);
W('INITREC :',INITREC);
W('BUCINUSE:',BUCINUSE);
W('BLKINUSE:',BLKINUSE);
N:=5;
W('RECINUSE:',RECINUSE);
WRITE(LIST,' FILEINIT: ');
IF FILEINIT THEN WRITE(LIST,' TRUE') ELSE WRITE(LIST,'FALSE');
WRITE(LIST,' FILEOPEN: ');
IF FILEOPEN THEN WRITELN(LIST,' TRUE') ELSE WRITELN(LIST,'FALSE');
WRITELN(LIST);
WRITELN(LIST,'KEY-DESCRIPTION');
WRITELN(LIST);
WRITELN(LIST,' KEYFLD KEYPOS KEYLNG KEYSGN');
FOR I:=1 TO KEYFLDS DO
WRITELN(LIST,I:9,KEYPOS(I):9,KEYLNG(I):9,KEYSGN(I):9);
WRITELN(LIST);
WRITELN(LIST,'BUCKETTABLE');
WRITELN(LIST);
WRITELN(LIST,' ADR NUM KEY');
FOR I:=1 TO NBUC DO
BEGIN
WRITE(LIST,Z((I-1)*ENTRYSIZE+1):6,Z((I-1)*ENTRYSIZE+2):6);
FOR J:=1 TO KEYSIZE DO WRITE(LIST,Z((I-1)*ENTRYSIZE+2+J):6);
WRITELN(LIST)
END;
WRITELN(LIST);
FOR I:=SBUC TO NBUC DO
BEGIN
WRITELN(LIST,I:5,'. BUCKET');
WRITELN(LIST);
READTABLE(ZO,F,I);
IF IER<>0 THEN EXIT(REPORT);
WRITELN(LIST,'BLOCKTABLE');
WRITELN(LIST);
WRITELN(LIST,' ADR NUM KEY');
FOR J:=1 TO BLKPRBUC DO
BEGIN
WRITE(LIST,Z((J-1)*ENTRYSIZE+BLT):6,Z((J-1)*ENTRYSIZE
+BLT+1):6);
FOR K:=1 TO KEYSIZE DO WRITE(LIST,Z((J-1)*ENTRYSIZE+BLT+1+K):6);
WRITELN(LIST)
END;
(* WRITELN(LIST);
FOR J:=1 TO BLKPRBUC DO
BEGIN
WRITE(LIST,I:5,'. BUCKET ',J:5,'. BLOCK');
READBLOCK(ZO,F,J,1);
IF IER<>0 THEN EXIT(REPORT);
FOR K:=1 TO RECPRBLK DO
BEGIN
IF K>Z(BLT+(J-1)*ENTRYSIZE+1) THEN
WRITE(LIST,' *')
ELSE WRITE(LIST,' ');
FOR L:=1 TO RECSIZE DO
WRITE(LIST,Z(BLK+(K-1)*RECSIZE+L-1));
WRITELN(LIST);
END;
WRITELN(LIST)
END;*)
WRITELN(LIST)
END
END
END;
(*$P*)
PROCEDURE ERROR(VAR FIL:FILNAVN);
BEGIN
WRITELN('FEJL I REGISTER ',FIL,' FEJLKODE ',IER,' RETURN');
CH:=' ';EDIT(CH);IF CH='R' THEN REPORT(ZONE.H,REGISTER,1);
EXIT(RAPPORT)
END;
PROCEDURE OFEJL(VAR FIL:FILNAVN);
VAR I:INTEGER;
BEGIN
GOTOXY(1,20);
WRITELN('REGISTERFEJL ',IER,' I ',FIL,' . SITUATIONEN ER FORSØGT REDDET.');
WRITELN('TAST 0, HVIS DER SKAL FORTSÆTTES');
REPEAT GOTOXY(40,21);READLN;READ(I) UNTIL IORESULT=0;
IF I<>0 THEN ERROR(FIL);
CLEARSCREEN
END;
(*$P*)
BEGIN
CLEARSCREEN;
WRITE('INDTAST FILNAVN ');READLN;READ(FNAVN);
ZONE.H.FILENAME:=' ';
FOR I:=1 TO POS(':',FNAVN)-1 DO ZONE.H.FILENAME(I):=FNAVN(I);
REWRITE(REGISTER,FNAVN);
IOPEN(ZONE.H,REGISTER,LÆS);IF IER<>0 THEN OFEJL(ZONE.H.FILENAME);
WRITELN('REPORT, SBUC');READLN;READ(I);
REPORT(ZONE.H,REGISTER,I)
END.