|
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: 7936 (0x1f00)
Types: TextFile
Notes: Mikados_K
Names: »CP0.K«
└─⟦5630b2e42⟧ Bits:30009005 START APRIL 1985 aft april 1985 (PASCAL kildetekster)
└─⟦this⟧ »CP0.K«
└─⟦6c21327e0⟧ Bits:30008986 LINIMATIC K-FILER (IKKE HELT UPTODTATE)
└─⟦this⟧ »CP0.K«
PROGRAM CENTRALPROCES;
(*$D-*)
CONST MAXUSERS =2;
MAXFILES =25;
MAXOPENFILES =9;
MZONESIZE =3150;
HELPBLT = 180;
MAXRECSIZE = 100;
TOTALKEYSIZE =100;
MAXKEYSIZE =10;
(*$IISFHEAD*)
USERNR =1..MAXUSERS;
FHEADNR =1..MAXOPENFILES;
ZONEADR =1..MZONESIZE;
KEYADR =1..TOTALKEYSIZE;
FILNR =1..MAXFILES;
POSTADR =0..MAXRECSIZE;
AR =ARRAY (0..0) OF INTEGER;
COMMBUF =ARRAY (POSTADR) OF INTEGER;(*commbuf(0)=filnr,resten er posten*)
MESSAGETYPE=(ÅBEN,LUK,LÆSPOST,LÆSPOSTX,NÆSTE,NÆSTEX,SLET,SLETX,GEMPOST,
INDSÆT,INITIER,UTILMELD,UAFMELD,PTILMELD,PAFMELD,STOPSYS,
RETURNHEAD,RETURNSTAT);
MESSAGE =RECORD
KOMMANDO:MESSAGETYPE;
INFO,IREC:INTEGER
END;
SENDER =^INTEGER; (*ADRESSE PÅ MESSAGE-AFSENDER *)
POINTREC=^COMMBUF; (*ADRESSE PÅ FÆLLESOMRÅDE-START *)
PRIORANGE=4..7;
CPSTAT =RECORD
CPPCB :INTEGER;
STATUS :ARRAY (1..100) OF INTEGER
END;
STATFILE=FILE OF CPSTAT;
USERDESC=RECORD
PROGRAMNR:INTEGER;
FILES:ARRAY (FHEADNR) OF RECORD
STATUS:ACCMODE;
KEYSTART:INTEGER
END
END;
VAR
USER :ARRAY (USERNR) OF USERDESC;
Z :ARRAY (ZONEADR) OF INTEGER;
KEY :ARRAY (KEYADR) OF INTEGER;
FILEHEAD:ARRAY (FHEADNR) OF ISFHEAD; (*NBUC KÆDER LEDIGE SAMMEN*)
HEADBASE:ARRAY (FILNR) OF INTEGER;
FUSK :AR; (*FOR AT KUNNE FLYTTE EN ADRESSE*)
REC :POINTREC; (*FRA ET MESSAGE IND I POST *)
AFSENDER:SENDER;
AFSKED :POINTREC; (*RESERVERET PLADS TIL SVAR-BESKED*)
CURRFUNC:MESSAGETYPE;
CURRFILE:FILNR;
STATUSER,
CURRUSER:USERNR;
CURRHEAD:FHEADNR;
ISF1,ISF2,ISF3,ISF4,ISF5,ISF6,ISF7,ISF8,ISF9:ISF;
AVAILZONE,
AVAILKEY,
CURRZONE,
AVAILHEAD,
NROFUSERS,
MLÆNGDE,MSTATUS,
IER,IREC:INTEGER;
SVAR :BOOLEAN;
BESKED :MESSAGE;
CPSTATUS:STATFILE;
(*NÆSTE LEDIGE ZONEADR (NLZ) = AVAILZONE
Z(NLZ)>0 => ZONESIZE=Z(NLZ+1)
Z(NLZ)<0 => ZONESIZE=1
NLZ=ABS(Z(NLZ))
DITTO FOR KEY; Z(NLZ)<0 FOREKOMMER IKKE I Z*)
(*$P*)
(*$IRETURNEZ*)
SEGMENT PROCEDURE PRELUDE;
(*INITIALISERING AF DATASTRUKTURER*)
BEGIN
FOR CURRUSER:=1 TO MAXUSERS DO WITH USER(CURRUSER) DO
BEGIN
PROGRAMNR:=-1;
FOR CURRHEAD:=1 TO MAXOPENFILES DO WITH FILES(CURRHEAD) DO
BEGIN
STATUS:=LUKKET;
KEYSTART:=0
END
END;
FOR CURRHEAD:=1 TO MAXOPENFILES DO
WITH FILEHEAD(CURRHEAD) DO BEGIN NBUC:=CURRHEAD+1;FILEOPEN:=FALSE END;
FOR CURRFILE:=1 TO MAXFILES DO HEADBASE(CURRFILE):=0;
AVAILHEAD:=1;
AVAILZONE:=HELPBLT+1;
AVAILKEY:=1;
Z(AVAILZONE):=MZONESIZE+1;
Z(AVAILZONE+1):=MZONESIZE-HELPBLT;
KEY(1):=TOTALKEYSIZE+1;
KEY(2):=TOTALKEYSIZE;
NROFUSERS:=0
END;
(*$P*)
SEGMENT PROCEDURE POSTLUDE;
VAR I:INTEGER;
(*EVT. STATISTIKUDSKRIFTER, SIKKERHEDSKOPIERING , ANDET*)
BEGIN
I:=AVAILZONE;
IF (I<>HELPBLT+1) OR (Z(I)<>MZONESIZE+1) THEN
REPEAT
WRITELN(LIST,I:8,Z(I):8,Z(I+1):8);
I:=Z(I)
UNTIL I>=MZONESIZE;
I:=AVAILKEY;
IF (I<>1) OR (KEY(I)<>TOTALKEYSIZE+1) THEN
REPEAT
WRITELN(LIST,I:8,KEY(I):8,KEY(I+1):8);
IF KEY(I)<0 THEN I:=-KEY(I) ELSE I:=KEY(I)
UNTIL I>=TOTALKEYSIZE
END;
(*$P*)
PROCEDURE SENDM(RECEIVER:SENDER;VAR CONTENTS:MESSAGE;
LENGTH:INTEGER;VAR STATUS:INTEGER);EXTERNAL;
PROCEDURE RECEIV(VAR AFSENDER:SENDER;VAR CONTENTS:MESSAGE;
VAR LENGTH:INTEGER);EXTERNAL;
PROCEDURE ALLOCA(VAR ADDRESS:POINTREC;LENGTH:INTEGER;
VAR STATUS:INTEGER);EXTERNAL;
PROCEDURE DEALLO(ADDRESS:POINTREC;VAR STATUS:INTEGER);EXTERNAL;
PROCEDURE SETPR(PRIORITY:PRIORANGE);EXTERNAL;
(*$P*)
PROCEDURE UDFØR;
(*$IFXCOMCOP*)
(*$IINITIATE*)
PROCEDURE IOC;
BEGIN
IER:=IORESULT;
IF IER<>0 THEN
BEGIN
EXIT(UDFØR);
WRITELN('CP IO-FEJL ',IER);READLN
END
END;
(*$IEXCOMCOP*)
(*$ISÆTØG*)
(*$IREADPROC*)
(*$IFINDPOST*)
(*$IFORSKYD*)
(*$IIOPEN*)
(*$IICLOSE*)
(*$IPUTGET*)
(*$L+*)
(*$IINSERT*)
(*$L-*)
(*$INEXTREC*)
(*$IDELETE*)
(*$ILUKOP*)
(*$P*)
PROCEDURE EXECUTE(VAR F:ISF);
BEGIN
CASE CURRFUNC OF
ÅBEN :BEGIN
LUKOP(F);
IF IER=0 THEN IOPEN(F)
END;
LUK :ICLOSE(F);
LÆSPOST,
LÆSPOSTX:GETREC(F);
NÆSTE,
NÆSTEX :NEXTREC(F);
SLET,
SLETX :DELETE(F);
GEMPOST :PUTREC(F);
INDSÆT :INSERT(F);
INITIER :INITIATE(F)
END
END;
(*$P*)
BEGIN (*UDFØR*)
CASE CURRHEAD OF
1: EXECUTE(ISF1);
2: EXECUTE(ISF2);
3: EXECUTE(ISF3);
4: EXECUTE(ISF4);
5: EXECUTE(ISF5);
6: EXECUTE(ISF6);
7: EXECUTE(ISF7);
8: EXECUTE(ISF8);
9: EXECUTE(ISF9)(*;
10: EXECUTE(ISF10) *)
END
END (*UDFØR*);
(*$IDETERMIN*)
(*$IOBEY*)
(*$P*)
PROCEDURE ALLEGRO;
(*ADMINISTRATION AF DATASTRUKTUR, MODTAGELSE OG AFSENDELSE AF MESSAGES,
BRUG AF FILSYSTEMET*)
(*$XT*)
(*$IWRITCURR*)
(*$X-*)
BEGIN
REPEAT
IER:=0;
RECEIV(AFSENDER,BESKED,MLÆNGDE);
ALLOCA(AFSKED,16,MSTATUS);
IF MSTATUS<>0 THEN
BEGIN
WRITELN('ALLOCASTATUS',MSTATUS:5);
READLN
END;
(*$XT*) WRITCURR; (*$X-*)
DETERMIN;
(*$XT*) WRITCURR; (*$X-*)
IF IER=0 THEN OBEY;
(*$XT*) WRITCURR; (*$X-*)
DEALLO(AFSKED,MSTATUS);
IF MSTATUS<>0 THEN
BEGIN
WRITELN('DEALLOSTATUS',MSTATUS:5);
READLN
END;
BESKED.INFO:=IER;
IF CURRFUNC=ÅBEN THEN
BEGIN
BESKED.IREC:=FILEHEAD(CURRHEAD).RECSIZE;
SENDM(AFSENDER,BESKED,6,MSTATUS)
END
ELSE SENDM(AFSENDER,BESKED,4,MSTATUS);
IF MSTATUS<>0 THEN
BEGIN
WRITELN('SENDMSTATUS',MSTATUS:5);
READLN
END
UNTIL (CURRFUNC=STOPSYS) AND (NROFUSERS=0)
END;
(*$P*)
BEGIN
SETPR(5);
PRELUDE;
ALLEGRO;
POSTLUDE;
SETPR(6)
END.