Power-Programmierung/CD1.mdf/pascal/library/dos/grafik/vgakit/gif/source/parray.pas

Pascal/Delphi Source File | 1991-09-25 | 5.8 KB | 245 lines

UNIT PARRAY;
{$F+}
{
  DIESE UNIT DIENT DAZU, EIN GROßES 1- DIMENSIONALES ARRAY ZU ERMÖGLICHEN,
  DAS ZUERST AUF DEM HEAP ANGELEGT WIRD UND INS EMS ÜBERLÄUFT.
  IM GEGENSATZ ZU DEN GROßEN ARRAYS VON TURBO PROFESSIONAL WIRD EIN
  WESENTLICH SCHNELLERER ZUGRIFF ERZIELT, WEIL NICHT ARRAYINHALTE MIT DEM
  HAUPTPROGRAMM AUSGETAUSCHT WERDEN SONDERN POINTER.
}

INTERFACE


USES  TPEMS,TPSTRING;


TYPE  BYTEARR    = ARRAY[0..1] OF BYTE;
      BYTEARRPTR = ^BYTEARR;
      PTRARRAY   = ARRAY[0..1] OF BYTEARRPTR;


FUNCTION  PARRINIT(ROWS,SIZE:WORD;FREEHEAP:LONGINT):WORD;
PROCEDURE PARRNEW(VAR P:PTRARRAY;ROW:WORD);
PROCEDURE PARRPTR(VAR P:PTRARRAY;ROW:WORD);
PROCEDURE PARRPTR2(VAR P:PTRARRAY;ROW:WORD);
PROCEDURE PARRDISPOSE(VAR P:PTRARRAY);
PROCEDURE PASWAPOUT(VAR P:PTRARRAY;NAME:STRING);
PROCEDURE PASWAPIN(VAR P:PTRARRAY;NAME:STRING;LOESCHE:BOOLEAN);
PROCEDURE PARRZEIGEDATEN;


IMPLEMENTATION


TYPE  SOF = RECORD O,S : WORD; END;


CONST EMSINUSE : BOOLEAN = FALSE;


VAR   INEMS    : WORD; { ERSTES ARRAY- ELEMENT IM EMS }
      EP1,EP2  : WORD;
      ES1,ES2  : WORD;
      USEEMS   : BOOLEAN;
      EMSH     : WORD;    { EMS HANDLE }
      EMSROWS  : WORD;
      ROWSIZE  : WORD;
      RR,AR    : WORD;

      EXITSAVE : POINTER;


FUNCTION  PARRINIT(ROWS,SIZE:WORD;FREEHEAP:LONGINT):WORD;
VAR   AVPAGES  : WORD;
      EMSP     : POINTER; { PAGEFRAMEPOINTER }
      L        : LONGINT;
BEGIN
  RR      := ROWS;
  USEEMS  := FALSE;
  EMSROWS := 0;
  EP1     := $FFFF;
  EP2     := $FFFF;
  ROWSIZE := SIZE;
  IF (MAXAVAIL - FREEHEAP) > LONGINT(LONGINT(SUCC(ROWS)) * LONGINT(SIZE))
    THEN BEGIN
{ ALLES PASST AUF DEN HEAP }
    INEMS := ROWS;
    PARRINIT := ROWS;
    AR       := ROWS;
  END ELSE BEGIN
{ EIN TEIL MUß INS EMS }
    INEMS := (MAXAVAIL - FREEHEAP) DIV SIZE;
    IF EMSINSTALLED THEN BEGIN
      USEEMS     := TRUE;
      EMSP       := EMSPAGEFRAMEPTR;
      ES1        := SOF(EMSP).S;
      ES2        := ES1 + $800;
      AVPAGES    := EMSPAGESAVAIL;
      EMSH       := ALLOCATEEMSPAGES(AVPAGES);
      EMSINUSE   := TRUE;
      IF SAVEEMSCONTEXT(EMSH) THEN {};
      L := LONGINT(AVPAGES) SHL 14;
      IF L > (LONGINT(ROWS - INEMS) * LONGINT(SIZE)) THEN BEGIN
        PARRINIT := ROWS;
        AR       := ROWS;
        EMSROWS  := ROWS - PRED(INEMS);
      END ELSE BEGIN
        EMSROWS  := L DIV SIZE;
        PARRINIT := INEMS + EMSROWS;
        AR       := INEMS + EMSROWS;
      END;
    END ELSE BEGIN
{ KEIN EMS VORHANDEN }
      PARRINIT := PRED(INEMS);
    END;
  END;
END; { PARRINIT }


PROCEDURE PARRNEW(VAR P:PTRARRAY;ROW:WORD);
VAR   LP  : WORD;
      AA  : LONGINT;
BEGIN
  IF ROW < INEMS THEN BEGIN
{ SPEICHER AUF DEM HEAP ALLOKIEREN }
    GETMEM(P[ROW],ROWSIZE);
  END ELSE BEGIN
{ SPEICHER IM EMS ALLOKIEREN }
    AA := (LONGINT(ROW - INEMS) * LONGINT(ROWSIZE));
    LP := AA SHR 14;
    IF EP1 <> LP THEN BEGIN
      EP1 := LP;
      IF MAPEMSPAGE(EMSH,EP1,0) THEN {};
      IF MAPEMSPAGE(EMSH,SUCC(EP1),1) THEN {};
    END;
    P[ROW] := PTR(ES1,AA AND $3FFF);
  END;
