ASKernel.pas

unit ASKernel;

{ **************************************************************************** }
{ Rejbrand AlgoSim Kernel                                                      }
{ Copyright © 2019 Andreas Rejbrand                                            }
{ https://english.rejbrand.se/                                                 }
{ **************************************************************************** }

{$WARN SYMBOL_PLATFORM OFF}
{$WARN DUPLICATE_CTOR_DTOR OFF}

interface

uses
  Windows, Messages, Classes, ASObjStore, ASPropMan, ASObjects,
  Generics.Defaults, Generics.Collections, ASNum, ExtCtrls, ASKernelDefs,
  SyncObjs, VisCtl2D;

type
  TCmdRes = record
    Handled: Boolean;
    Result: Boolean;
    class function Unhandled: TCmdRes; static; inline;
    class operator Implicit(AResult: Boolean): TCmdRes; static;
  end;

  TCommandHandler = function(ACommand: Cardinal; AParam1, AParam2, AParam3,
    AParam4: NativeInt): TCmdRes of object;

  TASKernel = class;

  TExecState = (esReady, esRunning, esPausing, esPaused, esAborting);
  TExecStateEx = -1..Ord(High(TExecState));

  TQueueChangedEvent = procedure(AKernel: TASKernel; AState: TExecStateEx; AError: Boolean) of object;

  TExecutionContext = class
  strict private
    FLastErrorCS: TCriticalSection;
    FLastError: TAlgosimFailure;
    FRecursionDepth: Integer;
    function GetLastError: TAlgosimFailure;
    function GetEnterPause: Boolean; inline;
    procedure SetEnterPause(AEnterPause: Boolean); inline;
  private
    procedure SetLastError(AError: TAlgosimFailure);
  public
    FormatOptions: TFormatOptions;
    Kernel: TASKernel;
    constructor Create; overload;
    constructor Create(AKernel: TASKernel); overload;
    destructor Destroy; override;
    function PropertyStore: TPropertyStore;
    function StoreStack: TObjStoreStack;
    function AbortCurrent: Boolean; inline;
    function AbortCurrentEvent: TEvent; inline;
    function EnterPauseEvent: TEvent; inline;
    function ResumeEvent: TEvent; inline;
    procedure NotifyPause; inline;
    procedure NotifyResume; inline;
    procedure Init; inline;
    procedure EnterFcn; inline;
    procedure LeaveFcn; inline;
    property RecursionDepth: Integer read FRecursionDepth;
    /// <summary>Contains the last evaluation error object.</summary>
    /// <remarks>When read, a copy of the object is returned. The caller gains
    ///  ownership of this object.</remarks>
    property _LastError: TAlgosimFailure read GetLastError;
    property EnterPause: Boolean read GetEnterPause write SetEnterPause;
  end;

  TASKernel = class
  public
  const
    WM_EXECOUTPUT       = WM_USER + 1;
    WM_EXECPERFORM      = WM_USER + 2;
    WM_EXECPROP         = WM_USER + 3;
    WM_QUEUECHANGED     = WM_USER + 4;
  const
    ExecStateNames: array[TExecState] of string = ('Ready', 'Running', 'Pausing...', 'Paused', 'Aborting...');
  type
    TExecStateHelper = record helper for TExecState
      function ToString: string;
    end;
    TCmdHistoryItem = class
      StartTime: TDateTime;
      EvalTime: Double;
      Cmd: string;
      Result: TAlgosimObject;
      constructor Create(const AStartTime: TDateTime; const ACmd: string);
      destructor Destroy; override;
    end;
    TIdentType = (itFunction, itOperator, itVariable, itFcnVariable);
    TIdentTypeHelper = record helper for TIdentType
      function ToString: string;
    end;
    TIdentTypes = set of TIdentType;
  const
    AllIdentTypes = [Low(TIdentType)..High(TIdentType)];
  type
    TIdentInfo = record
      IdentType: TIdentType;
      ClassType: TAlgosimObjectClass;
      TypeName: string;
      Name: string;
      &Operator: TOperator;
      Attributes: TIdentAttribs;
      Preview: string;
      function FullDescription: string;
      constructor CreateOp(AOperator: TOperator);
      constructor CreateFcn(const AFcnName: string);
      constructor CreateVar(AIdentType: TIdentType; const AName: string;
        AClassType: TAlgosimObjectClass; const ATypeName: string;
        AAttributes: TIdentAttribs);
    end;
    PWorkQueueItem = ^TWorkQueueItem;
    TWorkQueueItem = record
    public
      Kernel: TASKernel;
      UID: TGUID;
      Enqueued: TDateTime;
      Dequeued: TDateTime;
      Cmd: string;
      function ToString: string;
    private
      constructor CreateNew(AKernel: TASKernel; const ACmd: string);
    end;
  const
    NullJob: TWorkQueueItem =
      (
        Kernel: nil;
        UID: (D1: 0; D2: 0; D3: 0; D4: (0, 0, 0, 0, 0, 0, 0, 0));
        Enqueued: 0.0;
        Dequeued: 0.0;
        Cmd: ''
      );
  type
    TOutputHandler = procedure(const AWorkItem: TWorkQueueItem;
      AResult: TAlgosimObject) of object;
    TLockInfo = record
      Paused: Boolean;
    end;
  strict private
  type
    TOutputBuffer = TStringList;
    TWorkQueue = TQueue<TWorkQueueItem>;
    TAsyncExecuter = class(TThread)
    strict private
      Kernel: TASKernel;
      procedure Perform(const AWorkItem: TWorkQueueItem);
    protected
      procedure Execute; override;
    public
      constructor Create(AKernel: TASKernel);
      destructor Destroy; override;
    end;
    PPerformRec = ^TPerformRec;
    TPerformRec = record
      Command: Cardinal;
      Params: array[0..3] of NativeInt;
    end;
  var
    FStartTime: TDateTime;
    FSessionID: TGUID;
    FGlobal: TAlgosimObjStore;
    FStoreStack: TObjStoreStack;
    FContext: TExecutionContext;
    FPropStore: TPropertyStore;
    FCommandHandler: TCommandHandler;
    FBuffers: TObjectDictionary<string, TOutputBuffer>;
    FCommandHistoryCS: TCriticalSection;
    FCommandHistory: TObjectList<TCmdHistoryItem>;
    FSaveHistResults: Boolean;
    FEvalLevel: Integer;
    FIdleTimer: TTimer;
    FOutputHandler: TOutputHandler;
    FWorkQueue: TWorkQueue;
    FWorkQueueCS: TCriticalSection;
    FCurrentJob: TWorkQueueItem;
    FAsyncExecuter: TAsyncExecuter;
    FWorkEvent: TEvent;
    FCallbackWndClass: Word;
    FCallbackWindow: HWND;
    FBufferCS: TCriticalSection;
    FOnQueueChanged: TQueueChangedEvent;
    FObjStoreCS: TCriticalSection;
    FClientObjStoreLock: Integer;
    FState: TExecState;
    FPauseEvent: TEvent; // set when execution is actually paused -- used by client obj store lock
    function GetNamedBuffer(const ABufferName: string): TOutputBuffer;
    function GetOrCreateBuffer(const ABufferName: string): TOutputBuffer;
    procedure CreateWorkCallbackWnd;
    class function CallbackWndProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM;
      lParam: LPARAM): LRESULT; static; stdcall;
    function GetCommandHistoryItem(Index: Integer): TCmdHistoryItem;
    function GetCommandHistoryLength: Integer;
    procedure CommandHistoryAdd(const ACmdHistoryItem: TCmdHistoryItem);
    procedure DoQueueChanged(AState: TExecState; AError: Boolean = False); overload;
    procedure DoQueueChanged; overload;
  strict private class var
    FSendMessageTimestamp: UInt64;
  private
    FAsyncRunning: Boolean;
    FDestroying: Boolean;
    FAbortCurrent: Boolean; // set when an abortion request is made
    FAbortCurrentEvent: TEvent; // set when an abortion request is made -- used by FCN_Wait
    FEnterPause: Boolean; // set when a pause request is made
    FEnterPauseEvent: TEvent; // set when a pause request is made -- used by FCN_Wait
    FResumeEvent: TEvent; // set when a resume request is made
    function GetFormatOptions: TFormatOptions;
    procedure SetFormatOptions(const Value: TFormatOptions);
    procedure IdleTimerTimer(Sender: TObject);
    function WQ_Enqueue(const AExpr: string): TWorkQueueItem;
    function WQ_TryDequeue(out AWorkQueueItem: TWorkQueueItem): Boolean;
    procedure WQ_JobEnded;
    function WQ_TryRemove(const AID: TGUID): Boolean;
    function WQ_GetArray: TArray<TWorkQueueItem>;
    procedure WQ_Clear;
    procedure WQ_AbortCurrent;
    property WorkEvent: TEvent read FWorkEvent;
    function DoOnOutput(const AWorkItem: TWorkQueueItem;
      AResult: TAlgosimObject): Boolean;
    procedure NotifyPause;
    procedure NotifyResume;
  public
    constructor Create;
    destructor Destroy; override;
    property StoreStack: TObjStoreStack read FStoreStack;
    procedure ClearAllVars;
    procedure LoadDefVars;
    function Evaluate(const AExpr: string): TAlgosimObject;
    function EvaluateAsync(const AExpr: string): TWorkQueueItem;
    procedure AbortJob(const AID: TGUID);
    procedure AbortAll;
    procedure BufferAppend(const ABufferName, AText: string);
    procedure ClearBuffer(const ABufferName: string);
    procedure RemoveBuffer(const ABufferName: string);
    function GetBufferText(const ABufferName: string): string;
    function GetBuffers: TArray<string>;
    procedure ClearAllBuffers;
    procedure Init;
    function GetMatchingIdents(ATypes: TIdentTypes;
      const AText: string = ''; AHideSystem: Boolean = False): TArray<TIdentInfo>;
    function GetVariableRef(const AName: string;
      const APromise: TReadOnlyPromise): TAlgosimObject;
    function TryLockObjStore(out ALockInfo: TLockInfo): Boolean;
    procedure LockObjStore(out ALockInfo: TLockInfo);
    procedure UnlockObjStore(const ALockInfo: TLockInfo);
    function VariableExists(const AName: string): Boolean;
    function Perform(ACommand: Cardinal; AParam1, AParam2,
      AParam3, AParam4: NativeInt): Boolean;
    function IsValidIdent(const S: string): Boolean;
    procedure Pause;
    procedure Resume;
    class property SendMessageTimestamp: UInt64 read FSendMessageTimestamp;
    property State: TExecState read FState;
    property StartTime: TDateTime read FStartTime;
    property SessionID: TGUID read FSessionID;
    property FormatOptions: TFormatOptions read GetFormatOptions write SetFormatOptions;
    property CommandHistory[Index: Integer]: TCmdHistoryItem read GetCommandHistoryItem;
    property CommandHistoryLength: Integer read GetCommandHistoryLength;
    procedure ClearCommandHistory;
    property SaveHistResults: Boolean read FSaveHistResults write FSaveHistResults;
    property AsyncRunning: Boolean read FAsyncRunning;
    property PropStore: TPropertyStore read FPropStore;
    property PropertyStore: TPropertyStore read FPropStore;
    property CallbackWindow: HWND read FCallbackWindow;
    property WorkQueue: TArray<TWorkQueueItem> read WQ_GetArray;
    property OnCommand: TCommandHandler read FCommandHandler write FCommandHandler;
    property OnOutput: TOutputHandler read FOutputHandler write FOutputHandler;
    property OnQueueChanged: TQueueChangedEvent read FOnQueueChanged write FOnQueueChanged;
  end;

  TKernelProperties = class(TMultiProcPropertyStore)
  strict protected
    class function KernelVersion: TAlgosimObject; static;
    class function BuildTime: TAlgosimObject; static;
    class function SaveHistory: TAlgosimObject; static;
  strict private
    class var FKernel: TASKernel;
    class function GetKernel: TASKernel; static;
  protected
    class property Kernel: TASKernel read GetKernel;
  public
    constructor Create; overload; override;
    constructor Create(AKernel: TASKernel); reintroduce; overload;
  end;

  TSessionProperties = class(TMultiProcPropertyStore)
  strict protected
    function ID: TAlgosimObject;
    function StartTime: TAlgosimObject;
  strict private
    FKernel: TASKernel;
  public
    constructor Create; overload; override;
    constructor Create(AKernel: TASKernel); reintroduce; overload;
  end;

