paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-17 19:49:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ add functions that abstract working with virtual memory across targets for use with callbacks (for now only Windows is implemented; *nix targets should come next)

Browse Source 
git-svn-id: trunk@40701 -
This commit is contained in:
svenbarth 2018-12-29 19:21:23 +00:00
parent 30b1a45704
commit 147dd4021d
2 changed files with 39 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
packages/rtl-objpas/src/inc/rtti.pp
View File

@ -542,6 +542,9 @@ resourcestring
implementation
uses
{$ifdef windows}
Windows,
{$endif}
fgl;
type
@ -701,6 +704,40 @@ var
GRttiPool : TRttiPool;
FuncCallMgr: TFunctionCallManagerArray;
function AllocateMemory(aSize: PtrUInt): Pointer;
begin
{$IF DEFINED(WINDOWS)}
Result := VirtualAlloc(Nil, aSize, MEM_RESERVE or MEM_COMMIT, PAGE_READWRITE);
{$ELSE}
Result := GetMem(aSize);
{$ENDIF}
end;
function ProtectMemory(aPtr: Pointer; aSize: PtrUInt; aExecutable: Boolean): Boolean;
{$IF DEFINED(WINDOWS)}
var
oldprot: DWORD;
{$ENDIF}
begin
{$IF DEFINED(WINDOWS)}
if aExecutable then
Result := VirtualProtect(aPtr, aSize, PAGE_EXECUTE_READ, oldprot)
else
Result := VirtualProtect(aPtr, aSize, PAGE_READWRITE, oldprot);
{$ELSE}
Result := True;
{$ENDIF}
end;
procedure FreeMemory(aPtr: Pointer);
begin
{$IF DEFINED(WINDOWS)}
VirtualFree(aPtr, 0, MEM_RELEASE);
{$ELSE}
FreeMem(aPtr);
{$ENDIF}
end;
function CCToStr(aCC: TCallConv): String; inline;
begin
WriteStr(Result, aCC);
@ -1719,7 +1756,7 @@ begin
end;
tkBool : begin
case GetTypeData(ATypeInfo)^.OrdType of
otUByte: result.FData.FAsSByte := ShortInt(PBoolean(ABuffer)^);
otUByte: result.FData.FAsSByte := ShortInt(System.PBoolean(ABuffer)^);
otUWord: result.FData.FAsUWord := Byte(PBoolean16(ABuffer)^);
otULong: result.FData.FAsULong := SmallInt(PBoolean32(ABuffer)^);
otUQWord: result.FData.FAsUInt64 := QWord(PBoolean64(ABuffer)^);

2
packages/rtl-objpas/src/x86_64/invoke.inc
View File

@ -235,7 +235,7 @@ begin
end;
tkBool: begin
case td^.OrdType of
otUByte: val := ShortInt(PBoolean(aArgs[i].ValueRef)^);
otUByte: val := ShortInt(System.PBoolean(aArgs[i].ValueRef)^);
otUWord: val := Byte(PBoolean16(aArgs[i].ValueRef)^);
otULong: val := SmallInt(PBoolean32(aArgs[i].ValueRef)^);
otUQWord: val := QWord(PBoolean64(aArgs[i].ValueRef)^);