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 } ------------------------------------------------------------------------ FreeXP CVS-Mailingliste CVS-List@freexp.de http://www.freexp.de/cgi-bin/mailman/listinfo/cvs-list