resourcestring
  SAnsDescription = 'This is the result of the last computation.';

implementation

uses
  SysUtils, Types, UITypes, Forms, Dialogs, ASPropStores, ASTokenizer, ASParser,
  GenHelpers, ASStructs, ASFunctions, ASExpression, ASExecutionContext, ShellAPI,
  MultiInput, DateUtils, ASFcnMgr, ASMidi, Math, StrUtils, ColorDialog, Graphics,
  ComObj, ActiveX, ClientDefs, TDMB;

{ TExecutionContext }

constructor TExecutionContext.Create;
begin
  raise Exception.Create('Cannot create an execution context without specifying a kernel.');
end;

function TExecutionContext.AbortCurrent: Boolean;
begin
  Result := Kernel.FAbortCurrent;
end;

function TExecutionContext.AbortCurrentEvent: TEvent;
begin
  Result := Kernel.FAbortCurrentEvent;
end;

constructor TExecutionContext.Create(AKernel: TASKernel);
begin
  FLastErrorCS := TCriticalSection.Create;
  FormatOptions := DefaultFormatOptions;
  Kernel := AKernel;
end;

destructor TExecutionContext.Destroy;
begin
  SetLastError(nil);
  FreeAndNil(FLastErrorCS);
  inherited;
end;

procedure TExecutionContext.EnterFcn;
begin
  Inc(FRecursionDepth);
end;

function TExecutionContext.EnterPauseEvent: TEvent;
begin
  Result := Kernel.FEnterPauseEvent;
end;

function TExecutionContext.GetEnterPause: Boolean;
begin
  Result := Kernel.FEnterPause;
end;

function TExecutionContext.GetLastError: TAlgosimFailure;
begin
  if FLastErrorCS = nil then
    Exit(nil);
  FLastErrorCS.Enter;
  try
    if Assigned(FLastError) then
      Result := TAlgosimFailure.Create(FLastError)
    else
      Result := nil;
  finally
    FLastErrorCS.Leave;
  end;
end;

procedure TExecutionContext.Init;
begin
  FRecursionDepth := 0;
end;

procedure TExecutionContext.LeaveFcn;
begin
  Dec(FRecursionDepth);
end;

procedure TExecutionContext.NotifyPause;
begin
  Kernel.NotifyPause;
end;

procedure TExecutionContext.NotifyResume;
begin
  Kernel.NotifyResume;
end;

function TExecutionContext.PropertyStore: TPropertyStore;
begin
  Result := Kernel.PropertyStore;
end;

function TExecutionContext.ResumeEvent: TEvent;
begin
  Result := Kernel.FResumeEvent;
end;

procedure TExecutionContext.SetEnterPause(AEnterPause: Boolean);
begin
  Kernel.FEnterPause := AEnterPause;
end;

procedure TExecutionContext.SetLastError(AError: TAlgosimFailure);
begin
  if FLastErrorCS = nil then
    Exit;
  FLastErrorCS.Enter;
  try
    TObjReplacer<TAlgosimFailure>.Replace(FLastError, AError)
  finally
    FLastErrorCS.Leave;
  end;
end;

function TExecutionContext.StoreStack: TObjStoreStack;
begin
  Result := Kernel.StoreStack;
end;

{ TASKernel }

procedure TASKernel.AbortAll;
begin
  WQ_Clear;
  WQ_AbortCurrent;
end;

procedure TASKernel.AbortJob(const AID: TGUID);
begin
  WQ_TryRemove(AID);
end;

procedure TASKernel.BufferAppend(const ABufferName, AText: string);
begin
  if (FBufferCS = nil) or (FBuffers = nil) then
    Exit;
  FBufferCS.Enter;
  try
    GetOrCreateBuffer(ABufferName).Add(AText);
  finally
    FBufferCS.Leave;
  end;
end;

class function TASKernel.CallbackWndProc(hWnd: HWND; uMsg: UINT;
  wParam: WPARAM; lParam: LPARAM): LRESULT;
var
  Kernel: TASKernel;
begin
  case uMsg of
    WM_EXECOUTPUT:
      begin
        Result := 0;
        if wParam <> 0 then
        begin
          Kernel := PWorkQueueItem(wParam).Kernel;
          if TObject(Kernel) is TASKernel then // TObject cast necessary -- otherwise the *is* expression might be replaced by True by the optimizer
          begin
            try
              Result := Ord(Kernel.DoOnOutput(PWorkQueueItem(wParam)^, PAlgosimObject(lParam)^));
            except
              Result := 0;
            end;
          end;
        end;
      end;
    WM_EXECPERFORM:
      try
        Result := Ord((TObject(wParam) is TASKernel) and (lParam <> 0) and TASKernel(wParam).Perform
          (
            PPerformRec(lParam).Command,
            PPerformRec(lParam).Params[0],
            PPerformRec(lParam).Params[1],
            PPerformRec(lParam).Params[2],
            PPerformRec(lParam).Params[3]
          ));
      except
        Result := 0;
      end;
    WM_EXECPROP:
      try
        if (TObject(wParam) is TASKernel) and not TASKernel(wParam).FDestroying then
          Result := LRESULT(TASKernel(wParam).PropStore.GetValue(string(PChar(lParam))))
        else
          Result := 0;
      except
        on E: Exception do
          Result := LRESULT(ASO(E));
      end;
    WM_QUEUECHANGED:
      begin
        if (TObject(wParam) is TASKernel) and Assigned(TASKernel(wParam).FOnQueueChanged) then
        begin
          TASKernel(wParam).FOnQueueChanged(TASKernel(wParam),
            TExecStateEx(lParam and $FFFF), lParam shr 16 <> 0);
          Result := 1;
        end
        else
          Result := 0;
      end;
  else
    Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
  end;
  if InSendMessage then
    FSendMessageTimestamp := GetTickCount64;
end;

procedure TASKernel.ClearAllBuffers;
begin
  if (FBufferCS = nil) or (FBuffers = nil) then
    Exit;
  FBufferCS.Enter;
  try
    FBuffers.Clear;
  finally
    FBufferCS.Leave;
  end;
end;

procedure TASKernel.ClearAllVars;
var
  i: Integer;
begin
  for i := FStoreStack.Count - 1 downto 0 do
    FStoreStack.Store[i].Clear;
end;

procedure TASKernel.ClearBuffer(const ABufferName: string);
begin
  if (FBufferCS = nil) or (FBuffers = nil) then
    Exit;
  FBufferCS.Enter;
  try
    GetOrCreateBuffer(ABufferName).Clear;
  finally
    FBufferCS.Leave;
  end;
end;

procedure TASKernel.ClearCommandHistory;
begin
  if (FCommandHistory = nil) or (FCommandHistoryCS = nil) then
    Exit;
  FCommandHistoryCS.Enter;
  try
    FCommandHistory.Clear;
  finally
    FCommandHistoryCS.Leave;
  end;
end;

procedure TASKernel.CommandHistoryAdd(const ACmdHistoryItem: TCmdHistoryItem);
begin
  if (FCommandHistory = nil) or (FCommandHistoryCS = nil) then
    Exit;
  FCommandHistoryCS.Enter;
  try
    FCommandHistory.Add(ACmdHistoryItem);
  finally
    FCommandHistoryCS.Leave;
  end;
end;

constructor TASKernel.Create;
begin
  FStartTime := Now;
  if CreateGUID(FSessionID) <> S_OK then
    FSessionID := TGUID.Empty;
  FObjStoreCS := TCriticalSection.Create;
  FCommandHistoryCS := TCriticalSection.Create;
  FCommandHistory := TObjectList<TCmdHistoryItem>.Create(True);
  FBufferCS := TCriticalSection.Create;
  FBuffers := TObjectDictionary<string, TOutputBuffer>.Create([doOwnsValues]);
  FGlobal := TAlgosimObjStore.Create;
  FStoreStack := TObjStoreStack.Create([FGlobal]);
  FPropStore := TGlobalPropStore.Create;
  FPropStore.AddSubstore(TKernelProperties.Create(Self));
  FPropStore.AddSubstore(TSessionProperties.Create(Self));
  FIdleTimer := TTimer.Create(nil);
  FIdleTimer.Enabled := False;
  FIdleTimer.Interval := 500;
  FIdleTimer.OnTimer := IdleTimerTimer;
  FContext := TExecutionContext.Create(Self);
  LoadDefVars;
  CreateWorkCallbackWnd;
  FAbortCurrentEvent := TEvent.Create(nil, True, False, '');
  FResumeEvent := TEvent.Create(nil, True, False, '');
  FEnterPauseEvent := TEvent.Create(nil, False, False, '');
  FPauseEvent := TEvent.Create(nil, True, False, '');
  FWorkEvent := TEvent.Create(nil, False, False, '');
  FWorkQueueCS := TCriticalSection.Create;
  FWorkQueue := TWorkQueue.Create;
  FAsyncExecuter := TAsyncExecuter.Create(Self);
  {$IFDEF DEBUG}
  TThread.NameThreadForDebugging('GUI', MainThreadID);
  TThread.NameThreadForDebugging('AsyncExecuter', FAsyncExecuter.ThreadID);
  {$ENDIF}
end;

procedure TASKernel.CreateWorkCallbackWnd;
const
  WndClassName = 'ASExecMsgWndClass';
  WndNamePrefix = 'ASExecMsgWnd';
var
  wc: TWndClass;
begin
  FillChar(wc, SizeOf(wc), 0);
  wc.lpfnWndProc := @CallbackWndProc;
  wc.hInstance := HInstance;
  wc.lpszClassName := WndClassName;
  FCallbackWndClass := Windows.RegisterClass(wc);
  if FCallbackWndClass <> 0 then
    FCallbackWindow := CreateWindow(WndClassName,
      PChar(WndNamePrefix + NativeUInt(Self).ToHexString), 0, 0, 0, 0, 0,
      HWND_MESSAGE, 0, HInstance, nil);
end;

