IN307%DHAFEU11.BITNET@cunyvm.cuny.edu ( Peter Sawatzki) (05/03/91)
I don't know if this topic was discussed before so here is
a simple unit that shows how to handle HUGE global memory
blocks in Turbo Pascal for Windows:
$A+,B-,I-,N-,R-,S-,V-,W+,X+
Unit HugeMem;
HugeMem - manage huge global memory blocks
written by Peter Sawatzki <IN307DHAFEU11>
(c) 1-May-1991 ver.0.1
Interface
Uses
WinTypes,
WinProcs;
Procedure hRead (Var aFile: File; aHandle: THandle; Size: LongInt);
Procedure hWrite (Var aFile: File; aHandle: THandle; Size: LongInt);
Procedure hMove (srcHandle, dstHandle: THandle; Size: LongInt);
Procedure hFillChar (aHandle: THandle; Size: LongInt; aByte: Byte);
Procedure hPutByte (aHandle: THandle; aByte: Byte; aLoc: LongInt);
Function hByteAt (aHandle: THandle; aLoc: LongInt): Byte;
NOTE: all procedures operate on unlocked memory blocks. Easily one can
add procedures to operate on locked memory blocks e.g. on Pointers, but
one must be careful not to cross segment boundaries. For example a
Move (x^,y^,$8000) will fail, if Word(x)>=$8001 |||||
Implementation
Const
MaxBlock = $10000 Div 2; - n Blocks *must* fit in a 64k Segment
procedure AHIncr; far; external 'KERNEL' index 114; magic function
procedure AHShift; far; external 'KERNEL' index 113; dito
-hrw: read/write huge amount of data:
aFile - File to read from/write to
aHandle - Handle to memory block of at least Size bytes memory
Size - number of bytes to transfer
rflag - read from file if True, write to file if False
procedure hrw(Var aFile: File; aHandle: THandle; Size: LongInt; rflag: Boolean);
var
Count: Word;
anAddr: Pointer;
begin
anAddr:= GlobalLock(aHandle);
while Size > 0 do begin
if Size>MaxBlock Then
Count:= MaxBlock
Else
Count:= Word(Size);
If rflag Then
BlockRead(aFile, anAddr^, Count)
Else
BlockWrite(aFile,anAddr^, Count);
Dec(Size,Count);
Asm
Mov Ax,Count
Add Word Ptr anAddr,Ax
Jnc 1
Add Word Ptr anAddr+2,OFFSET AHIncr
1:
End;
end;
GlobalUnlock(aHandle);
end;
Procedure hread(Var aFile: File; aHandle: THandle; Size: LongInt);
Begin
hrw(aFile,aHandle,Size,True)
End;
Procedure hwrite(Var aFile: File; aHandle: THandle; Size: LongInt);
Begin
hrw(aFile,aHandle,Size,False)
End;
-hMove: copy Size bytes from memory block srcHandle to dstHandle
Procedure hMove (srcHandle, dstHandle: THandle; Size: LongInt);
Var
srcAdr, dstAdr: Pointer;
Count: Word;
Begin
srcAdr:= GlobalLock(srcHandle);
dstAdr:= GlobalLock(dstHandle);
While Size>0 Do Begin
If Size>MaxBlock Then
Count:= MaxBlock
Else
Count:= Word(Size);
Move(srcAdr^,dstAdr^,Count);
Dec(Size,Count);
Asm
Mov Ax,Count
Add Word Ptr srcAdr,Ax
Jnc 1
Add Word Ptr srcAdr+2,OFFSET AHIncr
1:Add Word Ptr dstAdr,Ax
Jnc 2
Add Word Ptr dstAdr+2,OFFSET AHIncr
2:
End;
End;
GlobalUnlock(srcHandle);
GLobalUnlock(dstHandle);
End;
-hFillChar: fill memory block with aByte
Procedure hFillChar (aHandle: THandle; Size: LongInt; aByte: Byte);
Var
anAddr: Pointer;
Count: Word;
Begin
anAddr:= GlobalLock(aHandle);
While Size>0 Do Begin
If Size>MaxBlock Then
Count:= MaxBlock
Else
Count:= Word(Size);
FillChar(anAddr^,Count,aByte);
Dec(Size,Count);
Asm
Mov Ax,Count
Add Word Ptr anAddr,Ax
Jnc 1
Add Word Ptr anAddr+2,OFFSET AHIncr
1:
End;
End;
GlobalUnlock(aHandle);
End;
Procedure hPutByte (aHandle: THandle; aByte: Byte; aLoc: LongInt);
Var
anAddr: Pointer;
Begin
anAddr:= GlobalLock(aHandle);
Asm
Mov Ax,Word Ptr aLoc
Add Word Ptr anAddr,Ax Mov would work as well|
Mov Ax,Word Ptr aLoc+2
Mov Cx,OFFSET AHShift
Shl Ax,Cl Calculate segment
Add Word Ptr anAddr+2,Ax
End;
Byte(anAddr^):= aByte;
GlobalUnlock(aHandle);
End;
Function hByteAt (aHandle: THandle; aLoc: LongInt): Byte;
Var
anAddr: Pointer;
Begin
anAddr:= GlobalLock(aHandle);
Asm
Mov Ax,Word Ptr aLoc
Add Word Ptr anAddr,Ax Mov would work as well|
Mov Ax,Word Ptr aLoc+2
Mov Cx,OFFSET AHShift
Shl Ax,Cl Calculate segment
Add Word Ptr anAddr+2,Ax
End;
hByteAt:= Byte(anAddr^);
GlobalUnlock(aHandle);
End;
End.
(* simple program to test Unit HugeMem *)
Program HugeTest;
Uses
HugeMem,
WinProcs,
WinTypes,
WinCrt;
Procedure Error (Msg: String);
Begin
WriteLn('Error: ',Msg);
Halt(1)
End;
Var
f: File;
Handle1,
Handle2: THandle;
Flen,i: LongInt;
Begin
Assign(f,'c:tpwtpw.exe');
Reset(f,1);
FLen:= FileSize(f);
Handle1:= GlobalAlloc(gmem_Moveable,Flen);
If Handle1=0 Then Error('Not enaugh memory for file|');
WriteLn('Reading file...');
HugeMem.hRead(f,Handle1,FLen);
Close(f);
Handle2:= GlobalAlloc(gmem_Moveable,FLen);
If Handle2=0 Then Error('Not enaugh memory to test hmove');
WriteLn('Moving...');
HugeMem.hmove(Handle1,Handle2,FLen);
WriteLn('Writing data to "test.out"...');
Assign(f,'test.out');
ReWrite(f,1);
HugeMem.hWrite(f,Handle2,FLen);
Close(f);
GlobalFree(Handle1);
GlobalFree(Handle2);
- test hFillChar and hPutByte
Handle1:= GlobalAlloc(gmem_Moveable,100*1024);
If Handle1=0 Then Error('allocating fillchar buffer');
WriteLn('hFillChar...');
HugeMem.hFillChar(Handle1,GlobalSize(Handle1),Byte('t'));
WriteLn('hPutByte...');
i:= 0;
Repeat
hPutByte(Handle1,13,i);
hPutByte(Handle1,10,i+1);
Inc(i,72);
Until i>99*1024;
WriteLn('Writing text file...');
Assign(f,'test.txt'); ReWrite(f,1);
HugeMem.hWrite(f,Handle1,GlobalSize(Handle1));
GlobalFree(Handle1);
WriteLn('Done.');
End.
:::::::::::::::::::::::::::::::::::::::::
: Peter Sawatzki <IN307DHAFEU11.BITNET> :
:::::::::::::::::::::::::::::::::::::::::