CVS freexp

[CVS User mw]

Update of /server/cvs/freexp
In directory m6s15:/tmp/cvs-serv1720

Modified Files:
        xpx.pas 
Added Files:
        umb_heap.pas 
Removed Files:
        umbheap.pas 
Log Message:
MW: - UMBHEAP ist derzeit inaktiv udn auch UMB-Overlays, da beides
      nicht funktioniert. 
      (UMBHEAP stuerzt ab, UMBOverlays sind funktionslos)


--- /server/cvs/freexp/xpx.pas  2009/05/24 19:40:59     1.48
+++ /server/cvs/freexp/xpx.pas  2009/05/24 19:46:19     1.49
@@ -8,7 +8,7 @@
 { Die Nutzungsbedingungen fuer diesen Quelltext finden Sie in der }
 { Datei SLIZENZ.TXT oder auf www.crosspoint.de/oldlicense.html.   }
 { --------------------------------------------------------------- }
-{ $Id: xpx.pas,v 1.48 2009/05/24 19:40:59 mw Exp $ }
+{ $Id: xpx.pas,v 1.49 2009/05/24 19:46:19 mw Exp $ }
 
 { CrossPoint - First Unit }
 
@@ -19,7 +19,7 @@
 interface
 
 uses
-  ems, xms, overxms,umbheap, crt, 
dos,dosx,typeform,fileio,mouse,inout,xp0,crc,xpglobal, mcb,compdate,timemark;
+  ems, xms, overxms, crt, 
dos,dosx,typeform,fileio,mouse,inout,xp0,crc,xpglobal, mcb,compdate,timemark;
 
 implementation
 
@@ -382,13 +382,17 @@
     end;
   UpString(ownpath);
   TestCD;
-  Extend_Heap;
   starting:=false;
 end.
 
 {
   $Log: xpx.pas,v $
-  Revision 1.48  2009/05/24 19:40:59  mw
+  Revision 1.49  2009/05/24 19:46:19  mw
+  MW: - UMBHEAP ist derzeit inaktiv udn auch UMB-Overlays, da beides
+        nicht funktioniert.
+        (UMBHEAP stuerzt ab, UMBOverlays sind funktionslos)
+
+  Revision 1.48  2009-05-24 19:40:59  mw
   *** empty log message ***
 
   Revision 1.47  2009-05-24 19:38:54  mw

--- /server/cvs/freexp/umb_heap.pas     2009/05/24 19:46:19     NONE
+++ /server/cvs/freexp/umb_heap.pas     2009/05/24 19:46:19     1.1
{ --------------------------------------------------------------- }
{ Dieser Quelltext ist urheberrechtlich geschuetzt.               }
{ (c) 2009 FreeXP, http://www.freexp.de                           }
{ CrossPoint ist eine eingetragene Marke von Peter Mandrella.     }
{                                                                 }
{ Die Nutzungsbedingungen fuer diesen Quelltext finden Sie in der }
{ Datei SLIZENZ.TXT oder auf www.crosspoint.de/oldlicense.html.   }
{ --------------------------------------------------------------- }
{ $Id: umb_heap.pas,v 1.1 2009/05/24 19:46:19 mw Exp $ }
Unit
  UMB_Heap;

Interface

Const
  Max_Blocks      = 4;

Type
  UMBDataType = Array[1..Max_Blocks] Of Word;

Procedure Extend_Heap;
Procedure GetBlockSizes(Var US : UMBDataType);

Implementation

Type
  PFreeRec        = ^TFreeRec;
  TFreeRec        = Record
    Next          : PFreeRec;
    Size          : Pointer;
  End;

Var
  Block_Segments  : UMBDataType;
  Block_Sizes     : UMBDataType;
  SaveExitProc    : Pointer;

Function UMB_Driver_Present : Boolean;

Var
  Flag            : Boolean;

Begin
  Flag := False;
  Asm
    Mov   AX, $4300
    Int   $2F
    CMP   AL, $80
    JNE   @Done
    Inc   [Flag]
  @Done:
  End;
  UMB_Driver_Present := Flag;
End;

Procedure Allocate_UMB;

Var
  I,
  Save_Strategy,
  Block_Segment,
  Block_Size      : Word;

Begin
  For I := 1 To Max_Blocks Do
    Begin
      Block_Segments[I] := 0;
      Block_Sizes[I] := 0;
    End;
  Asm
    Mov   AX, $5801
    Mov   BX, $0FFFF
    Int   $21
    Mov   AX, $5803
    Mov   BX, $0001
    Int   $21
  End;
  For I := 1 To Max_Blocks Do
    Begin
      Block_Segment := 0;
      Block_Size := 0;
      Asm
        Mov   AX, $4800
        Mov   BX, $0FFFF
        Int   $21
        CMP   BX, 0
        JE    @Fail
        Mov   AX, $4800
        Int   $21
        JC    @Fail
        Mov   [Block_Segment], AX
        Mov   [Block_Size], BX
      @Fail:
      End;
      Block_Segments[I] := Block_Segment;
      Block_Sizes[I] := Block_Size;
    End;
End;

Procedure Release_UMB; Far;

Var
  I,
  Segment : Word;

Begin
  ExitProc := SaveExitProc;
  Asm
    Mov   AX, $5803
    Mov   BX, $0000
    Int   $21
  End;
  For I := 1 To Max_Blocks Do
    Begin
      Segment := Block_Segments[I];
      If (Segment > 0) Then
        Asm
          Mov   AX, $4901
          Mov   BX, [Segment]
          Mov   ES, BX
          Int   $21
        End;
    End;
End;

Function Pointer_To_LongInt(p : Pointer) : LongInt;

Type
  PtrRec          = Record
    Lo, Hi        : Word;
  End;

Begin
  Pointer_To_LongInt := LongInt(PtrRec(P).Hi * 16 + PtrRec(P).Lo);
End;

Procedure Extend_Heap;

Var
  I               : Word;
  Temp            : PFreeRec;

Begin
  If UMB_Driver_Present then
    Begin
      Allocate_UMB;
      Temp := HeapPtr;
      I := 1;
      While ((Block_Sizes[I] > 0) And
             (I <= Max_Blocks)) Do
        Begin
          Temp^.Next := Ptr(Block_Segments[I], 0);
          Temp       := Temp^.Next;
          Temp^.Next := HeapPtr;
          Move(Block_Sizes[I], Temp^.Size, SizeOf(Word));
          Temp^.Size := Pointer(LongInt(Temp^.Size) SHL 16);
          Inc(I);
        End;
      If (Block_Sizes[1] > 0) then
        FreeList := Ptr(Block_Segments[1], 0);
    End;
End;

Procedure GetBlockSizes(Var US : UMBDataType);

Begin
  US := Block_Sizes;
End;

Begin
  FillChar(Block_Sizes, SizeOf(Block_Sizes), 0);
  SaveExitProc := ExitProc;
  ExitProc := @Release_UMB;
End.

{
  $Log: umb_heap.pas,v $
  Revision 1.1  2009/05/24 19:46:19  mw
  MW: - UMBHEAP ist derzeit inaktiv udn auch UMB-Overlays, da beides
        nicht funktioniert.
        (UMBHEAP stuerzt ab, UMBOverlays sind funktionslos)

}

------------------------------------------------------------------------
FreeXP CVS-Mailingliste
CVS-List@freexp.de
http://www.freexp.de/cgi-bin/mailman/listinfo/cvs-list