tslediter/funcext/tvclib/utssvr_tsltoken_c.tsf

unit utssvr_tsltoken_c;
interface
function get_sys_functions();
function get_tsl_tokenizeex(s,flg);
implementation
uses cstructurelib; 
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 t_tsltokenex2 = 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}
    public 
    function create();
    begin
        //TSL_TokenizeEx2(s,flg); 
        fsource := array();
        fresult := array();
        skiperror := true;  
        fflags := 2^13-1; 
    end 
    function tslL_getfunctions();//系统函数
    begin
        //return array();
        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
    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
        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
end.