|
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: 1248 (0x4e0)
Types: TextFile
Notes: Mikados_K
Names: »INITIATE.K«
└─⟦5630b2e42⟧ Bits:30009005 START APRIL 1985 aft april 1985 (PASCAL kildetekster)
└─⟦this⟧ »INITIATE.K«
└─⟦6c21327e0⟧ Bits:30008986 LINIMATIC K-FILER (IKKE HELT UPTODTATE)
└─⟦this⟧ »INITIATE.K«
(*$P*)
SEGMENT PROCEDURE INITIATE(VAR F:ISF);
VAR I,BUCADR,BLKADR,J:INTEGER;
BEGIN
WITH FILEHEAD(CURRHEAD) DO
IF FILEOPEN THEN
BEGIN
IER:=0;
IF FILEINIT THEN IER:=-13;
IF RECINUSE>0 THEN IER:=-13;
IF IREC<1 THEN IER:=-5;
IF IREC>NREC THEN IER:=-5;
IF IER<>0 THEN EXIT(INITIATE);
FOR I:=1 TO NBUC DO
BEGIN
BUCADR:=2+SEGINBUT+SEGINBUC*(I-1);
Z(BUT+(I-1)*ENTRYSIZE):=BUCADR;
Z(BUT+(I-1)*ENTRYSIZE+1):=0;
FOR J:=1 TO BLKPRBUC DO
BEGIN
BLKADR:=BUCADR+SEGINBLT+SEGINBLK*(J-1);
Z(BLT+(J-1)*ENTRYSIZE):=BLKADR;
Z(BLT+(J-1)*ENTRYSIZE+1):=0;
(* COPSEGS(F,BLKADR,BLKSIZE,BLK,SKRIV); UNØDVENDIG *)
END;
COPSEGS(F,BUCADR,BLTSIZE,BLT,SKRIV);
END;
COPSEGS(F,2,BUTSIZE,BUT,SKRIV);
INITREC:=IREC;
IRPRBUC:=(IREC-1)DIV NBUC +1;
IRPRBLK:=RECPRBLK (*(IRPRBUC-1) DIV BLKPRBUC +1*)
END
ELSE
IER:=-3
END;