DataMuseum.dk

top - download

    Length: 2496 (0x9c0)
    Types: TextFile
    Notes: Mikados_K
    Names: »FXCOMCOP.K«

└─⟦eb89399bc⟧ Bits:30008990 SOM ISFORIG, MEN KUN K-FILER
    └─⟦this⟧ »FXCOMCOP.K« 

Mikados K File

PROCEDURE EXTRACT(VAR ZO:ISFHEAD;VAR XREC,RESULT:AR;RECPOS,RESPOS:INTEGER);
VAR I,J,KP:INTEGER;
BEGIN
  WITH ZO DO
       FOR I:=1 TO KEYFLDS DO
       BEGIN
         KP:=KEYPOS(I)+RECPOS-2;
         FOR J:=1 TO KEYLNG(I) DO
         BEGIN
           RESULT(RESPOS):=XREC(KP+J);
           RESPOS:=RESPOS+1
         END
       END
END;
 
 
FUNCTION COMPARE(VAR ZO:ISFHEAD;VAR CKEY1,CKEY2:AR;KEY1POS,KEY2POS:INTEGER)
                 :INTEGER;
VAR I,J,KP:INTEGER;
BEGIN
  KP:=0;
  COMPARE:=0;
  WITH ZO DO
       FOR I:=1 TO KEYFLDS DO
       BEGIN
         FOR J:=KP TO KP+KEYLNG(I)-1 DO
           IF CKEY1(KEY1POS+J)<>CKEY2(KEY2POS+J) THEN
               BEGIN
                 IF CKEY1(KEY1POS+J)>CKEY2(KEY2POS+J) THEN
                       COMPARE:=KEYSGN(I) ELSE
                       COMPARE:=-KEYSGN(I);
                 EXIT(COMPARE)
               END;
         KP:=KP+KEYLNG(I)
       END
END;
PROCEDURE COPSEGS(*VAR Z:AR;VAR F:ISF;SEGADR,WORDS,WORDADR,INOUT:INTEGER*);
VAR I:INTEGER;
BEGIN
  WORDADR:=WORDADR-1;
  IF INOUT=LÆS THEN
  BEGIN
    SEEK(F,SEGADR);
    IER:=IORESULT;
    IF IER<>0 THEN EXIT(COPSEGS);
    REPEAT
       GET(F);
       IF IORESULT<>0 THEN
       BEGIN
         IER:=IORESULT;
         EXIT(COPSEGS)
       END;
       IF WORDS>231 THEN
       BEGIN
         FOR I:=1 TO 232 DO Z(WORDADR+I):=F^(I);
         WORDADR:=WORDADR+232;
       END ELSE FOR I:=1 TO WORDS DO Z(WORDADR+I):=F^(I);
       WORDS:=WORDS-232
    UNTIL WORDS<1
  END ELSE
  BEGIN
    SEEK(F,SEGADR);
    IER:=IORESULT;
    IF IER<>0 THEN EXIT(COPSEGS);
    REPEAT
       IF WORDS>231 THEN
       BEGIN
         FOR I:=1 TO 232 DO F^(I):=Z(WORDADR+I);
         WORDADR:=WORDADR+232;
       END ELSE FOR I:=1 TO WORDS DO F^(I):=Z(WORDADR+I);
       WORDS:=WORDS-232;
       PUT(F);
       IF IORESULT<>0 THEN
       BEGIN
         IER:=IORESULT;
         EXIT(COPSEGS)
       END
    UNTIL WORDS<1
  END
END;