home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 09_10 / tricks / ovrxms.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-06-06  |  4.5 KB  |  133 lines
  1. (* ------------------------------------------------------ *)
  2. (*                       OVRXMS.PAS                       *)
  3. (*     Auslagern von Overlays in den extended Memory      *)
  4. (*          (c) 1991 Dirk Schneider & TOOLBOX             *)
  5. (* ------------------------------------------------------ *)
  6. UNIT OvrXMS;
  7.  
  8. INTERFACE
  9.  
  10. CONST
  11.   ovrNoXMSDriver = -7;     { XMS-Treiber nicht installiert }
  12.   ovrNoXMSMemory = -8;     { nicht genügend Platz im EM    }
  13.  
  14.   PROCEDURE OvrInitXMS;
  15.  
  16. IMPLEMENTATION
  17.  
  18. USES
  19.   Overlay, XMS;
  20.  
  21. TYPE
  22.   OvrCtrl = RECORD      { Typ eines Overlay-Steuersegments }
  23.     int_3f   : INTEGER; { Befehl Int 3F                    }
  24.     Unterbr  : INTEGER; { Ret-Offset für Unterbrechung     }
  25.     CodePtr  : LONGINT; { Position in der OVR-Datei        }
  26.     LENGTH   : INTEGER; { Länge des Codes                  }
  27.     ReTablen : INTEGER; { Länge der Relokationtabelle      }
  28.     jmpcnt   : INTEGER; { Anzahl der Sprungvektoren        }
  29.     nextCode : WORD;    { Liste Steuerblöcke               }
  30.     Ldadr    : WORD;    { Lade-Segment                     }
  31.     stackOfs : WORD;    { StackOfs für Unterbrechung       }
  32.     nextload : WORD;    { Liste Steuerblöcke der gel. Unit }
  33.     EMS_Page : INTEGER; { EMS-Seitennummer                 }
  34.     EMS_Ofs  : WORD;    { EMS-Offset                       }
  35.     User1    : WORD;    { 6 Bytes sind frei                }
  36.     User2    : WORD;
  37.     User3    : WORD;
  38.     Vector   : ARRAY [0..1] OF ARRAY [1..4] OF BYTE;
  39.   END;                  { Vektoren für Init und 1. Routine }
  40.  
  41. VAR                     
  42.   CtrlPtr     : ^OvrCtrl;       { Zeiger auf Steuersegment }
  43.   OldExitProc : POINTER;        { Exit-Prozedur sichern    }
  44.  
  45.  
  46.   FUNCTION OwnOvrRead(OvrSeg : WORD) : INTEGER; FAR;
  47.     (* ersetzt Turbo Pascal's OvrRead *)
  48.   BEGIN
  49.     CtrlPtr := PTR(OvrSeg, 0);
  50.     WITH CtrlPtr^ DO
  51.       IF (NOT XMM_Move(PTR(Ldadr, 0), 0, NIL, User2,
  52.                        ((LENGTH+1) SHR 1) SHL 1)) THEN
  53.       OvrResult := ovrIOError ELSE OvrResult := ovrOK;
  54.     OwnOvrRead := OvrResult;               { Fehler zurück }
  55.   END;
  56.  
  57.   PROCEDURE OvrInitXMS;
  58.     (* kopiert Overlay Units in den ext. Memory *)
  59.   VAR
  60.     chain          : WORD;
  61.     error, OvrSize : INTEGER;
  62.   BEGIN
  63.     OvrSize := 0;
  64.     chain   := OVRCODELIST;
  65.     WHILE chain <> 0 DO BEGIN       { Liste der Steuerseg. }
  66.       CtrlPtr := PTR(chain+PREFIXSEG+$10, 0); { relokieren }
  67.       WITH CtrlPtr^ DO BEGIN
  68.         User1 := (LENGTH+1023) SHR 10;    { Größe in kByte }
  69.         INC(OvrSize, User1);          { Gesamtgröße merken }
  70.         chain := nextCode;
  71.       END;
  72.     END;
  73.     IF (NOT XMM_avail) THEN BEGIN     { XMS-Treiber inst. ?}
  74.       OvrResult := ovrNoXMSDriver;
  75.       Exit;
  76.     END ELSE IF (XMM_Memavail < OvrSize) THEN BEGIN
  77.       OvrResult := ovrNoXMSMemory;
  78.       Exit;
  79.     END;                              { reicht RAM ?       }
  80.     chain := OVRCODELIST;
  81.     WHILE chain <> 0 DO BEGIN
  82.       INC(chain, PREFIXSEG+$10);      { relokieren ...     }
  83.       CtrlPtr := PTR(chain, 0);
  84.       WITH CtrlPtr^ DO BEGIN
  85.         Ldadr := OVRHEAPORG;
  86.         User2 := XMM_Alloc(User1);    { Block im EM        }
  87.         IF (User2 = 0) THEN BEGIN
  88.           OvrResult := ovrNoXMSMemory;
  89.           Exit;
  90.         END;
  91.         error := OvrReadBuf(chain);   { Ovr-Unit lesen     }
  92.         IF error <> 0 THEN BEGIN
  93.           OvrResult := ovrIOError;
  94.           Exit;
  95.         END;
  96.         IF (NOT XMM_Move(NIL, User2, PTR(Ldadr, 0), 0,
  97.                        ((LENGTH+1) SHR 1) SHL 1)) THEN BEGIN
  98.           OvrResult := ovrIOError;
  99.           Exit;
  100.         END;
  101.         Ldadr := 0;               { Ladeadresse löschen    }
  102.         chain := nextCode;        { nächstes Steuersegment }
  103.       END;
  104.     END;
  105.     OvrReadBuf := OwnOvrRead;
  106.                                { neue OvrRead installieren }
  107.   END;
  108.  
  109.   PROCEDURE OvrExit; FAR;
  110.     (* gibt allokierte Blöcke im ext. Memory frei *)
  111.   VAR
  112.     chain : WORD;
  113.   BEGIN
  114.     chain := OVRCODELIST;
  115.     WHILE chain <> 0 DO BEGIN
  116.       INC(chain, PREFIXSEG+$10);
  117.       CtrlPtr := PTR(chain, 0);
  118.       IF NOT XMM_Free(CtrlPtr^.User2) THEN BEGIN
  119.         OvrResult := ovrIOError;
  120.         Exit;
  121.       END;
  122.       chain := CtrlPtr^.nextCode;
  123.     END;
  124.     EXITPROC := OldExitProc;        { alte Exit-Proc laden }
  125.   END;
  126.  
  127. BEGIN
  128.   OldExitProc := EXITPROC;
  129.   EXITPROC    := @OvrExit;
  130. END.
  131. (* ------------------------------------------------------ *)
  132. (*                  Ende von OVRXMS.PAS                   *)
  133.