liujianjun/tslediter
3
0
Fork 1
Code Issues Pull Requests Projects Releases Wiki Activity

tsl

Browse Source 
更新
This commit is contained in:
liujianjun
2024-04-23 15:16:15 +08:00
parent d560c062d2
commit 8239223d05
23 changed files with 415 additions and 307 deletions
Download Patch File Download Diff File Expand all files Collapse all files
funcext/tvclib/cstructurelib.tsf
+1 -1
View File
@@ -1232,7 +1232,7 @@ type t_mem_mgr = class()
//if not _tool then
_tool := 0;
try
_tool := new aefclassobj_();
if findclass("aefclassobj_") then _tool := new aefclassobj_();
except
end;
funcext/tvclib/tslvcl.tsf
+1 -1
View File
@@ -6088,7 +6088,7 @@ type Ttfm2Component = class(TTmfParser)
function GetLibPaths(); //获得libpath
begin
unit(utssvr_api_c).get_tssvr_api_c();
p := get_self_libpath();
p := sysgettsllibpath();
if not p then return array();
wapi := gettswin32api();
FCurrentp := wapi.get_current_directory();
funcext/tvclib/utslvclcefinterface.tsf
+1
View File
@@ -1,6 +1,7 @@
unit utslvclcefinterface;
interface
uses cstructurelib;
function cef_version_info(entry:integer);
function cef_object_get(ptr,cls);
function cef_object_del(ptr);
function cef_dictionary_value_create();
funcext/tvclib/utssvr_api_c.tsf
+250 -8
View File
@@ -2,7 +2,10 @@ 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();
@@ -11,6 +14,21 @@ 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";
@@ -22,9 +40,25 @@ type tsl_c_api_const = class()
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();
@@ -83,16 +117,221 @@ type t_func_finder_register = class(tsl_c_api_const) //
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;
isok := 0;
if not getglobalcache("@@tsl_c_api@@",isok) then
begin
setglobalcache("@@tsl_c_api@@","tsl_c_api");
reg_libpath_funcs();
end
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
@@ -247,8 +486,11 @@ type t_tssvr_api_c = class(tsl_c_api_const)
private
class function reg_libpath_funcs();//注册需要的函数
begin
tslL_register(0,"get_self_libpath",makeinstance(thisfunction(get_self_libpath),"cdecl",0));
tslL_register(0,"set_self_libpath",makeinstance(thisfunction(set_self_libpath),"cdecl",0));
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
funcext/tvclib/utssvr_tsltoken_c.tsf
-227
View File
@@ -1,227 +0,0 @@
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.
funcext/tvclib/uvclthreadworker.tsf
+143 -62
View File
@@ -19,7 +19,6 @@ type TCustomThreadworker = class(t_worker_host)
begin
eg := unit(utssvr_api_c).get_func_finder_register();
eg.add_hook(thisfunction(finder));
//fn := "t_thread_call_back_"$tarraycont;
fn := add_thread_call(ns);
end
fp := findfunction(fn);
@@ -29,9 +28,10 @@ type TCustomThreadworker = class(t_worker_host)
end
if not fp then raise ("工作线程构造失败!回调函数错误!" $fn);
set_heartbeat();
p := format_thread_param(systhreadid(),fn);
p := format_thread_param(get_thread_id(),fn);
b := static makeinstance(thisfunction(t_thread_worker),"stdcall",1);
cid :=create_thread(b,p);
if not cid then raise ("工作线程构造失败!可能是堆栈不够");
inherited create(cid);
//////////////////
end
@@ -60,15 +60,15 @@ type TCustomThreadworker = class(t_worker_host)
begin
setglobalcache("~~main~~threader~~",1,(now()+0.015));
end
static lenct;
class function dispatch();
begin
if not FThreaders then return ;
set_heartbeat();
lsdata := nil;
for idx,i in mrows(FThreaders,1) do
begin
o := FThreaders[i];
msg := o.fetch(data);
msg := o.fetch(data,nil,lsdata);
if msg then
begin
case msg of
@@ -106,8 +106,7 @@ type TCustomThreadworker = class(t_worker_host)
end
end
property handle read FHandle;
private
private
class function init_workerhost();
begin
if not ifarray(FThreaders) then
@@ -145,12 +144,12 @@ type t_worker_host = class(t_worker_base)
inherited;
end
function destroy();override;
begin
begin
if fworkerstate=1 then
begin
clear();
begin
post_to_("qq",1);
end
clear();
FCatcheData := array();
inherited;
end
@@ -165,7 +164,7 @@ type t_worker_host = class(t_worker_base)
**}
function terminate();override;
begin
if fworkerstate=1 then inherited;
if fworkerstate=1 then return inherited;
end
function ClientReady(flg); //任务句柄改变
begin
@@ -276,53 +275,64 @@ type t_worker_base = class()
function create(id);
begin
FData := array();
fmy_thread := systhreadid();
fmy_thread := get_thread_id();
fto_thread:=id;
fpostct := 0;
end
function close(); //关闭
begin
terminate();
return terminate();
end
function terminate();virtual; //停止
begin
post_to_("q",1);
return post_to_("q",1);
end
function postmessage(d);virtual; //发送数据
begin
return post_to_("#d",d);
end
function fetch(d); //获取数据
end
class function fetch_byid(id,cid,d);
begin
ls := listglobalcache();
myid := "#"$fmy_thread$"#"$fto_thread$"#";
nw := now();
sid := "#"$id$"#";
ls := select ["name"] from listglobalcache() where(["endtm"]>nw and 1=pos(sid,["name"])) order by ["createtm"] end ;
for i,vd in ls do
begin
v := vd["name"];
if getglobalcache(v,d) and not ifnil(d) then
begin
r := get_v_type(v);
del_name(v);
ss := str2array(v,"#");
cid := strtoint64def(ss[2],0);
return r;
end
end
end
function fetch(d,flg,ls); //获取数据
begin
nw := now();
if not ifarray(ls) then
begin
if flg then
begin
ls := select ["name"] from listglobalcache() where(["endtm"]>nw) order by ["createtm"] end ;
end else
begin
ls := listglobalcache();
end
end
myid := "#"$fmy_thread$"#"$fto_thread$"#";
for i,vd in ls do
begin
v := vd["name"];
endm := vd["endtm"];
if endm>0 and endm<nw then continue;
if endm>0 and endm<nw then continue;
if pos(myid,v)=1 then
begin
if getglobalcache(v,d) and not ifnil(d) then
begin
msn := static array(
"#d#",//数据
"#e#",//错误信息
"#s#", //启动成功
"#q#",//退出
"#qq#", //退出完成
"#se#" //启动错误
);
//r := "d";
for ii,vv in msn do
begin
if pos(vv,v) then
begin
r := replacetext(vv,"#","");
break;
end
end
r := get_v_type(v);
del_name(v);
end
return r;
@@ -349,33 +359,54 @@ type t_worker_base = class()
function post_to_(t,d); //发送
begin
if ifnil(d) then return 0;
return setglobalcache(format_idx(t),d,now()+0.001) ;
r := setglobalcache(format_idx(t),d,now()+0.001) ;
return 1;
end
{**
@param(OnMessage)(function[TThreadWorker,data]) 消息回调 %%
**}
private
function del_name(vn);
class function del_name(vn);
begin
setglobalcache(vn,nil,(now()-1));
end
private
class function get_v_type(v);
begin
msn := static array(
"#d#",//数据
"#e#",//错误信息
"#s#", //启动成功
"#q#",//退出
"#qq#", //退出完成
"#se#" //启动错误
);
//r := "d";
for ii,vv in msn do
begin
if pos(vv,v) then
begin
r := replacetext(vv,"#","");
break;
end
end
return r;
end
function format_idx(t); //格式化
begin
return "#"$fto_thread$"#"$fmy_thread$"#"$t$"#&"$(fpostct++);
begin
return "#"$fto_thread$"#"$fmy_thread$"#"$t$"#&"$(fpostct++);
end
private
FData;
fmy_thread;
fto_thread;
fpostct;
static const fexpired = 1/24/60/6000;
FData; //数据缓存
fmy_thread; //threadid
fto_thread; //链接id
fpostct; //post次数
end
function format_thread_param(id,script);//信息编码
begin
t := get_mem_mgr();
s := tostn(array(id,script));
//s := tostn(array(id,script));
s := id$";"$ script;
len := length(s)+2;
p := t.tmalloc(len);
t.writestr(p,s);
@@ -386,15 +417,15 @@ begin
t := get_mem_mgr();
s := t.readstr(p);
t.tfree(p);
d := stn(s);
id := d[0];
d := str2array(s,";");//stn(s);
id := strtoint64(d[0]);
script := d[1];
end
function t_thread_worker(ptr:pointer):{$ifdef linux}pointer{$else}integer{$endif}; //回调
begin
unformat_thread_param(ptr,id,fn);
this := new t_worker_client(id);
mypid := systhreadid();
mypid := get_thread_id();
fptr := findfunction(fn);
if not ifobj(fptr) then //非函数指针
@@ -412,23 +443,24 @@ begin
if not getglobalcache("~~main~~threader~~",d) then
begin
heartbeatstoped++;
if heartbeatstoped>5 then
if heartbeatstoped>3 then //主线程已经退出了
begin
this.post_to_("qq",1);
//this.post_to_("qq",1);
this.clear();
return ;//systerminate(2,mypid);
end
end
msg := this.fetch(d);
msg := this.fetch(d,true,nil);
case msg of
"d":begin //数据
if iffuncptr(fptr) then
begin
begin
try
call(fptr,this,d);
except
this.err(exceptobject.errinfo);
end;
end
end
sleep(1);
end
"qq":
@@ -436,8 +468,7 @@ begin
this.clear();
return 1;//systerminate(1,mypid);
end
"q":begin //退出
"q":begin //要求退出
this.clear();
this.post_to_("qq",1);
return ;//systerminate(1,mypid);
@@ -447,18 +478,67 @@ begin
sleep(10);
end
end ;
tslprocessmessages(false); //20230428添加tsl消息分发
tslprocessmessages(false); //20230428添加tsl消息分发
end
end
function get_thread_id();
begin
{$ifdef linux}
return systhreadself();
{$endif}
return systhreadid();
end
function create_thread(f,p);//构造线程
begin
{$ifdef linux}
return g_thread_new(f,p);
{$ifdef linux}
return pthread_create(f,p);
//return g_thread_new(f,p);
{$endif}
return CreateThread(f,p);
end
function g_thread_new(f:pointer;p:pointer):pointer;
///////////////////////////////pthread////////////////////////////////
{type pthread_attr_t = class(tslcstructureobj)
function create(ptr);
begin
inherited Create(getpstr(),ptr);
end
private
static pstrc;
function getpstr();
begin
if not pstrc then
begin
d := array(
("detachstate","int",0),//int detachstate; // 线程的分离状态
("schedpolicy","int",0),//int schedpolicy; // 线程调度策略
("schedparam","int",0), //structsched_param schedparam; // 线程的调度参数
("inheritsched","int",0), //int inheritsched; // 线程的继承性
("scope","int",0), //int scope; // 线程的作用域
("guardsize","intptr",0), // size_t guardsize; // 线程栈末尾的警戒缓冲区大小
("stackaddr_set","int",0), //int stackaddr_set; // 线程的栈设置
("stackaddr","intptr",0), //void* stackaddr; // 线程栈的位置
("stacksize","intptr",0) //size_t stacksize; // 线程栈的大小
);
pstrc := MemoryAlignmentCalculate(d);
end
return pstrc;
end
end
function pthread_attr_init(attr):integer;
begin
_f_ := static function(attr:pointer):integer;cdecl; external getdlsymaddress( "libc.so.6" ,functionname(1));
return ##_f_(attr._getptr_());
end }
function pthread_create(f,p):integer;
begin
//attr := new pthread_attr_t();pthread_attr_init(attr);attr._setvalue_("stacksize",10240000);
pth := 0;
_f_ := static function(var thread:pointer;attr:pointer; f:pointer;arg:pointer):integer;cdecl; external getdlsymaddress( "libc.so.6" ,functionname(1));
if 0= ##_f_(pth,0,f,p) then return pth;
end
/////////////////////gthread///////////////////////////////
{function g_thread_new(f:pointer;p:pointer):pointer;
begin
if not g_thread_get_initialized() then g_thread_init();
_f_ := static function(n:string;f:pointer;p:pointer):pointer;cdecl; external getdlsymaddress( "libgtk-3.so.0" ,functionname(1));
@@ -473,7 +553,8 @@ function g_thread_init():Integer;
begin
_f_ := static function():Integer;cdecl; external getdlsymaddress( "libgtk-3.so.0" ,functionname(1));
return ##_f_();
end
end }
///////////////////////////////////////////////////////
function CreateThread(f:pointer;p:pointer):pointer;
begin
_f_ := static function(attr:pointer;size:pointer;addr:pointer;p:pointer;flag:Integer;var threadid:Integer):pointer;stdcall; external getdlsymaddress( "kernel32.dll" , functionname(1));