unit Unixlib;

{$IFDEF FPC}
  {$MODE DELPHI} {$H+}
  {$ASMMODE Intel}
{$ENDIF}
 {$INLINE ON}
interface

uses
  Classes, SysUtils, Forms,
  controls, fileutil ,LazUTF8,dl,
  base,base2;

const DLL_Error=-9900;

{$IFDEF WINDOWS}
function WinHandle(const form:string):integer;
 {$ENDIF}

{$IFDEF CPU386}
function SyncAssign(const DLLName,FUNCName:string; a:array of const):NativeInt;
function SyncAssignCdecl(const DLLName,FUNCName:string; a:array of const):NativeInt;
function Assign(const DLLName,FUNCName:string; a:array of const):NativeInt;
function AssignCdecl(const DLLName,FUNCName:string; a:array of const):NativeInt;
function AssignFPU(const DLLName,FUNCName:string; a:array of const):extended;
function AssignFPUCdecl(const DLLName,FUNCName:string; a:array of const):extended;
{$ENDIF}

{$IFDEF CPUX86_64}
function SyncAssign(const DLLName,FUNCName:string; a:array of const):Int64;
function Assign(const DLLName,FUNCName:string; a:array of const):Int64;
{$ENDIF}

implementation
 uses
 textfrm,locatefrm,locatech,paintfrm,inputdlg,charinp,MyThread;




{$IFDEF CPU386}
type
    PPointerArray=^TPointerArray;
    TPointerArray=array[0..7] of pointer;
    TLongIntFunction=function:LongInt;
    TFPUFunction=function:extended;

Function RoundToLongint(x:extended):longint;assembler;
asm
    PUSH EDX
    PUSH EAX
    FLD x
    FISTP QWORD PTR [ESP]
    WAIT
    POP EAX
    POP EDX
end;

type
    TSyncAssign=class
        handle:Pointer;
        ProcAddr:TLongIntFunction;
        params:PPointerArray;
        paramsize:integer;
        resultvar:NativeInt;
        cdec:boolean;
        constructor create(const DLLName,FUNCName:string; a:array of const; c:boolean);
        destructor destroy;override;
        procedure exec;
    end;

 constructor TSyncAssign.create(const DLLName,FUNCName:string; a:array of const; c:boolean);
var
  i:integer;
begin
  Handle:=dlopen (PChar(ExtractFilePath(Application.ExeName)+DLLName), RTLD_LAZY);
  if Handle=nil then
     Handle:=dlopen (PChar(DLLName), RTLD_LAZY);
  if (Handle=nil) then
     SetExceptionWith(DLLName + ' could not be loaded',DLL_Error );

  Pointer(@ProcAddr):= dlsym(Handle, PChar(FuncName));
  if @ProcAddr=nil then
                 SetExceptionWith(FuncName+' Not Found',DLL_Error);
  paramsize:=Length(a);
  params:=AllocMem(sizeof(pointer)*paramsize);
  for i:=0 to High(a) do
     with a[i] do
      begin
       case VTYPE of
        VTINTEGER:   longint(params^[i]):=VInteger;
        VTInt64:     NativeInt(params^[i]):=VINT64^;
        VTExtended:  longint(params^[i]):=RoundToLongint(VExtended^);
        vtAnsistring:params^[i]:=PChar(VAnsistring);
       else
        setexceptionWith(IntToStr(i)+'th Parameter incompatible',Dll_Error);
       end;
      end;
  cdec:=c;
end;

destructor TSyncAssign.destroy;
begin
  freemem(params,sizeof(pointer)*paramsize);
  inherited destroy;
end;

procedure TSyncAssign.exec;
var
  i:integer;
  p:pointer;
begin
   try
       for i:=paramsize-1 downto 0 do
         begin
           p:=@params^[i];
           asm
             mov eax, p
             push dword ptr [eax]
           end;
         end;
       resultvar:=ProcAddr;

       if cdec then  // restore stack
         for i:=paramsize-1 downto 0 do
             begin
               asm
                 pop EAX
               end;
             end;

   except
      on E:EExtype do
         raise;
      else
         SetException(DLL_Error)
   end;