END; { PARRNEW }


PROCEDURE PARRPTR(VAR P:PTRARRAY;ROW:WORD);
VAR   LP  : WORD;
BEGIN
  IF ROW >= INEMS THEN BEGIN
{ POINTER EMS ERMITTELN }
    LP := (LONGINT(ROW - INEMS) * LONGINT(ROWSIZE)) SHR 14;
    IF EP1 <> LP THEN BEGIN
      EP1 := LP;
      IF MAPEMSPAGE(EMSH,EP1,0) THEN {};
      IF MAPEMSPAGE(EMSH,SUCC(EP1),1) THEN {};
    END;
    SOF(P[ROW]).S := ES1;
  END;
END; { PARRPTR }


PROCEDURE PARRPTR2(VAR P:PTRARRAY;ROW:WORD);
VAR   LP  : WORD;
BEGIN
  IF ROW >= INEMS THEN BEGIN
{ POINTER EMS ERMITTELN }
    LP := (LONGINT(ROW - INEMS) * LONGINT(ROWSIZE)) SHR 14;
    IF EP2 <> LP THEN BEGIN
      EP2 := LP;
      IF MAPEMSPAGE(EMSH,EP2,2) THEN {};
      IF MAPEMSPAGE(EMSH,SUCC(EP2),3) THEN {};
    END;
    SOF(P[ROW]).S := ES2;
  END;
END; { PARRPTR2 }


PROCEDURE PARRDISPOSE(VAR P:PTRARRAY);
VAR   I  : WORD;
BEGIN
  FOR I := 0 TO PRED(INEMS) DO BEGIN
    IF P[I] <> NIL THEN FREEMEM(P[I],ROWSIZE);
    P[I] := NIL;
  END;
  IF USEEMS THEN BEGIN
    IF RESTOREEMSCONTEXT(EMSH) THEN {};
    IF DEALLOCATEEMSHANDLE(EMSH) THEN {};
    EMSINUSE := FALSE;
  END;
END; { PARRDISPOSE }


PROCEDURE PASWAPOUT(VAR P:PTRARRAY;NAME:STRING);
VAR   I  : WORD;
      F  : FILE;
BEGIN
{$I-}
  ASSIGN(F,NAME);
  REWRITE(F,1);
  IF IORESULT = 0 THEN BEGIN
    FOR I := 0 TO PRED(INEMS) DO BEGIN
      IF P[I] <> NIL THEN BEGIN
        BLOCKWRITE(F,P[I]^,ROWSIZE);
        FREEMEM(P[I],ROWSIZE);
        P[I] := NIL;
      END;
    END; { NEXT I }
    CLOSE(F);
  END;
{$I+}
END; { PASWAPOUT }


PROCEDURE PASWAPIN(VAR P:PTRARRAY;NAME:STRING;LOESCHE:BOOLEAN);
VAR   I,W  : WORD;
      F    : FILE;
BEGIN
{$I-}
  ASSIGN(F,NAME);
  RESET(F,1);
  IF IORESULT = 0 THEN BEGIN
    FOR I := 0 TO PRED(INEMS) DO BEGIN
      IF NOT EOF(F) THEN BEGIN
        GETMEM(P[I],ROWSIZE);
        BLOCKREAD(F,P[I]^,ROWSIZE,W);
      END;
    END; { NEXT I }
    CLOSE(F);
    IF LOESCHE THEN ERASE(F);
  END;
{$I+}
END; { PASWAPIN }


PROCEDURE PARRZEIGEDATEN;
BEGIN
  WRITELN;
  WRITELN(ROWSIZE:10,LONGINT(ROWSIZE) * LONGINT(INEMS):10,MAXAVAIL:10);
  WRITELN(RR:6,AR:6,INEMS:6,EMSROWS:6,USEEMS:6,EMSH:6);
  WRITELN(HEXW(EP1),'  ',HEXW(EP2),'  ',HEXW(ES1),'  ',HEXW(ES2));
(*
VAR   INEMS    : WORD; { ERSTES ARRAY- ELEMENT IM EMS }
      EP1,EP2  : WORD;
      ES1,ES2  : WORD;
      USEEMS   : BOOLEAN;
      EMSH     : WORD;    { EMS HANDLE }
      EMSROWS  : WORD;
      ROWSIZE  : WORD;
*)
END;


PROCEDURE NEWEXIT;
BEGIN
  IF EMSINUSE THEN BEGIN
    IF RESTOREEMSCONTEXT(EMSH) THEN {};
    IF DEALLOCATEEMSHANDLE(EMSH) THEN {};
  END;
  EXITPROC := EXITSAVE;
END; { NEWEXIT }


BEGIN
  EXITSAVE := EXITPROC;
  EXITPROC := @NEWEXIT;
END.