|
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: 3744 (0xea0)
Types: TextFile
Notes: Mikados_K
Names: »EXCOMCOP.K«
└─⟦5630b2e42⟧ Bits:30009005 START APRIL 1985 aft april 1985 (PASCAL kildetekster)
└─⟦this⟧ »EXCOMCOP.K«
└─⟦6c21327e0⟧ Bits:30008986 LINIMATIC K-FILER (IKKE HELT UPTODTATE)
└─⟦this⟧ »EXCOMCOP.K«
(*$P*)
PROCEDURE EXTRACT;(*RECPOS,RESPOS:ZONEADR*)
(*UDTRÆK NØGLE AF POST I ZONEN, OG GEM I ZONEN*)
VAR I,
J,KP :INTEGER;
BEGIN
WITH FILEHEAD(CURRHEAD) DO
FOR I:=1 TO KEYFLDS DO
BEGIN
KP:=KEYPOS(I)+RECPOS-2;
FOR J:=1 TO KEYLNG(I) DO
BEGIN
Z(RESPOS):=Z(KP+J);
IF ABS(KEYSGN(I))=2 THEN
Z(RESPOS):=(Z(RESPOS) MOD 256)*256+Z(RESPOS) DIV 256;
RESPOS:=RESPOS+1
END
END
END;
PROCEDURE REXTRACT;(*RESPOS:ZONEADR*)
(*UDTRÆK NØGLE AF POST , OG GEM I ZONEN*)
VAR I,
J,KP :INTEGER;
BEGIN
WITH FILEHEAD(CURRHEAD) DO
FOR I:=1 TO KEYFLDS DO
BEGIN
KP:=KEYPOS(I)-1;
FOR J:=1 TO KEYLNG(I) DO
BEGIN
Z(RESPOS):=REC^(KP+J);
IF ABS(KEYSGN(I))=2 THEN
Z(RESPOS):=(Z(RESPOS) MOD 256)*256 + Z(RESPOS) DIV 256;
RESPOS:=RESPOS+1
END
END
END;
FUNCTION COMPARE;(*KEY1POS,KEY2POS:ZONEADR):INTEGER*)
(*SAMMENLIGNER TO NØGLER I ZONEN*)
VAR I,
J,KP:INTEGER;
BEGIN
KP:=0;
COMPARE:=0;
WITH FILEHEAD(CURRHEAD) DO
FOR I:=1 TO KEYFLDS DO
BEGIN
FOR J:=KP TO KP+KEYLNG(I)-1 DO
IF Z(KEY1POS+J)<>Z(KEY2POS+J) THEN
BEGIN
IF Z(KEY1POS+J)>Z(KEY2POS+J) THEN
COMPARE:=KEYSGN(I) ELSE
COMPARE:=-KEYSGN(I);
EXIT(COMPARE)
END;
KP:=KP+KEYLNG(I)
END
END;
(*$P*)
PROCEDURE COPSEGS;(*VAR F:ISF;SEGADR,WORDS,WORDADR:INTEGER;INOUT:ACCMODE*)
VAR I:INTEGER;
BEGIN
(*$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;
▶06◀(*$P*)▶06◀,PROCEDURE EXTRACT;(*RECPOS,RESPOS:ZONEADR*) ,0(*UDTRÆK NØGLE AF POST I ZONEN, OG GEM I ZONEN*)0▶06◀VAR I,▶06◀▶12◀ J,KP :INTEGER;▶12◀▶05◀BEGIN▶05◀▶1c◀ WITH FILEHEAD(CURRHEAD) DO▶1c◀" FOR I:=1 TO KEYFLDS DO "" BEGIN "" KP:=KEYPOS(I)+RECPOS-2; "" FOR J:=1 TO KEYLNG(I) DO "" BEGIN "" Z(RESPOS):=Z(KP+J); "▶1e◀ IF ABS(KEYSGN(I))=2 THEN▶1e◀= Z(RESPOS):=(Z(RESPOS) MOD 256)*256+Z(RESPOS) DIV 256;=" RESPOS:=RESPOS+1 "" END "" END "▶04◀END;▶04◀▶01◀ ▶01◀&PROCEDURE REXTRACT;(*RESPOS:ZONEADR*) &)(*UDTRÆK NØGLE AF POST , OG GEM I ZONEN*))▶06◀VAR I,▶06◀▶12◀ J,KP :INTEGER;▶12◀▶05◀BEGIN▶05◀▶1c◀ WITH FILEHEAD(CURRHEAD) DO▶1c◀$ FOR I:=1 TO KEYFLDS DO $$ BEGIN $$ KP:=KEYPOS(I)-1; $$ FOR J:=1 TO KEYLNG(I) DO $$ BEGIN $$ Z(RESPOS):=REC^(KP+J); $▶1e◀ IF ABS(KEYSGN(I))=2 THEN▶1e◀? Z(RESPOS):=(Z(RESPOS) MOD 256)*256 + Z(RESPOS) DIV 256;?$ RESPOS:=RESPOS+1 $$ END $$ END $▶04◀END;▶04◀▶01◀ ▶01◀6FUNCTION COMPARE;(*KEY1POS,KEY2POS:ZONEADR):INTEGER*) 6"(*SAMMENLIGNER TO NØGLER I ZONEN*)"▶06◀VAR I,▶06◀▶11◀ J,KP:INTEGER;▶11◀▶05◀BEGIN▶05◀▶08◀ KP:=0;▶08◀\r COMPARE:=0;\r▶1c◀ WITH FILEHEAD(CURRHEAD) DO▶1c◀3 FOR I:=1 TO KEYFLDS DO 33 BEGIN 33 FOR J:=KP TO KP+KEYLNG(I)-1 DO 33 IF Z(KEY1POS+J)<>Z(KEY2POS+J) THEN 33 BEGIN 33 IF Z(KEY1POS+J)>Z(KEY2POS+J) THEN 3/ COMPARE:=KEYSGN(I) ELSE // COMPARE:=-KEYSGN(I); /3 EXIT(COMPARE) 33 END; 33 KP:=KP+KEYLNG(I) 33 END 3▶04◀END;▶04◀▶06◀(*$P*)▶06◀KPROCEDURE COPSEGS;(*VAR F:ISF;SEGADR,WORDS,WORDADR:INTEGER;INOUT:ACCMODE*) K▶0e◀VAR I:INTEGER;▶0e◀▶05◀BEGIN▶05◀ (*$C-*) ▶13◀ IF INOUT=LÆS THEN▶13◀▶07◀ BEGIN▶07◀▶13◀ SEEK(F,SEGADR);▶13◀▶08◀ IOC;▶08◀
REPEAT
9 GET(F); 9
IOC;
9 IF WORDS>231 THEN 99 BEGIN 9' MOVELEFT(F^(1),Z(WORDADR),464);'9 (*FOR I:=1 TO 232 DO Z(WORDADR+I):=F^(I);*) 99 WORDADR:=WORDADR+232; 92 END ELSE MOVELEFT(F^(1),Z(WORDADR),2*WORDS);2: (*FOR I:=1 TO WORDS DO Z(WORDADR+I):=F^(I);*):9 WORDS:=WORDS-232 9▶11◀ UNTIL WORDS<1▶11◀
END ELSE
▶07◀ BEGIN▶07◀▶13◀ SEEK(F,SEGADR);▶13◀▶08◀ IOC;▶08◀
REPEAT
9 IF WORDS>231 THEN 99 BEGIN 9' MOVELEFT(Z(WORDADR),F^(1),464);'9 (*FOR I:=1 TO 232 DO F^(I):=Z(WORDADR+I);*) 99 WORDADR:=WORDADR+232; 92 END ELSE MOVELEFT(Z(WORDADR),F^(1),2*WORDS);2: (*FOR I:=1 TO WORDS DO F^(I):=Z(WORDADR+I);*):9 WORDS:=WORDS-232; 99 PUT(F); 9
IOC
▶11◀ UNTIL WORDS<1▶11◀▶05◀ END▶05◀ (*$C+*) ▶04◀END;▶04◀▶00◀▶00◀ 99 BEGIN 99 IER:=IORESULT; 99 EXIT(COPSEGS) 99 END 9▶11◀ UNTIL WORDS<1▶11◀▶05◀ END▶05◀▶04◀END;▶04◀▶00◀▶00◀cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc