diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml
index dd6a61698..e8d8f56ef 100644
--- a/.github/workflows/build.yml
+++ b/.github/workflows/build.yml
@@ -38,13 +38,13 @@ jobs:
test: Simba-Linux64
- name: MacOS 64
- runs-on: macos-latest
+ runs-on: macos-13
build-mode: MACOS64
binary: Simba-MacOS.dmg
test: Simba
- name: MacOS AArch64
- runs-on: macos-14
+ runs-on: macos-13
build-mode: MACOS-AARCH64
binary: Simba-MacOS-AArch64.dmg
#test: Simba MatchTemplateMask test fails, investigate later
@@ -96,15 +96,15 @@ jobs:
P12_PASSWORD: ${{ secrets.P12_PASSWORD }}
KEYCHAIN_PASSWORD: ${{ secrets.KEYCHAIN_PASSWORD }}
run: |
- echo -n "$BUILD_CERTIFICATE_BASE64" | base64 --decode --output certificate.p12
- security create-keychain -p "$KEYCHAIN_PASSWORD" build.keychain
- security default-keychain -s build.keychain
- security unlock-keychain -p "$KEYCHAIN_PASSWORD" build.keychain
- security import certificate.p12 -k build.keychain -P "$P12_PASSWORD" -T /usr/bin/codesign
- security set-key-partition-list -S apple-tool:,apple:,codesign: -s -k "$KEYCHAIN_PASSWORD" build.keychain
+ # echo -n "$BUILD_CERTIFICATE_BASE64" | base64 --decode --output certificate.p12
+ # security create-keychain -p "$KEYCHAIN_PASSWORD" build.keychain
+ # security default-keychain -s build.keychain
+ # security unlock-keychain -p "$KEYCHAIN_PASSWORD" build.keychain
+ # security import certificate.p12 -k build.keychain -P "$P12_PASSWORD" -T /usr/bin/codesign
+ # security set-key-partition-list -S apple-tool:,apple:,codesign: -s -k "$KEYCHAIN_PASSWORD" build.keychain
- codesign --deep --sign "7ACAD7EE0AA3A0783CE9592567098A3F08FC0B0B" Simba.app
- codesign -v Simba.app
+ # codesign --deep --sign "7ACAD7EE0AA3A0783CE9592567098A3F08FC0B0B" Simba.app
+ # codesign -v Simba.app
brew install create-dmg
diff --git a/DocGen/docgen.simba b/DocGen/docgen.simba
index aede4cfd4..bc48ac051 100644
--- a/DocGen/docgen.simba
+++ b/DocGen/docgen.simba
@@ -57,7 +57,6 @@ begin
APIFiles += ['Source\script\imports\simba.import_image.pas', 'Image' ];
APIFiles += ['Source\script\imports\simba.import_dtm.pas', 'DTM' ];
APIFiles += ['Source\script\imports\simba.import_async.pas', 'ASync' ];
- APIFiles += ['Source\script\imports\simba.import_stringmap.pas', 'String Map' ];
end;
procedure H2ToH3(Dir: String);
diff --git a/Source/Simba.lpi b/Source/Simba.lpi
index d954e15ef..33e3c8f16 100644
--- a/Source/Simba.lpi
+++ b/Source/Simba.lpi
@@ -238,6 +238,9 @@
+
+
+
@@ -263,9 +266,7 @@
-
-
@@ -291,6 +292,9 @@
+
+
+
@@ -343,7 +347,7 @@
-
+
diff --git a/Source/ide/simba.ide_editor_paramhint.pas b/Source/ide/simba.ide_editor_paramhint.pas
index 551679529..5a45174d6 100644
--- a/Source/ide/simba.ide_editor_paramhint.pas
+++ b/Source/ide/simba.ide_editor_paramhint.pas
@@ -514,8 +514,8 @@ procedure TSimbaParamHint.DoEditorCommand(Sender: TObject; AfterProcessing: Bool
if (Length(Decls) > 0) then
begin
- if (Decl is TDeclaration_Method) then
- FDisplayPoint.X := FDisplayPoint.X - Length(Decl.Name);
+ if (Decls[0] is TDeclaration_Method) and (Length(Decls[0].Name) > 0) then
+ FDisplayPoint.X := FDisplayPoint.X - Length(Decls[0].Name);
FHintForm.Font := Font;
FHintForm.Font.Color := Editor.Highlighter.IdentifierAttribute.Foreground;
diff --git a/Source/script/imports/lcl/simba.import_lcl_form.pas b/Source/script/imports/lcl/simba.import_lcl_form.pas
index 4dd66d24f..8ffacb101 100644
--- a/Source/script/imports/lcl/simba.import_lcl_form.pas
+++ b/Source/script/imports/lcl/simba.import_lcl_form.pas
@@ -121,8 +121,14 @@ procedure _LapeCustomForm_CloseQuery(const Params: PParamArray; const Result: Po
end;
procedure _LapeCustomForm_EnsureVisible(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
+
+ procedure Execute;
+ begin
+ PCustomForm(Params^[0])^.EnsureVisible(PBoolean(Params^[1])^);
+ end;
+
begin
- PCustomForm(Params^[0])^.EnsureVisible(PBoolean(Params^[1])^);
+ RunInMainThread(@Execute);
end;
procedure _LapeCustomForm_FocusControl(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
@@ -177,23 +183,36 @@ procedure _LapeCustomForm_StayOnTop_Write(const Params: PParamArray); LAPE_WRAPP
end;
procedure _LapeCustomForm_Show(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
+
+ procedure Execute;
+ begin
+ PCustomForm(Params^[0])^.Show();
+ end;
+
begin
- PCustomForm(Params^[0])^.Show();
+ RunInMainThread(@Execute);
end;
procedure _LapeCustomForm_ShowModal(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+
+ procedure Execute;
+ begin
+ PInteger(Result)^ := PCustomForm(Params^[0])^.ShowModal();
+ end;
+
begin
- PInteger(Result)^ := PCustomForm(Params^[0])^.ShowModal();
+ RunInMainThread(@Execute);
end;
procedure _LapeCustomForm_ShowOnTop(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
-begin
- PCustomForm(Params^[0])^.ShowOnTop();
-end;
-procedure _LapeCustomForm_ProcessMessages(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
+ procedure Execute;
+ begin
+ PCustomForm(Params^[0])^.ShowOnTop();
+ end;
+
begin
- Application.ProcessMessages();
+ RunInMainThread(@Execute);
end;
procedure _LapeCustomForm_Active_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
@@ -343,13 +362,30 @@ procedure _LapeCustomForm_ShowInTaskBar_Write(const Params: PParamArray); LAPE_W
procedure _LapeForm_Create(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
begin
- if not IsMainThread() then
- SimbaException('Forms must be created and run on the main thread, use RunInMainThread');
-
PForm(Result)^ := TForm.CreateNew(PComponent(Params^[0])^);
PForm(Result)^.ShowInTaskBar := stAlways;
end;
+procedure _LapeFormThread_Run(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
+begin
+ RunInMainThread(TThreadMethod(Params^[0]^));
+end;
+
+procedure _LapeFormThread_Queue(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
+begin
+ QueueOnMainThread(TThreadMethod(Params^[0]^));
+end;
+
+procedure _LapeFormThread_IsCurrentThread(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ PBoolean(Result)^ := IsMainThread();
+end;
+
+procedure _LapeFormThread_ProcessMessages(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
+begin
+ Application.ProcessMessages();
+end;
+
procedure _LapeForm_SaveSession(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
function ArrToSessionProperties(const Arr: TStringArray): String;
@@ -396,41 +432,6 @@ procedure _LapeForm_RestoreSession(const Params: PParamArray); LAPE_WRAPPER_CALL
end;
end;
-procedure _LapeForm_Show(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
-begin
- PForm(Params^[0])^.Show();
-end;
-
-procedure _LapeForm_Close(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
-begin
- PForm(Params^[0])^.Close();
-end;
-
-procedure _LapeForm_Hide(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
-begin
- PForm(Params^[0])^.Hide();
-end;
-
-procedure _LapeForm_ClientWidth_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
-begin
- PInteger(Result)^ := PForm(Params^[0])^.ClientWidth;
-end;
-
-procedure _LapeForm_ClientWidth_Write(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
-begin
- PForm(Params^[0])^.ClientWidth := PInteger(Params^[1])^;
-end;
-
-procedure _LapeForm_ClientHeight_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
-begin
- PInteger(Result)^ := PForm(Params^[0])^.ClientHeight;
-end;
-
-procedure _LapeForm_ClientHeight_Write(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
-begin
- PForm(Params^[0])^.ClientHeight := PInteger(Params^[1])^;
-end;
-
procedure _LapeForm_OnActivate_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
begin
PNotifyEvent(Result)^ := PForm(Params^[0])^.OnActivate;
@@ -641,96 +642,6 @@ procedure _LapeForm_OnResize_Write(const Params: PParamArray); LAPE_WRAPPER_CALL
PForm(Params^[0])^.OnResize := PNotifyEvent(Params^[1])^;
end;
-procedure _LapeForm_Enabled_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
-begin
- PBoolean(Result)^ := PForm(Params^[0])^.Enabled;
-end;
-
-procedure _LapeForm_Enabled_Write(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
-begin
- PForm(Params^[0])^.Enabled := PBoolean(Params^[1])^;
-end;
-
-procedure _LapeForm_Font_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
-begin
- PFont(Result)^ := PForm(Params^[0])^.Font;
-end;
-
-procedure _LapeForm_Font_Write(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
-begin
- PForm(Params^[0])^.Font := PFont(Params^[1])^;
-end;
-
-procedure _LapeForm_Visible_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
-begin
- PBoolean(Result)^ := PForm(Params^[0])^.Visible;
-end;
-
-procedure _LapeForm_Visible_Write(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
-begin
- PForm(Params^[0])^.Visible := PBoolean(Params^[1])^;
-end;
-
-procedure _LapeForm_Canvas_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
-begin
- PCanvas(Result)^ := PForm(Params^[0])^.Canvas;
-end;
-
-procedure _LapeForm_Canvas_Write(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
-begin
- PForm(Params^[0])^.Canvas := PCanvas(Params^[1])^;
-end;
-
-procedure _LapeForm_Left_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
-begin
- PInteger(Result)^ := PForm(Params^[0])^.Left;
-end;
-
-procedure _LapeForm_Left_Write(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
-begin
- PForm(Params^[0])^.Left := PInteger(Params^[1])^;
-end;
-
-procedure _LapeForm_Height_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
-begin
- PInteger(Result)^ := PForm(Params^[0])^.Height;
-end;
-
-procedure _LapeForm_Height_Write(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
-begin
- PForm(Params^[0])^.Height := PInteger(Params^[1])^;
-end;
-
-procedure _LapeForm_Top_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
-begin
- PInteger(Result)^ := PForm(Params^[0])^.Top;
-end;
-
-procedure _LapeForm_Top_Write(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
-begin
- PForm(Params^[0])^.Top := PInteger(Params^[1])^;
-end;
-
-procedure _LapeForm_Width_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
-begin
- PInteger(Result)^ := PForm(Params^[0])^.Width;
-end;
-
-procedure _LapeForm_Width_Write(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
-begin
- PForm(Params^[0])^.Width := PInteger(Params^[1])^;
-end;
-
-procedure _LapeForm_Caption_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
-begin
- PString(Result)^ := PForm(Params^[0])^.Caption;
-end;
-
-procedure _LapeForm_Caption_Write(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
-begin
- PForm(Params^[0])^.Caption := PString(Params^[1])^;
-end;
-
procedure _LapeCustomForm_Position_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
begin
PPosition(Result)^ := PCustomForm(Params^[0])^.Position;
@@ -1079,7 +990,6 @@ procedure ImportLCLForm(Compiler: TSimbaScript_Compiler);
addGlobalFunc('procedure TLazCustomForm.SetRestoredBounds(ALeft, ATop, AWidth, AHeight: Integer);', @_LapeCustomForm_SetRestoredBounds);
addGlobalFunc('function TLazCustomForm.ShowModal: Integer;', @_LapeCustomForm_ShowModal);
addGlobalFunc('procedure TLazCustomForm.ShowOnTop;', @_LapeCustomForm_ShowOnTop);
- addGlobalFunc('procedure TLazCustomForm.ProcessMessages; static;', @_LapeCustomForm_ProcessMessages);
addProperty('TLazCustomForm', 'BorderStyle', 'ELazFormBorderStyle', @_LapeCustomForm_Read_BorderStyle, @_LapeCustomForm_Write_BorderStyle);
addProperty('TLazCustomForm', 'BorderIcons', 'ELazFormBorderIcons', @_LapeCustomForm_Read_BorderIcons, @_LapeCustomForm_Write_BorderIcons);
addProperty('TLazCustomForm', 'Active', 'Boolean', @_LapeCustomForm_Active_Read);
@@ -1102,6 +1012,14 @@ procedure ImportLCLForm(Compiler: TSimbaScript_Compiler);
addClass('TLazForm', 'TLazCustomForm');
addClassConstructor('TLazForm', '(AOwner: TLazComponent = nil)', @_LapeForm_Create);
+
+ addGlobalType('record end;', 'LazFormThread');
+ addGlobalType('procedure() of object', 'TLazFormThreadMethod', FFI_DEFAULT_ABI);
+ addGlobalFunc('procedure LazFormThread.Run(Method: TLazFormThreadMethod); static', @_LapeFormThread_Run);
+ addGlobalFunc('procedure LazFormThread.Queue(Method: TLazFormThreadMethod); static', @_LapeFormThread_Queue);
+ addGlobalFunc('function LazFormThread.IsCurrentThread: Boolean; static', @_LapeFormThread_IsCurrentThread);
+ addGlobalFunc('procedure LazFormThread.ProcessMessages; static', @_LapeFormThread_ProcessMessages);
+
addGlobalFunc('procedure TLazForm.SaveSession(FileName: String; Things: TStringArray);', @_LapeForm_SaveSession);
addGlobalFunc('procedure TLazForm.RestoreSession(FileName: String; Things: TStringArray);', @_LapeForm_RestoreSession);
diff --git a/Source/script/imports/simba.import_async.pas b/Source/script/imports/simba.import_async.pas
index 6e6099d0e..854828400 100644
--- a/Source/script/imports/simba.import_async.pas
+++ b/Source/script/imports/simba.import_async.pas
@@ -20,57 +20,87 @@ implementation
ASync
=====
Things that run in the background.
+
+```
+procedure ThisIsCalledWhenFinished(constref Result: TASyncHTTPResult);
+begin
+ WriteLn(Result.Response);
+ WriteLn(Result.Data);
+end;
+
+begin
+ ASync.HTTPGet('httpbin.org/get', @ThisIsCalledWhenFinished);
+
+ Sleep(5000); // give some time to complete
+end;
+```
*)
(*
-ASyncHTTP.Get
+ASync.HTTPGet
-------------
-> procedure ASyncHTTP.Get(URL: String; OnFinished: TASyncHTTPFinishedEvent; OnProgress: TASyncHTTPProgressEvent); static;
+> procedure ASync.HTTPGet(URL: String; OnFinish: TASyncHTTPFinishEvent; OnProgress: TASyncHTTPProgressEvent = nil); static;
*)
procedure _LapeASyncHTTP_Get1(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
begin
- ASyncHTTP.Get(PString(Params^[0])^, TASyncHTTPFinishedEvent(Params^[1]^), TASyncHTTPProgressEvent(Params^[3]^));
+ ASyncHTTP.Get(PString(Params^[0])^, [], TASyncHTTPFinishEvent(Params^[1]^), TASyncHTTPProgressEvent(Params^[3]^));
end;
(*
-ASyncHTTP.Get
+ASync.HTTPGet
-------------
-> procedure ASyncHTTP.Get(URL: String; DestFile: String; OnFinished: TASyncHTTPFinishedEvent; OnProgress: TASyncHTTPProgressEvent); static;
+> procedure ASync.HTTPGet(URL: String; RequestHeaders: TStringArray; OnFinish: TASyncHTTPFinishEvent; OnProgress: TASyncHTTPProgressEvent = nil); static;
*)
procedure _LapeASyncHTTP_Get2(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
begin
- ASyncHTTP.Get(PString(Params^[0])^, PString(Params^[1])^, TASyncHTTPFinishedEvent(Params^[2]^), TASyncHTTPProgressEvent(Params^[3]^));
+ ASyncHTTP.Get(PString(Params^[0])^, PStringArray(Params^[1])^, TASyncHTTPFinishEvent(Params^[2]^), TASyncHTTPProgressEvent(Params^[3]^));
end;
-procedure _LapeASyncHTTP_GetZip(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
+(*
+ASync.HTTPGetFile
+-----------------
+> procedure ASync.HTTPGetFile(URL: String; DestFile: String; OnFinish: TASyncHTTPFinishEvent; OnProgress: TASyncHTTPProgressEvent = nil); static;
+*)
+procedure _LapeASyncHTTP_GetFile1(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
begin
- ASyncHTTP.GetZip(PString(Params^[0])^, PString(Params^[1])^, TASyncHTTPFinishedEvent(Params^[2]^), TASyncHTTPProgressEvent(Params^[3]^));
+ ASyncHTTP.GetFile(PString(Params^[0])^, [], PString(Params^[1])^, TASyncHTTPFinishEvent(Params^[2]^), TASyncHTTPProgressEvent(Params^[3]^));
end;
(*
-ASyncHTTP.Post
--------------
-> procedure ASyncHTTP.Post(URL, PostData: String; OnFinished: TASyncHTTPFinishedEvent); static;
+ASync.HTTPGetFile
+-----------------
+> procedure ASync.HTTPGetFile(URL: String; RequestHeaders: TStringArray; DestFile: String; OnFinish: TASyncHTTPFinishEvent; OnProgress: TASyncHTTPProgressEvent = nil); static;
+*)
+procedure _LapeASyncHTTP_GetFile2(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
+begin
+ ASyncHTTP.GetFile(PString(Params^[0])^, PStringArray(Params^[1])^, PString(Params^[2])^,TASyncHTTPFinishEvent(Params^[3]^), TASyncHTTPProgressEvent(Params^[4]^));
+end;
+
+
+(*
+ASync.HTTPPost
+--------------
+> procedure ASync.HTTPPost(URL, Data: String; OnFinish: TASyncHTTPFinishEvent); static;
*)
procedure _LapeASyncHTTP_Post1(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
begin
- ASyncHTTP.Post(PString(Params^[0])^, PString(Params^[1])^, TASyncHTTPFinishedEvent(Params^[2]^));
+ ASyncHTTP.Post(PString(Params^[0])^, [], PString(Params^[1])^, TASyncHTTPFinishEvent(Params^[2]^));
end;
(*
-ASyncHTTP.Post
--------------
-> procedure ASyncHTTP.Post(URL, PostData: String; Headers: TStringArray; OnFinished: TASyncHTTPFinishedEvent); static;
+ASync.HTTPPost
+--------------
+> procedure ASync.HTTPPost(URL: String; RequestHeaders: TStringArray; Data: String; RequestHeaders: TStringArray; OnFinish: TASyncHTTPFinishEvent); static;
*)
procedure _LapeASyncHTTP_Post2(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
begin
- ASyncHTTP.Post(PString(Params^[0])^, PString(Params^[1])^, PStringArray(Params^[2])^, TASyncHTTPFinishedEvent(Params^[3]^));
+ ASyncHTTP.Post(PString(Params^[0])^, PStringArray(Params^[1])^, PString(Params^[2])^, TASyncHTTPFinishEvent(Params^[3]^));
end;
(*
-ASyncMouse.Move
+ASync.MouseMove
---------------
-> procedure ASyncMouse.Move(Target: TTarget; Dest: TPoint; Accuracy: Double = 1);
+> procedure ASync.MouseMove(Target: TTarget; Dest: TPoint; Accuracy: Double = 1);
*)
procedure _LapeASyncMouse_Move(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
begin
@@ -78,19 +108,19 @@ procedure _LapeASyncMouse_Move(const Params: PParamArray); LAPE_WRAPPER_CALLING_
end;
(*
-ASyncMouse.ChangeDest
+ASync.MouseChangeDest
---------------------
-> procedure TASyncMouse.ChangeDest(Dest: TPoint);
+> procedure ASync.MouseChangeDest(Dest: TPoint);
*)
-procedure _LapeASyncMouse_ChangeDest(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
+procedure _LapeASyncMouse_MouseChangeDest(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
begin
ASyncMouse.ChangeDest(PPoint(Params^[0])^);
end;
(*
-ASyncMouse.IsMoving
--------------------
-> function TASyncMouse.IsMoving: Boolean;
+ASync.MouseMoving
+-----------------
+> function ASync.MouseMoving: Boolean;
*)
procedure _LapeASyncMouse_IsMoving(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
begin
@@ -98,9 +128,9 @@ procedure _LapeASyncMouse_IsMoving(const Params: PParamArray; const Result: Poin
end;
(*
-ASyncMouse.WaitMoving
+ASync.MouseWaitMoving
---------------------
-> procedure TASyncMouse.WaitMoving;
+> procedure ASync.MouseWaitMoving;
*)
procedure _LapeASyncMouse_WaitMoving(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
begin
@@ -108,9 +138,9 @@ procedure _LapeASyncMouse_WaitMoving(const Params: PParamArray); LAPE_WRAPPER_CA
end;
(*
-ASyncMouse.Stop
+ASync.MouseStop
---------------
-> procedure TASyncMouse.Stop;
+> procedure ASync.MouseStop;
*)
procedure _LapeASyncMouse_Stop(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
begin
@@ -118,37 +148,34 @@ procedure _LapeASyncMouse_Stop(const Params: PParamArray); LAPE_WRAPPER_CALLING_
end;
(*
-ASyncUnZip.Unzip
-----------------
-> procedure ASyncUnZip.Unzip(ZipFile, DestPath: String; OnFinished: TASyncUnzipFinishedEvent; OnProgress: TASyncUnzipProgressEvent = nil); static;
+ASync.FileUnzip
+---------------
+> procedure ASync.FileUnzip(ZipFile, DestPath: String; OnFinish: TASyncUnzipFinishEvent; OnProgress: TASyncUnzipProgressEvent = nil); static;
*)
procedure _LapeASyncUnZip_Unzip(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
begin
- ASyncUnzip.Unzip(PString(Params^[0])^, PString(Params^[1])^, TASyncUnzipFinishedEvent(Params^[2]^), TASyncUnzipProgressEvent(Params^[3]^));
+ ASyncUnzip.Unzip(PString(Params^[0])^, PString(Params^[1])^, TASyncUnzipFinishEvent(Params^[2]^), TASyncUnzipProgressEvent(Params^[3]^));
end;
procedure ImportASync(Compiler: TSimbaScript_Compiler);
begin
with Compiler do
begin
- // Empty "namespaces"
- addGlobalType('record end;', 'ASyncMouse');
- addGlobalType('record end;', 'ASyncHTTPClient');
- addGlobalType('record end;', 'ASyncUnZip');
-
ImportingSection := 'ASync';
- addGlobalFunc('procedure ASyncMouse.Move(constref Target: TTarget; Dest: TPoint; Accuracy: Double = 1); static; overload;', @_LapeASyncMouse_Move);
- addGlobalFunc('procedure ASyncMouse.ChangeDest(Dest: TPoint); static;', @_LapeASyncMouse_ChangeDest);
- addGlobalFunc('function ASyncMouse.IsMoving: Boolean; static;', @_LapeASyncMouse_IsMoving);
- addGlobalFunc('procedure ASyncMouse.WaitMoving; static;', @_LapeASyncMouse_WaitMoving);
- addGlobalFunc('procedure ASyncMouse.Stop; static;', @_LapeASyncMouse_Stop);
- addGlobalFunc(
- 'procedure ASyncMouse.Move(Dest: TPoint; Accuracy: Double = 1); static; overload;', [
- 'begin',
- ' ASyncMouse.Move(System.Target, Dest, Accuracy);',
- 'end;'
- ]);
+ // namespace
+ addGlobalType('record end;', 'ASync');
+
+ addGlobalFunc('procedure ASync.MouseMove(constref Target: TTarget; Dest: TPoint; Accuracy: Double = 1); static; overload;', @_LapeASyncMouse_Move);
+ addGlobalFunc('procedure ASync.MouseMove(Dest: TPoint; Accuracy: Double = 1); static; overload;', [
+ 'begin',
+ ' ASync.MouseMove(System.Target, Dest, Accuracy);',
+ 'end;'
+ ]);
+ addGlobalFunc('procedure ASync.MouseChangeDest(Dest: TPoint); static;', @_LapeASyncMouse_MouseChangeDest);
+ addGlobalFunc('function ASync.MouseMoving: Boolean; static;', @_LapeASyncMouse_IsMoving);
+ addGlobalFunc('procedure ASync.MouseWaitMoving; static;', @_LapeASyncMouse_WaitMoving);
+ addGlobalFunc('procedure ASync.MouseStop; static;', @_LapeASyncMouse_Stop);
addGlobalType([
'record',
@@ -161,13 +188,15 @@ procedure ImportASync(Compiler: TSimbaScript_Compiler);
'end;'],
'TASyncHTTPResult');
- addGlobalType('procedure(constref Result: TASyncHTTPResult) of object', 'TASyncHTTPFinishedEvent', FFI_DEFAULT_ABI);
+ addGlobalType('procedure(constref Result: TASyncHTTPResult) of object', 'TASyncHTTPFinishEvent', FFI_DEFAULT_ABI);
addGlobalType('procedure(URL: String; Position, Size: Int64) of object', 'TASyncHTTPProgressEvent', FFI_DEFAULT_ABI);
- addGlobalFunc('procedure ASyncHTTPClient.Get(URL: String; OnFetched: TASyncHTTPFinishedEvent; OnProgress: TASyncHTTPProgressEvent = nil); static; overload;', @_LapeASyncHTTP_Get1);
- addGlobalFunc('procedure ASyncHTTPClient.Get(URL, DestFile: String; OnFetched: TASyncHTTPFinishedEvent; OnProgress: TASyncHTTPProgressEvent = nil); static; overload;', @_LapeASyncHTTP_Get2);
- addGlobalFunc('procedure ASyncHTTPClient.GetZip(URL, DestFile: String; OnFinished: TASyncHTTPFinishedEvent; OnProgress: TASyncHTTPProgressEvent = nil); static;', @_LapeASyncHTTP_GetZip);
- addGlobalFunc('procedure ASyncHTTPClient.Post(URL, PostData: String); static; overload;', @_LapeASyncHTTP_Post1);
- addGlobalFunc('procedure ASyncHTTPClient.Post(URL, PostData: String; Headers: TStringArray); static; overload;', @_LapeASyncHTTP_Post2);
+
+ addGlobalFunc('procedure ASync.HTTPGet(URL: String; OnFinish: TASyncHTTPFinishEvent; OnProgress: TASyncHTTPProgressEvent = nil); static; overload;', @_LapeASyncHTTP_Get1);
+ addGlobalFunc('procedure ASync.HTTPGet(URL: String; RequestHeaders: TStringArray; OnFinish: TASyncHTTPFinishEvent; OnProgress: TASyncHTTPProgressEvent = nil); static; overload;', @_LapeASyncHTTP_Get2);
+ addGlobalFunc('procedure ASync.HTTPGetFile(URL: String; DestFile: String; OnFinish: TASyncHTTPFinishEvent; OnProgress: TASyncHTTPProgressEvent = nil); static; overload;', @_LapeASyncHTTP_GetFile1);
+ addGlobalFunc('procedure ASync.HTTPGetFile(URL: String; RequestHeaders: TStringArray; DestFile: String; OnFinish: TASyncHTTPFinishEvent; OnProgress: TASyncHTTPProgressEvent = nil); static; overload;', @_LapeASyncHTTP_GetFile2);
+ addGlobalFunc('procedure ASync.HTTPPost(URL, Data: String; OnFinish: TASyncHTTPFinishEvent = nil); static; overload;', @_LapeASyncHTTP_Post1);
+ addGlobalFunc('procedure ASync.HTTPPost(URL: String; RequestHeaders: TStringArray; Data: String; OnFinish: TASyncHTTPFinishEvent = nil); static; overload;', @_LapeASyncHTTP_Post2);
addGlobalType([
'record',
@@ -179,10 +208,35 @@ procedure ImportASync(Compiler: TSimbaScript_Compiler);
'end;'],
'TASyncUnzipResult');
- addGlobalType('procedure(constref Result: TASyncUnzipResult) of object', 'TASyncUnzipFinishedEvent', FFI_DEFAULT_ABI);
+ addGlobalType('procedure(constref Result: TASyncUnzipResult) of object', 'TASyncUnzipFinishEvent', FFI_DEFAULT_ABI);
addGlobalType('procedure(Position, Total: Int64) of object', 'TASyncUnzipProgressEvent', FFI_DEFAULT_ABI);
- addGlobalFunc('procedure ASyncUnZip.Unzip(ZipFile, DestPath: String; OnFinished: TASyncUnzipFinishedEvent; OnProgress: TASyncUnzipProgressEvent = nil); static;', @_LapeASyncUnZip_Unzip);
+ addGlobalFunc('procedure ASync.FileUnZip(ZipFile, DestPath: String; OnFinish: TASyncUnzipFinishEvent; OnProgress: TASyncUnzipProgressEvent = nil); static;', @_LapeASyncUnZip_Unzip);
+
+ addGlobalFunc(
+ 'function ASync.Schedules: TStringArray; static;', [
+ 'begin',
+ ' Result := _ScheduleNames();',
+ 'end;'
+ ]);
+ addGlobalFunc(
+ 'procedure ASync.ScheduleEvery(Name: String; Method: procedure of object; Interval: Integer); static; overload;', [
+ 'begin',
+ ' _ScheduleEvery(Name, @Method, Interval);',
+ 'end;'
+ ]);
+ addGlobalFunc(
+ 'procedure ASync.ScheduleEvery(Name: String; Method: procedure(Params: TPointerArray) of object; Params: TPointerArray; Interval: Integer); static; overload;', [
+ 'begin',
+ ' _ScheduleEveryEx(Name, @Method, Params, Interval);',
+ 'end;'
+ ]);
+ addGlobalFunc(
+ 'procedure ASync.ScheduleStop(Name: String); static;', [
+ 'begin',
+ ' _ScheduleStop(Name);',
+ 'end;'
+ ]);
ImportingSection := '';
end;
diff --git a/Source/script/imports/simba.import_base.pas b/Source/script/imports/simba.import_base.pas
index 579e2cb56..0fa455ca8 100644
--- a/Source/script/imports/simba.import_base.pas
+++ b/Source/script/imports/simba.import_base.pas
@@ -14,7 +14,7 @@ implementation
uses
Graphics, Variants,
- lptypes, lpvartypes, lpparser,
+ lptypes, lpvartypes, lpparser, ffi,
simba.nativeinterface, simba.env, simba.baseclass, simba.vartype_ordarray;
(*
@@ -478,6 +478,7 @@ procedure ImportBase(Compiler: TSimbaScript_Compiler);
addGlobalType('array of Int64', 'TInt64Array');
addGlobalType('array of Byte', 'TByteArray');
addGlobalType('array of Variant', 'TVariantArray');
+ addGlobalType('array of Pointer', 'TPointerArray');
addGlobalType('record X, Y: Integer; end', 'TPoint');
addGlobalType('array of TPoint', 'TPointArray');
diff --git a/Source/script/imports/simba.import_threading.pas b/Source/script/imports/simba.import_threading.pas
index c709472b9..7e8a74881 100644
--- a/Source/script/imports/simba.import_threading.pas
+++ b/Source/script/imports/simba.import_threading.pas
@@ -11,58 +11,600 @@ interface
uses
Classes, SysUtils,
- simba.base, simba.script_compiler;
+ simba.base, simba.vartype_string, simba.script_compiler, simba.threading;
procedure ImportThreading(Compiler: TSimbaScript_Compiler);
implementation
+{$WARN 4046 ERROR} // stop compiling on creating a class with an abstract method
+
uses
- lptypes, lpparser, ffi,
- simba.threading;
+ syncobjs,
+ lptypes, lpmessages, lpvartypes, lpinterpreter;
+
+type
+ PSimbaLock = ^TSimbaLock;
+ TSimbaLock = class(TObject)
+ protected
+ FCriticalSection: TCriticalSection;
+ public
+ constructor Create; reintroduce;
+ destructor Destroy; override;
+
+ function TryEnter: Boolean;
+ procedure Enter;
+ procedure Leave;
+ end;
+
+constructor TSimbaLock.Create;
+begin
+ inherited Create();
+
+ FCriticalSection := TCriticalSection.Create();
+end;
+
+destructor TSimbaLock.Destroy;
+begin
+ FreeAndNil(FCriticalSection);
+
+ inherited Destroy();
+end;
-procedure _LapeCurrentThreadID(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+function TSimbaLock.TryEnter: Boolean;
begin
- TThreadID(Result^) := GetCurrentThreadID();
+ Result := FCriticalSection.TryEnter();
end;
-procedure _LapeMainThreadID(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+procedure TSimbaLock.Enter;
+begin
+ FCriticalSection.Enter();
+end;
+
+procedure TSimbaLock.Leave;
+begin
+ FCriticalSection.Leave();
+end;
+
+type
+ TPointerArray = array of Pointer;
+
+ PSimbaThreadBase = ^TSimbaThreadBase;
+ TSimbaThreadBase = class(TThread)
+ protected
+ FCodeRunner: TLapeCodeRunner;
+ FMethod: TMethod;
+ FTerminateMethod: TMethod;
+ FName: String;
+
+ procedure Invoke(Method: TMethod; Params: array of Pointer);
+
+ procedure DoMethod; virtual; abstract;
+ procedure DoTerminateMethod; virtual; abstract;
+
+ procedure DoTerminate; override;
+ procedure Execute; override;
+
+ function GetName: String;
+ procedure SetName(Value: String);
+ public
+ constructor Create(Emitter: TLapeCodeEmitter; Method, TerminateMethod: TMethod); reintroduce;
+ constructor Create(Emitter: TLapeCodeEmitter; Method: TMethod); reintroduce;
+ destructor Destroy; override;
+
+ function WaitForTerminate(Timeout: Int32): Boolean;
+
+ property Name: String read GetName write SetName;
+ end;
+
+ TSimbaThread = class(TSimbaThreadBase)
+ protected
+ procedure DoMethod; override;
+ procedure DoTerminateMethod; override;
+ end;
+
+ TSimbaThreadEx = class(TSimbaThreadBase)
+ protected
+ FParams: TPointerArray;
+
+ function getParamsAsParam: Pointer;
+
+ procedure DoMethod; override;
+ procedure DoTerminateMethod; override;
+ end;
+
+ TSimbaThreadSchedule = class(TSimbaThreadBase)
+ protected
+ FInterval: Integer;
+ FTerminateLock: TWaitableLock;
+
+ procedure TerminatedSet; override;
+
+ procedure DoMethod; override;
+ procedure DoTerminateMethod; override;
+ end;
+
+ TSimbaThreadScheduleEx = class(TSimbaThreadBase)
+ protected
+ FInterval: Integer;
+ FTerminateLock: TWaitableLock;
+ FParams: TPointerArray;
+
+ function getParamsAsParam: Pointer;
+ procedure TerminatedSet; override;
+ procedure DoMethod; override;
+ procedure DoTerminateMethod; override;
+ end;
+
+function TSimbaThreadScheduleEx.getParamsAsParam: Pointer;
begin
- TThreadID(Result^) := MainThreadID;
+ Result := Pointer(FParams);
+ // inc ref count
+ Inc(PSizeInt(Result - SizeOf(SizeInt) * 2)^);
end;
-procedure _LapeQueueInMainThread(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
+procedure TSimbaThreadScheduleEx.TerminatedSet;
begin
- QueueOnMainThread(TThreadMethod(Params^[0]^));
+ inherited TerminatedSet;
+
+ FTerminateLock.Unlock();
end;
-procedure _LapeRunInMainThread(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
+procedure TSimbaThreadScheduleEx.DoMethod;
begin
- RunInMainThread(TThreadMethod(Params^[0]^));
+ FTerminateLock.Lock();
+
+ while not Terminated do
+ begin
+ Invoke(FMethod, [getParamsAsParam()]);
+
+ FTerminateLock.WaitLocked(FInterval);
+ end;
end;
-procedure _LapeRunInThread(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
+procedure TSimbaThreadScheduleEx.DoTerminateMethod;
begin
- RunInThread(TThreadMethod(Params^[0]^), True);
+ { nothing }
+end;
+
+procedure TSimbaThreadSchedule.TerminatedSet;
+begin
+ inherited TerminatedSet();
+
+ FTerminateLock.Unlock();
+end;
+
+procedure TSimbaThreadSchedule.DoMethod;
+begin
+ FTerminateLock.Lock();
+
+ while not Terminated do
+ begin
+ Invoke(FMethod, []);
+
+ FTerminateLock.WaitLocked(FInterval);
+ end;
+end;
+
+procedure TSimbaThreadSchedule.DoTerminateMethod;
+begin
+ { nothing }
+end;
+
+function TSimbaThreadEx.getParamsAsParam: Pointer;
+begin
+ Result := Pointer(FParams);
+ // inc ref count
+ Inc(PSizeInt(Result - SizeOf(SizeInt) * 2)^);
+end;
+
+procedure TSimbaThreadEx.DoMethod;
+begin
+ Invoke(FMethod, [getParamsAsParam()]);
+end;
+
+procedure TSimbaThreadEx.DoTerminateMethod;
+begin
+ Invoke(FTerminateMethod, [Self, getParamsAsParam()]);
+end;
+
+procedure TSimbaThread.DoMethod;
+begin
+ Invoke(FMethod, []);
+end;
+
+procedure TSimbaThread.DoTerminateMethod;
+begin
+ Invoke(FTerminateMethod, [Self]);
+end;
+
+procedure TSimbaThreadBase.Invoke(Method: TMethod; Params: array of Pointer);
+var
+ VarStack: TByteArray = nil;
+ I: Integer;
+begin
+ SetLength(VarStack, SizeOf(Pointer) + (Length(Params) * SizeOf(Pointer)));
+ PPointer(@VarStack[0])^ := Method.Data;
+ for I := 0 to High(Params) do
+ PPointer(@VarStack[SizeOf(Pointer) * (I+1)])^ := Params[I];
+
+ FCodeRunner.Run(TCodePos(Method.Code), VarStack);
+end;
+
+procedure TSimbaThreadBase.DoTerminate;
+begin
+ if Assigned(FTerminateMethod.Code) then
+ DoTerminateMethod();
+end;
+
+procedure TSimbaThreadBase.Execute;
+begin
+ if Assigned(FMethod.Code) then
+ DoMethod();
+end;
+
+function TSimbaThreadBase.GetName: String;
+begin
+ Result := FName;
+end;
+
+procedure TSimbaThreadBase.SetName(Value: String);
+begin
+ FName := Value;
+ NameThreadForDebugging(FName, ThreadID);
+end;
+
+constructor TSimbaThreadBase.Create(Emitter: TLapeCodeEmitter; Method, TerminateMethod: TMethod);
+begin
+ inherited Create(True, DefaultStackSize div 2);
+
+ FCodeRunner := TLapeCodeRunner.Create(Emitter);
+ FMethod := Method;
+ FTerminateMethod := TerminateMethod;
+end;
+
+constructor TSimbaThreadBase.Create(Emitter: TLapeCodeEmitter; Method: TMethod);
+begin
+ Create(Emitter, Method, Default(TMethod));
+end;
+
+destructor TSimbaThreadBase.Destroy;
+begin
+ FreeAndNil(FCodeRunner);
+
+ inherited Destroy();
+end;
+
+function TSimbaThreadBase.WaitForTerminate(Timeout: Int32): Boolean;
+begin
+ Result := WaitForThreadTerminate(ThreadID, Timeout) = 0;
+end;
+
+// function _CreateThread(Emitter: Pointer; Method: procedure of object; OnTerminate: procedure(Thread: TThread) of object): Pointer;
+procedure _LapeCreateThread(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ TSimbaThread(Result^) := TSimbaThread.Create(TLapeCodeEmitter(Params^[0]^), PMethod(Params^[1])^, PMethod(Params^[2])^);
+ TSimbaThread(Result^).Start();
+end;
+
+// function _CreateThreadEx(Emitter: Pointer; Method: procedure(Params: TPointerArray) of object; OnTerminate: procedure(Thread: TThread; Params: TPointerArray) of object; Params: TPointerArray): Pointer;
+procedure _LapeCreateThreadEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ TSimbaThreadEx(Result^) := TSimbaThreadEx.Create(TLapeCodeEmitter(Params^[0]^), PMethod(Params^[1])^, PMethod(Params^[2])^);
+ TSimbaThreadEx(Result^).FParams := TPointerArray(Params^[3]^);
+ TSimbaThreadEx(Result^).Start();
+end;
+
+// function _CreateThreadAnon(Emitter: Pointer; Method: procedure of object; OnTerminateMethod: procedure of object): Pointer;', @_LapeCreateThreadAnon);
+procedure _LapeCreateThreadAnon(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ TSimbaThread(Result^) := TSimbaThread.Create(TLapeCodeEmitter(Params^[0]^), PMethod(Params^[1])^, PMethod(Params^[2])^);
+ TSimbaThread(Result^).FreeOnTerminate := True;
+ TSimbaThread(Result^).Start();
+end;
+
+// function function _CreateThreadAnonEx(Emitter: Pointer; Method: procedure(Params: TPointerArray) of object; OnTerminateMethod: procedure of object; Params: TPointerArray): Pointer;
+procedure _LapeCreateThreadAnonEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ TSimbaThreadEx(Result^) := TSimbaThreadEx.Create(TLapeCodeEmitter(Params^[0]^), PMethod(Params^[1])^, PMethod(Params^[2])^);
+ TSimbaThreadEx(Result^).FParams := TPointerArray(Params^[3]^);
+ TSimbaThreadEx(Result^).FreeOnTerminate := True;
+ TSimbaThreadEx(Result^).Start();
+end;
+
+// function _CreateThreadSchedule(CodeEmitter: Pointer; Method: procedure of object; Interval: Integer; Name: String): Pointer
+procedure _LapeCreateThreadSchedule(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ TSimbaThreadSchedule(Result^) := TSimbaThreadSchedule.Create(TLapeCodeEmitter(Params^[0]^), PMethod(Params^[1])^);
+ TSimbaThreadSchedule(Result^).FInterval := PInteger(Params^[2])^;
+ TSimbaThreadSchedule(Result^).Name := PString(Params^[3])^;
+ TSimbaThreadSchedule(Result^).Start();
+end;
+
+// function _CreateThreadScheduleEx(CodeEmitter: Pointer; Method: procedure(Params: TPointerArray) of object; Params: TPointerArray; Interval: Integer): Pointer
+procedure _LapeCreateThreadScheduleEx(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ TSimbaThreadScheduleEx(Result^) := TSimbaThreadScheduleEx.Create(TLapeCodeEmitter(Params^[0]^), PMethod(Params^[1])^);
+ TSimbaThreadScheduleEx(Result^).FParams := Copy(TPointerArray(Params^[2]^));
+ TSimbaThreadScheduleEx(Result^).FInterval := PInteger(Params^[3])^;
+ TSimbaThreadScheduleEx(Result^).Name := PString(Params^[4])^;
+ TSimbaThreadScheduleEx(Result^).Start();
+end;
+
+procedure _LapeThread_Name_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ PString(Result)^ := PSimbaThreadBase(Params^[0])^.Name;
+end;
+
+procedure _LapeThread_Name_Write(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
+begin
+ PSimbaThreadBase(Params^[0])^.Name := PString(Params^[1])^;
+end;
+
+procedure _LapeThread_Running_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ PBoolean(Result)^ := not PSimbaThreadBase(Params^[0])^.Finished;
+end;
+
+procedure _LapeThread_ThreadID_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ PUInt64(Result)^ := UInt64(PSimbaThreadBase(Params^[0])^.ThreadID);
+end;
+
+procedure _LapeThread_IsTerminated_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ PBoolean(Result)^ := PSimbaThreadBase(Params^[0])^.Terminated;
+end;
+
+procedure _LapeThread_FatalException_Read(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ with PSimbaThreadBase(Params^[0])^ do
+ begin
+ if (FatalException is lpException) then
+ begin
+ PString(Result)^ := lpException(FatalException).Error;
+
+ // todo: fix lape adding "Runtime error:" to `Error`
+ if PString(Result)^.StartsWith('Runtime error: "') then
+ PString(Result)^ := PString(Result)^.CopyRange(Length('Runtime error: "') + 1, Length(PString(Result)^) - 1);
+ end else if (FatalException is Exception) then
+ PString(Result)^ := Exception(FatalException).Message
+ else
+ PString(Result)^ := '';
+ end;
+end;
+
+procedure _LapeThread_Terminate(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
+begin
+ PSimbaThreadBase(Params^[0])^.Terminate();
+end;
+
+procedure _LapeThread_WaitForTerminate1(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
+begin
+ PSimbaThreadBase(Params^[0])^.WaitFor();
+end;
+
+procedure _LapeThread_WaitForTerminate2(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ PBoolean(Result)^ := PSimbaThreadBase(Params^[0])^.WaitForTerminate(PInteger(Params^[1])^);
+end;
+
+procedure _LapeThread_Free(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
+begin
+ PSimbaThreadBase(Params^[0])^.Free();
+end;
+
+procedure _LapeLock_Create(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ PSimbaLock(Result)^ := TSimbaLock.Create();
+end;
+
+procedure _LapeLock_TryEnter(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ PBoolean(Result)^ := PSimbaLock(Params^[0])^.TryEnter();
+end;
+
+procedure _LapeLock_Enter(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
+begin
+ PSimbaLock(Params^[0])^.Enter();
+end;
+
+procedure _LapeLock_Leave(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
+begin
+ PSimbaLock(Params^[0])^.Leave();
+end;
+
+procedure _LapeLock_Free(const Params: PParamArray); LAPE_WRAPPER_CALLING_CONV
+begin
+ PSimbaLock(Params^[0])^.Free();
+end;
+
+procedure _LapeCurrentThread(const Params: PParamArray; const Result: Pointer); LAPE_WRAPPER_CALLING_CONV
+begin
+ if (TThread.CurrentThread is TSimbaThreadBase) then
+ TThread(Result^) := TThread.CurrentThread
+ else
+ TThread(Result^) := nil;
end;
procedure ImportThreading(Compiler: TSimbaScript_Compiler);
begin
with Compiler do
begin
+ ImportingSection := '!Threading';
+
+ addGlobalVar(
+ 'record' + LineEnding +
+ ' CoreCount: Int32;' + LineEnding +
+ ' ThreadCount: Int32;' + LineEnding +
+ ' PhysicalMemory: Int32;' + LineEnding +
+ 'end;',
+ @SimbaCPUInfo,
+ 'CPUInfo'
+ ).isConstant := True;
+
ImportingSection := 'Threading';
- addGlobalVar(CPUCount, 'CPU_COUNT').isConstant := True;
+ addGlobalType('strict Pointer', 'TThread');
+ addGlobalFunc('property TThread.Name: String', @_LapeThread_Name_Read);
+ addGlobalFunc('property TThread.Name(Value: String)', @_LapeThread_Name_Write);
+ addGlobalFunc('property TThread.Running: Boolean', @_LapeThread_Running_Read);
+ addGlobalFunc('property TThread.ThreadID: UInt64', @_LapeThread_ThreadID_Read);
+ addGlobalFunc('property TThread.FatalException: String', @_LapeThread_FatalException_Read);
+ addGlobalFunc('property TThread.IsTerminated: Boolean', @_LapeThread_IsTerminated_Read);
+ addGlobalFunc('procedure TThread.Terminate;', @_LapeThread_Terminate);
+ addGlobalFunc('procedure TThread.WaitForTerminate; overload', @_LapeThread_WaitForTerminate1);
+ addGlobalFunc('function TThread.WaitForTerminate(Timeout: Int32): Boolean; overload', @_LapeThread_WaitForTerminate2);
+ addGlobalFunc('procedure TThread.Free;', @_LapeThread_Free);
+
+ addGlobalType('strict Pointer', 'TLock');
+ addGlobalFunc('function TLock.Create: TLock; static;', @_LapeLock_Create);
+ addGlobalFunc('function TLock.TryEnter: Boolean;', @_LapeLock_TryEnter);
+ addGlobalFunc('procedure TLock.Enter;', @_LapeLock_Enter);
+ addGlobalFunc('procedure TLock.Leave;', @_LapeLock_Leave);
+ addGlobalFunc('procedure TLock.Free;', @_LapeLock_Free);
+
+ addGlobalFunc('function CurrentThread: TThread', @_LapeCurrentThread);
+
+ ImportingSection := '!Threading';
+
+ addGlobalVar(Emitter, '_CodeEmitter').isConstant := True;
+ addGlobalFunc('function _CreateThread(Emitter: Pointer; Method: procedure of object; OnTerminate: procedure(Thread: TThread) of object): TThread;', @_LapeCreateThread);
+ addGlobalFunc('function _CreateThreadEx(Emitter: Pointer; Method: procedure(Params: TPointerArray) of object; OnTerminate: procedure(Thread: TThread; Params: TPointerArray) of object; Params: TPointerArray): TThread;', @_LapeCreateThreadEx);
+ addGlobalFunc('function _CreateThreadAnon(Emitter: Pointer; Method: procedure of object; OnTerminateMethod: procedure(Thread: TThread) of object): TThread;', @_LapeCreateThreadAnon);
+ addGlobalFunc('function _CreateThreadAnonEx(Emitter: Pointer; Method: procedure(Params: TPointerArray) of object; OnTerminateMethod: procedure(Thread: TThread; Params: TPointerArray) of object; Params: TPointerArray): TThread;', @_LapeCreateThreadAnonEx);
+ addGlobalFunc('function _CreateThreadSchedule(Emitter: Pointer; Method: procedure of object; Interval: Integer; Name: String): TThread', @_LapeCreateThreadSchedule);
+ addGlobalFunc('function _CreateThreadScheduleEx(Emitter: Pointer; Method: procedure(Params: TPointerArray) of object; Params: TPointerArray; Interval: Integer; Name: String): TThread', @_LapeCreateThreadScheduleEx);
+
+ addGlobalVar('array of TThread', nil, '_ScheduleThreads');
+ with addGlobalVar('TLock', nil, '_ScheduleLock') do
+ PPointer(Ptr)^ := TSimbaLock.Create();
+
+ addGlobalFunc(
+ 'procedure _ScheduleEvery(Name: String; Method: procedure of object; Interval: Integer);', [
+ 'begin',
+ ' _ScheduleLock.Enter();',
+ ' try',
+ ' if (not IsScriptMethod(Method)) then',
+ ' raise "Script method expected";',
+ ' _ScheduleThreads += _CreateThreadSchedule(_CodeEmitter, Method, Interval, Name);',
+ ' finally',
+ ' _ScheduleLock.Leave();',
+ ' end;',
+ 'end;'
+ ]);
+
+ addGlobalFunc(
+ 'procedure _ScheduleEveryEx(Name: String; Method: procedure(Params: TPointerArray) of object; Params: TPointerArray; Interval: Integer);', [
+ 'begin',
+ ' _ScheduleLock.Enter();',
+ ' try',
+ ' if (not IsScriptMethod(Method)) then',
+ ' raise "Script method expected";',
+ ' _ScheduleThreads += _CreateThreadScheduleEx(_CodeEmitter, Method, Params, Interval, Name);',
+ ' finally',
+ ' _ScheduleLock.Leave();',
+ ' end;',
+ 'end;'
+ ]);
+
+ addGlobalFunc(
+ 'procedure _ScheduleStop(Name: String);', [
+ 'var I: Int32;',
+ 'begin',
+ ' _ScheduleLock.Enter();',
+ ' try',
+ ' for I := 0 to High(_ScheduleThreads) do',
+ ' if (_ScheduleThreads[i].Name = Name) then',
+ ' begin',
+ ' _ScheduleThreads[i].Terminate();',
+ ' _ScheduleThreads[i].WaitForTerminate();',
+ ' _ScheduleThreads[I].Free();',
+ ' end;',
+ ' finally',
+ ' _ScheduleLock.Leave();',
+ ' end;',
+ 'end;'
+ ]);
+
+ addGlobalFunc(
+ 'function _ScheduleNames: TStringArray;', [
+ 'var I: Integer;',
+ 'begin',
+ ' _ScheduleLock.Enter();',
+ ' try',
+ ' for I := 0 to High(_ScheduleThreads) do',
+ ' if _ScheduleThreads[I].Running then',
+ ' Result += _ScheduleThreads[I].Name;',
+ ' finally',
+ ' _ScheduleLock.Leave();',
+ ' end;',
+ 'end;'
+ ]);
+
+ ImportingSection := 'Threading';
+
+ addGlobalFunc(
+ 'function TThread.Create(Method: procedure of object): TThread; static; overload;', [
+ 'begin',
+ ' if (not IsScriptMethod(Method)) then',
+ ' raise "Script method expected";',
+ ' Result := _CreateThread(_CodeEmitter, Method, nil);',
+ 'end;'
+ ]);
+
+ addGlobalFunc(
+ 'function TThread.Create(Method: procedure of object; OnTerminateMethod: procedure(Thread: TThread) of object): TThread; static; overload;', [
+ 'begin',
+ ' if (not IsScriptMethod(Method)) or (not IsScriptMethod(OnTerminateMethod)) then',
+ ' raise "Script method expected";',
+ ' Result := _CreateThread(_CodeEmitter, Method, OnTerminateMethod);',
+ 'end;'
+ ]);
+
+ addGlobalFunc(
+ 'function TThread.CreateEx(Method: procedure(Params: TPointerArray) of object; Params: TPointerArray): TThread; static; overload;', [
+ 'begin',
+ ' if (not IsScriptMethod(Method)) then',
+ ' raise "Script method expected";',
+ ' Result := _CreateThreadEx(_CodeEmitter, Method, nil, Params);',
+ 'end;'
+ ]);
- addGlobalType(getBaseType(DetermineIntType(SizeOf(TThreadID), False)).createCopy(), 'TThreadID');
- addGlobalType('procedure() of object', 'TThreadMethod', FFI_DEFAULT_ABI);
+ addGlobalFunc(
+ 'function TThread.CreateEx(Method: procedure(Params: TPointerArray) of object; OnTerminateMethod: procedure(Thread: TThread; Params: TPointerArray) of object; Params: TPointerArray): TThread; static; overload;', [
+ 'begin',
+ ' if (not IsScriptMethod(Method)) or (not IsScriptMethod(OnTerminateMethod)) then',
+ ' raise "Script method expected";',
+ ' Result := _CreateThreadEx(_CodeEmitter, Method, OnTerminateMethod, Params);',
+ 'end;'
+ ]);
- addGlobalFunc('function CurrentThreadID: TThreadID', @_LapeCurrentThreadID);
- addGlobalFunc('function MainThreadID: TThreadID', @_LapeMainThreadID);
+ addGlobalFunc(
+ 'procedure RunInThread(Method: procedure of object); overload;', [
+ 'begin',
+ ' _CreateThreadAnon(_CodeEmitter, Method, nil);',
+ 'end;'
+ ]);
+ addGlobalFunc(
+ 'procedure RunInThread(Method: procedure of object; OnTerminateMethod: procedure(Thread: TThread) of object); overload;', [
+ 'begin',
+ ' _CreateThreadAnon(_CodeEmitter, Method, nil);',
+ 'end;'
+ ]);
- addGlobalFunc('procedure QueueInMainThread(Method: TThreadMethod)', @_LapeQueueInMainThread);
- addGlobalFunc('procedure RunInMainThread(Method: TThreadMethod)', @_LapeRunInMainThread);
- addGlobalFunc('procedure RunInThread(Method: TThreadMethod)', @_LapeRunInThread);
+ addGlobalFunc(
+ 'procedure RunInThreadEx(Method: procedure(Params: TPointerArray) of object; Params: TPointerArray); overload;', [
+ 'begin',
+ ' _CreateThreadAnonEx(_CodeEmitter, Method, nil, Params);',
+ 'end;'
+ ]);
+ addGlobalFunc(
+ 'procedure RunInThreadEx(Method: procedure(Params: TPointerArray) of object; OnTerminateMethod: procedure(Thread: TThread; Params: TPointerArray) of object; Params: TPointerArray); overload;', [
+ 'begin',
+ ' _CreateThreadAnonEx(_CodeEmitter, Method, OnTerminateMethod, Params);',
+ 'end;'
+ ]);
ImportingSection := '';
end;
diff --git a/Source/simba.component_synedit.pas b/Source/simba.component_synedit.pas
index 35c31299e..a262d4a25 100644
--- a/Source/simba.component_synedit.pas
+++ b/Source/simba.component_synedit.pas
@@ -11,7 +11,7 @@ interface
uses
Classes, SysUtils, Controls, Forms, StdCtrls, Graphics,
- SynEdit, SynEditTypes, SynEditFoldedView, SynEditTextBuffer, SynEditMarkupSelection, SynEditWrappedView,
+ SynEdit, SynEditTypes, SynEditFoldedView, SynEditTextBuffer, SynEditMarkupSelection, {%H-}SynEditWrappedView,
LazSynEditText,
simba.ide_theme, simba.component_scrollbar;
diff --git a/Source/simba.containers.pas b/Source/simba.containers.pas
index 16d9eaa40..87a795c62 100644
--- a/Source/simba.containers.pas
+++ b/Source/simba.containers.pas
@@ -84,7 +84,7 @@ generic TSimbaArrayBuffer<_T> = record
FCount: Integer;
FArr: TArr;
- procedure EnsureGrowth(const Len: Integer = 1); inline;
+ procedure Grow(const Len: Integer = 1);
function GetItem(const Index: Integer): _T; inline;
public
property Size: Integer read FLength;
@@ -255,26 +255,24 @@ function TSimbaStack.Pop: _T;
Result := FArr[FCount];
end;
-procedure TSimbaArrayBuffer.EnsureGrowth(const Len: Integer);
+procedure TSimbaArrayBuffer.Grow(const Len: Integer);
begin
- if (FCount + Len >= FLength) then
- begin
- FLength := FLength + Len;
- if (FLength < 32) then
- FLength := 32
- else
- if (FLength > 256000) then
- FLength := FLength * 4
- else
- FLength := FLength * 2;
+ FLength := FLength + Len;
+ if (FLength < 32) then
+ FLength := 32
+ else
+ if (FLength > 256000) then
+ FLength := FLength * 4
+ else
+ FLength := FLength * 2;
- SetLength(FArr, FLength);
- end;
+ SetLength(FArr, FLength);
end;
procedure TSimbaPointBufferHelper.Add(const X, Y: Integer);
begin
- EnsureGrowth();
+ if (FCount+1 >= FLength) then
+ Grow();
FArr[FCount].X := X;
FArr[FCount].Y := Y;
@@ -310,7 +308,8 @@ procedure TSimbaArrayBuffer.InitWith(const Values: TArr);
procedure TSimbaArrayBuffer.Add(const Value: _T);
begin
- EnsureGrowth();
+ if (FCount+1 >= FLength) then
+ Grow();
FArr[FCount] := Value;
Inc(FCount);
@@ -324,7 +323,8 @@ procedure TSimbaArrayBuffer.Add(const Values: TArr);
if (Len > 0) then
begin
- EnsureGrowth(Len);
+ if (FCount + Len >= FLength) then
+ Grow(Len);
Move(Values[0], FArr[FCount], Len * SizeOf(_T));
Inc(FCount, Len);
end;
diff --git a/Source/simba.fs_async.pas b/Source/simba.fs_async.pas
index 915aa3767..bd25867e3 100644
--- a/Source/simba.fs_async.pas
+++ b/Source/simba.fs_async.pas
@@ -21,12 +21,12 @@ TASyncUnzipResult = record
Exception: String;
TimeUsed: Double;
end;
- TASyncUnzipFinishedEvent = procedure(constref Result: TASyncUnzipResult) of object;
+ TASyncUnzipFinishEvent = procedure(constref Result: TASyncUnzipResult) of object;
TASyncUnzipProgressEvent = procedure(Position, Total: Int64) of object;
ASyncUnzip = class
class procedure Unzip(ZipFile, DestPath: String;
- OnFinished: TASyncUnzipFinishedEvent;
+ OnFinished: TASyncUnzipFinishEvent;
OnProgress: TASyncUnzipProgressEvent); static;
end;
@@ -41,16 +41,16 @@ TUnzipInBackground = class(TThread)
FZipFile: String;
FDestPath: String;
FOnProgress: TASyncUnzipProgressEvent;
- FOnFinished: TASyncUnzipFinishedEvent;
+ FOnFinished: TASyncUnzipFinishEvent;
procedure DoProgress(Sender: TObject; Const ATotPos, ATotSize: Int64);
procedure Execute; override;
public
- constructor Create(ZipFile, DestPath: String; OnProgress: TASyncUnzipProgressEvent; OnFinished: TASyncUnzipFinishedEvent); reintroduce;
+ constructor Create(ZipFile, DestPath: String; OnProgress: TASyncUnzipProgressEvent; OnFinished: TASyncUnzipFinishEvent); reintroduce;
end;
-class procedure ASyncUnzip.Unzip(ZipFile, DestPath: String; OnFinished: TASyncUnzipFinishedEvent; OnProgress: TASyncUnzipProgressEvent);
+class procedure ASyncUnzip.Unzip(ZipFile, DestPath: String; OnFinished: TASyncUnzipFinishEvent; OnProgress: TASyncUnzipProgressEvent);
begin
TUnzipInBackground.Create(ZipFile, DestPath, OnProgress, OnFinished);
end;
@@ -96,7 +96,7 @@ procedure TUnzipInBackground.Execute;
FOnFinished(Result);
end;
-constructor TUnzipInBackground.Create(ZipFile, DestPath: String; OnProgress: TASyncUnzipProgressEvent; OnFinished: TASyncUnzipFinishedEvent);
+constructor TUnzipInBackground.Create(ZipFile, DestPath: String; OnProgress: TASyncUnzipProgressEvent; OnFinished: TASyncUnzipFinishEvent);
begin
inherited Create(False, 512*512);
diff --git a/Source/simba.geometry.pas b/Source/simba.geometry.pas
index 86050f1f5..bbfb431cc 100644
--- a/Source/simba.geometry.pas
+++ b/Source/simba.geometry.pas
@@ -36,27 +36,26 @@ interface
type
TSimbaGeometry = class
- public
- class var
+ public class var
CosTable: array[0..359] of Double;
SinTable: array[0..359] of Double;
public
class constructor Create;
- class function PolygonArea(const Polygon: TPointArray): Double; static; inline;
+ class function PolygonArea(const Polygon: TPointArray): Double; static;
class function ExpandPolygon(const Polygon: TPointArray; Amount: Integer): TPointArray; static;
class function CrossProduct(const r, p, q: TPoint): Int64; static; overload; inline;
class function CrossProduct(const rx,ry, px,py, qx,qy: Double): Double; static; overload; inline;
- class function LinesIntersect(const P1, P2, Q1, Q2: TPoint): Boolean; static; overload; inline;
- class function LinesIntersect(const P1, P2, Q1, Q2: TPoint; out Where: TPoint): Boolean; static; overload; inline;
- class function PointInTriangle(const P, P1, P2, P3: TPoint): Boolean; static; inline;
- class function PointInBox(const P: TPoint; const Box: TBox): Boolean; static; inline;
- class function PointInQuad(const P: TPoint; const A,B,C,D: TPoint): Boolean; static; overload; inline;
- class function PointInQuad(const X, Y: Integer; const A,B,C,D: TPoint): Boolean; static; overload; inline;
- class function PointInPolygon(const P: TPoint; const Polygon: TPointArray): Boolean; static; overload; inline;
- class function PointInPolygon(const X, Y: Integer; const Polygon: TPointArray): Boolean; static; overload; inline;
- class function PointInCircle(const X, Y, CenterX, CenterY: Integer; const Radius: Double): Boolean; static; overload; inline;
- class function PointInCircle(const P, Center: TPoint; const Radius: Double): Boolean; static; overload; inline;
+ class function LinesIntersect(const P1, P2, Q1, Q2: TPoint): Boolean; static; overload;
+ class function LinesIntersect(const P1, P2, Q1, Q2: TPoint; out Where: TPoint): Boolean; static; overload;
+ class function PointInTriangle(const P, P1, P2, P3: TPoint): Boolean; static;
+ class function PointInBox(const P: TPoint; const Box: TBox): Boolean; static;
+ class function PointInQuad(const P: TPoint; const A,B,C,D: TPoint): Boolean; static; overload;
+ class function PointInQuad(const X, Y: Integer; const A,B,C,D: TPoint): Boolean; static; overload;
+ class function PointInPolygon(const P: TPoint; const Polygon: TPointArray): Boolean; static; overload;
+ class function PointInPolygon(const X, Y: Integer; const Polygon: TPointArray): Boolean; static; overload;
+ class function PointInCircle(const X, Y, CenterX, CenterY: Integer; const Radius: Double): Boolean; static; overload;
+ class function PointInCircle(const P, Center: TPoint; const Radius: Double): Boolean; static; overload;
class function PointInEllipse(const P, Center: TPoint; const YRadius, XRadius: Double): Boolean; static;
class function RotatePointFast(const P: TPoint; Degrees: Integer; X, Y: Double): TPoint; static;
@@ -65,7 +64,7 @@ TSimbaGeometry = class
class function RotatePoint(const P: TPoint; Radians, X, Y: Double): TPoint; static;
class function RotatePoints(const Points: TPointArray; Radians, X, Y: Double): TPointArray; static;
- class function AngleBetween(const P1, P2: TPoint): Double; static; inline;
+ class function AngleBetween(const P1, P2: TPoint): Double; static;
class function DeltaAngle(const DegreesA, DegreesB: Double; R: Double = 360): Double; static;
class function DistToLine(const P, P1, P2: TPoint; out Nearest: TPoint): Double; static; overload;
class function DistToLine(const P, P1, P2: TPoint): Double; static; overload;
diff --git a/Source/simba.http_async.pas b/Source/simba.http_async.pas
index b91c894b2..6c7dff131 100644
--- a/Source/simba.http_async.pas
+++ b/Source/simba.http_async.pas
@@ -22,15 +22,13 @@ TASyncHTTPResult = record
Exception: String;
TimeUsed: Double;
end;
- TASyncHTTPFinishedEvent = procedure(constref Result: TASyncHTTPResult) of object;
+ TASyncHTTPFinishEvent = procedure(constref Result: TASyncHTTPResult) of object;
TASyncHTTPProgressEvent = procedure(URL: String; Position, Size: Int64) of object;
ASyncHTTP = class
- class procedure Get(URL: String; OnFinished: TASyncHTTPFinishedEvent; OnProgress: TASyncHTTPProgressEvent); static;
- class procedure Get(URL: String; DestFile: String; OnFinished: TASyncHTTPFinishedEvent; OnProgress: TASyncHTTPProgressEvent); static;
- class procedure GetZip(URL, DestFile: String; OnFinished: TASyncHTTPFinishedEvent; OnProgress: TASyncHTTPProgressEvent); static;
- class procedure Post(URL, PostData: String; OnFinished: TASyncHTTPFinishedEvent); static;
- class procedure Post(URL, PostData: String; Headers: TStringArray; OnFinished: TASyncHTTPFinishedEvent); static;
+ class procedure Get(URL: String; RequestHeaders: TStringArray; OnFinish: TASyncHTTPFinishEvent; OnProgress: TASyncHTTPProgressEvent); static;
+ class procedure Post(URL: String; RequestHeaders: TStringArray; Data: String; OnFinish: TASyncHTTPFinishEvent); static;
+ class procedure GetFile(URL: String; RequestHeaders: TStringArray; DestFile: String; OnFinish: TASyncHTTPFinishEvent; OnProgress: TASyncHTTPProgressEvent); static;
end;
implementation
@@ -43,102 +41,31 @@ TURLFetchInBackground = class(TThread)
protected
FURL: String;
FDestFile: String;
- FOnFinished: TASyncHTTPFinishedEvent;
+ FRequestHeaders: TStringArray;
+ FOnFinished: TASyncHTTPFinishEvent;
FOnProgress: TASyncHTTPProgressEvent;
procedure DoProgress(Sender: TObject; URL, ContentType: String; Position, Size: Int64);
procedure Execute; override;
public
- constructor Create(URL: String; OnFinished: TASyncHTTPFinishedEvent; OnProgress: TASyncHTTPProgressEvent); reintroduce;
- constructor Create(URL: String; DestFile: String; OnFinished: TASyncHTTPFinishedEvent; OnProgress: TASyncHTTPProgressEvent); reintroduce;
- end;
-
- TURLFetchZipInBackground = class(TThread)
- protected
- FURL: String;
- FDestFile: String;
- FOnFinished: TASyncHTTPFinishedEvent;
- FOnProgress: TASyncHTTPProgressEvent;
-
- procedure DoProgress(Sender: TObject; URL, ContentType: String; Position, Size: Int64);
- procedure DoExtract(Sender: TObject; FileName: String; Position, Size: Int64);
-
- procedure Execute; override;
- public
- constructor Create(URL, DestFile: String; OnFinished: TASyncHTTPFinishedEvent; OnProgress: TASyncHTTPProgressEvent); reintroduce;
+ constructor Create(URL: String; RequestHeaders: TStringArray; OnFinish: TASyncHTTPFinishEvent; OnProgress: TASyncHTTPProgressEvent); reintroduce;
+ constructor Create(URL: String; RequestHeaders: TStringArray; DestFile: String; OnFinish: TASyncHTTPFinishEvent; OnProgress: TASyncHTTPProgressEvent); reintroduce;
end;
TURLPostInBackground = class(TThread)
protected
FURL: String;
FPostData: String;
- FHeaders: TStringArray;
- FOnFinished: TASyncHTTPFinishedEvent;
+ FRequestHeaders: TStringArray;
+ FOnFinished: TASyncHTTPFinishEvent;
procedure Execute; override;
public
- constructor Create(URL, PostData: String; Headers: TStringArray; OnFinished: TASyncHTTPFinishedEvent); reintroduce;
+ constructor Create(URL, PostData: String; RequestHeaders: TStringArray; OnFinish: TASyncHTTPFinishEvent); reintroduce;
end;
-procedure TURLFetchZipInBackground.DoProgress(Sender: TObject; URL, ContentType: String; Position, Size: Int64);
-begin
- if Assigned(FOnProgress) then
- FOnProgress(URL, Position, Size);
-end;
-
-procedure TURLFetchZipInBackground.DoExtract(Sender: TObject; FileName: String; Position, Size: Int64);
-begin
- if Assigned(FOnProgress) then
- FOnProgress('extract', Position, Size);
-end;
-
-procedure TURLFetchZipInBackground.Execute;
-var
- Result: TASyncHTTPResult;
-begin
- Result := Default(TASyncHTTPResult);
- Result.URL := FURL;
- Result.TimeUsed := HighResolutionTime();
- Result.Data := FDestFile;
-
- try
- with TSimbaHTTPClient.Create() do
- try
- OnDownloadProgress := @DoProgress;
- OnExtractProgress := @DoExtract;
-
- GetZip(FURL, FDestFile, False, []);
-
- Result.Response := ResponseStatus;
- Result.Headers := ResponseHeaders.ToStringArray;
- finally
- Free();
- end;
- except
- on E: Exception do
- Result.Exception := E.Message;
- end;
-
- Result.TimeUsed := HighResolutionTime() - Result.TimeUsed;
-
- if Assigned(FOnFinished) then
- FOnFinished(Result);
-end;
-
-constructor TURLFetchZipInBackground.Create(URL, DestFile: String; OnFinished: TASyncHTTPFinishedEvent; OnProgress: TASyncHTTPProgressEvent);
-begin
- inherited Create(False, 512*512);
-
- FreeOnTerminate := True;
-
- FURL := URL;
- FDestFile := DestFile;
- FOnFinished := OnFinished;
- FOnProgress := OnProgress;
-end;
-
-constructor TURLPostInBackground.Create(URL, PostData: String; Headers: TStringArray; OnFinished: TASyncHTTPFinishedEvent);
+constructor TURLPostInBackground.Create(URL, PostData: String; RequestHeaders: TStringArray; OnFinish: TASyncHTTPFinishEvent);
begin
inherited Create(False, 512*512);
@@ -146,13 +73,14 @@ constructor TURLPostInBackground.Create(URL, PostData: String; Headers: TStringA
FURL := URL;
FPostData := PostData;
- FHeaders := Headers;
- FOnFinished := OnFinished;
+ FRequestHeaders := RequestHeaders;
+ FOnFinished := OnFinish;
end;
procedure TURLPostInBackground.Execute;
var
Result: TASyncHTTPResult;
+ I: Integer;
begin
Result := Default(TASyncHTTPResult);
Result.URL := FURL;
@@ -161,7 +89,12 @@ procedure TURLPostInBackground.Execute;
try
with TSimbaHTTPClient.Create() do
try
- RequestHeaders.AddStrings(FHeaders);
+ I := 0;
+ while (I < High(FRequestHeaders)) do
+ begin
+ RequestHeader[FRequestHeaders[i]] := FRequestHeaders[i+1];
+ I += 2;
+ end;
Result.Data := Post(FURL, FPostData);
Result.Response := ResponseStatus;
@@ -180,29 +113,19 @@ procedure TURLPostInBackground.Execute;
FOnFinished(Result);
end;
-class procedure ASyncHTTP.Get(URL: String; OnFinished: TASyncHTTPFinishedEvent; OnProgress: TASyncHTTPProgressEvent);
-begin
- TURLFetchInBackground.Create(URL, OnFinished, OnProgress);
-end;
-
-class procedure ASyncHTTP.Get(URL: String; DestFile: String; OnFinished: TASyncHTTPFinishedEvent; OnProgress: TASyncHTTPProgressEvent);
-begin
- TURLFetchInBackground.Create(URL, DestFile, OnFinished, OnProgress);
-end;
-
-class procedure ASyncHTTP.GetZip(URL, DestFile: String; OnFinished: TASyncHTTPFinishedEvent; OnProgress: TASyncHTTPProgressEvent);
+class procedure ASyncHTTP.Get(URL: String; RequestHeaders: TStringArray; OnFinish: TASyncHTTPFinishEvent; OnProgress: TASyncHTTPProgressEvent);
begin
- TURLFetchZipInBackground.Create(URL, DestFile, OnFinished, OnProgress);
+ TURLFetchInBackground.Create(URL, RequestHeaders, OnFinish, OnProgress);
end;
-class procedure ASyncHTTP.Post(URL, PostData: String; OnFinished: TASyncHTTPFinishedEvent);
+class procedure ASyncHTTP.GetFile(URL: String; RequestHeaders: TStringArray; DestFile: String; OnFinish: TASyncHTTPFinishEvent; OnProgress: TASyncHTTPProgressEvent);
begin
- TURLPostInBackground.Create(URL, PostData, [], OnFinished);
+ TURLFetchInBackground.Create(URL, RequestHeaders, DestFile, OnFinish, OnProgress);
end;
-class procedure ASyncHTTP.Post(URL, PostData: String; Headers: TStringArray; OnFinished: TASyncHTTPFinishedEvent);
+class procedure ASyncHTTP.Post(URL: String; RequestHeaders: TStringArray; Data: String; OnFinish: TASyncHTTPFinishEvent);
begin
- TURLPostInBackground.Create(URL, PostData, Headers, OnFinished);
+ TURLPostInBackground.Create(URL, Data, RequestHeaders, OnFinish);
end;
procedure TURLFetchInBackground.DoProgress(Sender: TObject; URL, ContentType: String; Position, Size: Int64);
@@ -214,6 +137,7 @@ procedure TURLFetchInBackground.DoProgress(Sender: TObject; URL, ContentType: St
procedure TURLFetchInBackground.Execute;
var
Result: TASyncHTTPResult;
+ I: Integer;
begin
Result := Default(TASyncHTTPResult);
Result.URL := FURL;
@@ -224,6 +148,13 @@ procedure TURLFetchInBackground.Execute;
try
OnDownloadProgress := @DoProgress;
+ I := 0;
+ while (I < High(FRequestHeaders)) do
+ begin
+ RequestHeader[FRequestHeaders[i]] := FRequestHeaders[i+1];
+ I += 2;
+ end;
+
if (FDestFile <> '') then
begin
GetFile(FURL, FDestFile);
@@ -248,27 +179,23 @@ procedure TURLFetchInBackground.Execute;
FOnFinished(Result);
end;
-constructor TURLFetchInBackground.Create(URL: String; OnFinished: TASyncHTTPFinishedEvent; OnProgress: TASyncHTTPProgressEvent);
+constructor TURLFetchInBackground.Create(URL: String; RequestHeaders: TStringArray; OnFinish: TASyncHTTPFinishEvent; OnProgress: TASyncHTTPProgressEvent);
begin
inherited Create(False, 512*512);
FreeOnTerminate := True;
FURL := URL;
- FOnFinished := OnFinished;
+ FOnFinished := OnFinish;
FOnProgress := OnProgress;
+ FRequestHeaders := RequestHeaders;
end;
-constructor TURLFetchInBackground.Create(URL: String; DestFile: String; OnFinished: TASyncHTTPFinishedEvent; OnProgress: TASyncHTTPProgressEvent);
+constructor TURLFetchInBackground.Create(URL: String; RequestHeaders: TStringArray; DestFile: String; OnFinish: TASyncHTTPFinishEvent; OnProgress: TASyncHTTPProgressEvent);
begin
- inherited Create(False, 512*512);
-
- FreeOnTerminate := True;
+ Create(URL, RequestHeaders, OnFinish, OnProgress);
FDestFile := DestFile;
- FURL := URL;
- FOnFinished := OnFinished;
- FOnProgress := OnProgress;
end;
end.
diff --git a/Source/simba.inc b/Source/simba.inc
index 0b159d51c..1bfcbb5a7 100644
--- a/Source/simba.inc
+++ b/Source/simba.inc
@@ -9,7 +9,7 @@
{$DEFINE SIMBA_HAS_DEBUGINFO}
{$ELSE}
{$IFDEF SIMBA_MAX_OPTIMIZATION} // -O4 can do "unsafe" optimizations so this is not globally enabled.
- {$OPTIMIZATION LEVEL4}
+ {.$OPTIMIZATION LEVEL4}
{$ENDIF}
{$ENDIF}
diff --git a/Source/simba.threading.pas b/Source/simba.threading.pas
index e3799094f..5b0bbc158 100644
--- a/Source/simba.threading.pas
+++ b/Source/simba.threading.pas
@@ -108,8 +108,17 @@ TPoolThread = class(TThread)
var
SimbaThreadPool: TSimbaThreadPool = nil;
+ SimbaCPUInfo: record
+ CoreCount: Integer;
+ ThreadCount: Integer;
+ PhysicalMemory: Integer;
+ end;
+
implementation
+uses
+ NumCPULib;
+
procedure TLimit.Inc;
begin
InterlockedIncrement(FCount);
@@ -487,10 +496,11 @@ destructor TSimbaThreadPool.TPoolThread.Destroy;
end;
initialization
- if (TThread.ProcessorCount > 10) then
- SimbaThreadPool := TSimbaThreadPool.Create(Round(TThread.ProcessorCount * 0.75)) // dont go crazy if we have >8 cores.
- else
- SimbaThreadPool := TSimbaThreadPool.Create(TThread.ProcessorCount);
+ SimbaCPUInfo.ThreadCount := TNumCPULib.GetLogicalCPUCount();
+ SimbaCPUInfo.CoreCount := TNumCPULib.GetPhysicalCPUCount();
+ SimbaCPUInfo.PhysicalMemory := TNumCPULib.GetTotalPhysicalMemory();
+
+ SimbaThreadPool := TSimbaThreadPool.Create(SimbaCPUInfo.CoreCount);
finalization
FreeAndNil(SimbaThreadPool);
diff --git a/Source/simba.vartype_pointarray.pas b/Source/simba.vartype_pointarray.pas
index c4ef69c89..aaa19585c 100644
--- a/Source/simba.vartype_pointarray.pas
+++ b/Source/simba.vartype_pointarray.pas
@@ -1261,8 +1261,9 @@ function TPointArrayHelper.Grow(Iterations: Integer): TPointArray;
function TPointArrayHelper.Unique: TPointArray;
var
- Area, Width, Index: Integer;
+ Width, Index: Integer;
Box: TBox;
+ BoxArea: Int64;
Seen: TBooleanArray;
SrcPtr, DstPtr: PPoint;
SrcUpper: PtrUInt;
@@ -1275,14 +1276,14 @@ function TPointArrayHelper.Unique: TPointArray;
* Larger than 512MB in memory (approx 25K*25K area)
}
Box := Self.Bounds;
- Area := Box.Area;
+ BoxArea := Box.Area;
Width := Box.Width;
- if (Area * SizeOf(TPoint) > $20000000) or
- (Length(Self) / Area < 0.0002) then
+ if (BoxArea * SizeOf(TPoint) > $20000000) or
+ (Length(Self) / BoxArea < 0.0002) then
Exit(specialize TArrayUnique.Unique(Self));
SetLength(Result, Length(Self));
- SetLength(Seen, Area);
+ SetLength(Seen, BoxArea);
SrcUpper := PtrUInt(@Self[High(Self)]);
SrcPtr := @Self[0];
@@ -3327,6 +3328,11 @@ function T2DPointArrayHelper.Intersection: TPointArray;
var
I: Integer;
begin
+ if (Length(Self) = 0) then
+ Exit(Default(TPointArray));
+ if (Length(Self) = 1) then
+ Exit(Self[0]);
+
Result := Self[0].Intersection(Self[1]);
if (Length(Result) > 0) and (Length(Self) > 1) then
diff --git a/Tests/async_schedule.simba b/Tests/async_schedule.simba
new file mode 100644
index 000000000..bb06bd391
--- /dev/null
+++ b/Tests/async_schedule.simba
@@ -0,0 +1,21 @@
+{$assertions on}
+
+var
+ myVar: Integer;
+
+procedure counter;
+begin
+ Inc(myVar);
+end;
+
+begin
+ ASync.ScheduleEvery("counter", @counter, 1000);
+ Sleep(3000);
+ Assert(ToString(ASync.Schedules) = "[counter]");
+ ASync.ScheduleStop("counter");
+
+ Assert(myVar > 1);
+ Assert(ToString(ASync.Schedules) = "[]");
+
+ Sleep(1000);
+end.
diff --git a/Tests/threading.simba b/Tests/threading.simba
new file mode 100644
index 000000000..a4d2240bf
--- /dev/null
+++ b/Tests/threading.simba
@@ -0,0 +1,140 @@
+{$assertions on}
+
+var
+ i: Integer;
+ myThread: TThread;
+
+procedure MyProc;
+begin
+ while not CurrentThread.IsTerminated do
+ begin
+ if (i < 10) then
+ i := i + 1;
+ Sleep(25);
+ end;
+end;
+
+procedure MyProcTerminated(thread: TThread);
+begin
+ Assert(i = 10);
+ Assert(Thread.Name = 'Test1');
+ Assert(Thread.FatalException = '');
+end;
+
+procedure Integer.MyProc;
+begin
+ while not CurrentThread.IsTerminated do
+ begin
+ if (Self < 10) then
+ Self := Self + 1;
+ Sleep(25);
+ end;
+end;
+
+procedure Integer.MyProcTerminated(thread: TThread);
+begin
+ Assert(Self = 10);
+ Assert(Thread.Name = 'Test2');
+ Assert(Thread.FatalException = '');
+end;
+
+begin
+ i := 0;
+ myThread := TThread.Create(@MyProc, @MyProcTerminated);
+ myThread.Name := 'Test1';
+ Sleep(1000);
+ myThread.Terminate();
+ myThread.WaitForTerminate();
+ myThread.Free();
+
+ i := 0;
+ myThread := TThread.Create(@i.MyProc, @i.MyProcTerminated);
+ myThread.Name := 'Test2';
+ Sleep(1000);
+ myThread.Terminate();
+ myThread.WaitForTerminate();
+ myThread.Free();
+end;
+
+procedure MyProcWithParams(Params: TPointerArray);
+begin
+ Assert(Length(Params) = 2);
+ Assert(Params[0] = @i);
+ Assert(Params[1] = Pointer(1));
+
+ while not CurrentThread.IsTerminated do
+ begin
+ if (Integer(Params[0]^) < 10) then
+ Integer(Params[0]^) := Integer(Params[0]^) + 1;
+ Sleep(25);
+ end;
+end;
+
+procedure MyProcTerminatedWithParam(thread: TThread; Params: TPointerArray);
+begin
+ Assert(Length(Params) = 2);
+ Assert(Params[0] = @i);
+ Assert(Params[1] = Pointer(1));
+ Assert(Thread.Name = 'Test3');
+ Assert(Thread.FatalException = '');
+end;
+
+begin
+ i := 0;
+ myThread := TThread.CreateEx(@MyProcWithParams, @MyProcTerminatedWithParam, [@i, Pointer(1)]);
+ myThread.Name := 'Test3';
+ Sleep(1000);
+ myThread.Terminate();
+ myThread.WaitForTerminate();
+ myThread.Free();
+end;
+
+procedure Integer.MyProcWithParams(Params: TPointerArray);
+begin
+ Assert(Length(Params) = 2);
+ Assert(Params[0] = @i);
+ Assert(Params[1] = Pointer(1));
+
+ while not CurrentThread.IsTerminated do
+ begin
+ if (Integer(Params[0]^) < 10) then
+ Integer(Params[0]^) := Integer(Params[0]^) + 1;
+ Sleep(25);
+ end;
+end;
+
+procedure Integer.MyProcTerminatedWithParam(thread: TThread; Params: TPointerArray);
+begin
+ Assert(Self = 10);
+ Assert(Length(Params) = 2);
+ Assert(Params[0] = @i);
+ Assert(Params[1] = Pointer(1));
+ Assert(Thread.Name = 'Test4');
+ Assert(Thread.FatalException = '');
+end;
+
+begin
+ i := 0;
+ myThread := TThread.CreateEx(@i.MyProcWithParams, @i.MyProcTerminatedWithParam, [@i, Pointer(1)]);
+ myThread.Name := 'Test4';
+ Sleep(1000);
+ myThread.Terminate();
+ myThread.WaitForTerminate();
+ myThread.Free();
+end;
+
+procedure TestExceptionInThread;
+begin
+ raise 'Exception in thread: ' + ToString(CurrentThread.ThreadID);
+end;
+
+begin
+ with TThread.Create(@TestExceptionInThread) do
+ try
+ WaitForTerminate();
+ Assert(FatalException = 'Exception in thread: ' + ToString(ThreadID));
+ finally
+ Free();
+ end;
+end;
+
diff --git a/Tests/threading_locks.simba b/Tests/threading_locks.simba
new file mode 100644
index 000000000..d7856a728
--- /dev/null
+++ b/Tests/threading_locks.simba
@@ -0,0 +1,55 @@
+{$assertions on}
+
+var
+ lock: TLock := TLock.Create();
+ counter, errors: Integer;
+
+procedure TestWithLocks;
+var
+ expected: Integer;
+begin
+ while GetTimeRunning() < 1000 do
+ begin
+ lock.Enter();
+ expected := counter;
+ sleep(10);
+ if (counter <> expected) then
+ Inc(errors);
+ inc(counter);
+ lock.Leave();
+ end;
+end;
+
+procedure TestWithoutLocks;
+var
+ expected: Integer;
+begin
+ while GetTimeRunning() < 1000 do
+ begin
+ expected := counter;
+ sleep(10);
+ if (counter <> expected) then
+ Inc(errors);
+ inc(counter);
+ end;
+end;
+
+begin
+ counter := 0;
+ errors := 0;
+ RunInThread(@TestWithoutLocks);
+ RunInThread(@TestWithoutLocks);
+ RunInThread(@TestWithoutLocks);
+ Sleep(1500);
+ Assert(errors > 0);
+
+ counter := 0;
+ errors := 0;
+ RunInThread(@TestWithoutLocks);
+ RunInThread(@TestWithoutLocks);
+ RunInThread(@TestWithoutLocks);
+ Sleep(1500);
+ Assert(errors = 0);
+
+ lock.Free();
+end;
diff --git a/Third-Party/numcpulib.pas b/Third-Party/numcpulib.pas
new file mode 100644
index 000000000..83460e89a
--- /dev/null
+++ b/Third-Party/numcpulib.pas
@@ -0,0 +1,1500 @@
+{ *********************************************************************************** }
+{ * NumCPULib Library * }
+{ * Copyright (c) 2019 Ugochukwu Mmaduekwe * }
+{ * Github Repository * }
+
+{ * Distributed under the MIT software license, see the accompanying file LICENSE * }
+{ * or visit http://www.opensource.org/licenses/mit-license.php. * }
+
+{ * ******************************************************************************* * }
+
+(* &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& *)
+
+unit NumCPULib;
+
+{$DEFINE DELPHI}
+
+{$IFDEF FPC}
+{$UNDEF DELPHI}
+{$MODE DELPHI}
+
+// Disable Hints.
+{$HINTS OFF}
+
+{$IFDEF CPU386}
+ {$DEFINE NUMCPULIB_X86}
+{$ENDIF}
+
+{$IFDEF CPUX64}
+ {$DEFINE NUMCPULIB_X86_64}
+{$ENDIF}
+
+{$IFDEF CPUARM}
+ {$DEFINE NUMCPULIB_ARM}
+{$ENDIF}
+
+{$IFDEF CPUAARCH64}
+ {$DEFINE NUMCPULIB_AARCH64}
+{$ENDIF}
+
+{$IF DEFINED(NUMCPULIB_ARM) OR DEFINED(NUMCPULIB_AARCH64)}
+ {$DEFINE NUMCPULIB_ARMCPU}
+{$IFEND}
+
+{$IFDEF IPHONESIM}
+ {$DEFINE NUMCPULIB_IOSSIM}
+{$ENDIF}
+
+{$IF DEFINED(MSWINDOWS)}
+ {$DEFINE NUMCPULIB_MSWINDOWS}
+{$ELSEIF DEFINED(UNIX)}
+ {$DEFINE NUMCPULIB_UNIX}
+ {$IF DEFINED(BSD)}
+ {$IF DEFINED(DARWIN)}
+ {$DEFINE NUMCPULIB_APPLE}
+ {$IF DEFINED(NUMCPULIB_ARM) OR DEFINED(NUMCPULIB_AARCH64)}
+ {$DEFINE NUMCPULIB_IOS}
+ {$ELSE}
+ {$DEFINE NUMCPULIB_MACOS}
+ {$IFEND}
+ {$ELSEIF DEFINED(FREEBSD) OR DEFINED(NETBSD) OR DEFINED(OPENBSD) OR DEFINED(DRAGONFLY)}
+ {$DEFINE NUMCPULIB_GENERIC_BSD}
+ {$IFEND}
+ {$ELSEIF DEFINED(ANDROID)}
+ {$DEFINE NUMCPULIB_ANDROID}
+ {$ELSEIF DEFINED(LINUX)}
+ {$DEFINE NUMCPULIB_LINUX}
+ {$ELSEIF DEFINED(SOLARIS)}
+ {$DEFINE NUMCPULIB_SOLARIS}
+ {$ELSE}
+ {$DEFINE NUMCPULIB_UNDEFINED_UNIX_VARIANTS}
+ {$IFEND}
+{$ELSE}
+ //{$MESSAGE ERROR 'UNSUPPORTED TARGET.'}
+{$IFEND}
+
+{$IFDEF NUMCPULIB_ANDROID}
+ {$DEFINE NUMCPULIB_LINUX}
+{$ENDIF}
+
+{$IF DEFINED(NUMCPULIB_GENERIC_BSD) OR DEFINED(NUMCPULIB_APPLE)}
+ {$DEFINE NUMCPULIB_HAS_SYSCTL}
+{$IFEND}
+
+{$IF DEFINED(NUMCPULIB_LINUX) OR DEFINED(NUMCPULIB_GENERIC_BSD) OR DEFINED(NUMCPULIB_SOLARIS) OR DEFINED(NUMCPULIB_APPLE)}
+ {$DEFINE NUMCPULIB_HAS_SYSCONF}
+{$IFEND}
+
+{$IF DEFINED(NUMCPULIB_LINUX) OR DEFINED(NUMCPULIB_SOLARIS)}
+ {$DEFINE NUMCPULIB_WILL_PARSE_DATA}
+{$IFEND}
+
+{$ENDIF FPC}
+
+(* &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& *)
+
+{$IFDEF DELPHI}
+
+ // XE3 and Above
+{$IF CompilerVersion >= 24.0}
+ {$DEFINE DELPHIXE3_UP}
+ {$LEGACYIFEND ON}
+ {$ZEROBASEDSTRINGS OFF}
+{$IFEND}
+
+{$IFDEF CPU386}
+ {$DEFINE NUMCPULIB_X86}
+{$ENDIF}
+
+{$IFDEF CPUX64}
+ {$DEFINE NUMCPULIB_X86_64}
+{$ENDIF}
+
+{$IFDEF CPUARM32}
+ {$DEFINE NUMCPULIB_ARM}
+{$ENDIF}
+
+{$IFDEF CPUARM64}
+ {$DEFINE NUMCPULIB_AARCH64}
+{$ENDIF}
+
+{$IF DEFINED(NUMCPULIB_ARM) OR DEFINED(NUMCPULIB_AARCH64)}
+ {$DEFINE NUMCPULIB_ARMCPU}
+{$IFEND}
+
+{$IFDEF IOS}
+ {$IFNDEF CPUARM}
+ {$DEFINE NUMCPULIB_IOSSIM}
+ {$ENDIF}
+{$ENDIF}
+
+{$IFDEF IOS}
+ {$DEFINE NUMCPULIB_IOS}
+{$ENDIF}
+
+{$IFDEF MSWINDOWS}
+ {$DEFINE NUMCPULIB_MSWINDOWS}
+{$ENDIF}
+
+{$IFDEF MACOS}
+ {$IFNDEF IOS}
+ {$DEFINE NUMCPULIB_MACOS}
+ {$ENDIF}
+{$ENDIF}
+
+{$IFDEF ANDROID}
+ {$DEFINE NUMCPULIB_ANDROID}
+{$ENDIF}
+
+{$IF DEFINED(NUMCPULIB_IOS) OR DEFINED(NUMCPULIB_MACOS)}
+ {$DEFINE NUMCPULIB_APPLE}
+{$IFEND}
+
+{$IF DEFINED(LINUX) OR DEFINED(NUMCPULIB_ANDROID)}
+ {$DEFINE NUMCPULIB_LINUX}
+{$IFEND}
+
+{$IF DEFINED(NUMCPULIB_APPLE)}
+ {$DEFINE NUMCPULIB_HAS_SYSCTL}
+{$IFEND}
+
+{$IF DEFINED(NUMCPULIB_LINUX) OR DEFINED(NUMCPULIB_APPLE)}
+ {$DEFINE NUMCPULIB_HAS_SYSCONF}
+{$IFEND}
+
+{$IF DEFINED(NUMCPULIB_MSWINDOWS)}
+// XE2 and Above
+ {$IF CompilerVersion >= 23.0}
+ {$DEFINE DELPHIXE2_UP}
+ {$DEFINE HAS_GET_LOGICAL_PROCESSOR_INFORMATION_INBUILT}
+ {$IFEND}
+{$IFEND}
+
+{$IFDEF NUMCPULIB_LINUX}
+ {$DEFINE NUMCPULIB_WILL_PARSE_DATA}
+{$ENDIF}
+
+{$ENDIF DELPHI}
+
+interface
+
+uses
+{$IFDEF NUMCPULIB_MSWINDOWS}
+ Windows,
+{$ENDIF} // ENDIF NUMCPULIB_MSWINDOWS
+ // ================================================================//
+{$IFDEF NUMCPULIB_HAS_SYSCONF}
+{$IFDEF FPC}
+ unixtype,
+{$IFDEF LINUX}
+ Linux,
+{$ENDIF} // ENDIF LINUX
+{$ELSE}
+ Posix.Unistd,
+{$ENDIF} // ENDIF FPC
+{$ENDIF} // ENDIF NUMCPULIB_HAS_SYSCONF
+ // ================================================================//
+{$IFDEF NUMCPULIB_HAS_SYSCTL}
+{$IFDEF FPC}
+ sysctl,
+{$ELSE}
+ Posix.SysTypes,
+ Posix.SysSysctl,
+{$ENDIF} // ENDIF FPC
+{$ENDIF} // ENDIF NUMCPULIB_HAS_SYSCTL
+ // ================================================================//
+{$IFDEF NUMCPULIB_APPLE}
+{$IFDEF NUMCPULIB_MACOS}
+{$IFDEF FPC}
+ CocoaAll,
+{$ELSE}
+ Macapi.AppKit,
+{$ENDIF} // ENDIF FPC
+{$ENDIF} // ENDIF NUMCPULIB_MACOS
+{$ENDIF} // ENDIF NUMCPULIB_APPLE
+ // ================================================================//
+{$IFDEF NUMCPULIB_WILL_PARSE_DATA}
+{$IFDEF NUMCPULIB_SOLARIS}
+ Process,
+{$ENDIF} // ENDIF NUMCPULIB_SOLARIS
+ Classes,
+ StrUtils,
+{$ENDIF} // ENDIF NUMCPULIB_WILL_PARSE_DATA
+
+ // ================================================================//
+ SysUtils;
+
+type
+ ///
+ ///
+ /// A class with utilities to determine the number of CPUs available on
+ /// the current system.
+ ///
+ ///
+ /// This information can be used as a guide to how many tasks can be
+ /// run in parallel.
+ ///
+ ///
+ /// There are many properties of the system architecture that will
+ /// affect parallelism, for example memory access speeds (for all the
+ /// caches and RAM) and the physical architecture of the processor, so
+ /// the number of CPUs should be used as a rough guide only.
+ ///
+ ///
+ TNumCPULib = class sealed(TObject)
+
+ strict private
+
+ // ================================================================//
+{$IFDEF NUMCPULIB_HAS_SYSCONF}
+ class function GetAppropriateSysConfNumber(): Int32; static;
+{$ENDIF}
+ // ================================================================//
+{$IFDEF NUMCPULIB_HAS_SYSCTL}
+{$IFDEF NUMCPULIB_APPLE}
+ class function GetValueUsingSysCtlByName(const AName: String)
+ : UInt64; static;
+{$ENDIF}
+ class function GetLogicalCPUCountUsingSysCtl(): UInt32; static;
+{$ENDIF}
+ // ================================================================//
+{$IFDEF NUMCPULIB_MSWINDOWS}
+
+ const
+ KERNEL32 = 'kernel32.dll';
+
+{$IFNDEF HAS_GET_LOGICAL_PROCESSOR_INFORMATION_INBUILT}
+
+ type
+
+ TLogicalProcessorRelationship = (RelationProcessorCore = 0,
+ RelationNumaNode = 1, RelationCache = 2, RelationProcessorPackage = 3,
+ RelationGroup = 4, RelationAll = $FFFF);
+ TProcessorCacheType = (CacheUnified, CacheInstruction, CacheData,
+ CacheTrace);
+
+ TCacheDescriptor = record
+ Level: Byte;
+ Associativity: Byte;
+ LineSize: Word;
+ Size: DWORD;
+ pcType: TProcessorCacheType;
+ end;
+
+ PSystemLogicalProcessorInformation = ^TSystemLogicalProcessorInformation;
+
+ TSystemLogicalProcessorInformation = record
+ ProcessorMask: ULONG_PTR;
+ Relationship: TLogicalProcessorRelationship;
+ case Int32 of
+ 0:
+ (Flags: Byte);
+ 1:
+ (NodeNumber: DWORD);
+ 2:
+ (Cache: TCacheDescriptor);
+ 3:
+ (Reserved: array [0 .. 1] of ULONGLONG);
+ end;
+
+ KAffinity = NativeUInt;
+
+ TGroupAffinity = record
+ Mask: KAffinity;
+ Group: Word;
+ Reserved: array [0 .. 2] of Word;
+ end;
+
+ TProcessorRelationship = record
+ Flags: Byte;
+ Reserved: array [0 .. 20] of Byte;
+ GroupCount: Word;
+ GroupMask: array [0 .. 0] of TGroupAffinity;
+ end;
+
+ TNumaNodeRelationship = record
+ NodeNumber: DWORD;
+ Reserved: array [0 .. 19] of Byte;
+ GroupMask: TGroupAffinity;
+ end;
+
+ TCacheRelationship = record
+ Level: Byte;
+ Associativity: Byte;
+ LineSize: Word;
+ CacheSize: DWORD;
+ _Type: TProcessorCacheType;
+ Reserved: array [0 .. 19] of Byte;
+ GroupMask: TGroupAffinity;
+ end;
+
+ TProcessorGroupInfo = record
+ MaximumProcessorCount: Byte;
+ ActiveProcessorCount: Byte;
+ Reserved: array [0 .. 37] of Byte;
+ ActiveProcessorMask: KAffinity;
+ end;
+
+ TGroupRelationship = record
+ MaximumGroupCount: Word;
+ ActiveGroupCount: Word;
+ Reserved: array [0 .. 19] of Byte;
+ GroupInfo: array [0 .. 0] of TProcessorGroupInfo;
+ end;
+
+ PSystemLogicalProcessorInformationEx = ^
+ TSystemLogicalProcessorInformationEx;
+
+ TSystemLogicalProcessorInformationEx = record
+ Relationship: TLogicalProcessorRelationship;
+ Size: DWORD;
+ case Int32 of
+ 0:
+ (Processor: TProcessorRelationship);
+ 1:
+ (NumaNode: TNumaNodeRelationship);
+ 2:
+ (Cache: TCacheRelationship);
+ 3:
+ (Group: TGroupRelationship);
+ end;
+
+ MEMORYSTATUSEX = record
+ dwLength : DWORD;
+ dwMemoryLoad : DWORD;
+ ullTotalPhys : uint64;
+ ullAvailPhys : uint64;
+ ullTotalPageFile : uint64;
+ ullAvailPageFile : uint64;
+ ullTotalVirtual : uint64;
+ ullAvailVirtual : uint64;
+ ullAvailExtendedVirtual : uint64;
+ end;
+ TMemoryStatusEx = MEMORYSTATUSEX;
+
+{$ENDIF}
+
+ // ================================================================//
+
+ type
+ TGetLogicalProcessorInformation = function(Buffer:
+{$IFNDEF HAS_GET_LOGICAL_PROCESSOR_INFORMATION_INBUILT}TNumCPULib.{$ENDIF}PSystemLogicalProcessorInformation; var ReturnLength: DWORD): BOOL; stdcall;
+
+ TGetLogicalProcessorInformationEx = function(RelationshipType
+ : TLogicalProcessorRelationship; Buffer:
+{$IFNDEF HAS_GET_LOGICAL_PROCESSOR_INFORMATION_INBUILT}TNumCPULib.{$ENDIF}PSystemLogicalProcessorInformationEx; var ReturnLength: DWORD): BOOL; stdcall;
+
+ TGetGlobalMemoryStatus = procedure(var Buffer:MemoryStatus); stdcall;
+ TGetGlobalMemoryStatusEx = function(var Buffer:TMemoryStatusEx): BOOL; stdcall;
+
+ class var
+
+ FIsGetLogicalProcessorInformationAvailable,
+ FIsGetLogicalProcessorInformationAvailableEx: Boolean;
+ FGetLogicalProcessorInformation: TGetLogicalProcessorInformation;
+ FGetLogicalProcessorInformationEx: TGetLogicalProcessorInformationEx;
+
+ FIsGetGlobalMemoryStatusAvailable,
+ FIsGetGlobalMemoryStatusAvailableEx: Boolean;
+ FGetGlobalMemoryStatus: TGetGlobalMemoryStatus;
+ FGetGlobalMemoryStatusEx: TGetGlobalMemoryStatusEx;
+
+ // ================================================================//
+
+ type
+ TProcessorInformation = record
+ LogicalProcessorCount: UInt32;
+ ProcessorCoreCount: UInt32;
+ end;
+
+ type
+ TProcessorInformationEx = record
+ LogicalProcessorCount: UInt32;
+ ProcessorCoreCount: UInt32;
+ end;
+
+ // ================================================================//
+ class function GetProcedureAddress(ModuleHandle: THandle;
+ const AProcedureName: String; var AFunctionFound: Boolean): Pointer; static;
+ class function IsGetLogicalProcessorInformationAvailable(): Boolean; static;
+ class function IsGetLogicalProcessorInformationExAvailable(): Boolean; static;
+ class function CountSetBits(ABitMask: NativeUInt): UInt32; static;
+ class function GetProcessorInfo(): TProcessorInformation; static;
+ class function GetProcessorInfoEx(): TProcessorInformationEx; static;
+
+ class function IsGetGlobalMemoryStatusAvailable(): Boolean; static;
+ class function IsGetGlobalMemoryStatusAvailableEx(): Boolean; static;
+ class function GetPhysicalMemoryEx(): UInt32;
+ class function GetPhysicalMemory(): UInt32;
+
+ class function GetLogicalCPUCountWindows(): UInt32; static;
+ class function GetPhysicalCPUCountWindows(): UInt32; static;
+ class function GetTotalPhysicalMemoryWindows(): UInt32; static;
+{$ENDIF}
+ // ================================================================//
+{$IFDEF NUMCPULIB_APPLE}
+ class function GetLogicalCPUCountApple(): UInt32; static;
+ class function GetPhysicalCPUCountApple(): UInt32; static;
+ class function GetTotalPhysicalMemoryApple(): UInt32; static;
+{$ENDIF}
+ // ================================================================//
+{$IFDEF NUMCPULIB_WILL_PARSE_DATA}
+
+ type
+ TNumCPULibStringArray = array of String;
+
+ class function SplitString(const AInputString: String; ADelimiter: Char)
+ : TNumCPULibStringArray; static;
+
+ class function ParseLastString(const AInputString: String): String; static;
+ class function ParseInt32(const AInputString: String;
+ ADefault: Int32): Int32;
+ class function ParseLastInt32(const AInputString: String; ADefault: Int32)
+ : Int32; static;
+
+ class function BeginsWith(const AInputString, ASubString: string;
+ AIgnoreCase: Boolean; AOffset: Int32 = 1): Boolean; static;
+{$ENDIF}
+ // ================================================================//
+{$IFDEF NUMCPULIB_LINUX}
+
+ type
+ TLogicalProcessor = record
+ private
+ var
+ ProcessorNumber, PhysicalProcessorNumber, PhysicalPackageNumber: UInt32;
+ public
+ class function Create(AProcessorNumber, APhysicalProcessorNumber,
+ APhysicalPackageNumber: UInt32): TLogicalProcessor; static;
+ end;
+
+ class procedure ReadFileContents(const AFilePath: String;
+ var AOutputParameters: TStringList); static;
+ class function GetLogicalCPUCountLinux(): UInt32; static;
+ class function GetPhysicalCPUCountLinux(): UInt32; static;
+ class function GetTotalPhysicalMemoryLinux(): UInt32; static;
+ class function GetTotalSwapMemoryLinux(): UInt32; static;
+{$ENDIF}
+ // ================================================================//
+{$IFDEF NUMCPULIB_SOLARIS}
+ class procedure ExecuteAndParseProcessOutput(const ACallingProcess: String;
+ AInputParameters: TStringList; var AOutputParameters: TStringList);
+ class function GetLogicalCPUCountSolaris(): UInt32; static;
+ class function GetPhysicalCPUCountSolaris(): UInt32; static;
+ class function GetTotalPhysicalMemorySolaris(): UInt32; static;
+{$ENDIF}
+ // ================================================================//
+{$IFDEF NUMCPULIB_GENERIC_BSD}
+ class function GetLogicalCPUCountGenericBSD(): UInt32; static;
+{$ENDIF}
+ // ================================================================//
+
+ class procedure Boot(); static;
+ class constructor NumCPULib();
+
+ public
+
+ ///
+ /// This function will get the number of logical cores. Sometimes this is
+ /// different from the number of physical cores.
+ ///
+ class function GetLogicalCPUCount(): UInt32; static;
+
+ ///
+ /// This function will get the number of physical cores.
+ ///
+ class function GetPhysicalCPUCount(): UInt32; static;
+
+ class function GetTotalPhysicalMemory(): UInt32; static;
+ class function GetTotalSwapMemory(): UInt32; static;
+ end;
+
+{$IFDEF NUMCPULIB_HAS_SYSCONF}
+{$IFDEF FPC}
+
+function sysconf(i: cint): clong; cdecl; external 'c' name 'sysconf';
+{$ENDIF}
+{$ENDIF}
+
+implementation
+
+{ TNumCPULib }
+
+class procedure TNumCPULib.Boot();
+begin
+{$IFDEF NUMCPULIB_MSWINDOWS}
+ FIsGetLogicalProcessorInformationAvailable :=
+ IsGetLogicalProcessorInformationAvailable();
+ FIsGetLogicalProcessorInformationAvailableEx :=
+ IsGetLogicalProcessorInformationExAvailable();
+
+ FIsGetGlobalMemoryStatusAvailable :=
+ IsGetGlobalMemoryStatusAvailable();
+ FIsGetGlobalMemoryStatusAvailableEx :=
+ IsGetGlobalMemoryStatusAvailableEx();
+{$ENDIF}
+end;
+
+class constructor TNumCPULib.NumCPULib;
+begin
+ TNumCPULib.Boot();
+end;
+
+// ================================================================//
+{$IFDEF NUMCPULIB_HAS_SYSCONF}
+
+class function TNumCPULib.GetAppropriateSysConfNumber(): Int32;
+begin
+ // On ARM targets, processors could be turned off to save power So we
+ // use `_SC_NPROCESSORS_CONF` to get the real number.
+ // ****************************************************************//
+ // NUMCPULIB_LINUX
+{$IFDEF NUMCPULIB_LINUX}
+{$IFDEF NUMCPULIB_ARMCPU}
+{$IFDEF NUMCPULIB_ANDROID}
+ Result := 96; // _SC_NPROCESSORS_CONF
+{$ELSE}
+ // Devices like RPI
+ Result := 83; // _SC_NPROCESSORS_CONF
+{$ENDIF}
+{$ELSE}
+ // for non ARM Linux like CPU's
+{$IFDEF NUMCPULIB_ANDROID}
+ Result := 97; // _SC_NPROCESSORS_ONLN
+{$ELSE}
+ Result := 84; // _SC_NPROCESSORS_ONLN
+{$ENDIF} // ENDIF NUMCPULIB_ANDROID
+
+{$ENDIF} // ENDIF NUMCPULIB_ARMCPU
+{$ENDIF} // ENDIF NUMCPULIB_LINUX
+ // ****************************************************************//
+ // NUMCPULIB_GENERIC_BSD
+{$IFDEF NUMCPULIB_GENERIC_BSD}
+{$IF DEFINED(FREEBSD) OR DEFINED(DRAGONFLY)}
+ Result := 58; // _SC_NPROCESSORS_ONLN
+{$IFEND}
+{$IFDEF OPENBSD}
+ Result := 503; // _SC_NPROCESSORS_ONLN
+{$ENDIF}
+{$IFDEF NETBSD}
+ Result := 1002; // _SC_NPROCESSORS_ONLN
+{$ENDIF}
+{$ENDIF} // ENDIF NUMCPULIB_GENERIC_BSD
+ // ****************************************************************//
+ // NUMCPULIB_SOLARIS
+{$IFDEF NUMCPULIB_SOLARIS}
+{$IFDEF NUMCPULIB_ARMCPU}
+ Result := 14; // _SC_NPROCESSORS_CONF
+{$ELSE}
+ Result := 15; // _SC_NPROCESSORS_ONLN
+{$ENDIF}
+{$ENDIF} // ENDIF NUMCPULIB_SOLARIS
+ // ****************************************************************//
+ // NUMCPULIB_APPLE
+{$IFDEF NUMCPULIB_APPLE}
+{$IFDEF NUMCPULIB_ARMCPU}
+ Result := 57; // _SC_NPROCESSORS_CONF
+{$ELSE}
+ Result := 58; // _SC_NPROCESSORS_ONLN
+{$ENDIF}
+{$ENDIF} // ENDIF NUMCPULIB_APPLE
+end;
+{$ENDIF}
+// ================================================================//
+{$IFDEF NUMCPULIB_HAS_SYSCTL}
+{$IFDEF NUMCPULIB_APPLE}
+
+class function TNumCPULib.GetValueUsingSysCtlByName
+ (const AName: String): UInt64;
+var
+ LLen: size_t;
+begin
+ LLen := System.SizeOf(Result);
+{$IFDEF FPC}
+ fpsysctlbyname(PChar(AName), @Result, @LLen, nil, 0);
+{$ELSE}
+ SysCtlByName(PAnsiChar(AName), @Result, @LLen, nil, 0);
+{$ENDIF}
+end;
+{$ENDIF}
+
+class function TNumCPULib.GetLogicalCPUCountUsingSysCtl(): UInt32;
+var
+ LMib: array [0 .. 1] of Int32;
+ LLen: size_t;
+begin
+ LMib[0] := CTL_HW;
+ LMib[1] := HW_NCPU;
+ LLen := System.SizeOf(Result);
+{$IFDEF FPC}
+{$IF DEFINED(VER3_0_0) OR DEFINED(VER3_0_2)}
+ fpsysctl(PChar(@LMib), 2, @Result, @LLen, nil, 0);
+{$ELSE}
+ fpsysctl(@LMib, 2, @Result, @LLen, nil, 0);
+{$IFEND}
+{$ELSE}
+ sysctl(@LMib, 2, @Result, @LLen, nil, 0);
+{$ENDIF}
+end;
+{$ENDIF}
+// ================================================================//
+{$IFDEF NUMCPULIB_MSWINDOWS}
+
+class function TNumCPULib.CountSetBits(ABitMask: NativeUInt): UInt32;
+var
+ LShift, LIdx: UInt32;
+ LBitTest: NativeUInt;
+begin
+ LShift := (System.SizeOf(NativeUInt) * 8) - 1;
+ Result := 0;
+ LBitTest := NativeUInt(1) shl LShift;
+ LIdx := 0;
+ while LIdx <= LShift do
+ begin
+ if (ABitMask and LBitTest) <> 0 then
+ begin
+ System.Inc(Result);
+ end;
+ LBitTest := LBitTest shr 1;
+ System.Inc(LIdx);
+ end;
+end;
+
+class function TNumCPULib.GetProcessorInfo(): TProcessorInformation;
+var
+ LReturnLength: DWORD;
+ LProcInfo, LCurrentInfo: PSystemLogicalProcessorInformation;
+begin
+ LReturnLength := 0;
+ Result := Default (TProcessorInformation);
+
+ FGetLogicalProcessorInformation(nil, LReturnLength);
+ if GetLastError <> ERROR_INSUFFICIENT_BUFFER then
+ begin
+ RaiseLastOSError;
+ end
+ else
+ begin
+ System.GetMem(LProcInfo, LReturnLength);
+ try
+ if not FGetLogicalProcessorInformation(LProcInfo, LReturnLength) then
+ begin
+ RaiseLastOSError;
+ end
+ else
+ begin
+ LCurrentInfo := LProcInfo;
+ while (NativeUInt(LCurrentInfo) - NativeUInt(LProcInfo)) <
+ LReturnLength do
+ begin
+ case LCurrentInfo.Relationship of
+ RelationProcessorCore:
+ begin
+ System.Inc(Result.ProcessorCoreCount);
+ Result.LogicalProcessorCount := Result.LogicalProcessorCount +
+ CountSetBits(LCurrentInfo.ProcessorMask);
+ end;
+ end;
+ LCurrentInfo := PSystemLogicalProcessorInformation
+ (NativeUInt(LCurrentInfo) +
+ System.SizeOf(TSystemLogicalProcessorInformation));
+ end;
+ end;
+ finally
+ System.FreeMem(LProcInfo);
+ end;
+ end;
+end;
+
+class function TNumCPULib.GetProcessorInfoEx: TProcessorInformationEx;
+var
+ LReturnLength: DWORD;
+ LProcInfo, LCurrentInfo: PSystemLogicalProcessorInformationEx;
+ LIdx: Int32;
+begin
+ LReturnLength := 0;
+ Result := Default (TProcessorInformationEx);
+
+ FGetLogicalProcessorInformationEx(RelationAll, nil, LReturnLength);
+ if GetLastError <> ERROR_INSUFFICIENT_BUFFER then
+ begin
+ RaiseLastOSError;
+ end
+ else
+ begin
+ System.GetMem(LProcInfo, LReturnLength);
+ try
+ if not FGetLogicalProcessorInformationEx(RelationAll, LProcInfo,
+ LReturnLength) then
+ begin
+ RaiseLastOSError;
+ end
+ else
+ begin
+ LCurrentInfo := LProcInfo;
+ while (NativeUInt(LCurrentInfo) - NativeUInt(LProcInfo)) <
+ LReturnLength do
+ begin
+ case LCurrentInfo.Relationship of
+ RelationProcessorCore:
+ begin
+ System.Inc(Result.ProcessorCoreCount);
+ for LIdx := 0 to System.Pred
+ (LCurrentInfo.Processor.GroupCount) do
+ begin
+ Result.LogicalProcessorCount := Result.LogicalProcessorCount +
+ CountSetBits(LCurrentInfo.Processor.GroupMask[LIdx].Mask);
+ end;
+ end;
+ end;
+ LCurrentInfo := PSystemLogicalProcessorInformationEx
+ (NativeUInt(LCurrentInfo) + LCurrentInfo.Size);
+ end;
+ end;
+ finally
+ System.FreeMem(LProcInfo);
+ end;
+ end;
+end;
+
+class function TNumCPULib.GetLogicalCPUCountWindows(): UInt32;
+var
+ LIdx: Int32;
+ LProcessAffinityMask, LSystemAffinityMask: DWORD_PTR;
+ LMask: DWORD;
+ LSystemInfo: SYSTEM_INFO;
+ LProcInfo: TProcessorInformation;
+ LProcInfoEx: TProcessorInformationEx;
+begin
+ if IsGetLogicalProcessorInformationExAvailable then
+ begin
+ LProcInfoEx := GetProcessorInfoEx;
+ Result := LProcInfoEx.LogicalProcessorCount;
+ Exit;
+ end;
+ if IsGetLogicalProcessorInformationAvailable then
+ begin
+ LProcInfo := GetProcessorInfo;
+ Result := LProcInfo.LogicalProcessorCount;
+ Exit;
+ end;
+ // fallback if non of the above are available
+ // returns total number of processors available to system including logical hyperthreaded processors
+ LProcessAffinityMask := 0;
+ LSystemAffinityMask := 0;
+ if GetProcessAffinityMask(GetCurrentProcess, LProcessAffinityMask,
+ LSystemAffinityMask) then
+ begin
+ Result := 0;
+ for LIdx := 0 to 31 do
+ begin
+ LMask := DWORD(1) shl LIdx;
+ if (LProcessAffinityMask and LMask) <> 0 then
+ begin
+ System.Inc(Result);
+ end;
+ end;
+ end
+ else
+ begin
+ // can't get the affinity mask so we just report the total number of processors
+ LSystemInfo := Default (SYSTEM_INFO);
+ GetSystemInfo(LSystemInfo);
+ Result := LSystemInfo.dwNumberOfProcessors;
+ end;
+end;
+
+class function TNumCPULib.GetPhysicalCPUCountWindows(): UInt32;
+var
+ LProcInfo: TProcessorInformation;
+ LProcInfoEx: TProcessorInformationEx;
+begin
+ Result := 0;
+ if IsGetLogicalProcessorInformationExAvailable then
+ begin
+ LProcInfoEx := GetProcessorInfoEx;
+ Result := LProcInfoEx.ProcessorCoreCount;
+ Exit;
+ end;
+ if IsGetLogicalProcessorInformationAvailable then
+ begin
+ LProcInfo := GetProcessorInfo;
+ Result := LProcInfo.ProcessorCoreCount;
+ Exit;
+ end;
+end;
+
+class function TNumCPULib.GetPhysicalMemoryEx(): UInt32;
+var
+ M: TMemoryStatusEx;
+begin
+ Result := 0;
+ FillChar(M, SizeOf(TMemoryStatusEx), 0);
+ M.dwLength := SizeOf(TMemoryStatusEx);
+ if FGetGlobalMemoryStatusEx(M) then
+ Result := (M.ullTotalPhys shr 20);
+end;
+
+class function TNumCPULib.GetPhysicalMemory(): UInt32;
+var
+ M: TMemoryStatus;
+begin
+ FillChar(M, SizeOf(TMemoryStatus), 0);
+ M.dwLength := SizeOf(TMemoryStatus);
+ FGetGlobalMemoryStatus(M);
+ Result := (M.dwTotalPhys shr 20);
+end;
+
+class function TNumCPULib.GetTotalPhysicalMemoryWindows(): UInt32;
+begin
+ Result := 0;
+ if IsGetGlobalMemoryStatusAvailableEx then
+ begin
+ Result := GetPhysicalMemoryEx();
+ Exit;
+ end;
+ if IsGetGlobalMemoryStatusAvailable then
+ begin
+ Result := GetPhysicalMemory();
+ Exit;
+ end;
+end;
+
+class function TNumCPULib.GetProcedureAddress(ModuleHandle: THandle;
+ const AProcedureName: String; var AFunctionFound: Boolean): Pointer;
+begin
+ Result := GetProcAddress(ModuleHandle, PChar(AProcedureName));
+ if Result = Nil then
+ begin
+ AFunctionFound := False;
+ end;
+end;
+
+class function TNumCPULib.IsGetLogicalProcessorInformationAvailable(): Boolean;
+var
+ ModuleHandle: THandle;
+begin
+ Result := False;
+ ModuleHandle := SafeLoadLibrary(KERNEL32, SEM_FAILCRITICALERRORS);
+ if ModuleHandle <> 0 then
+ begin
+ Result := True;
+ FGetLogicalProcessorInformation := GetProcedureAddress(ModuleHandle,
+ 'GetLogicalProcessorInformation', Result);
+ end;
+end;
+
+class function TNumCPULib.IsGetLogicalProcessorInformationExAvailable: Boolean;
+var
+ ModuleHandle: THandle;
+begin
+ Result := False;
+ ModuleHandle := SafeLoadLibrary(KERNEL32, SEM_FAILCRITICALERRORS);
+ if ModuleHandle <> 0 then
+ begin
+ Result := True;
+ FGetLogicalProcessorInformationEx := GetProcedureAddress(ModuleHandle,
+ 'GetLogicalProcessorInformationEx', Result);
+ end;
+end;
+
+class function TNumCPULib.IsGetGlobalMemoryStatusAvailable(): Boolean;
+var
+ ModuleHandle: THandle;
+begin
+ Result := False;
+ ModuleHandle := SafeLoadLibrary(KERNEL32, SEM_FAILCRITICALERRORS);
+ if ModuleHandle <> 0 then
+ begin
+ Result := True;
+ FGetGlobalMemoryStatus := GetProcedureAddress(ModuleHandle,
+ 'GlobalMemoryStatus', Result);
+ end;
+end;
+
+class function TNumCPULib.IsGetGlobalMemoryStatusAvailableEx: Boolean;
+var
+ ModuleHandle: THandle;
+begin
+ Result := False;
+ ModuleHandle := SafeLoadLibrary(KERNEL32, SEM_FAILCRITICALERRORS);
+ if ModuleHandle <> 0 then
+ begin
+ Result := True;
+ FGetGlobalMemoryStatusEx := GetProcedureAddress(ModuleHandle,
+ 'GlobalMemoryStatusEx', Result);
+ end;
+end;
+
+
+{$ENDIF}
+// ================================================================//
+{$IFDEF NUMCPULIB_APPLE}
+
+class function TNumCPULib.GetLogicalCPUCountApple(): UInt32;
+//var
+// LTempRes: Int32;
+begin
+ Result := UInt32(GetValueUsingSysCtlByName('hw.logicalcpu'));
+ (*
+
+{$IF DEFINED(NUMCPULIB_MACOS)}
+ // >= (Mac OS X 10.4+)
+ if NSAppKitVersionNumber >= 824 then // NSAppKitVersionNumber10_4
+ begin
+ LTempRes := sysconf(GetAppropriateSysConfNumber());
+ end
+ else
+ begin
+ // fallback for when sysconf API is not available
+ LTempRes := Int32(GetLogicalCPUCountUsingSysCtl());
+ end;
+{$ELSE}
+ LTempRes := sysconf(GetAppropriateSysConfNumber());
+{$IFEND}
+ // final fallback if all above fails
+ if LTempRes < 1 then
+ begin
+ Result := UInt32(GetValueUsingSysCtlByName('hw.logicalcpu'));
+ end
+ else
+ begin
+ Result := UInt32(LTempRes);
+ end;
+ *)
+end;
+
+class function TNumCPULib.GetPhysicalCPUCountApple(): UInt32;
+begin
+ Result := UInt32(GetValueUsingSysCtlByName('hw.physicalcpu'));
+end;
+
+class function TNumCPULib.GetTotalPhysicalMemoryApple(): UInt32;
+begin
+ Result := (GetValueUsingSysCtlByName('hw.memsize') shr 20);
+end;
+{$ENDIF}
+// ================================================================//
+
+{$IFDEF NUMCPULIB_WILL_PARSE_DATA}
+
+class function TNumCPULib.SplitString(const AInputString: String;
+ ADelimiter: Char): TNumCPULibStringArray;
+var
+ LPosStart, LPosDel, LSplitPoints, LIdx, LLowIndex, LHighIndex, LLength: Int32;
+begin
+ Result := Nil;
+ if AInputString <> '' then
+ begin
+ { Determine the length of the resulting array }
+ LLowIndex := 1;
+ LHighIndex := System.Length(AInputString);
+ LSplitPoints := 0;
+ for LIdx := LLowIndex to LHighIndex do
+ begin
+ if (ADelimiter = AInputString[LIdx]) then
+ begin
+ System.Inc(LSplitPoints);
+ end;
+ end;
+
+ System.SetLength(Result, LSplitPoints + 1);
+
+ { Split the string and fill the resulting array }
+
+ LIdx := 0;
+ LLength := System.Length(ADelimiter);
+ LPosStart := 1;
+ LPosDel := System.Pos(ADelimiter, AInputString);
+ while LPosDel > 0 do
+ begin
+ Result[LIdx] := System.Copy(AInputString, LPosStart, LPosDel - LPosStart);
+ LPosStart := LPosDel + LLength;
+ LPosDel := PosEx(ADelimiter, AInputString, LPosStart);
+ System.Inc(LIdx);
+ end;
+ Result[LIdx] := System.Copy(AInputString, LPosStart,
+ System.Length(AInputString));
+ end;
+end;
+
+class function TNumCPULib.ParseLastString(const AInputString: String): String;
+var
+ LSplitResult: TNumCPULibStringArray;
+begin
+ LSplitResult := SplitString(AInputString, ' ');
+ if (System.Length(LSplitResult) < 1) then
+ begin
+ Result := Trim(AInputString);
+ end
+ else
+ begin
+ Result := Trim(LSplitResult[System.Length(LSplitResult) - 1]);
+ end;
+end;
+
+class function TNumCPULib.ParseInt32(const AInputString: String;
+ ADefault: Int32): Int32;
+var
+ LLocalString: String;
+begin
+ LLocalString := AInputString;
+ if BeginsWith(LowerCase(LLocalString), '0x', False) then
+ begin
+ Result := StrToIntDef(StringReplace(LLocalString, '0x', '$',
+ [rfReplaceAll, rfIgnoreCase]), ADefault);
+ end
+ else
+ begin
+ Result := StrToIntDef(LLocalString, ADefault);
+ end;
+end;
+
+
+class function TNumCPULib.ParseLastInt32(const AInputString: String;
+ ADefault: Int32): Int32;
+var
+ LLocalString: String;
+begin
+ LLocalString := ParseLastString(AInputString);
+ result:=ParseInt32(LLocalString,ADefault);
+end;
+
+class function TNumCPULib.BeginsWith(const AInputString, ASubString: String;
+ AIgnoreCase: Boolean; AOffset: Int32): Boolean;
+var
+ LIdx: Int32;
+ LPtrInputString, LPtrSubString: PChar;
+begin
+ LIdx := System.Length(ASubString);
+ Result := LIdx > 0;
+ LPtrInputString := PChar(AInputString);
+ System.Inc(LPtrInputString, AOffset - 1);
+ LPtrSubString := PChar(ASubString);
+ if Result then
+ begin
+ if AIgnoreCase then
+ begin
+ Result := StrLiComp(LPtrSubString, LPtrInputString, LIdx) = 0
+ end
+ else
+ begin
+ Result := StrLComp(LPtrSubString, LPtrInputString, LIdx) = 0
+ end;
+ end;
+end;
+{$ENDIF}
+// ================================================================//
+
+{$IFDEF NUMCPULIB_LINUX}
+
+class function TNumCPULib.TLogicalProcessor.Create(AProcessorNumber,
+ APhysicalProcessorNumber, APhysicalPackageNumber: UInt32): TLogicalProcessor;
+begin
+ Result := Default (TLogicalProcessor);
+ Result.ProcessorNumber := AProcessorNumber;
+ Result.PhysicalProcessorNumber := APhysicalProcessorNumber;
+ Result.PhysicalPackageNumber := APhysicalPackageNumber;
+end;
+
+class procedure TNumCPULib.ReadFileContents(const AFilePath: String;
+ var AOutputParameters: TStringList);
+const
+ BUF_SIZE = 2048; // Buffer size for reading the output in chunks
+var
+ LOutputStream: TStream;
+ LFileStream: TFileStream;
+ LBytesRead: LongInt;
+ LBuffer: array [0 .. BUF_SIZE - 1] of Byte;
+begin
+ if SysUtils.FileExists(AFilePath) then
+ begin
+ LFileStream := TFileStream.Create(AFilePath, fmOpenRead);
+ try
+ LOutputStream := TMemoryStream.Create;
+ try
+ // All data from file is read in a loop until no more data is available
+ repeat
+ // Get the new data from the file to a maximum of the LBuffer size that was allocated.
+ // Note that all read(...) calls will block except for the last one, which returns 0 (zero).
+ LBytesRead := LFileStream.Read(LBuffer, BUF_SIZE);
+
+ // Add the bytes that were read to the stream for later usage
+ LOutputStream.Write(LBuffer, LBytesRead)
+
+ until LBytesRead = 0; // Stop if no more data is available
+
+ // Required to make sure all data is copied from the start
+ LOutputStream.Position := 0;
+ AOutputParameters.LoadFromStream(LOutputStream);
+ finally
+ LOutputStream.Free;
+ end;
+ finally
+ LFileStream.Free;
+ end;
+ end;
+end;
+
+class function TNumCPULib.GetLogicalCPUCountLinux(): UInt32;
+begin
+ Result := UInt32(sysconf(GetAppropriateSysConfNumber()));
+end;
+
+class function TNumCPULib.GetPhysicalCPUCountLinux(): UInt32;
+var
+ LProcCpuInfos, LPhysicalProcessorsDetails: TStringList;
+ LIdx, LJIdx, LLogicalProcessorsIdx: Int32;
+ LCurrentProcessor, LCurrentCore, LCurrentPackage: UInt32;
+ LFirst: Boolean;
+ LLogicalProcessors: array of TLogicalProcessor;
+ LogicalProcessor: TLogicalProcessor;
+ LLineProcCpuInfo: String;
+begin
+ LProcCpuInfos := TStringList.Create();
+ LCurrentProcessor := 0;
+ LCurrentCore := 0;
+ LCurrentPackage := 0;
+ LFirst := True;
+ try
+ ReadFileContents('/proc/cpuinfo', LProcCpuInfos);
+ System.SetLength(LLogicalProcessors, LProcCpuInfos.Count);
+ // allocate enough space
+ LLogicalProcessorsIdx := 0;
+ for LIdx := 0 to System.Pred(LProcCpuInfos.Count) do
+ begin
+ // Count logical processors
+ LLineProcCpuInfo := LProcCpuInfos[LIdx];
+ if (BeginsWith(LLineProcCpuInfo, 'processor', False)) then
+ begin
+ if (not LFirst) then
+ begin
+ LLogicalProcessors[LLogicalProcessorsIdx] :=
+ TLogicalProcessor.Create(LCurrentProcessor, LCurrentCore,
+ LCurrentPackage);
+ System.Inc(LLogicalProcessorsIdx);
+ end
+ else
+ begin
+ LFirst := False;
+ end;
+ LCurrentProcessor := UInt32(ParseLastInt32(LLineProcCpuInfo, 0));
+ end
+ else if (BeginsWith(LLineProcCpuInfo, 'core id', False) or
+ BeginsWith(LLineProcCpuInfo, 'cpu number', False)) then
+ begin
+ // Count unique combinations of core id and physical id.
+ LCurrentCore := UInt32(ParseLastInt32(LLineProcCpuInfo, 0));
+ end
+ else if (BeginsWith(LLineProcCpuInfo, 'physical id', False)) then
+ begin
+ LCurrentPackage := UInt32(ParseLastInt32(LLineProcCpuInfo, 0));
+ end;
+ end;
+
+ LLogicalProcessors[LLogicalProcessorsIdx] :=
+ TLogicalProcessor.Create(LCurrentProcessor, LCurrentCore,
+ LCurrentPackage);
+ System.Inc(LLogicalProcessorsIdx);
+ // reduce to used size
+ System.SetLength(LLogicalProcessors, LLogicalProcessorsIdx);
+ LPhysicalProcessorsDetails := TStringList.Create();
+ LPhysicalProcessorsDetails.Sorted := True;
+ LPhysicalProcessorsDetails.Duplicates := dupIgnore;
+ try
+ for LJIdx := 0 to System.Pred(System.Length(LLogicalProcessors)) do
+ begin
+ LogicalProcessor := LLogicalProcessors[LJIdx];
+ LPhysicalProcessorsDetails.Add
+ (Format('%u:%u', [LogicalProcessor.PhysicalProcessorNumber,
+ LogicalProcessor.PhysicalPackageNumber]));
+ end;
+ // LogicalProcessorCount := System.Length(LLogicalProcessors);
+ Result := UInt32(LPhysicalProcessorsDetails.Count);
+ finally
+ LPhysicalProcessorsDetails.Free;
+ end;
+ finally
+ LProcCpuInfos.Free;
+ end;
+end;
+
+class function TNumCPULib.GetTotalPhysicalMemoryLinux(): UInt32; static;
+var
+ SystemInf: TSysInfo;
+ mu: cardinal;
+begin
+ result:=0;
+ try
+ FillChar({%H-}SystemInf,SizeOf(SystemInf),0);
+ SysInfo(@SystemInf);
+ mu := SystemInf.mem_unit;
+ result := (QWord(SystemInf.totalram*mu) shr 20);
+ except
+ end;
+end;
+
+class function TNumCPULib.GetTotalSwapMemoryLinux(): UInt32; static;
+var
+ SystemInf: TSysInfo;
+ mu: cardinal;
+begin
+ result:=0;
+ try
+ FillChar({%H-}SystemInf,SizeOf(SystemInf),0);
+ SysInfo(@SystemInf);
+ mu := SystemInf.mem_unit;
+ result := (QWord(SystemInf.totalswap*mu) shr 20);
+ except
+ end;
+end;
+
+
+{$ENDIF}
+// ================================================================//
+{$IFDEF NUMCPULIB_SOLARIS}
+
+class procedure TNumCPULib.ExecuteAndParseProcessOutput(const ACallingProcess
+ : String; AInputParameters: TStringList; var AOutputParameters: TStringList);
+const
+ BUF_SIZE = 2048; // Buffer size for reading the output in chunks
+var
+ LProcess: TProcess;
+ LOutputStream: TStream;
+ LBytesRead: LongInt;
+ LBuffer: array [0 .. BUF_SIZE - 1] of Byte;
+begin
+ LProcess := TProcess.Create(nil);
+
+ try
+ LProcess.Executable := ACallingProcess;
+ LProcess.Parameters.AddStrings(AInputParameters);
+
+ LProcess.Options := LProcess.Options + [poWaitOnExit, poUsePipes];
+
+ LProcess.Execute;
+
+ // Create a stream object to store the generated output in.
+ LOutputStream := TMemoryStream.Create;
+
+ try
+ // All generated output from LProcess is read in a loop until no more data is available
+ repeat
+ // Get the new data from the process to a maximum of the LBuffer size that was allocated.
+ // Note that all read(...) calls will block except for the last one, which returns 0 (zero).
+ LBytesRead := LProcess.Output.Read(LBuffer, BUF_SIZE);
+
+ // Add the bytes that were read to the stream for later usage
+ LOutputStream.Write(LBuffer, LBytesRead)
+
+ until LBytesRead = 0; // Stop if no more data is available
+
+ // Required to make sure all data is copied from the start
+ LOutputStream.Position := 0;
+ AOutputParameters.LoadFromStream(LOutputStream);
+ finally
+ LOutputStream.Free;
+ end;
+ finally
+ LProcess.Free;
+ end;
+end;
+
+class function TNumCPULib.GetLogicalCPUCountSolaris(): UInt32;
+begin
+ Result := UInt32(sysconf(GetAppropriateSysConfNumber()));
+end;
+
+class function TNumCPULib.GetPhysicalCPUCountSolaris(): UInt32;
+var
+ LInputParameters, LOuputParameters, LCoreChipIDs: TStringList;
+ LLineOutputInfo: String;
+ LIdx: Int32;
+ LChipId, LCoreId: UInt32;
+begin
+ Result := 0;
+
+ LCoreChipIDs := TStringList.Create();
+ LInputParameters := TStringList.Create();
+ LOuputParameters := TStringList.Create();
+ LCoreChipIDs.Sorted := True;
+ LCoreChipIDs.Duplicates := dupIgnore;
+ LOuputParameters.Sorted := True;
+ LOuputParameters.Duplicates := dupIgnore;
+ try
+ LInputParameters.Add('-m');
+ LInputParameters.Add('cpu_info');
+
+ ExecuteAndParseProcessOutput('/usr/bin/kstat', LInputParameters,
+ LOuputParameters);
+
+ for LIdx := 0 to System.Pred(LOuputParameters.Count) do
+ begin
+ LLineOutputInfo := LOuputParameters[LIdx];
+ if BeginsWith(LLineOutputInfo, 'chip_id', False) then
+ begin
+ LChipId := UInt32(ParseLastInt32(LLineOutputInfo, 0));
+ end
+ else if (BeginsWith(LLineOutputInfo, 'core_id', False)) then
+ begin
+ LCoreId := UInt32(ParseLastInt32(LLineOutputInfo, 0));
+ end;
+
+ LCoreChipIDs.Add(Format('%u:%u', [LCoreId, LChipId]));
+ end;
+
+ Result := UInt32(LCoreChipIDs.Count);
+
+ // fallback if above method fails, note: the method below only works only for Solaris 10 and above
+ if Result < 1 then
+ begin
+ LInputParameters.Clear;
+ LOuputParameters.Clear;
+
+ LInputParameters.Add('-p');
+ ExecuteAndParseProcessOutput('psrinfo', LInputParameters,
+ LOuputParameters);
+
+ Result := UInt32(ParseLastInt32(LOuputParameters.Text, 0));
+ end;
+
+ finally
+ LCoreChipIDs.Free;
+ LInputParameters.Free;
+ LOuputParameters.Free;
+ end;
+end;
+
+class function TNumCPULib.GetTotalPhysicalMemorySolaris(): UInt32; static;
+var
+ LInputParameters, LOuputParameters: TStringList;
+ LLineOutputInfo,aLastWord: String;
+ MemoryPages:QWord;
+ LIdx,LWordCount: Int32;
+begin
+ Result := 0;
+
+ LInputParameters := TStringList.Create();
+ LOuputParameters := TStringList.Create();
+ try
+ LInputParameters.Add('-n');
+ LInputParameters.Add('system_pages');
+ LInputParameters.Add('-p');
+ LInputParameters.Add('-s');
+ LInputParameters.Add('physmem');
+
+
+ ExecuteAndParseProcessOutput('/usr/bin/kstat', LInputParameters,
+ LOuputParameters);
+
+ for LIdx := 0 to System.Pred(LOuputParameters.Count) do
+ begin
+ LLineOutputInfo := LOuputParameters[LIdx];
+ if AnsiStartsText('unix:0:system_pages:physmem',LLineOutputInfo) then
+ begin
+ LWordCount:=WordCount(LLineOutputInfo,[' ',#9]);
+ aLastWord:=ExtractWord(LWordCount,LLineOutputInfo,[' ',#9]);
+ MemoryPages := QWord(ParseInt32(aLastWord, 0));
+ MemoryPages := MemoryPages*4096;//4096 = pagesize
+ MemoryPages := MemoryPages DIV (1024*1024);
+ result:=UInt32(MemoryPages);
+ break;
+ end
+ end;
+
+ finally
+ LInputParameters.Free;
+ LOuputParameters.Free;
+ end;
+end;
+
+
+{$ENDIF}
+// ================================================================//
+{$IFDEF NUMCPULIB_GENERIC_BSD}
+
+class function TNumCPULib.GetLogicalCPUCountGenericBSD(): UInt32;
+var
+ LTempRes: Int32;
+begin
+ LTempRes := sysconf(GetAppropriateSysConfNumber());
+ if LTempRes < 1 then
+ begin
+ Result := GetLogicalCPUCountUsingSysCtl();
+ end
+ else
+ begin
+ Result := UInt32(LTempRes);
+ end;
+end;
+{$ENDIF}
+
+class function TNumCPULib.GetLogicalCPUCount(): UInt32;
+begin
+{$IF DEFINED(NUMCPULIB_MSWINDOWS)}
+ Result := GetLogicalCPUCountWindows();
+{$ELSEIF DEFINED(NUMCPULIB_APPLE)}
+ Result := GetLogicalCPUCountApple();
+{$ELSEIF DEFINED(NUMCPULIB_LINUX)}
+ Result := GetLogicalCPUCountLinux();
+{$ELSEIF DEFINED(NUMCPULIB_SOLARIS)}
+ Result := GetLogicalCPUCountSolaris();
+{$ELSEIF DEFINED(NUMCPULIB_GENERIC_BSD)}
+ Result := GetLogicalCPUCountGenericBSD();
+{$ELSE}
+ // fallback for other Unsupported Oses
+ Result := 1;
+{$IFEND}
+end;
+
+class function TNumCPULib.GetPhysicalCPUCount(): UInt32;
+begin
+{$IF DEFINED(NUMCPULIB_MSWINDOWS)}
+ Result := GetPhysicalCPUCountWindows();
+{$ELSEIF DEFINED(NUMCPULIB_APPLE)}
+ Result := GetPhysicalCPUCountApple();
+{$ELSEIF DEFINED(NUMCPULIB_LINUX)}
+ Result := GetPhysicalCPUCountLinux();
+{$ELSEIF DEFINED(NUMCPULIB_SOLARIS)}
+ Result := GetPhysicalCPUCountSolaris();
+{$ELSE}
+ // fallback for other Unsupported Oses
+ Result := 1;
+{$IFEND}
+end;
+
+class function TNumCPULib.GetTotalPhysicalMemory(): UInt32;
+begin
+{$IF DEFINED(NUMCPULIB_MSWINDOWS)}
+ Result := GetTotalPhysicalMemoryWindows();
+{$ELSEIF DEFINED(NUMCPULIB_APPLE)}
+ Result := GetTotalPhysicalMemoryApple();
+{$ELSEIF DEFINED(NUMCPULIB_LINUX)}
+ Result := GetTotalPhysicalMemoryLinux();
+{$ELSEIF DEFINED(NUMCPULIB_SOLARIS)}
+ Result := GetTotalPhysicalMemorySolaris();
+{$ELSE}
+ // fallback for other Unsupported Oses
+ Result := 0;
+{$IFEND}
+end;
+
+class function TNumCPULib.GetTotalSwapMemory(): UInt32;
+begin
+{$IF DEFINED(NUMCPULIB_MSWINDOWS)}
+ Result := 0;
+{$ELSEIF DEFINED(NUMCPULIB_APPLE)}
+ Result := 0;
+{$ELSEIF DEFINED(NUMCPULIB_LINUX)}
+ Result := GetTotalSwapMemoryLinux();
+{$ELSEIF DEFINED(NUMCPULIB_SOLARIS)}
+ //Result := GetTotalPhysicalSwapSolaris();
+ Result := 0;
+{$ELSE}
+ // fallback for other Unsupported Oses
+ Result := 0;
+{$IFEND}
+end;
+
+
+end.