|
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: 13888 (0x3640)
Types: TextFile
Notes: Mikados_K
Names: »OBEY.K«
└─⟦5630b2e42⟧ Bits:30009005 START APRIL 1985 aft april 1985 (PASCAL kildetekster)
└─⟦this⟧ »OBEY.K«
└─⟦6c21327e0⟧ Bits:30008986 LINIMATIC K-FILER (IKKE HELT UPTODTATE)
└─⟦this⟧ »OBEY.K«
(*$P*)
PROCEDURE OBEY;
VAR RZ,RS,NS,I,SIZE,REST,PREDKEY,SUCCKEY:INTEGER;
PROCEDURE PEXTRACT(RESPOS:INTEGER);
(*UDTRÆK NØGLE AF POST , OG GEM I KEY*)
VAR I:INTEGER;
J,KP :POSTADR;
BEGIN
WITH FILEHEAD(CURRHEAD) DO
FOR I:=1 TO KEYFLDS DO
BEGIN
KP:=KEYPOS(I)-1;
FOR J:=1 TO KEYLNG(I) DO
BEGIN
KEY(RESPOS):=REC^(KP+J);
RESPOS:=RESPOS+1
END
END
END;
(*$P*)
PROCEDURE RELEASKEY;
BEGIN
WITH USER(CURRUSER) DO
WITH FILES(CURRHEAD) DO
BEGIN
IF KEYSTART<AVAILKEY THEN
BEGIN
RZ:=0;
IF FILEHEAD(CURRHEAD).KEYSIZE>1 THEN
BEGIN
KEY(KEYSTART):=AVAILKEY;
KEY(KEYSTART+1):=FILEHEAD(CURRHEAD).KEYSIZE
END
ELSE KEY(KEYSTART):=-AVAILKEY;
AVAILKEY:=KEYSTART
END
ELSE
BEGIN
RZ:=AVAILKEY;
WHILE ABS(KEY(RZ))<KEYSTART DO RZ:=ABS(KEY(RZ));
IF FILEHEAD(CURRHEAD).KEYSIZE>1 THEN
BEGIN
KEY(KEYSTART):=ABS(KEY(RZ));
KEY(KEYSTART+1):=FILEHEAD(CURRHEAD).KEYSIZE
END
ELSE KEY(KEYSTART):=-ABS(KEY(RZ));
IF KEY(RZ)<0 THEN
KEY(RZ):=-KEYSTART
ELSE
KEY(RZ):=KEYSTART
END;
IF ABS(KEY(KEYSTART))<TOTALKEYSIZE THEN
IF KEYSTART+FILEHEAD(CURRHEAD).KEYSIZE=ABS(KEY(KEYSTART)) THEN
BEGIN
IF KEY(ABS(KEY(KEYSTART)))<0 THEN
RS:=1
ELSE
RS:=KEY(ABS(KEY(KEYSTART))+1);
KEY(KEYSTART):=ABS(KEY(ABS(KEY(KEYSTART))));
KEY(KEYSTART+1):=FILEHEAD(CURRHEAD).KEYSIZE+RS
END;
IF RZ>0 THEN
BEGIN
IF KEY(RZ)<0 THEN RS:=1 ELSE RS:=KEY(RZ+1);
IF RZ+RS=ABS(KEY(RZ)) THEN
BEGIN
IF KEY(ABS(KEY(RZ)))<0 THEN
NS:=1
ELSE
NS:=KEY(ABS(KEY(RZ))+1);
KEY(RZ):=ABS(KEY(ABS(KEY(RZ))));
KEY(RZ+1):=RS+NS
END
END;
KEYSTART:=0
END
END;
(*$P*)
PROCEDURE OUVRIR;
BEGIN
WITH USER(CURRUSER) DO
IF FILES(CURRHEAD).STATUS=LUKKET THEN
BEGIN
CASE BESKED.IREC OF
2:FILES(CURRHEAD).STATUS:=LÆS;
3:
BEGIN
FILES(CURRHEAD).STATUS:=SKRIV;
FOR I:=1 TO MAXUSERS DO
IF USER(I).FILES(CURRHEAD).STATUS=XXCLUSIV THEN
BEGIN
IER:=-26;
I:=MAXUSERS
END
END;
5:
BEGIN
FILES(CURRHEAD).STATUS:=XXCLUSIV;
FOR I:=1 TO MAXUSERS DO
IF USER(I).FILES(CURRHEAD).STATUS IN (.SKRIV..XXCLUSIV.) THEN
BEGIN
IER:=-27;
I:=MAXUSERS
END
END
OTHERWISE IER:=-28;
IF IER<>0 THEN BEGIN FILES(CURRHEAD).STATUS:=LUKKET;EXIT(OBEY) END;
IF NOT FILEHEAD(CURRHEAD).FILEOPEN THEN UDFØR;
IF NOT (-IER IN (.0,18,19.)) THEN EXIT(OBEY);
IF NOT FILEHEAD(CURRHEAD).FILEINIT THEN IER:=-12;
PREDKEY:=0;
I:=AVAILKEY;
WHILE I<=TOTALKEYSIZE DO
BEGIN
IF KEY(I)<0 THEN SIZE:=1 ELSE SIZE:=KEY(I+1);
IF SIZE>=FILEHEAD(CURRHEAD).KEYSIZE THEN
BEGIN
FILES(CURRHEAD).KEYSTART:=I;
SUCCKEY:=ABS(KEY(I));
REST:=SIZE-FILEHEAD(CURRHEAD).KEYSIZE;
IF REST>0 THEN
BEGIN
I:=I+FILEHEAD(CURRHEAD).KEYSIZE;
IF REST>1 THEN
BEGIN
KEY(I):=SUCCKEY;
KEY(I+1):=REST
END
ELSE KEY(I):=-SUCCKEY
END
ELSE I:=SUCCKEY;
IF PREDKEY=0 THEN AVAILKEY:=I ELSE
IF KEY(PREDKEY)>0 THEN KEY(PREDKEY):=I ELSE KEY(PREDKEY):=-I;
I:=TOTALKEYSIZE+1
END
ELSE
BEGIN
PREDKEY:=I;
I:=ABS(KEY(I))
END
END;
IF FILES(CURRHEAD).KEYSTART=0 THEN
BEGIN
IER:=-29;
EXIT(OBEY)
END
END ELSE IER:=-25;
END;
(*$P*)
PROCEDURE FERMEZ;
BEGIN
WITH USER(CURRUSER) DO
BEGIN
FILES(CURRHEAD).STATUS:=LUKKET;
FOR I:=1 TO MAXUSERS DO
IF USER(I).FILES(CURRHEAD).STATUS<>LUKKET THEN I:=MAXUSERS+10;
IF I<MAXUSERS+10 THEN
BEGIN
UDFØR;
IF IER<>0 THEN EXIT(OBEY);
FILEHEAD(CURRHEAD).NBUC:=AVAILHEAD;
AVAILHEAD:=CURRHEAD;
HEADBASE(CURRFILE):=0;
CURRZONE:=FILEHEAD(CURRHEAD).BUT;
IF CURRZONE<AVAILZONE THEN
BEGIN
RZ:=0;
Z(CURRZONE):=AVAILZONE;
Z(CURRZONE+1):=FILEHEAD(CURRHEAD).AZSIZE;
AVAILZONE:=CURRZONE
END
ELSE
BEGIN
RZ:=AVAILZONE;
WHILE Z(RZ)<CURRZONE DO RZ:=Z(RZ);
Z(CURRZONE):=Z(RZ);
Z(CURRZONE+1):=FILEHEAD(CURRHEAD).AZSIZE;
Z(RZ):=CURRZONE
END;
IF Z(CURRZONE)<MZONESIZE THEN
IF CURRZONE+Z(CURRZONE+1)=Z(CURRZONE) THEN
BEGIN
Z(CURRZONE+1):=Z(CURRZONE+1)+Z(Z(CURRZONE)+1);
Z(CURRZONE):=Z(Z(CURRZONE))
END;
IF RZ>0 THEN
BEGIN
IF RZ+Z(RZ+1)=Z(RZ) THEN
BEGIN
Z(RZ+1):=Z(RZ+1)+Z(Z(RZ)+1);
Z(RZ):=Z(Z(RZ))
END
END
END;
RELEASKEY
END
END;
(*$P*)
PROCEDURE REED;
VAR I,J:INTEGER;
BEGIN
WITH USER(CURRUSER) DO
BEGIN
PEXTRACT(FILES(CURRHEAD).KEYSTART);
IF CURRFUNC=LÆSPOSTX THEN
BEGIN
FOR I:=1 TO MAXUSERS DO
IF (USER(I).FILES(CURRHEAD).STATUS=XCLUSIV) AND (I<>CURRUSER) THEN
BEGIN
FOR J:=1 TO FILEHEAD(CURRHEAD).KEYSIZE DO
IF KEY(J-1+USER(I).FILES(CURRHEAD).KEYSTART)<>
KEY(J-1+USER(CURRUSER).FILES(CURRHEAD).KEYSTART) THEN J:=10000;
IF J<10000 THEN
BEGIN
FILES(CURRHEAD).STATUS:=SKRIV;
IER:=-31;
EXIT(OBEY)
END
END
END;
UDFØR;
IF CURRFUNC=LÆSPOSTX THEN
BEGIN
IF FILES(CURRHEAD).STATUS=SKRIV THEN FILES(CURRHEAD).STATUS:=XCLUSIV
END
ELSE
IF FILES(CURRHEAD).STATUS=XCLUSIV THEN FILES(CURRHEAD).STATUS:=SKRIV
END
END;
(*$P*)
PROCEDURE NÆKST;
VAR I,J:INTEGER;
BEGIN
WITH USER(CURRUSER) DO
BEGIN
UDFØR;
PEXTRACT(FILES(CURRHEAD).KEYSTART);
IF CURRFUNC=NÆSTEX THEN
BEGIN
FOR I:=1 TO MAXUSERS DO
IF (USER(I).FILES(CURRHEAD).STATUS=XCLUSIV) AND (I<>CURRUSER) THEN
BEGIN
FOR J:=1 TO FILEHEAD(CURRHEAD).KEYSIZE DO
IF KEY(J-1+USER(I).FILES(CURRHEAD).KEYSTART)<>
KEY(J-1+USER(CURRUSER).FILES(CURRHEAD).KEYSTART) THEN J:=10000;
IF J<10000 THEN
BEGIN
FILES(CURRHEAD).STATUS:=SKRIV;
IER:=-31;
EXIT(OBEY)
END
END
END;
IF CURRFUNC=NÆSTEX THEN
BEGIN
IF FILES(CURRHEAD).STATUS=SKRIV THEN FILES(CURRHEAD).STATUS:=XCLUSIV
END
ELSE
IF FILES(CURRHEAD).STATUS=XCLUSIV THEN FILES(CURRHEAD).STATUS:=SKRIV
END
END;
(*$P*)
PROCEDURE ERASAVE;
VAR I,J:INTEGER;
HKEY:ARRAY (.1..MAXKEYSIZE.) OF INTEGER;
BEGIN
WITH USER(CURRUSER) DO
BEGIN
IF FILES(CURRHEAD).STATUS=XCLUSIV THEN
BEGIN
FOR I:=1 TO FILEHEAD(CURRHEAD).KEYSIZE DO
HKEY(I):=KEY(I-1+FILES(CURRHEAD).KEYSTART);
PEXTRACT(FILES(CURRHEAD).KEYSTART);
FOR I:=1 TO FILEHEAD(CURRHEAD).KEYSIZE DO
IF KEY(I-1+FILES(CURRHEAD).KEYSTART)<>HKEY(I) THEN I:=10000;
IF I>10000 THEN
BEGIN
FILES(CURRHEAD).STATUS:=SKRIV;
IER:=-33;
EXIT(OBEY)
END
END;
UDFØR;
IF CURRFUNC<>GEMPOST THEN
BEGIN
PEXTRACT(FILES(CURRHEAD).KEYSTART);
IF CURRFUNC=SLETX THEN
BEGIN
FOR I:=1 TO MAXUSERS DO
IF (USER(I).FILES(CURRHEAD).STATUS=XCLUSIV) AND (I<>CURRUSER) THEN
BEGIN
FOR J:=1 TO FILEHEAD(CURRHEAD).KEYSIZE DO
IF KEY(J-1+USER(I).FILES(CURRHEAD).KEYSTART)<>
KEY(J-1+USER(CURRUSER).FILES(CURRHEAD).KEYSTART) THEN J:=10000;
IF J<10000 THEN
BEGIN
FILES(CURRHEAD).STATUS:=SKRIV;
IER:=-31;
EXIT(OBEY)
END
END
END
END;
IF CURRFUNC IN (.SLET,GEMPOST.) THEN
IF FILES(CURRHEAD).STATUS=XCLUSIV THEN FILES(CURRHEAD).STATUS:=SKRIV
END
END;
(*$P*)
BEGIN
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 (.LUK..INITIER,RETURNHEAD.) THEN
IF FILES(CURRHEAD).STATUS=LUKKET THEN BEGIN IER:=-3;EXIT(OBEY) END;
IF CURRFUNC IN (.LÆSPOSTX,NÆSTEX,INDSÆT,INITIER.) THEN
IF FILES(CURRHEAD).STATUS=LÆS THEN BEGIN IER:=-30;EXIT(OBEY) END;
IF CURRFUNC IN (.SLET,SLETX,GEMPOST.) THEN
IF NOT (FILES(CURRHEAD).STATUS IN (.XCLUSIV,XXCLUSIV.)) THEN
BEGIN
IER:=-32;
EXIT(OBEY)
END;
CASE CURRFUNC OF
ÅBEN:OUVRIR;
LUK :FERMEZ;
LÆSPOST,LÆSPOSTX:REED;
NÆSTE,NÆSTEX:NÆKST;
SLET,SLETX,GEMPOST:ERASAVE;
INDSÆT:WITH FILES(CURRHEAD) DO
BEGIN
UDFØR;
PEXTRACT(KEYSTART);
IF STATUS=XCLUSIV THEN STATUS:=SKRIV
END;
INITIER:BEGIN
IREC:=BESKED.IREC;
UDFØR
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 CURRHEAD:=1 TO MAXOPENFILES DO WITH FILES(CURRHEAD) DO
IF STATUS<>LUKKET THEN
BEGIN
STATUS:=LUKKET;
RELEASKEY
END
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 CURRFILE:=1 TO MAXFILES DO
IF HEADBASE(CURRFILE)=0 THEN REC^(CURRFILE+1):=ORD(LUKKET)
ELSE
REC^(CURRFILE+1):=ORD(USER(STATUSER).FILES(HEADBASE(CURRFILE)).STATUS)
END
END (*CASE CURRFUNC*)
END
END;