506 lines
16 KiB
Plaintext
506 lines
16 KiB
Plaintext
unit utssvr_api_c;
|
||
interface
|
||
function get_tssvr_api_c();
|
||
function get_func_finder_register();
|
||
function get_sys_functions();
|
||
function get_tsl_tokenizeex(s,flg);
|
||
implementation
|
||
uses cstructurelib;
|
||
function get_tssvr_api_c();
|
||
begin
|
||
return static new t_tssvr_api_c();
|
||
end
|
||
function get_func_finder_register();
|
||
begin
|
||
return static new t_func_finder_register();
|
||
end
|
||
function get_sys_functions();
|
||
begin
|
||
return static get_tokener().tslL_getfunctions();
|
||
end
|
||
function get_tsl_tokenizeex(s,flg);
|
||
begin
|
||
o := get_tokener();
|
||
o.flags := flg;
|
||
o.source := s;
|
||
return o.result();
|
||
end
|
||
function get_tokener();
|
||
begin
|
||
return static new t_tsltokenex2();
|
||
end
|
||
type tsl_c_api_const = class()
|
||
{$ifdef linux}
|
||
static const C_TSSVRAPI="libTSSVRAPI.so";
|
||
static const C_PLUGIN="libTSLPlugin.so";
|
||
static const C_TSLInterp="libTSLInterp.so";
|
||
{$else}
|
||
static const C_TSSVRAPI="TSSVRAPI.dll";
|
||
static const C_PLUGIN="TSLPlugin.dll";
|
||
static const C_TSLInterp="TSLInterp.dll";
|
||
{$endif}
|
||
end
|
||
function main_thread_check(ck_name);
|
||
begin
|
||
myid := systhreadid();
|
||
mytd := nil;
|
||
if getglobalcache(ck_name,mytd) then
|
||
begin
|
||
return mytd<>myid;
|
||
end else
|
||
begin
|
||
setglobalcache(ck_name,myid);
|
||
end
|
||
return false ;
|
||
end
|
||
type t_func_finder_register = class(tsl_c_api_const) //º¯Êý×¢²áÀàÐÍ
|
||
function create();
|
||
begin
|
||
////////////////////////////////////////////////////////////////
|
||
if main_thread_check("~@~create-thread-func-finder~@~") then raise "t_func_finder_register created must in main thread!";
|
||
//////////////////////////////////////////////////////
|
||
t := C_TSSVRAPI;
|
||
fhookseted := false;
|
||
fhooks := array();
|
||
end
|
||
function add_hook(f);
|
||
begin
|
||
for i,v in fhooks do
|
||
begin
|
||
if v=f then return 0;
|
||
end
|
||
fhooks[length(fhooks)] := f;
|
||
if not fhookptr then fhookptr := makeinstance(thisfunction(find_HOOK));
|
||
if not fhookseted then
|
||
begin
|
||
TSL_InterpSetFindFunctionHook(fhookptr);
|
||
fhookseted := true;
|
||
end
|
||
end
|
||
function del_hook(f);
|
||
begin
|
||
len := length(fhooks)-1;
|
||
for i:= 0 to len do
|
||
begin
|
||
if f=fhooks[i] then
|
||
begin
|
||
if len=0 then
|
||
begin
|
||
TSL_InterpSetFindFunctionHook(0);
|
||
fhookseted := false;
|
||
end
|
||
return 1;
|
||
end
|
||
end
|
||
end
|
||
function find_HOOK(L:pointer;iUser:string;iName:string; oResult:object):integer;cdecl;
|
||
begin
|
||
for i,_f_ in fhooks do
|
||
begin
|
||
r := ##_f_(L,iUser,iName);
|
||
if ifstring(r) and r then
|
||
begin
|
||
oResult := array("body":r);
|
||
return 1;
|
||
end
|
||
end
|
||
end
|
||
function destroy();
|
||
begin
|
||
if fhookptr then deleteinstance(fhookptr);
|
||
fhookptr := 0;
|
||
end
|
||
private
|
||
function TSL_InterpSetFindFunctionHook(hook);
|
||
begin
|
||
c := static function(hook:pointer);cdecl;external getdlsymaddress(C_TSLInterp,functionname(1)) ;
|
||
return call(c,hook) ;
|
||
end
|
||
private
|
||
fhookseted;
|
||
fhookptr;
|
||
fhooks;
|
||
end
|
||
type t_tsltokenex2 = class(tsl_c_api_const) //½Å±¾½âÎö
|
||
public
|
||
function create();
|
||
begin
|
||
t := C_TSSVRAPI;
|
||
//TSL_TokenizeEx2(s,flg);
|
||
if findfunction("tsl_tokenizeex_2_") then fustslulib := true;
|
||
else fustslulib := false;
|
||
fsource := array();
|
||
fresult := array();
|
||
skiperror := true;
|
||
fflags := 2^13-1;
|
||
end
|
||
function tslL_getfunctions();//ϵͳº¯Êý
|
||
begin
|
||
//return array();
|
||
if fustslulib then
|
||
begin
|
||
return tsll_getfunctions_2_();
|
||
end
|
||
fs := 0;
|
||
cnt := 0;
|
||
_f_ := static procedure(var fs:pointer;var cnt:integer);cdecl ;external getdlsymaddress(C_PLUGIN,functionname(1));
|
||
##_f_(fs,ct);
|
||
return strs_ptr_to_array(fs,ct-1,1);
|
||
end
|
||
property source read fsource write set_source;
|
||
property result read get_result;
|
||
property flags read fflags write set_lags;
|
||
private
|
||
fustslulib;//Ìæ»»
|
||
function strs_ptr_to_array(ps,n,fr); //һά×Ö·û´®Êý×é
|
||
begin
|
||
mt := get_mem_mgr();
|
||
r := array();
|
||
i := 0;
|
||
if ps=0 then return r;
|
||
while true do
|
||
begin
|
||
if n>0 and i>=n then break;
|
||
p := mt.readptr(ps+8*i);
|
||
if p=0 then
|
||
begin
|
||
n := i-1;
|
||
break;
|
||
end
|
||
r[i] := mt.readstr(p);
|
||
if not fr then
|
||
mt.tfree(p);
|
||
i++;
|
||
end
|
||
return r;
|
||
end
|
||
function strs_ptr_to_array2(ps,n);//¶þά×Ö·û´®Êý×é
|
||
begin
|
||
mt := get_mem_mgr();
|
||
r := array();
|
||
if ps=0 then return r;
|
||
i := 0;
|
||
while true do
|
||
begin
|
||
if n>0 and i>=n then break;
|
||
p := mt.readptr(ps+8*i);
|
||
if p=0 then
|
||
begin
|
||
n := i;
|
||
break;
|
||
end
|
||
r[i] := strs_ptr_to_array(p);
|
||
i++;
|
||
end
|
||
mt.tfree(ps);
|
||
return r;
|
||
end
|
||
function ints_ptr_to_array(ps,n,flg);
|
||
begin
|
||
mt := get_mem_mgr();
|
||
r := array();
|
||
if ps=0 then return r;
|
||
i := 0;
|
||
while true do
|
||
begin
|
||
if i>=n then break;
|
||
t := mt.readint(ps+4*i);
|
||
if t=flg then break;
|
||
r[i] := t;
|
||
i++;
|
||
end
|
||
mt.tfree(ps);
|
||
return r;
|
||
end
|
||
function TSL_InterpNewErrorInfo();
|
||
begin
|
||
_f_ := static function():pointer;cdecl;external getdlsymaddress(C_TSLInterp,functionname(1));
|
||
return static ##_f_();
|
||
end
|
||
|
||
function TSL_TokenizeEx2();
|
||
begin
|
||
if fustslulib then
|
||
begin
|
||
fresult := tsl_tokenizeex_2_(fsource,fflags);
|
||
return;
|
||
end
|
||
oResult := TSL_InterpNewErrorInfo();
|
||
_f_ := static function(sc:string;skiperror:integer;
|
||
var sWords:pointer; var sUnits:pointer;
|
||
var sClasses:pointer;var sFunctions:pointer;
|
||
var iLines:pointer;var iBeginEnds:pointer;
|
||
var Dependency:pointer;var retBlocks:pointer;
|
||
var retBlockCount:integer;fflags:integer; oResult:pointer):integer;cdecl;external getdlsymaddress(C_TSLInterp,functionname(1));
|
||
//echo _f_;
|
||
##_f_(fsource,true,sWords,sUnits,sClasses,sFunctions,iLines,iBeginEnds,sDependency,retBlocks,retBlockCount,fflags,oResult);
|
||
fresult := array();
|
||
fresult["words"] :=strs_ptr_to_array(sWords);
|
||
fresult["units"] :=strs_ptr_to_array(sUnits);
|
||
fresult["class"] :=strs_ptr_to_array(sClasses);
|
||
n := 0;
|
||
fresult["functions"] := strs_ptr_to_array2(sFunctions,n);
|
||
fresult["lines"] := ints_ptr_to_array(iLines,n);
|
||
fresult["linebegend"] := ints_ptr_to_array(iBeginEnds,nil,-1);
|
||
fresult["dep"] := strs_ptr_to_array(sDependency);
|
||
fresult["blcks"] := getblicks(retBlocks,retBlockCount);
|
||
end
|
||
function getblicks(ptr,n);
|
||
begin
|
||
r := array();
|
||
if ptr=0 then return r;
|
||
mt := get_mem_mgr();
|
||
for i := 0 to n-1 do
|
||
begin
|
||
p := mt.readptr(ptr+i*8);
|
||
bki := new BlockForEditor(p);
|
||
r[i,"mtype"] := bki._getvalue_("mType");
|
||
r[i,"mbeg"] := bki._getvalue_("mBeg");
|
||
r[i,"mend"] := bki._getvalue_("mEnd");
|
||
ct := bki._getvalue_("mSubs");
|
||
r[i,"msubs"] := ct;
|
||
if ct>0 then
|
||
r[i,"msub"] := getblicks(bki._getvalue_("mSub"),ct);
|
||
end
|
||
return r;
|
||
end
|
||
function get_result();
|
||
begin
|
||
if ifnil(fresult) then
|
||
begin
|
||
TSL_TokenizeEx2();
|
||
end
|
||
return fresult;
|
||
end
|
||
function set_source(s);
|
||
begin
|
||
if fsource<>s and ifstring(s) then
|
||
begin
|
||
fsource := s;
|
||
fresult := nil;
|
||
end
|
||
end
|
||
function set_lags(f);
|
||
begin
|
||
if f>0 and f<>fflags then
|
||
begin
|
||
fflags := f;
|
||
fresult := nil;
|
||
end
|
||
end
|
||
private
|
||
fsource;
|
||
fflags;
|
||
fresult;
|
||
private
|
||
static const Block_TypeClass = 1;
|
||
static const Block_Function = 2;
|
||
static const Block_Statements = 4;
|
||
static const Block_If = 8;
|
||
static const Block_Else = 16;
|
||
static const Block_SubCase = 32;
|
||
static const Block_Goto_Label = 64;
|
||
static const Block_Empty_Begin_End = 128;
|
||
static const Block_Try = 256;
|
||
static const Block_NeedSql = 512;
|
||
static const Block_UnitStruct = 1024;
|
||
static const Block_Propertys = 2048;
|
||
static const Block_Fields = 4096;
|
||
end
|
||
type BlockForEditor=class(tslcstructureobj)
|
||
public
|
||
function create(ptr)
|
||
begin
|
||
inherited create(getstruct(),ptr);
|
||
end
|
||
private
|
||
static SSTRUCT;
|
||
class function getstruct()
|
||
begin
|
||
if not SSTRUCT then SSTRUCT := MemoryAlignmentCalculate(array(
|
||
("mType","int",0),
|
||
("mBeg","int",0),
|
||
("mEnd","int",0),
|
||
("mSubs","int",0),
|
||
("mFolded","int",0), //Õâ¸ö×Ö¶ÎʲôÒâ˼
|
||
("mSub","intptr",0),
|
||
("Clear","intptr",0) //cptr := _getvalue_("Clear"); f := procedure();cdecl;external cptr;
|
||
));
|
||
return SSTRUCT;
|
||
end
|
||
end
|
||
type t_tssvr_api_c = class(tsl_c_api_const)
|
||
function create();
|
||
begin
|
||
t := C_TSSVRAPI;
|
||
if main_thread_check("~@~create-thread-tssvr_api~@~") then raise "t_tssvr_api_c created must in main thread!";
|
||
reg_libpath_funcs();
|
||
|
||
end
|
||
class function TSL_ObjToStr(L:pointer;v:pointer):string;
|
||
begin
|
||
_f_ := static function(L:pointer;v:pointer;Topest:integer):string;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(L,v,1);
|
||
end
|
||
class function TSL_DelStrm(d:pointer);
|
||
begin
|
||
_f_ := static procedure(d:pointer);cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(d);
|
||
end
|
||
class function TSL_ObjToStrm(L:pointer;v:pointer);
|
||
begin
|
||
_f_ := static function(L:pointer;v:pointer;PackedTable:integer;precision:integer):pointer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(L,v,0,-1);
|
||
end
|
||
class function TSL_StrmToObj(L:pointer;v:pointer;ot:pointer);
|
||
begin
|
||
_f_ := static function(L:pointer;v:pointer;ot:pointer):integer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(L,v,ot);
|
||
end
|
||
class function TS_GetGlobalL();
|
||
begin
|
||
_f_ := static function():pointer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_();
|
||
end
|
||
//×¢²áº¯ÊýÏà¹Ø
|
||
class function TSL_SetIntPtr(l:pointer;o:pointer;i:pointer);
|
||
begin
|
||
_f_ := static procedure(l:pointer;o:pointer;i:pointer);cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(l,o,i);
|
||
end
|
||
class function TSL_StringCheck(O:pointer):integer;
|
||
begin
|
||
_f_ := static function(o:pointer):integer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(o);
|
||
end
|
||
|
||
class function TSL_SetInt(l:pointer;o:pointer;i:integer);
|
||
begin
|
||
_f_ := static procedure(l:pointer;o:pointer;i:integer);cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(l,o,i);
|
||
end
|
||
class function get_self_l_i(L:pointer; iArgs:pointer;iNum:integer; oResult:pointer):integer;cdecl;
|
||
begin
|
||
TSL_SetIntPtr(L,oResult,L);
|
||
return 1;
|
||
end
|
||
class function set_self_libpath(L:pointer; iArgs:pointer;iNum:integer; oResult:pointer):integer;cdecl;
|
||
begin
|
||
IF iNum=1 and TSL_StringCheck(iArgs) then
|
||
begin
|
||
s := TSL_AsString(iArgs);
|
||
p := TSL_Strdup(s);
|
||
TSL_SetString(L,oResult,TSL_SetLibPath(L, p));
|
||
return 1;
|
||
end
|
||
return 0;
|
||
end
|
||
class function get_self_libpath(L:pointer; iArgs:pointer;iNum:integer; oResult:pointer):integer;cdecl;
|
||
begin
|
||
TSL_SetString(L,oResult,TSL_GetLibPath(L));
|
||
return 1;
|
||
end
|
||
class function tslL_register(l:pointer;n:string;f:pointer);
|
||
begin
|
||
_f_ := static procedure(l:pointer;n:string;f:pointer);cdecl;external getdlsymaddress(C_PLUGIN,functionname(1));
|
||
return ##_f_(l,n,f);
|
||
end
|
||
class function TSL_SetString(L,O,S);
|
||
begin
|
||
_f_ := static function(l:pointer;o:pointer;s:string):integer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(L,O,S);
|
||
end
|
||
class function TSL_Strdup(s):string;
|
||
begin
|
||
_f_ := static function(s:string):pointer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(s);
|
||
end
|
||
class function TSL_GetLibPath(L);
|
||
begin
|
||
_f_ := static function(L:pointer):string;cdecl;external getdlsymaddress(C_TSLInterp,functionname(1));
|
||
return ##_f_(L);
|
||
end
|
||
class function TSL_SetLibPath(L,p);
|
||
begin
|
||
_f_ := static function(L:pointer;p:pointer):string;cdecl;external getdlsymaddress(C_TSLInterp,functionname(1));
|
||
return ##_f_(L,p);
|
||
end
|
||
class function TSL_AsInt(O);
|
||
begin
|
||
_f_ := static function(O:pointer):integer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(o);
|
||
end
|
||
class function TSL_AsIntPtr(O);
|
||
begin
|
||
_f_ := static function(O:pointer):pointer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(o);
|
||
end
|
||
class function TSL_NumberCheck(O);
|
||
begin
|
||
_f_ := static function(O:pointer):integer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(o);
|
||
end
|
||
|
||
class function TSL_AsString(O);
|
||
begin
|
||
_f_ := static function(O:pointer):string;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(o);
|
||
end
|
||
class function TSL_SetType(L,O,t);
|
||
begin
|
||
{
|
||
#define TSL_TINT 0 //32λÕûÊý
|
||
#define TSL_TNUMBER 1 //64λ¸¡µã
|
||
#define TSL_TSZSTRING 2 //×Ö·û´®
|
||
#define TSL_TTABLE 5 //Êý×é
|
||
#define TSL_TSTRING 6 //×Ö·û´®Ï±ê,½ö×÷ΪÊý×éµÄϱê
|
||
#define TSL_TGRAPH 8 //ͼÐÎ
|
||
#define TSL_TGRAPHGROUP 9 //ͼÐÎ×é
|
||
#define TSL_TNIL 10 //NILÀàÐÍ
|
||
#define TSL_TBINARY 11 //¶þ½øÖÆÀàÐÍ
|
||
#define TSL_TUNKNOWN 14 //COMÀàÐÍIUNKNOWN
|
||
#define TSL_TDISPATCH 15 //COMÀàÐÍIDISPATCH
|
||
#define TSL_TANY 16 //TSLÃæÏò¶ÔÏóÀàÐÍ
|
||
#define TSL_TMatrix 17 //MatrixÀàÐÍ,MSelect·µ»Ø
|
||
#define TSL_TINT64 20 //64λÕûÊý
|
||
#define TSL_TClassFieldRef 22 //Àà³ÉÔ±ÒýÓÃ
|
||
#define TSL_TFUNCTIONSELF 23 //ÓÃSELF»ñµÃµÄ½á¹û
|
||
#define TSL_TWSTRING 24 //UnicodeString
|
||
#define TSL_TCFUNCTION 25 //¶þ½øÖƺ¯ÊýÖ¸Õë
|
||
#define TSL_TNONE (-1) //ÎÞÀàÐÍ£¬´ËÀàÐͲ»»á±»Ê¹Ó㬽ö×÷ΪÌØÊâÓÃ;
|
||
}
|
||
_f_ := static procedure(L:pointer;o:pointer;t:integer);cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(L,O,t);
|
||
end
|
||
class function TSL_GetParamRef(L,idx);
|
||
begin
|
||
_f_ := static function(L:pointer;idx:integer):pointer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(L,idx);
|
||
end
|
||
class function TSL_ReadINTPtrFromPtr(p,idx);
|
||
begin
|
||
_f_ := static function(p:pointer;idx:integer):pointer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(p,idx);
|
||
end
|
||
class function TSL_ReadTObjectFromPtr(p,idx);
|
||
begin
|
||
_f_ := static function(p:pointer;idx:integer):pointer;cdecl;external getdlsymaddress(C_TSSVRAPI,functionname(1));
|
||
return ##_f_(p,idx);
|
||
end
|
||
private
|
||
class function reg_libpath_funcs();//×¢²áÐèÒªµÄº¯Êý
|
||
begin
|
||
if not findfunction("syssettsllibpath") then
|
||
begin
|
||
tslL_register(0,"sysgettsllibpath",makeinstance(thisfunction(get_self_libpath),"cdecl",0));
|
||
tslL_register(0,"syssettsllibpath",makeinstance(thisfunction(set_self_libpath),"cdecl",0));
|
||
end
|
||
end
|
||
//
|
||
end
|
||
|
||
initialization
|
||
|
||
|
||
|
||
end. |