destructor TASKernel.Destroy;
begin
  FDestroying := True;
  FreeAndNil(FAsyncExecuter);
  FreeAndNil(FWorkQueue);
  FreeAndNil(FWorkQueueCS);
  FreeAndNil(FWorkEvent);
  FreeAndNil(FPauseEvent);
  FreeAndNil(FEnterPauseEvent);
  FreeAndNil(FResumeEvent);
  FreeAndNil(FAbortCurrentEvent);
  if FCallbackWindow <> 0 then
    DestroyWindow(FCallbackWindow);
  FreeAndNil(FContext);
  FreeAndNil(FIdleTimer);
  FreeAndNil(FPropStore);
  FreeAndNil(FStoreStack);
  FreeAndNil(FGlobal);
  FreeAndNil(FBuffers);
  FreeAndNil(FBufferCS);
  FreeAndNil(FCommandHistory);
  FreeAndNil(FCommandHistoryCS);
  FreeAndNil(FObjStoreCS);
  inherited;
end;

function TASKernel.DoOnOutput(const AWorkItem: TWorkQueueItem;
  AResult: TAlgosimObject): Boolean;
begin
  Result := not FDestroying and Assigned(OnOutput);
  if Result then
    OnOutput(AWorkItem, AResult);
end;

procedure TASKernel.DoQueueChanged(AState: TExecState; AError: Boolean);
begin
  PostMessage(FCallbackWindow, WM_QUEUECHANGED, WPARAM(Self), LPARAM(Ord(AState) or Ord(AError) shl 16));
end;

procedure TASKernel.DoQueueChanged;
begin
  PostMessage(FCallbackWindow, WM_QUEUECHANGED, WPARAM(Self), LPARAM(-1));
end;

procedure TASKernel.WQ_AbortCurrent;
begin
  FAbortCurrent := True;
  if Assigned(FAbortCurrentEvent) then
    FAbortCurrentEvent.SetEvent;
  FState := esAborting;
  DoQueueChanged(esAborting);
end;

procedure TASKernel.WQ_Clear;
var
  OldLen: Integer;
begin
  if (FWorkQueueCS = nil) or (FWorkQueue = nil) then
    Exit;
  FWorkQueueCS.Enter;
  try
    OldLen := FWorkQueue.Count;
    FWorkQueue.Clear;
  finally
    FWorkQueueCS.Leave;
  end;
  if OldLen > 0 then
    DoQueueChanged;
end;

function TASKernel.WQ_Enqueue(const AExpr: string): TWorkQueueItem;
begin
  if (FWorkQueueCS = nil) or (FWorkQueue = nil) then
    Exit;
  Result := TWorkQueueItem.CreateNew(Self, AExpr);
  FWorkQueueCS.Enter;
  try
    FWorkQueue.Enqueue(Result);
  finally
    FWorkQueueCS.Leave;
  end;
  if Assigned(FWorkEvent) then
    FWorkEvent.SetEvent;
  DoQueueChanged;
end;

function TASKernel.WQ_GetArray: TArray<TWorkQueueItem>;
var
  Current: TWorkQueueItem;
begin
  if (FWorkQueueCS = nil) or (FWorkQueue = nil) then
    Exit(nil);
  FWorkQueueCS.Enter;
  try
    Result := FWorkQueue.ToArray;
    Current := FCurrentJob;
  finally
    FWorkQueueCS.Leave;
  end;
  if Current.UID <> TGUID.Empty then
    Result := [Current] + Result;
end;

procedure TASKernel.WQ_JobEnded;
begin
  if FWorkQueueCS = nil then
    Exit;
  FWorkQueueCS.Enter;
  try
    FCurrentJob := NullJob;
  finally
    FWorkQueueCS.Leave;
  end;
  DoQueueChanged;
end;

function TASKernel.WQ_TryDequeue(out AWorkQueueItem: TWorkQueueItem): Boolean;
begin
  if (FWorkQueueCS = nil) or (FWorkQueue = nil) then
    Exit(False);
  FWorkQueueCS.Enter;
  try
    FAbortCurrent := False;
    if FAbortCurrentEvent = nil then
      raise Exception.Create('No termination event object.');
    FAbortCurrentEvent.ResetEvent;
    Result := FWorkQueue.Count > 0;
    if Result then
    begin
      AWorkQueueItem := FWorkQueue.Dequeue;
      FCurrentJob := AWorkQueueItem;
      FCurrentJob.Dequeued := Now;
    end
    else
      FCurrentJob := NullJob;
  finally
    FWorkQueueCS.Leave;
  end;
  if Result then
    DoQueueChanged;
end;

function TASKernel.WQ_TryRemove(const AID: TGUID): Boolean;
var
  NewQueue: TWorkQueue;
  WQI: TWorkQueueItem;
begin
  if (FWorkQueueCS = nil) or (FWorkQueue = nil) then
    Exit(False);
  FWorkQueueCS.Enter;
  try
    if AID = FCurrentJob.UID then
    begin
      FAbortCurrent := True;
      if Assigned(FAbortCurrentEvent) then
        FAbortCurrentEvent.SetEvent;
      FState := esAborting;
      DoQueueChanged(esAborting);
      Exit(True);
    end;
    NewQueue := TWorkQueue.Create;
    try
      for WQI in FWorkQueue do
        if WQI.UID <> AID then
          NewQueue.Enqueue(WQI);
      Result := NewQueue.Count < FWorkQueue.Count;
      if Result then
        TSwapper<TWorkQueue>.Swap(FWorkQueue, NewQueue); // strong guarantee
    finally
      NewQueue.Free;
    end;
  finally
    FWorkQueueCS.Leave;
  end;
  if Result then
    DoQueueChanged;
end;

function TASKernel.Evaluate(const AExpr: string): TAlgosimObject;
var
  Tokens: TList<TToken>;
  Expr: TASExpression;
  HistItem: TCmdHistoryItem;
  c1, c2, f: Int64;
  LockInfo: TLockInfo;
begin

  if FDestroying then
    Exit(nil);

  if TThread.Current.ThreadId = MainThreadID then
    LockObjStore(LockInfo);
  try
    Inc(FEvalLevel);
    try
      Tokens := TTokenizer.Tokenize(AExpr);
      try
        Expr := TParser.Parse(Tokens);
        try
          HistItem := TCmdHistoryItem.Create(Now, AExpr);  // only if successfully (tokenized and) parsed
          // Notice we cannot transfer ownership of HistItem to FCommandHistory on
          // this line, because Expr.Evalutate below might clear FCommandHistory,
          // which would then free HistItem behind our back. Thus: try..except idiom
          try
            Expr.Context := TExecutionContextRef.Create(FContext);
            FContext.Init;
            QueryPerformanceCounter(c1); // nofail: documented never to fail on XP and later
            Expr.Evaluate;
            QueryPerformanceCounter(c2); // nofail
            QueryPerformanceFrequency(f); // nofail; also: f guaranteed not to be zero on XP and later
            HistItem.EvalTime := (c2 - c1) / f;
            TMover<TAlgosimObject>.Move(Result, Expr.Root.Value);
            if IsFailure(Result) then
              FContext.SetLastError(TAlgosimFailure(Result))
            else
            begin
              FGlobal.SetVariable('ans', Result, SAnsDescription);
              FContext.SetLastError(nil);
            end;
            if FSaveHistResults then
              HistItem.Result := Result.Clone;
          except
            HistItem.Free;
            raise;
          end;
          CommandHistoryAdd(HistItem); // transfer of ownership
        finally
          Expr.Free;
        end;
      finally
        Tokens.Free;
      end;
    finally
      Dec(FEvalLevel);
      if FEvalLevel = 0 then
        RestartTimer(FIdleTimer);
    end;
  finally
    if TThread.Current.ThreadId = MainThreadID then
      UnlockObjStore(LockInfo);
  end;

end;

function TASKernel.EvaluateAsync(const AExpr: string): TWorkQueueItem;
begin
  if FDestroying then
    Exit(NullJob);
  Result := WQ_Enqueue(AExpr);
