CVS freexp
CVS User mw
cvs-list at freexp.de
Son Mai 24 21:38:54 CEST 2009
Update of /server/cvs/freexp
In directory m6s15:/tmp/cvs-serv31223
Modified Files:
xpx.pas
Added Files:
umbheap.pas
Log Message:
MW: - UMBHeap
--- /server/cvs/freexp/xpx.pas 2009/05/17 10:25:41 1.46
+++ /server/cvs/freexp/xpx.pas 2009/05/24 19:38:54 1.47
@@ -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.46 2009/05/17 10:25:41 mw Exp $ }
+{ $Id: xpx.pas,v 1.47 2009/05/24 19:38:54 mw Exp $ }
{ CrossPoint - First Unit }
@@ -19,7 +19,7 @@
interface
uses
- ems, xms, overxms,ovrumb, 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
@@ -362,7 +362,6 @@
emsovrbuf:=false;
end;
OvrSetBuf(OvrGetBuf+50000); { > CodeSize(MASKE.TPU) }
- OvrMovBufToUMB;
{$ENDIF}
logo;
InitWinVersion;
@@ -383,12 +382,16 @@
end;
UpString(ownpath);
TestCD;
+ Extend_Heap;
starting:=false;
end.
{
$Log: xpx.pas,v $
- Revision 1.46 2009/05/17 10:25:41 mw
+ Revision 1.47 2009/05/24 19:38:54 mw
+ MW: - UMBHeap
+
+ Revision 1.46 2009-05-17 10:25:41 mw
MW: - Overlay-Buffer im UMB
Revision 1.45 2009-05-17 07:30:44 mw
--- /server/cvs/freexp/umbheap.pas 2009/05/24 19:38:54 NONE
+++ /server/cvs/freexp/umbheap.pas 2009/05/24 19:38:54 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: umbheap.pas,v 1.1 2009/05/24 19:38:54 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: umbheap.pas,v $
Revision 1.1 2009/05/24 19:38:54 mw
MW: - UMBHeap
}
Mehr Informationen über die CVS-List Mailingliste