|
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: »CP.K«
└─⟦5630b2e42⟧ Bits:30009005 START APRIL 1985 aft april 1985 (PASCAL kildetekster)
└─⟦this⟧ »CP.K«
└─⟦6c21327e0⟧ Bits:30008986 LINIMATIC K-FILER (IKKE HELT UPTODTATE)
└─⟦this⟧ »CP.K«
PROGRAM CENTRALPROCES;
CONST MAXUSERS =2;
MAXFILES =100;
MZONESIZE =4000;
HELPBLT = 300;
MAXRECSIZE = 150;
TOTALKEYSIZE =157;
MAXKEYSIZE =20;
TYPE
KEYADR =1..TOTALKEYSIZE;
AR =ARRAY (0..0) OF INTEGER;
(*$IISFHEAD1*)
USERNR =1..MAXUSERS;
ZONEADR =1..MZONESIZE;
FILNR =1..MAXFILES;
POSTADR =0..MAXRECSIZE;
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;
STATUS:ARRAY (FILNR) OF ACCMODE
END;
VAR
USER :ARRAY (USERNR) OF USERDESC;
Z :ARRAY (ZONEADR) OF INTEGER;
ZONEPOST:ARRAY (FILNR) OF INTEGER;(*NR PÅ FØRSTE POST I ZONEFIL*)
FILEHEAD:ISFHEAD;
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;
NROFFILES:FILNR;
STATUSER,
CURRUSER:USERNR;
F,ZONEFIL:ISF;
CFILE,
CURRFILE,
NROFUSERS,
MLÆNGDE,MSTATUS,
IER,IREC:INTEGER;
SVAR :BOOLEAN;
BESKED :MESSAGE;
CPSTATUS:STATFILE;
(*$P*)
(*$IRETURNE1*)
PROCEDURE IOC;
FORWARD;
PROCEDURE LÆSZONE;
FORWARD;
PROCEDURE SKRIVZONE;
FORWARD;
PROCEDURE COPSEGS(SEGADR,WORDS,WORDADR:INTEGER;INOUT:ACCMODE);
FORWARD;
(*$IINITIAT1*)
(*$P*)
SEGMENT PROCEDURE PRELUDE;
TYPE
NIVEAU=(MENIG,SERGENT,LØJTNANT,KAPTAJN,MAJOR,OBERST,GENERAL,HSM,UMULIUS);
FILDESC=RECORD
FILNAVN,DESCNAVN,POSTNAVN,REGNAVN:STRING(18);
VEDLNIVEAU:NIVEAU;
ZONESIZE:INTEGER;
END;
FILEDESC=FILE OF FILDESC;
VAR
ISFFILES:FILEDESC;
FNAVN :STRING(18);
ZFADR,Q :INTEGER;
(*$IIOPE1*)
(*$P*)
BEGIN (*PRELUDE*)
FNAVN:='ZONEFIL:P2:0350:S';
(*^ RAMDISK*)
REWRITE(ZONEFIL,FNAVN);IOC;
CURRFILE:=0;
ZFADR:=1;
FNAVN:='ISFFILES:P2:0000:S';
RESET(ISFFILES,FNAVN);IOC;
SEEK(ISFFILES,1);IOC;
GET(ISFFILES);IOC;
WHILE ISFFILES^.FILNAVN(1)<>'@' DO
BEGIN
CURRFILE:=CURRFILE+1;
IER:=0;
IF ISFFILES^.FILNAVN(1)<>'#' THEN
BEGIN
Z(HELPBLT+1):=ISFFILES^.ZONESIZE;
IF ISFFILES^.ZONESIZE>MZONESIZE-HELPBLT THEN
IER:=-16
ELSE
BEGIN
ZONEPOST(CURRFILE):=ZFADR;
REWRITE(F,ISFFILES^.FILNAVN);IOC;
FILEHEAD.FILENAME:=ISFFILES^.FILNAVN;
IOPEN;
IF TOTALKEYSIZE<MAXUSERS*FILEHEAD.KEYSIZE THEN IER:=-29
END;
IF IER<>0 THEN
BEGIN
GOTOXY(1,10);
Q:=1;
WRITELN('FEJL NR',IER:5,' VED ÅBNING AF ',ISFFILES^.FILNAVN);
IF NOT (-IER IN (.18,19.)) THEN EXIT(CENTRALPROCES)
END;
SKRIVZONE;
ZFADR:=ZFADR+(75+MAXUSERS*FILEHEAD.KEYSIZE-1) DIV 232+1+
(FILEHEAD.BUTSIZE+FILEHEAD.BLTSIZE+FILEHEAD.BLKSIZE-1) DIV 232+1
END
ELSE
ZONEPOST(CURRFILE):=0;
GET(ISFFILES);IOC
END;
NROFFILES:=CURRFILE;
FOR CURRUSER:=1 TO MAXUSERS DO WITH USER(CURRUSER) DO
BEGIN
PROGRAMNR:=-1;
FOR CURRFILE:=1 TO NROFFILES DO STATUS(CURRFILE):=LUKKET
END;
CURRFILE:=0;
NROFUSERS:=0;
CLOSE(ISFFILES);IOC
END; (*PRELUDE*)
(*$P*)
SEGMENT PROCEDURE POSTLUDE;
(*$IICLOS1*)
(*LUKNING AF ALLE FILER*)
BEGIN (*POSTLUDE*)
IF CURRFILE<>0 THEN
SKRIVZONE
ELSE WRITELN('CURRFILE VAR 0');
FOR CURRFILE:=1 TO NROFFILES DO
IF ZONEPOST(CURRFILE)<>0 THEN
BEGIN
LÆSZONE;
ICLOSE
END;
CLOSE(ZONEFIL);IOC
END; (*POSTLUDE*)
(*$P*)
PROCEDURE IOC;
BEGIN
IER:=IORESULT;
IF IER<>0 THEN
BEGIN
WRITELN('CP IO-FEJL ',IER);READLN;
EXIT(CENTRALPROCES)
END
END;
PROCEDURE LÆSZONE;
VAR TIL:INTEGER;
BEGIN (*$XT*)
WRITELN('LÆSZONE',CURRFILE:5,ZONEPOST(CURRFILE):5);READLN;(*$X-*)
(*$C-*)
SEEK(ZONEFIL,ZONEPOST(CURRFILE));IOC;
TIL:=1;
REPEAT
GET(ZONEFIL);IOC;
(*$R-*)
MOVELEFT(ZONEFIL^(1),FILEHEAD.A(TIL),464);
(*$R+*)
TIL:=TIL+232
UNTIL TIL>75+MAXUSERS*FILEHEAD.KEYSIZE;
(*$XT*)
WRITELN(FILEHEAD.BUT:5,FILEHEAD.ENTRYSIZE:5,FILEHEAD.FILENAME);READLN;(*$X-*)
TIL:=FILEHEAD.BUT;
REPEAT
GET(ZONEFIL);IOC;
MOVELEFT(ZONEFIL^(1),Z(TIL),464);
TIL:=TIL+232
UNTIL TIL>FILEHEAD.KEY2-1; (*$XT*)
WRITELN(Z(FILEHEAD.BUT):5,Z(FILEHEAD.BUT+1):5);READLN;(*$X-*)
REWRITE(F,FILEHEAD.FILENAME);IOC
(*$C+*)
END;
PROCEDURE SKRIVZONE;
VAR TIL:INTEGER;
BEGIN (*$XT*)
WRITELN('SKRIVZONE',CURRFILE:5,ZONEPOST(CURRFILE):5);READLN;(*$X-*)
(*$C-*)
SEEK(ZONEFIL,ZONEPOST(CURRFILE));IOC;
TIL:=1;
REPEAT
(*$R-*)
MOVELEFT(FILEHEAD.A(TIL),ZONEFIL^(1),464);
(*$R+*)
PUT(ZONEFIL);IOC;
TIL:=TIL+232
UNTIL TIL>75+MAXUSERS*FILEHEAD.KEYSIZE;
TIL:=FILEHEAD.BUT;
REPEAT
MOVELEFT(Z(TIL),ZONEFIL^(1),464);
PUT(ZONEFIL);IOC;
TIL:=TIL+232
UNTIL TIL>FILEHEAD.KEY2-1;
CLOSE(F);IOC
(*$C+*)
END;
(*$P*)
FUNCTION KEYSTART:INTEGER;
BEGIN
KEYSTART:=(CURRUSER-1)*FILEHEAD.KEYSIZE+1
END;
PROCEDURE COPSEGS;(*SEGADR,WORDS,WORDADR:INTEGER;INOUT:ACCMODE*)
VAR I:INTEGER;
BEGIN (*$XT*)
WRITELN('COPSEGS',SEGADR:5,WORDS:5,WORDADR:5);(*$X-*)
(*$C-*)
IF INOUT=LÆS THEN
BEGIN
SEEK(F,SEGADR);
IOC;
REPEAT
GET(F);
IOC;
IF WORDS>231 THEN
BEGIN
MOVELEFT(F^(1),Z(WORDADR),464);
(*FOR I:=1 TO 232 DO Z(WORDADR+I):=F^(I);*)
WORDADR:=WORDADR+232;
END ELSE MOVELEFT(F^(1),Z(WORDADR),2*WORDS);
(*FOR I:=1 TO WORDS DO Z(WORDADR+I):=F^(I);*)
WORDS:=WORDS-232
UNTIL WORDS<1
END ELSE
BEGIN
SEEK(F,SEGADR);
IOC;
REPEAT
IF WORDS>231 THEN
BEGIN
MOVELEFT(Z(WORDADR),F^(1),464);
(*FOR I:=1 TO 232 DO F^(I):=Z(WORDADR+I);*)
WORDADR:=WORDADR+232;
END ELSE MOVELEFT(Z(WORDADR),F^(1),2*WORDS);
(*FOR I:=1 TO WORDS DO F^(I):=Z(WORDADR+I);*)
WORDS:=WORDS-232;
PUT(F);
IOC
UNTIL WORDS<1
END
(*$C+*)
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;
PROCEDURE OBEY;
FORWARD;
(*$IEXCOMCO1*)
(*$ISÆTØ1*)
(*$IREADPRO1*)
(*$IFINDPOS1*)
(*$IFORSKY1*)
(*$IPUTGE1*)
(*$IINSER1*)
(*$INEXTRE1*)
(*$IDELET1*)
(*$IDETERMI1*)
(*$IOBE1*)
(*$P*)
PROCEDURE ALLEGRO;
(*ADMINISTRATION AF DATASTRUKTUR, MODTAGELSE OG AFSENDELSE AF MESSAGES,
BRUG AF FILSYSTEMET*)
BEGIN
REPEAT
IER:=0;
RECEIV(AFSENDER,BESKED,MLÆNGDE);
(*
REPEAT
IF BESKED.KOMMANDO=ÅBEN THEN
ALLOCA(AFSKED,16,MSTATUS)
ELSE
ALLOCA(AFSKED,14,MSTATUS);
IF MSTATUS<>0 THEN
BEGIN
WRITELN('ALLOCASTATUS',MSTATUS:5);
READLN;READ(MSTATUS)
END
UNTIL MSTATUS=0;
*)
DETERMIN;
IF IER=0 THEN OBEY;
(*
DEALLO(AFSKED,MSTATUS);
IF MSTATUS<>0 THEN
BEGIN
WRITELN('DEALLOSTATUS',MSTATUS:5);
READLN
END;
*)
BESKED.INFO:=IER;
REPEAT
IF CURRFUNC=ÅBEN THEN
BEGIN
BESKED.IREC:=FILEHEAD.RECSIZE;
SENDM(AFSENDER,BESKED,6,MSTATUS)
END
ELSE
IF (CURRFUNC<>STOPSYS) OR (NROFUSERS<>0) THEN
SENDM(AFSENDER,BESKED,4,MSTATUS);
IF MSTATUS<>0 THEN
BEGIN
WRITELN('SENDMSTATUS',MSTATUS:5);
READLN;READ(MSTATUS)
END
UNTIL MSTATUS=0
UNTIL (CURRFUNC=STOPSYS) AND (NROFUSERS=0)
END;
(*$P*)
BEGIN
SETPR(5); (*$XT*)
WRITELN(1:5,MEMAVAIL:6);(*$X-*)
PRELUDE; (*$XT*)
WRITELN(2:5,MEMAVAIL:6);(*$X-*)
ALLEGRO; (*$XT*)
WRITELN(3:5,MEMAVAIL:6);(*$X-*)
POSTLUDE; (*$XT*)
WRITELN(4:5,MEMAVAIL:6);(*$X-*)
SETPR(6);
IF (CURRFUNC=STOPSYS) AND (NROFUSERS=0) THEN
SENDM(AFSENDER,BESKED,4,MSTATUS)
END.