end;

function TASKernel.GetBuffers: TArray<string>;
begin
  if (FBufferCS = nil) or (FBuffers = nil) then
    Exit(nil);
  FBufferCS.Enter;
  try
    Result := FBuffers.Keys.ToArray;
  finally
    FBufferCS.Leave;
  end;
end;

function TASKernel.GetBufferText(const ABufferName: string): string;
begin
  if (FBufferCS = nil) or (FBuffers = nil) then
    Exit('');
  FBufferCS.Enter;
  try
    Result := GetNamedBuffer(ABufferName).Text;
  finally
    FBufferCS.Leave;
  end;
end;

function TASKernel.GetCommandHistoryItem(Index: Integer): TCmdHistoryItem;
begin
  if (FCommandHistory = nil) or (FCommandHistoryCS = nil) then
    Exit(nil);
  FCommandHistoryCS.Enter;
  try
    if InRange(Index, 0, FCommandHistory.Count - 1) then
      Result := FCommandHistory[Index]
    else
      Result := nil;
  finally
    FCommandHistoryCS.Leave;
  end;
end;

function TASKernel.GetCommandHistoryLength: Integer;
begin
  if (FCommandHistory = nil) or (FCommandHistoryCS = nil) then
    Exit(0);
  FCommandHistoryCS.Enter;
  try
    Result := FCommandHistory.Count;
  finally
    FCommandHistoryCS.Leave;
  end;
end;

function TASKernel.GetFormatOptions: TFormatOptions;
begin
  Result := FContext.FormatOptions;
end;

function TASKernel.GetMatchingIdents(ATypes: TIdentTypes;
  const AText: string; AHideSystem: Boolean): TArray<TIdentInfo>;
var
  TextLower: string;
  List: TList<TIdentInfo>;
  s: string;
  op: TOperator;
  v: TAlgosimVariable;
  it: TIdentType;

  procedure Process(const AIdentInfo: TIdentInfo);
  begin
    if
      (AIdentInfo.IdentType in ATypes)
        and
      (AText.IsEmpty or AIdentInfo.Name.ToLower.Contains(TextLower))
        and
      (not AHideSystem or not (iaSYstem in AIdentInfo.Attributes))
    then
      List.Add(AIdentInfo);
  end;

var
  LockInfo: TASKernel.TLockInfo;

begin

  TextLower := AText.ToLower;

  List := TList<TIdentInfo>.Create;
  try

    if itFunction in ATypes then
      for s in TFunctionMgr.FcnNames do
        Process(TIdentInfo.CreateFcn(s));

    if itOperator in ATypes then
      for op := Low(TOperator) to High(TOperator) do
        Process(TIdentInfo.CreateOp(op));

    if ([itVariable, itFcnVariable] * ATypes <> []) and Assigned(FStoreStack) and Assigned(FObjStoreCS) then
    begin

      LockObjStore(LockInfo);
      try

        for s in FStoreStack.GetVariableList do
        begin

          if FStoreStack.TryGetVariable(s, v) = nil then
            Continue;

          if v.ObjRef is TAlgosimFunctionObject then
            it := itFcnVariable
          else
            it := itVariable;

          Process(
            TIdentInfo.CreateVar(
              it,
              s,
              TAlgosimObjectClass(v.ObjRef.ClassType),
              v.ObjRef.TypeName,
              v.Attributes
            )
          );

        end;

      finally
        UnlockObjStore(LockInfo);
      end;

    end;

    List.Sort(
      TComparer<TIdentInfo>.Construct(
        function(const Left, Right: TIdentInfo): Integer
        begin
          Result := CompareValue(Ord(Left.IdentType), Ord(Right.IdentType));
          if Result = 0 then
            Result := CompareText(Left.Name, Right.Name);
        end
      )
    );

    Result := List.ToArray;

  finally
    List.Free;
  end;

end;

function TASKernel.GetNamedBuffer(const ABufferName: string): TOutputBuffer;
begin
  if not FBuffers.TryGetValue(ABufferName, Result) then
    raise EBufferException.CreateFmt(SNamedBufferNotFound, [ABufferName]);
end;

function TASKernel.GetOrCreateBuffer(const ABufferName: string): TOutputBuffer;
begin
  if not FBuffers.TryGetValue(ABufferName, Result) then
    if IsValidIdent(ABufferName) then
    begin
      Result := TOutputBuffer.Create;
      FBuffers.AddOrSetValue(ABufferName, Result);
    end
    else
      raise EBufferException.CreateFmt(SInvalidBufferName, [ABufferName]);
end;

function TASKernel.GetVariableRef(const AName: string;
  const APromise: TReadOnlyPromise): TAlgosimObject;
begin

  if APromise <> I_Will_Not_Modify_The_Object then
    Exit(nil);

  if FStoreStack = nil then
    Exit(nil);

  if FObjStoreCS = nil then
    Exit(nil);

  if FClientObjStoreLock <= 0 then
    raise EObjStoreLocked.Create('Client hasn''t locked the object store.');

  if FStoreStack.GetObjRef(AName, Result) = nil then
    raise EUnknownIdentifier.CreateFmt(SUnknownIdentifier, [AName]);

end;

procedure TASKernel.IdleTimerTimer(Sender: TObject);
begin
  FIdleTimer.Enabled := False;
end;

procedure TASKernel.Init;
var
  S: string;
begin
  S := Format('Algosim kernel %d.%d.%d%s',
    [
      ASKernelDefs.KernelVersion.Major,
      ASKernelDefs.KernelVersion.Minor,
      ASKernelDefs.KernelVersion.Release,
      sLineBreak
    ]);
  Perform(CLIENT_COMMAND_PRINT, 0, NativeInt(PChar(S)), 0, 0);
end;

function TASKernel.IsValidIdent(const S: string): Boolean;
begin
  Result := ASKernelDefs.IsValidIdent(S);
end;