end;

function SyncAssign(const DLLName,FUNCName:string; a:array of const):NativeInt;
begin
  with TSyncAssign.create(DllName,FuncName,a,false) do
    begin
        TmyThread(TThread.CurrentThread).SyncExec(exec);
        result:=resultvar;
        free;
    end;
end;

function SyncAssignCdecl(const DLLName,FUNCName:string; a:array of const):NativeInt;
begin
  with TSyncAssign.create(DllName,FuncName,a,true) do
    begin
        TmyThread(TThread.CurrentThread).SyncExec(exec);
        result:=resultvar;
        free;
    end;
end;

function Assign(const DLLName,FUNCName:string; a:array of const):NativeInt;
var
  handle:Pointer;
  ProcAddr:TLongIntFunction;
  params:PPointerArray;
  i:integer;
  p:pointer;
begin
  Handle:=dlopen (PChar(ExtractFilePath(Application.ExeName)+DLLName), RTLD_LAZY);
  if Handle=nil then
     Handle:=dlopen (PChar(DLLName), RTLD_LAZY);
  if (Handle=nil) then
     SetExceptionWith(DLLName + ' could not be loaded' ,DLL_Error);

  Pointer(@ProcAddr):= dlsym(Handle, PChar(FuncName));
  if @ProcAddr=nil then
                 SetExceptionWith(FuncName+' Not Found',DLL_Error);

  params:=AllocMem(sizeof(pointer)*Length(a));
  try
    for i:=0 to High(a) do
     with a[i] do
      begin
       case VTYPE of
        VTINTEGER:   longint(params^[i]):=VInteger;
        VTInt64:     NativeInt(params^[i]):=VINT64^;
        VTExtended:  longint(params^[i]):=RoundToLongint(VExtended^);
        vtAnsistring:params^[i]:=PChar(VAnsistring);
       else
        setexceptionWith(IntToStr(i)+'th Parameter imcompatible',Dll_Error);
       end;
      end;


     try
       for i:=high(a) downto 0 do
         begin
           p:=@params^[i];
           asm
             mov eax, p
             push dword ptr [eax]
           end;
         end;

       result:=ProcAddr;

     except
      on E:EExtype do
         raise;
      else
         SetException(DLL_Error)
     end;

  finally
     FreeMem(params,sizeof(pointer)*Length(a));
  end;

end;

function AssignCdecl(const DLLName,FUNCName:string; a:array of const):NativeInt;
var
  handle:Pointer;
  ProcAddr:TLongIntFunction;
  params:PPointerArray;
  i,j:integer;
  p:pointer;
begin
  Handle:=dlopen (PChar(ExtractFilePath(Application.ExeName)+DLLName), RTLD_LAZY);
  if Handle=nil then
     Handle:=dlopen (PChar(DLLName), RTLD_LAZY);
  if (Handle=nil) then
     SetExceptionWith(DLLName + ' could not be loaded' ,DLL_Error);

  Pointer(@ProcAddr):= dlsym(Handle, PChar(FuncName));
  if @ProcAddr=nil then
                 SetExceptionWith(FuncName+' Not Found',DLL_Error);

  params:=AllocMem(sizeof(pointer)*Length(a));
  try
    for i:=0 to High(a) do
     with a[i] do
      begin
       case VTYPE of
        VTINTEGER:   longint(params^[i]):=VInteger;
        VTInt64:     NativeInt(params^[i]):=VINT64^;
        VTExtended:  longint(params^[i]):=RoundToLongint(VExtended^);
        vtAnsistring:params^[i]:=PChar(VAnsistring);
       else
        setexceptionWith(IntToStr(i)+'th Parameter imcompatible',Dll_Error);
       end;
      end;


     try
       for i:=high(a) downto 0 do
         begin
           p:=@params^[i];
           asm
             mov eax, p
             push dword ptr [eax]
           end;
         end;

       result:=ProcAddr;

       // restore stack  (assume Cdecl)
       for i:=0 to High(a) do
         begin
           asm
             pop EAX
           end;
         end;

     except
      on E:EExtype do
         raise;
      else
         SetException(DLL_Error)
     end;

  finally
     FreeMem(params,sizeof(pointer)*Length(a));
  end;
