paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-15 09:39:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ imported the global memory win16 api functions

Browse Source 
git-svn-id: trunk@31543 -
This commit is contained in:
nickysn 2015-09-05 22:56:02 +00:00
parent f751b18754
commit 1775725c26
2 changed files with 97 additions and 0 deletions

69
rtl/win16/winprocs.pp
View File

@ -109,6 +109,60 @@ function GetCurrentTask: HTASK; external 'KERNEL';
procedure Yield; external 'KERNEL';
procedure DirectedYield(Task: HTASK); external 'KERNEL';
{ Global memory management }
function GlobalDiscard(h: HGLOBAL): HGLOBAL; inline;
function GlobalAlloc(Flags: UINT; Bytes: DWORD): HGLOBAL; external 'KERNEL';
function GlobalReAlloc(Mem: HGLOBAL; Bytes: DWORD; Flags: UINT): HGLOBAL; external 'KERNEL';
function GlobalFree(Mem: HGLOBAL): HGLOBAL; external 'KERNEL';
function GlobalDosAlloc(Bytes: DWORD): DWORD; external 'KERNEL';
function GlobalDosFree(Selector: UINT): UINT; external 'KERNEL';
function GlobalLock(Mem: HGLOBAL): FarPointer; external 'KERNEL';
function GlobalUnlock(Mem: HGLOBAL): BOOL; external 'KERNEL';
function GlobalSize(Mem: HGLOBAL): DWORD; external 'KERNEL';
function GlobalHandle(Mem: UINT): DWORD; external 'KERNEL';
function GlobalFlags(Mem: HGLOBAL): UINT; external 'KERNEL';
function GlobalWire(Mem: HGLOBAL): FarPointer; external 'KERNEL';
function GlobalUnWire(Mem: HGLOBAL): BOOL; external 'KERNEL';
function GlobalPageLock(Selector: HGLOBAL): UINT; external 'KERNEL';
function GlobalPageUnlock(Selector: HGLOBAL): UINT; external 'KERNEL';
procedure GlobalFix(Mem: HGLOBAL); external 'KERNEL';
procedure GlobalUnfix(Mem: HGLOBAL); external 'KERNEL';
function GlobalLRUNewest(Mem: HGLOBAL): HGLOBAL; external 'KERNEL';
function GlobalLRUOldest(Mem: HGLOBAL): HGLOBAL; external 'KERNEL';
function GlobalCompact(MinFree: DWORD): DWORD; external 'KERNEL';
procedure GlobalNotify(NotifyProc: GNOTIFYPROC); external 'KERNEL';
function LockSegment(Segment: UINT): HGLOBAL; external 'KERNEL';
procedure UnlockSegment(Segment: UINT); external 'KERNEL';
function LockData(dummy: SmallInt): HGLOBAL; inline;
procedure UnlockData(dummy: SmallInt); inline;
function AllocSelector(Selector: UINT): UINT; external 'KERNEL';
function FreeSelector(Selector: UINT): UINT; external 'KERNEL';
function AllocDStoCSAlias(Selector: UINT): UINT; external 'KERNEL';
function PrestoChangoSelector(sourceSel, destSel: UINT): UINT; external 'KERNEL';
function GetSelectorBase(Selector: UINT): DWORD; external 'KERNEL';
function SetSelectorBase(Selector: UINT; Base: DWORD): UINT; external 'KERNEL';
function GetSelectorLimit(Selector: UINT): DWORD; external 'KERNEL';
function SetSelectorLimit(Selector: UINT; Base: DWORD): UINT; external 'KERNEL';
procedure LimitEmsPages(Kbytes: DWORD); external 'KERNEL';
procedure ValidateFreeSpaces; external 'KERNEL';
implementation
function LOBYTE(w: Word): Byte;
@ -161,4 +215,19 @@ begin
OFFSETOF:=LOWORD(LongInt(lp));
end;
function GlobalDiscard(h: HGLOBAL): HGLOBAL;
begin
GlobalDiscard := GlobalReAlloc(h, 0, GMEM_MOVEABLE);
end;
function LockData(dummy: SmallInt): HGLOBAL;
begin
LockData := LockSegment(UINT(-1));
end;
procedure UnlockData(dummy: SmallInt);
begin
UnlockSegment(UINT(-1));
end;
end.

28
rtl/win16/wintypes.pp
View File

@ -116,6 +116,34 @@ type
HTASK = THandle;
const
{ Global Memory Flags }
GMEM_FIXED = $0000;
GMEM_MOVEABLE = $0002;
GMEM_NOCOMPACT = $0010;
GMEM_NODISCARD = $0020;
GMEM_ZEROINIT = $0040;
GMEM_MODIFY = $0080;
GMEM_DISCARDABLE = $0100;
GMEM_NOT_BANKED = $1000;
GMEM_SHARE = $2000;
GMEM_DDESHARE = $2000;
GMEM_NOTIFY = $4000;
GMEM_LOWER = GMEM_NOT_BANKED;
GHND = GMEM_MOVEABLE or GMEM_ZEROINIT;
GPTR = GMEM_FIXED or GMEM_ZEROINIT;
{ GlobalFlags return flags (in addition to GMEM_DISCARDABLE) }
GMEM_DISCARDED = $4000;
GMEM_LOCKCOUNT = $00FF;
{ Low system memory notification message }
WM_COMPACTING = $0041;
type
GNOTIFYPROC = function(hGlbl: HGLOBAL): BOOL; far;
implementation
end.