procedure TASKernel.LoadDefVars;
begin
  FGlobal.ForceSetVariable('π', ASO(Pi), 'The ratio of a circle''s circumference to its diameter.', True);
  FGlobal.ForceSetVariable('e', ASO(Exp(1)), 'The base of the natural logarithm.', True);
  FGlobal.ForceSetVariable('i', ASO(ImaginaryUnit), 'The imaginary unit, a square root of negative one.', True, True);
  FGlobal.ForceSetVariable('false', ASO(False), 'The false boolean value.', True, True);
  FGlobal.ForceSetVariable('true', ASO(True), 'The true boolean value.', True, True);
  FGlobal.ForceSetVariable('otherwise', ASO(True), 'A symbol used in piecewise function definitions; equal to true.', True, True);
  FGlobal.ForceSetVariable('∅', TAlgosimSet.Create, 'The empty set.', True, True);
  FGlobal.ForceSetVariable('ℎ', ASO(6.62607015E-34), 'The Planck constant.', True);
  FGlobal.ForceSetVariable('ℏ', ASO(6.62607015E-34 / (2*Pi)), 'The Planck constant divided by 2π.', True);
  FGlobal.ForceSetVariable('¶', ASO(#13#10), 'The line break sequence (CR+LF).', False, True);
  begin
    var asoinfty := nil;
    try
      asoinfty := ASO(Infinity);  // may raise depending on the (generalized) floating-point mode
    except
    end;
    if Assigned(asoinfty) then
      FGlobal.ForceSetVariable('∞', asoinfty, 'Real positive infinity.', True, True);
  end;
end;

procedure TASKernel.LockObjStore(out ALockInfo: TLockInfo);
begin
  if not TryLockObjStore(ALockInfo) then
    raise EObjStoreLocked.Create('Object store is locked.');
end;

procedure TASKernel.NotifyPause;
begin
  FState := esPaused;
  FAsyncRunning := False;
  if Assigned(FObjStoreCS) then
    FObjStoreCS.Leave;
  if Assigned(FPauseEvent) then
    FPauseEvent.SetEvent;
  DoQueueChanged(esPaused);
end;

procedure TASKernel.NotifyResume;
begin
  if Assigned(FPauseEvent) then
    FPauseEvent.ResetEvent;
  if Assigned(FObjStoreCS) then
    FObjStoreCS.Enter;
  FAsyncRunning := True;
  FState := esRunning;
  DoQueueChanged(esRunning);
end;

var
  _MidiInit: Boolean;

procedure MidiInit;
begin
  if _MidiInit then
    Exit;
  ASMidi.TNotePlayer.Init;
  _MidiInit := True;
end;

procedure TASKernel.Pause;
begin
  if (FResumeEvent = nil) or (FEnterPauseEvent = nil) then
    Exit;
  FState := esPausing;
  FResumeEvent.ResetEvent;
  FEnterPause := True;
  FEnterPauseEvent.SetEvent;
  DoQueueChanged(esPausing);
end;

function TASKernel.Perform(ACommand: Cardinal; AParam1, AParam2, AParam3,
  AParam4: NativeInt): Boolean;
const
  MBMRBASE = 1000;
var
  ObjInfo: TObject;
  MsgBoxInfo: TMsgBoxInfo absolute ObjInfo;
  InputBoxInfo: TInputBoxInfo absolute ObjInfo;
  FileDialogInfo: TFileDialogInfo absolute ObjInfo;
  FontInfo: TFont absolute ObjInfo;
  Dialog: TObject;
  FileOpenDialog: TFileOpenDialog absolute Dialog;
  FileSaveDialog: TFileSaveDialog absolute Dialog;
  TaskDialog: TTaskDialog absolute Dialog;
  i: Integer;
  S: string;
  CmdRes: TCmdRes;
  CmdLine: string;
  PI: TProcessInformation;
  SI: TStartupInfo;
  PR: TPerformRec;
begin

  if (Self = nil) or FDestroying then
    Exit(False);

  if TThread.Current.ThreadID <> MainThreadID then
  begin
    PR.Command := ACommand;
    PR.Params[0] := AParam1;
    PR.Params[1] := AParam2;
    PR.Params[2] := AParam3;
    PR.Params[3] := AParam4;
    Exit(SendMessage(FCallbackWindow, WM_EXECPERFORM, WPARAM(Self), LPARAM(@PR)) <> 0);
  end;

  if Assigned(FCommandHandler) then
  begin
    CmdRes := FCommandHandler(ACommand, AParam1, AParam2, AParam3, AParam4);
    if CmdRes.Handled then
      Exit(CmdRes.Result);
  end;

  case ACommand of
    CLIENT_COMMAND_SYSTEM:
      Result := ShellExecute(0, nil, PChar(AParam1), PChar(AParam2), nil, SW_SHOWNORMAL) > 32;
    CLIENT_COMMAND_MSGBOX:
      begin
        if TObject(AParam1) is TMsgBoxInfo then
        begin
          MsgBoxInfo := TMsgBoxInfo(AParam1);
          TaskDialog := TTaskDialog.Create(nil);
          try
            TaskDialog.Caption := Application.Title;
            TaskDialog.Text := MsgBoxInfo.Text;
            if SameText(MsgBoxInfo.Icon, 'information') then
              TaskDialog.MainIcon := tdiInformation
            else if SameText(MsgBoxInfo.Icon, 'warning') then
              TaskDialog.MainIcon := tdiWarning
            else if SameText(MsgBoxInfo.Icon, 'error') then
              TaskDialog.MainIcon := tdiError
            else
              TaskDialog.MainIcon := tdiNone;
            if Length(MsgBoxInfo.Buttons) > 0 then
              TaskDialog.CommonButtons := []
            else
              TaskDialog.CommonButtons := [tcbOk];
            TaskDialog.Flags := [tfPositionRelativeToWindow];
            for i := 0 to High(MsgBoxInfo.Buttons) do
            begin
              with TaskDialog.Buttons.Add do
              begin
                Caption := MsgBoxInfo.Buttons[i];
                Default := (i = MsgBoxInfo.DefButton) or ((i = 0) and (MsgBoxInfo.DefButton = -1));
                if i = MsgBoxInfo.CancelButton then
                  ModalResult := mrCancel
                else
                  ModalResult := MBMRBASE + i;
              end;
            end;
            TaskDialog.ExecuteModally;
            if TaskDialog.ModalResult = mrCancel then
              MsgBoxInfo.Result := MsgBoxInfo.CancelButton
            else
              MsgBoxInfo.Result := TaskDialog.ModalResult - MBMRBASE;
          finally
            TaskDialog.Free;
          end;
          Result := True;
        end
        else
          Result := False;
      end;
    CLIENT_COMMAND_INPUTBOX:
      begin
        if TObject(AParam1) is TInputBoxInfo then
        begin
          InputBoxInfo := TInputBoxInfo(AParam1);
          S := InputBoxInfo.DefVal;
          if TMultiInputBox.TextInputBox(nil, Application.Title, InputBoxInfo.Caption, S) then
          begin
            InputBoxInfo.OutText := S;
            InputBoxInfo.Canceled := False;
          end
          else
            InputBoxInfo.Canceled := True;
          Result := True;
        end
        else
          Result := False;
      end;
    CLIENT_COMMAND_COLORDIALOG:
      begin
        with TColorDialog.Create(nil) do
          try
            Color := PColor(AParam1)^;
            PBoolean(AParam2)^ := Execute;
            if PBoolean(AParam2)^ then
              PColor(AParam1)^ := Color;
          finally
            Free;
          end;
        Result := True;
      end;
    CLIENT_COMMAND_FONTDIALOG:
      begin
        if TObject(AParam1) is TFont then
        begin
          FontInfo := TFont(AParam1);
          with TFontDialog.Create(nil) do
            try
              Font.Assign(FontInfo);
              PBoolean(AParam2)^ := Execute;
              if PBoolean(AParam2)^ then
                FontInfo.Assign(Font);
            finally
              Free;
            end;
          Result := True;
        end
        else
          Result := False;
      end;
    CLIENT_COMMAND_FILEDIALOG:
      begin
        if TObject(AParam1) is TFileDialogInfo then
        begin
          FileDialogInfo := TFileDialogInfo(AParam1);
          Result := True;
          case FileDialogInfo.DialogKind of
            fdkOpen:
              begin
                FileOpenDialog := TFileOpenDialog.Create(nil);
                try
                  FileOpenDialog.FileName := FileDialogInfo.FileName;
                  for S in FileDialogInfo.Filters do
                  begin
                    var parts := S.split(['|']);
                    if Length(parts) = 2 then
                      with FileOpenDialog.FileTypes.Add do
                      begin
                        DisplayName := parts[0];
                        FileMask := parts[1];
                      end;
                  end;
                  FileOpenDialog.Options := [fdoPathMustExist, fdoFileMustExist];
                  if FileDialogInfo.MultiSel then
                    FileOpenDialog.Options := FileOpenDialog.Options + [fdoAllowMultiSelect];
                  FileDialogInfo.Canceled := not FileOpenDialog.Execute;
                  if not FileDialogInfo.Canceled then
                    if FileDialogInfo.MultiSel then
                      FileDialogInfo.Files := FileOpenDialog.Files.ToStringArray
                    else
                      FileDialogInfo.FileName := FileOpenDialog.FileName;
                finally
                  FileOpenDialog.Free;
                end;
              end;
            fdkSave:
              begin
                FileSaveDialog := TFileSaveDialog.Create(nil);
                try
                  FileSaveDialog.FileName := FileDialogInfo.FileName;
                  for S in FileDialogInfo.Filters do
                  begin
                    var parts := S.split(['|']);
                    if Length(parts) = 2 then
                      with FileSaveDialog.FileTypes.Add do
                      begin
                        DisplayName := parts[0];
                        FileMask := parts[1];
                      end;
                  end;
                  FileSaveDialog.DefaultExtension := FileDialogInfo.DefaultExt.TrimLeft(['.']);
                  FileSaveDialog.Options := [fdoOverwritePrompt];
                  FileDialogInfo.Canceled := not FileSaveDialog.Execute;
                  if not FileDialogInfo.Canceled then
                    FileDialogInfo.FileName := FileSaveDialog.FileName;
                finally
                  FileSaveDialog.Free;
                end;
              end;
          end;
        end
        else
          Result := False;
      end;
    CLIENT_COMMAND_SELFTEST, CLIENT_COMMAND_GRPHTEST:
      begin
        if ACommand = CLIENT_COMMAND_GRPHTEST then
          CmdLine := '"' + Application.ExeName + '"' + #32 + '/GrphTest'
        else
          CmdLine := '"' + Application.ExeName + '"' + #32 + '/SelfTest';
        UniqueString(CmdLine);
        FillChar(SI, SizeOf(SI), 0);
        FillChar(PI, SizeOf(PI), 0);
        SI.cb := SizeOf(SI);
        Result := CreateProcess(PChar(Application.ExeName), PChar(CmdLine),
          nil, nil, False, 0, nil, nil, SI, PI);
        if Result then
        begin
          CloseHandle(PI.hThread);
          CloseHandle(PI.hProcess);
        end;
      end;
    CLIENT_COMMAND_MIDI_SETINSTRUMENT:
      begin
        MidiInit;
        ASMidi.TNotePlayer.Instrument := TMIDIInstrument(AParam1);
        Result := True;
      end;
    CLIENT_COMMAND_MIDI_GETINSTRUMENT:
      begin
        MidiInit;
        PInteger(AParam1)^ := Ord(ASMidi.TNotePlayer.Instrument);
        Result := True;
      end;
    CLIENT_COMMAND_MIDI_SETVOLUME:
      begin
        MidiInit;
        ASMidi.TNotePlayer.Volume := AParam1;
        Result := True;
      end;
    CLIENT_COMMAND_MIDI_GETVOLUME:
      begin
        MidiInit;
        PInteger(AParam1)^ := ASMidi.TNotePlayer.Volume;
        Result := True;
      end;
    CLIENT_COMMAND_MIDI_NOTEON:
      begin
        MidiInit;
        ASMidi.TNotePlayer.NoteOn(AParam1, AParam2);
        Result := True;
      end;
    CLIENT_COMMAND_MIDI_NOTEOFF:
      begin
        MidiInit;
        ASMidi.TNotePlayer.NoteOff(AParam1, AParam2);
        Result := True;
      end;
    CLIENT_COMMAND_MIDI_PNOTEON:
      begin
        MidiInit;
        ASMidi.TNotePlayer.PercussionNoteOn(TMIDIPercussionKey(AParam1), AParam2);
        Result := True;
      end;
    CLIENT_COMMAND_MIDI_PNOTEOFF:
      begin
        MidiInit;
        ASMidi.TNotePlayer.PercussionNoteOff(TMIDIPercussionKey(AParam1), AParam2);
        Result := True;
      end;
    CLIENT_COMMAND_MIDI_SILENCE:
      begin
        MidiInit;
        ASMidi.TNotePlayer.Silence;
        Result := True;
      end;
    CLIENT_COMMAND_MIDI_FORCEDSILENCE:
      begin
        MidiInit;
        ASMidi.TNotePlayer.ForcedSilence;
        Result := True;
      end;
    CLIENT_COMMAND_MIDI_RESET:
      begin
        MidiInit;
        ASMidi.TNotePlayer.Reset;
        Result := True;
      end;
    CLIENT_COMMAND_MIDI_MESSAGE:
      begin
        MidiInit;
        ASMidi.TNotePlayer.SendMessage('SendMessage', AParam1);
        Result := True;
      end
  else
    Result := False;
  end;

end;

procedure TASKernel.RemoveBuffer(const ABufferName: string);
var
  Found: Boolean;
begin

  if (FBufferCS = nil) or (FBuffers = nil) then
    Exit;

  FBufferCS.Enter;
  try
    Found := FBuffers.ContainsKey(ABufferName);
    if Found then
      FBuffers.Remove(ABufferName)
  finally
    FBufferCS.Leave;
  end;

  if not Found then
    raise EBufferException.CreateFmt(SNamedBufferNotFound, [ABufferName]);

end;

procedure TASKernel.Resume;
begin
  if (FEnterPauseEvent = nil) or (FResumeEvent = nil) or not (FState in [esPaused, esPausing]) then
    Exit;
  FState := esRunning;
  FEnterPauseEvent.ResetEvent;
  FEnterPause := False;
  FResumeEvent.SetEvent;
  DoQueueChanged(esRunning);
end;

procedure TASKernel.SetFormatOptions(const Value: TFormatOptions);
begin
  FContext.FormatOptions := Value;
end;

function TASKernel.TryLockObjStore(out ALockInfo: TLockInfo): Boolean;
begin

  FillChar(ALockInfo, SizeOf(ALockInfo), 0);

  if FAsyncRunning and (FState <> esPaused) and Assigned(FPauseEvent) then
  begin
    Pause;
    if FPauseEvent.WaitFor(500) = wrSignaled then
      ALockInfo.Paused := True
    else
      Resume;
  end;

  Result := Assigned(FObjStoreCS) and FObjStoreCS.TryEnter;
  if Result then
    Inc(FClientObjStoreLock);

end;

procedure TASKernel.UnlockObjStore(const ALockInfo: TLockInfo);
begin
  if FClientObjStoreLock <= 0 then
    raise EKernelException.Create('Client hasn''t locked the object store.');
  Dec(FClientObjStoreLock);
  FObjStoreCS.Leave;
  if (FClientObjStoreLock = 0) and ALockInfo.Paused then
    Resume;
end;

function TASKernel.VariableExists(const AName: string): Boolean;
var
  &Var: TAlgosimVariable;
  LockInfo: TASKernel.TLockInfo;
begin

  if FStoreStack = nil then
    raise EKernelException.Create('No store stack.');

  if FObjStoreCS = nil then
    raise EKernelException.Create('No store stack critical section.');

  LockObjStore(LockInfo);
  try
    Result := FStoreStack.TryGetVariable(AName, &Var) <> nil;
  finally
    UnlockObjStore(LockInfo);
  end;

end;

{ TCmdRes }

class operator TCmdRes.Implicit(AResult: Boolean): TCmdRes;
begin
  Result.Handled := True;
  Result.Result := AResult;
end;

class function TCmdRes.Unhandled: TCmdRes;
begin
  Result.Handled := System.False;
  Result.Result := System.False;
end;

{ TKernelProperties }

class function TKernelProperties.BuildTime: TAlgosimObject;
begin
  Result := ASODateTime(ASKernelDefs.LinkerTimestamp);
end;

constructor TKernelProperties.Create;
begin
  inherited;
  FName := 'kernel';
  AddValue('version', KernelVersion);
  AddValue('BuildTime', BuildTime);
  AddValue('SaveHistory', SaveHistory);
end;

constructor TKernelProperties.Create(AKernel: TASKernel);
begin
  Create;
  FKernel := AKernel;
end;

class function TKernelProperties.GetKernel: TASKernel;
begin
  if Assigned(FKernel) then
    Result := FKernel
  else
    raise Exception.Create('TKernelProperties: Kernel not specified.');
end;

class function TKernelProperties.KernelVersion: TAlgosimObject;
begin
  Result := ASOVersionData(ASKernelDefs.KernelVersion);
end;

class function TKernelProperties.SaveHistory: TAlgosimObject;
begin
  Result := ASO(Kernel.SaveHistResults);
end;

{ TSessionProperties }

constructor TSessionProperties.Create;
begin
  inherited;
  FName := 'session';
  AddValue('ID', ID);
  AddValue('StartTime', StartTime);
end;

constructor TSessionProperties.Create(AKernel: TASKernel);
begin
  Create;
  FKernel := AKernel;
end;

function TSessionProperties.ID: TAlgosimObject;
begin
  if Assigned(FKernel) then
    Result := ASO(GUIDToString(FKernel.SessionID))
  else
    Result := ASO(null);
end;

function TSessionProperties.StartTime: TAlgosimObject;
begin
  if Assigned(FKernel) then
    Result := ASODateTime(FKernel.StartTime)
  else
    Result := ASO(null);
end;

{ TASKernel.TCmdHistoryItem }

constructor TASKernel.TCmdHistoryItem.Create(const AStartTime: TDateTime;
  const ACmd: string);
begin
  StartTime := AStartTime;
  Cmd := ACmd;
end;

destructor TASKernel.TCmdHistoryItem.Destroy;
begin
  FreeAndNil(Result);
  inherited;
end;

{ TASKernel.TExecStateHelper }

function TASKernel.TExecStateHelper.ToString: string;
begin
  if InRange(Ord(Self), Ord(Low(TExecState)), Ord(High(TExecState))) then
    Result := ExecStateNames[Self]
  else
    Result := 'Unknown';
end;

{ TASKernel.TIdentInfo }

constructor TASKernel.TIdentInfo.CreateFcn(const AFcnName: string);
begin
  IdentType := itFunction;
  Name := AFcnName;
  ClassType := nil;
  TypeName := '';
  &Operator := TOperator(0);
  Attributes := [];
  Preview := '';
end;

constructor TASKernel.TIdentInfo.CreateOp(AOperator: TOperator);
begin
  IdentType := itOperator;
  Name := AOperator.Symbol;
  ClassType := nil;
  TypeName := '';
  &Operator := AOperator;
  Attributes := [];
  Preview := '';
end;

constructor TASKernel.TIdentInfo.CreateVar(AIdentType: TIdentType;
  const AName: string; AClassType: TAlgosimObjectClass; const ATypeName: string;
  AAttributes: TIdentAttribs);
begin
  IdentType := AIdentType;
  Name := AName;
  ClassType := AClassType;
  TypeName := ATypeName;
  &Operator := TOperator(0);
  Attributes := AAttributes;
  Preview := '';
end;

function TASKernel.TIdentInfo.FullDescription: string;
var
  TypeStr: string;
begin
  if (IdentType = itVariable) and (iaProtected in Attributes) then
    TypeStr := 'constant'
  else
    TypeStr := IdentType.ToString;
  Result := Format('%s (%s)', [Name, TypeStr]);
end;

{ TASKernel.TIdentTypeHelper }

function TASKernel.TIdentTypeHelper.ToString: string;
begin
  case Self of
    itFunction:
      Result := 'function';
    itOperator:
      Result := 'operator';
    itVariable:
      Result := 'variable';
    itFcnVariable:
      Result := 'user-defined function';
  else
    Result := 'unknown';
  end;
end;

{ TASKernel.TWorkQueueItem }

constructor TASKernel.TWorkQueueItem.CreateNew(AKernel: TASKernel;
  const ACmd: string);
begin
  Kernel := AKernel;
  if CreateGUID(UID) <> S_OK then
    UID := TGUID.Empty;
  Enqueued := Now;
  Cmd := ACmd;
end;

function TASKernel.TWorkQueueItem.ToString: string;
var
  LTopmostState: string;
begin
  if Assigned(Kernel) then
    LTopmostState := Kernel.State.ToString;
  Result := Format('%s: %s'#13#10'%s: %s'#13#10'%s: %s'#13#10'%s: %s'#13#10'%s: %s',
    [
      'UID',      UID.ToString,
      'Status',   IfThen(Dequeued = 0.0, 'Queued', LTopmostState),
      'Enqueued', DateTimeToStr(Enqueued),
      'Dequeued', IfThen(Dequeued = 0.0, 'Not yet', DateTimeToStr(Dequeued)),
      'Command',  Cmd
    ]
  );
end;

{ TASKernel.TAsyncExecuter }

constructor TASKernel.TAsyncExecuter.Create(AKernel: TASKernel);
begin
  Kernel := AKernel;
  inherited Create(False);
end;

destructor TASKernel.TAsyncExecuter.Destroy;
begin
  Terminate;
  if Assigned(Kernel) then
  begin
    Kernel.WQ_Clear;
    Kernel.WQ_AbortCurrent;
    if Assigned(Kernel.FWorkEvent) then
      Kernel.FWorkEvent.SetEvent;
  end;
  inherited;
end;

procedure TASKernel.TAsyncExecuter.Execute;
var
  WorkItem: TWorkQueueItem;
begin
  inherited;
  var CW: Word := KernelFPUCW;
  if Kernel = nil then
    Exit;
  if Kernel.WorkEvent = nil then
    Exit;
  OleCheck(CoInitialize(nil));
  try
    while not Terminated do
    begin
      while not Terminated and Kernel.WQ_TryDequeue(WorkItem) do
      begin
        asm
          FNCLEX
          FLDCW  CW
        end;
        Perform(WorkItem);
      end;
      Kernel.FState := esReady;
      Kernel.DoQueueChanged(esReady);
      Kernel.FEnterPause := False;
      Kernel.FEnterPauseEvent.ResetEvent;
      Kernel.WorkEvent.WaitFor(INFINITE);
    end;
  finally
    CoUninitialize
  end;
end;

procedure TASKernel.TAsyncExecuter.Perform(const AWorkItem: TWorkQueueItem);
var
  Res: TAlgosimObject;
  Err: TAlgosimObject;
begin

  if Kernel = nil then
    Exit;

  if Kernel.FObjStoreCS = nil then
    raise EKernelException.Create('No object store critical section.');

  Err := nil;
  try

    Kernel.FState := esRunning;
    Kernel.DoQueueChanged(esRunning);
    Kernel.FAsyncRunning := True;
    Kernel.FObjStoreCS.Enter;
    try
      try
        try
          Res := Kernel.Evaluate(AWorkItem.Cmd);
        finally
          Kernel.WQ_JobEnded;
        end;
      except
        on E: Exception do
          Err := ASO(E);
      end;
    finally
      Kernel.FAsyncRunning := False;
      Kernel.FObjStoreCS.Leave;
    end;

    Kernel.DoQueueChanged(esReady, Assigned(Err) or IsFailure(Res));

    if not Terminated then
      if Assigned(Err) then
        SendMessage(Kernel.FCallbackWindow, WM_EXECOUTPUT, WPARAM(@AWorkItem), LPARAM(@Err))
      else
        SendMessage(Kernel.FCallbackWindow, WM_EXECOUTPUT, WPARAM(@AWorkItem), LPARAM(@Res));

  finally
    Err.Free;
  end;

end;

end.