end;

function AssignFPU(const DLLName,FUNCName:string; a:array of const):extended;
var
  handle:Pointer;
  ProcAddrX:TFPUFunction;
  params:PPointerArray;
  i:integer;
  p:pointer;
begin
  Handle:=dlopen (PChar(ExtractFilePath(Application.ExeName)+DLLName), RTLD_LAZY);
  if Handle=nil then
     Handle:=dlopen (PChar(DLLName), RTLD_LAZY);
  if (Handle=nil) then
     SetExceptionWith(DLLName + ' could not be loaded' ,DLL_Error);

  Pointer(@ProcAddrX):= dlsym(Handle, PChar(FuncName));
  if @ProcAddrX=nil then
                 SetExceptionWith(FuncName+' Not Found',DLL_Error);

  params:=AllocMem(sizeof(pointer)*Length(a));
  try
    for i:=0 to High(a) do
     with a[i] do
      begin
       case VTYPE of
        VTINTEGER:   longint(params^[i]):=VInteger;
        VTInt64:     NativeInt(params^[i]):=VINT64^;
        VTExtended:  longint(params^[i]):=RoundToLongint(VExtended^);
        vtAnsistring:params^[i]:=PChar(VAnsistring);
       else
        setexceptionWith(IntToStr(i)+'th Parameter imcompatible',Dll_Error);
       end;
      end;


     try
       for i:=high(a) downto 0 do
         begin
           p:=@params^[i];
           asm
             mov eax, p
             push dword ptr [eax]
           end;
         end;

       result:=ProcAddrX;
     except
      on E:EExtype do
         raise;
      else
         SetException(DLL_Error)
     end;

  finally
     FreeMem(params,sizeof(pointer)*Length(a));
  end;

end;

function AssignFPUCdecl(const DLLName,FUNCName:string; a:array of const):extended;
var
  handle:Pointer;
  ProcAddrX:TFPUFunction;
  params:PPointerArray;
  i:integer;
  p:pointer;
begin
  Handle:=dlopen (PChar(ExtractFilePath(Application.ExeName)+DLLName), RTLD_LAZY);
  if Handle=nil then
     Handle:=dlopen (PChar(DLLName), RTLD_LAZY);
  if (Handle=nil) then
     SetExceptionWith(DLLName + ' could not be loaded' ,DLL_Error);

  Pointer(@ProcAddrX):= dlsym(Handle, PChar(FuncName));

  if @ProcAddrX=nil then
                 SetExceptionWith(FuncName+' Not Found',DLL_Error);

  params:=AllocMem(sizeof(pointer)*Length(a));
  try
    for i:=0 to High(a) do
     with a[i] do
      begin
       case VTYPE of
        VTINTEGER:   longint(params^[i]):=VInteger;
        VTInt64:     NativeInt(params^[i]):=VINT64^;
        VTExtended:  longint(params^[i]):=RoundToLongint(VExtended^);
        vtAnsistring:params^[i]:=PChar(VAnsistring);
       else
        setexceptionWith(IntToStr(i)+'th Parameter imcompatible',Dll_Error);
       end;
      end;


     try
       for i:=high(a) downto 0 do
         begin
           p:=@params^[i];
           asm
             mov eax, p
             push dword ptr [eax]
           end;
         end;

       result:=ProcAddrX;
       // restore stack  (assume Cdecl)
        for i:=0 to High(a) do
          begin
            asm
              pop EAX
            end;
          end;

     except
      on E:EExtype do
         raise;
      else
         SetException(DLL_Error)
     end;

  finally
     FreeMem(params,sizeof(pointer)*Length(a));
  end;

end;

{$ENDIF}

{$IFDEF CPUX86_64}
type
    PPointerArray=^TPointerArray;
    TPointerArray=array[0..7] of pointer;
    TNativeIntFunction=function:NativeInt;
    TFPUFunction=function:extended;

