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.