|
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: 10112 (0x2780)
Types: TextFile
Notes: Mikados_K
Names: »OBE1.K«
└─⟦5630b2e42⟧ Bits:30009005 START APRIL 1985 aft april 1985 (PASCAL kildetekster)
└─⟦this⟧ »OBE1.K«
└─⟦6c21327e0⟧ Bits:30008986 LINIMATIC K-FILER (IKKE HELT UPTODTATE)
└─⟦this⟧ »OBE1.K«
(*$P*)
PROCEDURE OBEY;
VAR I:INTEGER;
PROCEDURE PEXTRACT(RESPOS:INTEGER);
(*UDTRÆK NØGLE AF POST , OG GEM I KEYS*)
VAR I:INTEGER;
J,KP :POSTADR;
BEGIN
WITH FILEHEAD DO
FOR I:=1 TO KEYFLDS DO
BEGIN
KP:=KEYPOS(I)-1;
FOR J:=1 TO KEYLNG(I) DO
BEGIN
KEYS(RESPOS):=REC^(KP+J);
RESPOS:=RESPOS+1
END
END
END;
(*$P*)
PROCEDURE OUVRIR;
BEGIN
WITH USER(CURRUSER) DO
IF STATUS(CURRFILE)=LUKKET THEN
BEGIN
CASE BESKED.IREC OF
2:STATUS(CURRFILE):=LÆS;
3:
BEGIN
STATUS(CURRFILE):=SKRIV;
FOR I:=1 TO MAXUSERS DO
IF USER(I).STATUS(CURRFILE)=XXCLUSIV THEN
BEGIN
IER:=-26;
I:=MAXUSERS
END
END;
5:
BEGIN
STATUS(CURRFILE):=XXCLUSIV;
FOR I:=1 TO MAXUSERS DO
IF USER(I).STATUS(CURRFILE) IN (.SKRIV..XXCLUSIV.) THEN
BEGIN
IER:=-27;
I:=MAXUSERS
END
END
OTHERWISE IER:=-28;
IF IER<>0 THEN BEGIN STATUS(CURRFILE):=LUKKET;EXIT(OBEY) END;
IF NOT FILEHEAD.FILEOPEN THEN IER:=-3;
IF IER<>0 THEN EXIT(OBEY);
IF NOT FILEHEAD.FILEINIT THEN IER:=-12;
END ELSE IER:=-25
END;
(*$P*)
PROCEDURE REED;
VAR K,KI,I,J:INTEGER;
BEGIN
WITH USER(CURRUSER) DO WITH FILEHEAD DO
BEGIN
K:=KEYSTART;
PEXTRACT(K);
IF CURRFUNC=LÆSPOSTX THEN
BEGIN
FOR I:=1 TO MAXUSERS DO
IF (USER(I).STATUS(CURRFILE)=XCLUSIV) AND (I<>CURRUSER) THEN
BEGIN
KI:=(I-1)*KEYSIZE;
FOR J:=1 TO KEYSIZE DO
IF KEYS(J+KI)<>KEYS(J-1+K) THEN J:=10000;
IF J<10000 THEN
BEGIN
STATUS(CURRFILE):=SKRIV;
IER:=-31;
EXIT(OBEY)
END
END
END;
GETREC;
IF CURRFUNC=LÆSPOSTX THEN
BEGIN
IF STATUS(CURRFILE)=SKRIV THEN STATUS(CURRFILE):=XCLUSIV
END
ELSE
IF STATUS(CURRFILE)=XCLUSIV THEN STATUS(CURRFILE):=SKRIV
END
END;
(*$P*)
PROCEDURE NÆKST;
VAR K,KI,I,J:INTEGER;
BEGIN
WITH USER(CURRUSER) DO WITH FILEHEAD DO
BEGIN
K:=KEYSTART;
NEXTREC;
PEXTRACT(K);
IF CURRFUNC=NÆSTEX THEN
BEGIN
FOR I:=1 TO MAXUSERS DO
IF (USER(I).STATUS(CURRFILE)=XCLUSIV) AND (I<>CURRUSER) THEN
BEGIN
KI:=(I-1)*KEYSIZE;
FOR J:=1 TO KEYSIZE DO
IF KEYS(J+KI)<>KEYS(J-1+K) THEN J:=10000;
IF J<10000 THEN
BEGIN
STATUS(CURRFILE):=SKRIV;
IER:=-31;
EXIT(OBEY)
END
END
END;
IF CURRFUNC=NÆSTEX THEN
BEGIN
IF STATUS(CURRFILE)=SKRIV THEN STATUS(CURRFILE):=XCLUSIV
END
ELSE
IF STATUS(CURRFILE)=XCLUSIV THEN STATUS(CURRFILE):=SKRIV
END
END;
(*$P*)
PROCEDURE ERASAVE;
VAR K,KI,I,J:INTEGER;
HKEY:ARRAY (.1..MAXKEYSIZE.) OF INTEGER;
BEGIN
WITH USER(CURRUSER) DO WITH FILEHEAD DO
BEGIN
K:=KEYSTART;
IF STATUS(CURRFILE)=XCLUSIV THEN
BEGIN
(*
FOR I:=1 TO FILEHEAD.KEYSIZE DO
HKEY(I):=KEY(I-1+FILES(CURRHEAD).KEYSTART);
*)
MOVELEFT(KEYS(K),HKEY(1),2*KEYSIZE);
PEXTRACT(K);
FOR I:=1 TO KEYSIZE DO
IF KEYS(I-1+K)<>HKEY(I) THEN I:=10000;
IF I>10000 THEN
BEGIN
STATUS(CURRFILE):=SKRIV;
IER:=-33;
EXIT(OBEY)
END
END;
IF CURRFUNC=GEMPOST THEN
PUTREC
ELSE
BEGIN
DELETE;
PEXTRACT(K);
IF CURRFUNC=SLETX THEN
BEGIN
FOR I:=1 TO MAXUSERS DO
IF (USER(I).STATUS(CURRFILE)=XCLUSIV) AND (I<>CURRUSER) THEN
BEGIN
KI:=(I-1)*KEYSIZE;
FOR J:=1 TO KEYSIZE DO
IF KEYS(J+KI)<>KEYS(J-1+K) THEN J:=10000;
IF J<10000 THEN
BEGIN
STATUS(CURRFILE):=SKRIV;
IER:=-31;
EXIT(OBEY)
END
END
END
END;
IF CURRFUNC IN (.SLET,GEMPOST.) THEN
IF STATUS(CURRFILE)=XCLUSIV THEN STATUS(CURRFILE):=SKRIV
END
END;
(*$P*)
BEGIN (*OBEY*)
WITH USER(CURRUSER) DO
BEGIN
(*PAS PÅ DATASTRUKTUR NÅR OBEY MISLYKKES*)
CASE PROGRAMNR OF
-1:IF CURRFUNC IN
(.ÅBEN..INITIER,UAFMELD..PAFMELD,RETURNHEAD,RETURNSTAT.) THEN IER:=-22;
0:IF CURRFUNC IN
(.ÅBEN..INITIER,PAFMELD,RETURNHEAD,RETURNSTAT.) THEN IER:=-24
ELSE IF CURRFUNC IN (.UTILMELD,STOPSYS.) THEN IER:=-21
OTHERWISE
IF CURRFUNC IN (.UTILMELD..PTILMELD,STOPSYS.) THEN IER:=-23;
IF IER<>0 THEN EXIT(OBEY);
IF CURRFUNC IN (.LÆSPOST..INITIER,RETURNHEAD.) THEN
IF STATUS(CURRFILE)=LUKKET THEN BEGIN IER:=-3;EXIT(OBEY) END;
IF CURRFUNC IN (.LÆSPOSTX,NÆSTEX,INDSÆT,INITIER.) THEN
IF STATUS(CURRFILE)=LÆS THEN BEGIN IER:=-30;EXIT(OBEY) END;
IF CURRFUNC IN (.SLET,SLETX,GEMPOST.) THEN
IF NOT (STATUS(CURRFILE) IN (.XCLUSIV,XXCLUSIV.)) THEN
BEGIN
IER:=-32;
EXIT(OBEY)
END;
CASE CURRFUNC OF
ÅBEN:OUVRIR;
LUK :STATUS(CFILE):=LUKKET;(*IKKE NØDV.CURRFILE, ZONEN BRUGES IKKE*)
LÆSPOST,LÆSPOSTX:REED;
NÆSTE,NÆSTEX:NÆKST;
SLET,SLETX,GEMPOST:ERASAVE;
INDSÆT:BEGIN
INSERT;
PEXTRACT(KEYSTART);
IF STATUS(CURRFILE)=XCLUSIV THEN STATUS(CURRFILE):=SKRIV
END;
INITIER:BEGIN
IREC:=BESKED.IREC;
INITIATE
END;
UTILMELD:
BEGIN
PROGRAMNR:=0;
IF NROFUSERS=MAXUSERS THEN
BEGIN
IER:=-34;
EXIT(OBEY)
END;
NROFUSERS:=NROFUSERS+1
END;
UAFMELD:
BEGIN
PROGRAMNR:=-1;
NROFUSERS:=NROFUSERS-1;
FOR CFILE:=1 TO NROFFILES DO STATUS(CFILE):=LUKKET
END;
PTILMELD:PROGRAMNR:=BESKED.INFO;
PAFMELD:PROGRAMNR:=0;
STOPSYS:BEGIN
IF BESKED.INFO=1 THEN NROFUSERS:=0;
IER:=NROFUSERS
END;
RETURNHEAD:RETURNEZ;
RETURNSTAT:
BEGIN
REC^(1):=USER(STATUSER).PROGRAMNR;
FOR CFILE:=1 TO NROFFILES DO
IF ZONEPOST(CFILE)=0 THEN REC^(CFILE+1):=ORD(LUKKET)
ELSE
REC^(CFILE+1):=ORD(USER(STATUSER).STATUS(CFILE))
END
END (*CASE CURRFUNC*)
END
END; (*OBEY*)