type
    TSyncAssign=class
        handle:Pointer;
        ProcAddr:TNativeIntFunction;
        params:PPointerArray;
        paramsize:integer;
        resultvar:Int64;
        constructor create(const DLLName,FUNCName:string; a:array of const);
        destructor destroy;override;
        procedure exec;
    end;

 constructor TSyncAssign.create(const DLLName,FUNCName:string; a:array of const);
var
  i:integer;
begin
  Handle:=dlopen (PChar(ExtractFilePath(Application.ExeName)+DLLName), RTLD_LAZY);
  if Handle=nil then
     Handle:=dlopen (PChar(DLLName), RTLD_LAZY);
  if (Handle=nil) then
     SetExceptionWith(DLLName + ' could not be loaded',DLL_Error );

  Pointer(@ProcAddr):= dlsym(Handle, PChar(FuncName));
  if @ProcAddr=nil then
                 SetExceptionWith(FuncName+' Not Found',DLL_Error);
  paramsize:=Length(a);
  params:=AllocMem(sizeof(pointer)*paramsize);
  for i:=0 to High(a) do
     with a[i] do
      begin
       case VTYPE of
        VTINTEGER:   Int64(params^[i]):=VInteger;
        VTInt64:     Int64(params^[i]):=VINT64^;
        VTExtended:  Int64(params^[i]):=System.Round(VExtended^);
        vtAnsistring:params^[i]:=PChar(VAnsistring);
       else
        setexceptionWith(IntToStr(i)+'th Parameter imcompatible',Dll_Error);
       end;
      end;
end;

destructor TSyncAssign.destroy;
begin
  freemem(params,sizeof(pointer)*paramsize);
  inherited destroy;
end;

procedure TSyncAssign.exec;
var
  i,j:integer;
  p:pointer;
  x:Int64;
begin
  try
       j:=ParamSize;
        while j>6 do
          begin
            dec(j);
            x:=int64(params^[j]);
            asm
            push x
            end;
          end;
        if ParamSize>=6 then
           begin
             x:=int64(params^[5]);
             asm
                mov  r9,x
             end;
          end;
        if ParamSize>=5 then
           begin
             x:=int64(params^[4]);
             asm
                mov  r8,x
             end;
          end;
         if ParamSize>=4 then
             begin
               x:=int64(params^[3]);
               asm
                  mov  rcx,x
               end;
            end;
        if ParamSize>=3 then
            begin
              x:=int64(params^[2]);
              asm
                 mov  rdx,x
              end;
           end;
        if ParamSize>=2 then
            begin
              x:=int64(params^[1]);
              asm
                 mov  rsi,x
              end;
           end;
        if ParamSize>=1 then
            begin
              x:=int64(params^[0]);
              asm
                 mov  rdi,x
              end;
           end;



  except
   on E:EExtype do
      raise;
   else
      SetException(DLL_Error)
  end;


end;

function SyncAssign(const DLLName,FUNCName:string; a:array of const):int64;
begin
  with TSyncAssign.create(DllName,FuncName,a) do
    begin
        TmyThread(TThread.CurrentThread).SyncExec(exec);
        result:=resultvar;
        free;
    end;
end;

function Assign(const DLLName,FUNCName:string; a:array of const):Int64;
var
  handle:Pointer;
  ProcAddr:TNativeIntFunction;
  params:PPointerArray;
  paramsize:integer;
  i,j:Integer;
  x:Int64;
  p:pointer;
