DataMuseum.dk

top - download

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

└─⟦6b1c9961a⟧ Bits:30008989 INDPERM P1
    └─⟦this⟧ »FINDPOST.K« 

Mikados K File

PROCEDURE FINDPOST(VAR ZO:ISFHEAD;VAR F:ISF;VAR REC:AR);
VAR NUM,I,X,PEG:INTEGER;
BEGIN
  WITH ZO DO
  BEGIN
    EXTRACT(ZO,REC,Z,1,KEY1);
    X:=-1;
    I:=1;
    REPEAT
      IF Z((I-1)*ENTRYSIZE+2)>0 THEN
      BEGIN
        PEG:=I;
        X:=COMPARE(ZO,Z,Z,(I-1)*ENTRYSIZE+3,KEY1)
      END;
      I:=I+1
    UNTIL (I>NBUC) OR (X>=0);
    IF X<0 THEN
    BEGIN
      READTABLE(ZO,F,PEG);
      IF IER<>0 THEN EXIT(FINDPOST);
      FOR PEG:=BLKPRBUC DOWNTO 1 DO
      IF Z((PEG-1)*ENTRYSIZE+BLT+1)>0 THEN
      BEGIN
        READBLOCK(ZO,F,PEG,1);
        IF IER<>0 THEN EXIT(FINDPOST);
        BLKENTRY:=1+Z((PEG-1)*ENTRYSIZE+BLT+1);
        IER:=-1;
        EXIT(FINDPOST)
      END;
      WRITE('KATASTROFE 1 FINDPOST');
      I:=I DIV 0
    END ELSE
    BEGIN
      READTABLE(ZO,F,PEG);
      IF IER<>0 THEN EXIT(FINDPOST);
      I:=BLT+1;
      PEG:=0;
      X:=-1;
      REPEAT
        IF PEG=BLKPRBUC THEN BEGIN WRITELN('KATASTROFE 3');I:=I DIV 0 END;
        NUM:=Z(I);
        PEG:=PEG+1;
        IF NUM>0 THEN
        BEGIN
          X:=COMPARE(ZO,Z,Z,I+1,KEY1);
          IF X>=0 THEN
          BEGIN
            READBLOCK(ZO,F,PEG,1);
            IF IER<>0 THEN EXIT(FINDPOST)
          END
        END;
        I:=I+ENTRYSIZE
      UNTIL X>=0;
      I:=0;
      REPEAT
        I:=I+1;
        IF I>NUM THEN
        BEGIN
          WRITELN(LIST,'KATASTROFE 2 ',RECSIZE:5,REC(1):8,REC(2):8,REC(3):8);
          WRITELN(LIST,'I,NUM ',I:3,NUM:3);
          WRITELN(LIST,Z(BLK+(I-2)*RECSIZE):8,Z(BLK+1+(I-2)*RECSIZE):8);
          FOR I:=1 TO 25 DO
            WRITELN(LIST,Z(BLK+(I-1)*RECSIZE):8,Z(BLK+1+(I-1)*RECSIZE):8,
                    Z(BLK+2+(I-1)*RECSIZE):8);
            I:=I DIV 0
        END;
        EXTRACT(ZO,Z,Z,BLK+(I-1)*RECSIZE,KEY2);
        X:=COMPARE(ZO,Z,Z,KEY2,KEY1)
      UNTIL X>=0;
      IF X=0 THEN IER:=0 ELSE IER:=-1;
      BLKENTRY:=I
    END
  END
END;