FPPS4/sys/kern/kern_namedobj.pas

158 lines
2.6 KiB
Plaintext

unit kern_namedobj;
{$mode ObjFPC}{$H+}
{$CALLING SysV_ABI_CDecl}
interface
uses
mqueue,
kern_named_id;
type
p_namedobj=^t_namedobj;
t_namedobj=packed object(t_id_named_desc)
link:TAILQ_ENTRY;
objp:Pointer;
end;
var
named_table:t_id_desc_table;
procedure named_table_init; //SYSINIT
function get_obj_name(objp:Pointer;objt:Integer;name:PChar):Boolean;
function sys_namedobj_create(name:PChar;objp:Pointer;objt:Integer):Integer;
function sys_namedobj_delete(id,objt:Integer):Integer;
const
NAMED_OBJT=$1000;
NAMED_DYNL=$2000;
implementation
uses
errno,
systm,
kern_thr,
kern_rwlock;
var
namedobj_list:TAILQ_HEAD=(tqh_first:nil;tqh_last:@namedobj_list.tqh_first);
namedobj_lock:Pointer;
procedure named_table_init;
begin
id_table_init(@named_table,1);
end;
procedure namedobj_add(data:p_namedobj);
begin
rw_wlock(namedobj_lock);
TAILQ_INSERT_TAIL(@namedobj_list,data,@data^.link);
rw_wunlock(namedobj_lock);
end;
procedure namedobj_rem(data:p_namedobj);
begin
rw_wlock(namedobj_lock);
TAILQ_REMOVE(@namedobj_list,data,@data^.link);
rw_wunlock(namedobj_lock);
end;
procedure namedobj_free(data:pointer);
begin
namedobj_rem(data);
FreeMem(data);
end;
function get_obj_name(objp:Pointer;objt:Integer;name:PChar):Boolean;
var
entry:p_namedobj;
begin
Result:=False;
objt:=Word(objt) or NAMED_OBJT;
rw_rlock(namedobj_lock);
entry:=TAILQ_FIRST(@namedobj_list);
while (entry<>nil) do
begin
if (entry^.objp=objp) and
(entry^.objt=objt) then
begin
Result:=True;
copystr(entry^.name,name,SizeOf(entry^.name),nil);
Break;
end;
entry:=TAILQ_NEXT(entry,@entry^.link);
end;
rw_runlock(namedobj_lock);
end;
function sys_namedobj_create(name:PChar;objp:Pointer;objt:Integer):Integer;
var
td:p_kthread;
_name:t_id_name;
obj:p_namedobj;
key:Integer;
begin
if (name=nil) then Exit(EINVAL);
td:=curkthread;
if (td=nil) then Exit(-1);
_name:=Default(t_id_name);
Result:=copyinstr(name,@_name,SizeOf(t_id_name),nil);
if (Result<>0) then Exit;
obj:=AllocMem(SizeOf(t_namedobj));
if (obj=nil) then Exit(ENOMEM);
obj^.desc.free:=@namedobj_free;
obj^.objt:=Word(objt) or NAMED_OBJT;
obj^.name:=_name;
obj^.objp:=objp;
namedobj_add(obj);
key:=0;
if not id_name_new(@named_table,obj,@key) then
begin
namedobj_free(obj);
Exit(EAGAIN);
end;
id_release(obj);
td^.td_retval[0]:=key;
Writeln('namedobj_create("',_name,'",0x',HexStr(QWORD(objp),11),',0x',HexStr(objt,4),'):',key);
Result:=0;
end;
function sys_namedobj_delete(id,objt:Integer):Integer;
var
obj:p_namedobj;
begin
Result:=ESRCH;
if not id_name_del(@named_table,id,Word(objt) or NAMED_OBJT,@obj) then Exit;
id_release(obj);
Result:=0;
end;
end.