begin
  Handle:=dlopen (PChar(ExtractFilePath(Application.ExeName)+DLLName), RTLD_LAZY);
  if Handle=nil then
     Handle:=dlopen (PChar(DLLName), RTLD_LAZY);
  if (Handle=nil) then
     SetExceptionWith(DLLName + ' could not be loaded',DLL_Error );

  Pointer(@ProcAddr):= dlsym(Handle, PChar(FuncName));
  if @ProcAddr=nil then
                 SetExceptionWith(FuncName+' Not Found',DLL_Error);

  paramsize:=Length(a);
  params:=AllocMem(sizeof(pointer)*paramsize);

  try
    for i:=0 to High(a) do
     with a[i] do
      begin
       case VTYPE of
        VTINTEGER:   Int64(params^[i]):=VInteger;
        VTInt64:     Int64(params^[i]):=VINT64^;
        VTExtended:  Int64(params^[i]):=System.Round(VExtended^);
        vtAnsistring:params^[i]:=PChar(VAnsistring);
       else
        setexceptionWith(IntToStr(i)+'th Parameter imcompatible',Dll_Error);
       end;
      end;


     try
       j:=ParamSize;
        while j>6 do
          begin
            dec(j);
            x:=int64(params^[j]);
            asm
            push x
            end;
          end;
        if ParamSize>=6 then
           begin
             x:=int64(params^[5]);
             asm
                mov  r9,x
             end;
          end;
        if ParamSize>=5 then
           begin
             x:=int64(params^[4]);
             asm
                mov  r8,x
             end;
          end;
         if ParamSize>=4 then
             begin
               x:=int64(params^[3]);
               asm
                  mov  rcx,x
               end;
            end;
        if ParamSize>=3 then
            begin
              x:=int64(params^[2]);
              asm
                 mov  rdx,x
              end;
           end;
        if ParamSize>=2 then
            begin
              x:=int64(params^[1]);
              asm
                 mov  rsi,x
              end;
           end;
        if ParamSize>=1 then
            begin
              x:=int64(params^[0]);
              asm
                 mov  rdi,x
              end;
           end;

         result:=ProcAddr;


     except
      on E:EExtype do
         raise;
      else
         SetException(DLL_Error)
     end;

  finally
     FreeMem(params,sizeof(pointer)*Length(a));
  end;

end;

function AssignFPU(const DLLName,FUNCName:string; a:array of const):extended;
var
  handle:Pointer;
  ProcAddrX:TFPUFunction;
  params:PPointerArray;
  paramsize:integer;
  i,j:Integer;
  x:Int64;
  p:pointer;
begin
  Handle:=dlopen (PChar(ExtractFilePath(Application.ExeName)+DLLName), RTLD_LAZY);
  if Handle=nil then
     Handle:=dlopen (PChar(DLLName), RTLD_LAZY);
  if (Handle=nil) then
     SetExceptionWith(DLLName + ' could not be loaded',DLL_Error );

  Pointer(@ProcAddrX):= dlsym(Handle, PChar(FuncName));
  if @ProcAddrX=nil then
                 SetExceptionWith(FuncName+' Not Found',DLL_Error);

  paramsize:=Length(a);
  params:=AllocMem(sizeof(pointer)*paramsize);

  try
    for i:=0 to High(a) do
     with a[i] do
      begin
       case VTYPE of
        VTINTEGER:   Int64(params^[i]):=VInteger;
        VTInt64:     Int64(params^[i]):=VINT64^;
        VTExtended:  Int64(params^[i]):=System.Round(VExtended^);
        vtAnsistring:params^[i]:=PChar(VAnsistring);
       else
        setexceptionWith(IntToStr(i)+'th Parameter imcompatible',Dll_Error);
       end;
      end;


     try
        j:=ParamSize;
        while j>6 do
          begin
            dec(j);
            x:=int64(params^[j]);
            asm
            push x
            end;
          end;
        if ParamSize>=6 then
           begin
             x:=int64(params^[5]);
             asm
                mov  r9,x
             end;
          end;
        if ParamSize>=5 then
           begin
             x:=int64(params^[4]);
             asm
                mov  r8,x
             end;
          end;
         if ParamSize>=4 then
             begin
               x:=int64(params^[3]);
               asm
                  mov  rcx,x
               end;
            end;
        if ParamSize>=3 then
            begin
              x:=int64(params^[2]);
              asm
                 mov  rdx,x
              end;
           end;
        if ParamSize>=2 then
            begin
              x:=int64(params^[1]);
              asm
                 mov  rsi,x
              end;
           end;
        if ParamSize>=1 then
            begin
              x:=int64(params^[0]);
              asm
                 mov  rdi,x
              end;
           end;
        result:=ProcAddrX;




     except
      on E:EExtype do
         raise;
      else
         SetException(DLL_Error)
     end;

  finally
     FreeMem(params,sizeof(pointer)*Length(a));
  end;

end;
{$ENDIF}



end.

